X-Git-Url: http://git.rot13.org/?a=blobdiff_plain;ds=sidebyside;f=trace-path.pl;h=5f9884ad8cf6a66c3fabc2941d6ea534bffd3aab;hb=009020449eecf3b71c575224c2051e166a17ab53;hp=77a378dd96943092ec954274b7d574fe20148732;hpb=01ae0a1734084fede2462c006ba650433300238d;p=perl-landing-airplanes.git diff --git a/trace-path.pl b/trace-path.pl index 77a378d..5f9884a 100755 --- a/trace-path.pl +++ b/trace-path.pl @@ -11,13 +11,21 @@ use SDL::Event; use Math::CatmullRom; #use Algorithm::Line::Bresenham; -use Carp qw/confess/; -use Data::Dump qw/dump/; +use Carp qw(cluck); +use Data::Dump qw(dump); + +our $debug = 0; my ( $w, $h ) = ( 800, 480 ); my $mouse_trashold = 10; my $max_path_length = 200; +sub debug { + return unless $debug; + my ($package, $filename, $line) = caller; + warn '# ', dump( @_ ), " $filename +$line\n"; +} + our $app = SDL::App->new( -width => $w, -height => $h, @@ -42,7 +50,7 @@ sub curve { return unless $#path > 4; my $curve = Math::CatmullRom->new( splice @path, 0, $#path + $#path / 2 ); my @curve = $curve->curve( $mouse_trashold * $max_path_length / 2 ); - warn "curve ", dump @curve; + debug 'curve' => @curve; my $i = 0; while ( $i < $#curve ) { @@ -58,32 +66,36 @@ sub handle_events { my $type = $event->type(); if ( $type == SDL_MOUSEBUTTONDOWN() ) { - warn "mouse down ", $event->button_x, ' ', $event->button_y; + debug 'mouse down', $event->button_x, $event->button_y; $mouse_down = 1; } elsif ( $type == SDL_MOUSEBUTTONUP() ) { - warn "mouse up ", $event->button_x, ' ', $event->button_y; + debug 'mouse up', $event->button_x, $event->button_y; $mouse_down = 0; curve; } elsif ( $type == SDL_QUIT() ) { exit; } elsif ( $type == SDL_KEYDOWN() ) { my $key = $event->key_name; - warn "key down $key\n"; + debug 'key down', $key; exit if $key =~ m/^[xq]$/; - if ( $key eq 's' ) { + if ( $key eq 's' ) { # XXX draw curve curve; - } elsif ( $key eq 'd' ) { + } elsif ( $key eq 'backspace' ) { # XXX clean screen @path = (); my $rect = SDL::Rect->new( -x => 0, -y => 0, -w => $w, -h => $h ); $app->fill( $rect, $black ); $app->update( $rect ); + } elsif ( $key eq 'd' ) { # XXX toggle debug + $debug = ! $debug; + warn "debug $debug\n"; + } else { + warn "unknown key $key"; } } elsif ( $type == SDL_KEYUP() ) { - warn "key up ", $event->key_name,$/; + debug 'key up', $event->key_name; } elsif ( $type == SDL_MOUSEMOTION() ) { -# warn "mouse ", $event->motion_xrel, ' ', $event->motion_yrel; my ( $x, $y ) = ( $event->motion_x, $event->motion_y ); - warn "mouse $mouse_down @ $x*$y\n"; + debug 'mouse', $mouse_down, $x, $y; my $dx = abs( $last_x - $x ); my $dy = abs( $last_y - $y ); if ( $mouse_down && ( $dx > $mouse_trashold || $dy > $mouse_trashold ) ) { @@ -100,7 +112,7 @@ sub handle_events { } } } else { - warn "unknown $type\n"; + warn "unknown type $type\n"; } } };