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
  17 our $app = SDL::App->new(
  18         -width  => $w,
  19         -height => $h,
  20         -depth  => 16,
  21 #       -flags=>SDL_DOUBLEBUF | SDL_HWSURFACE | SDL_HWACCEL,
  22         -title  => 'Trace mouse',
  23 );
  24
  25 our $event = SDL::Event->new;
  26
  27 our $mouse_down = 0;
  28
  29 our $white = SDL::Color->new( 0xff, 0xff, 0xff );
  30
  31 sub handle_events {
  32
  33         while ( $event->wait ) {
  34                 my $type = $event->type();
  35
  36                 if ( $type == SDL_MOUSEBUTTONDOWN() ) {
  37                         warn "mouse down ", $event->button_x, ' ', $event->button_y;
  38                         $mouse_down = 1;
  39                 } elsif ( $type == SDL_MOUSEBUTTONUP() ) {
  40                         warn "mouse up ", $event->button_x, ' ', $event->button_y;
  41                         $mouse_down = 0;
  42                 } elsif ( $type == SDL_QUIT() ) {
  43                         exit;
  44                 } elsif ( $type == SDL_KEYDOWN() ) {
  45                         warn "key down ", $event->key_name,$/;
  46                         exit if $event->key_name =~ m/^[xq]$/;
  47                 } elsif ( $type == SDL_KEYUP() ) {
  48                         warn "key up ", $event->key_name,$/;
  49                 } elsif ( $type == SDL_MOUSEMOTION() ) {
  50 #                       warn "mouse ", $event->motion_xrel, ' ', $event->motion_yrel;
  51                         warn "mouse $mouse_down @ ", $event->motion_x, ' ', $event->motion_y;
  52                         if ( $mouse_down ) {
  53                                 my $rect = SDL::Rect->new( -x => $event->motion_x, -y => $event->motion_y, -w => 3, -h => 3 );
  54                                 $app->fill( $rect, $white );
  55                                 $app->update( $rect );
  56                         }
  57                 } else {
  58                         warn "unknown $type\n";
  59                 }
  60         }
  61 };
  62
  63 while(1) {
  64         handle_events;
  65         $app->sync;
  66         $app->delay(1);
  67 }
  68
  69 1;