trace-path.pl

   1 #!/usr/bin/perl
   2
   3 use warnings;
   4 use strict;
   5
   6 use SDL::App;
   7 use SDL::Rect;
   8 use SDL::Color;
   9 use SDL::Constants;
  10 use SDL::Event;
  11
  12 use Carp qw/confess/;
  13 use Data::Dump qw/dump/;
  14
  15 my ( $w, $h ) = ( 800, 480 );
  16 my $mouse_trashold = 10;
  17
  18 our $app = SDL::App->new(
  19         -width  => $w,
  20         -height => $h,
  21         -depth  => 16,
  22 #       -flags=>SDL_DOUBLEBUF | SDL_HWSURFACE | SDL_HWACCEL,
  23         -title  => 'Trace mouse',
  24 );
  25
  26 our $event = SDL::Event->new;
  27
  28 our $mouse_down = 0;
  29
  30 our $white = SDL::Color->new( 0xff, 0xff, 0xff );
  31
  32 my ( $last_x, $last_y ) = ( 0,0 );
  33
  34 sub handle_events {
  35
  36         while ( $event->wait ) {
  37                 my $type = $event->type();
  38
  39                 if ( $type == SDL_MOUSEBUTTONDOWN() ) {
  40                         warn "mouse down ", $event->button_x, ' ', $event->button_y;
  41                         $mouse_down = 1;
  42                 } elsif ( $type == SDL_MOUSEBUTTONUP() ) {
  43                         warn "mouse up ", $event->button_x, ' ', $event->button_y;
  44                         $mouse_down = 0;
  45                 } elsif ( $type == SDL_QUIT() ) {
  46                         exit;
  47                 } elsif ( $type == SDL_KEYDOWN() ) {
  48                         warn "key down ", $event->key_name,$/;
  49                         exit if $event->key_name =~ m/^[xq]$/;
  50                 } elsif ( $type == SDL_KEYUP() ) {
  51                         warn "key up ", $event->key_name,$/;
  52                 } elsif ( $type == SDL_MOUSEMOTION() ) {
  53 #                       warn "mouse ", $event->motion_xrel, ' ', $event->motion_yrel;
  54                         my ( $x, $y ) = ( $event->motion_x, $event->motion_y );
  55                         warn "mouse $mouse_down @ $x*$y\n";
  56                         my $dx = abs( $last_x - $x );
  57                         my $dy = abs( $last_y - $y );
  58                         if ( $mouse_down && ( $dx > $mouse_trashold || $dy > $mouse_trashold ) ) {
  59                                 my $rect = SDL::Rect->new( -x => $event->motion_x, -y => $event->motion_y, -w => 3, -h => 3 );
  60                                 $app->fill( $rect, $white );
  61                                 $app->update( $rect );
  62                                 $last_x = $x;
  63                                 $last_y = $y;
  64                         }
  65                 } else {
  66                         warn "unknown $type\n";
  67                 }
  68         }
  69 };
  70
  71 while(1) {
  72         handle_events;
  73         $app->sync;
  74         $app->delay(1);
  75 }
  76
  77 1;