draw dots on mouse down

diff --git a/trace-path.pl b/trace-path.pl
new file mode 100755 (executable)
index 0000000..8232a2a
--- /dev/null
+++ b/trace-path.pl
@@ -0,0 +1,69 @@
+#!/usr/bin/perl
+
+use warnings;
+use strict;
+
+use SDL::App;
+use SDL::Rect;
+use SDL::Color;
+use SDL::Constants;
+use SDL::Event;
+
+use Carp qw/confess/;
+use Data::Dump qw/dump/;
+
+my ( $w, $h ) = ( 800, 480 );
+
+our $app = SDL::App->new(
+       -width  => $w,
+       -height => $h,
+       -depth  => 16,
+#      -flags=>SDL_DOUBLEBUF | SDL_HWSURFACE | SDL_HWACCEL,
+       -title  => 'Trace mouse',
+);
+
+our $event = SDL::Event->new;
+
+our $mouse_down = 0;
+
+our $white = SDL::Color->new( 0xff, 0xff, 0xff );
+
+sub handle_events {
+
+       while ( $event->wait ) {
+               my $type = $event->type();
+
+               if ( $type == SDL_MOUSEBUTTONDOWN() ) {
+                       warn "mouse down ", $event->button_x, ' ', $event->button_y;
+                       $mouse_down = 1;
+               } elsif ( $type == SDL_MOUSEBUTTONUP() ) {
+                       warn "mouse up ", $event->button_x, ' ', $event->button_y;
+                       $mouse_down = 0;
+               } elsif ( $type == SDL_QUIT() ) {
+                       exit;
+               } elsif ( $type == SDL_KEYDOWN() ) {
+                       warn "key down ", $event->key_name,$/;
+                       exit if $event->key_name =~ m/^[xq]$/;
+               } elsif ( $type == SDL_KEYUP() ) {
+                       warn "key up ", $event->key_name,$/;
+               } elsif ( $type == SDL_MOUSEMOTION() ) {
+#                      warn "mouse ", $event->motion_xrel, ' ', $event->motion_yrel;
+                       warn "mouse $mouse_down @ ", $event->motion_x, ' ', $event->motion_y;
+                       if ( $mouse_down ) {
+                               my $rect = SDL::Rect->new( -x => $event->motion_x, -y => $event->motion_y, -w => 3, -h => 3 );
+                               $app->fill( $rect, $white );
+                               $app->update( $rect );
+                       }
+               } else {
+                       warn "unknown $type\n";
+               }
+       }
+};
+
+while(1) {
+       handle_events;
+       $app->sync;
+       $app->delay(1);
+}
+
+1;