X-Git-Url: http://git.rot13.org/?p=perl-landing-airplanes.git;a=blobdiff_plain;f=trace-path.pl;h=3611481d31779f5f53a2c114127463547c296f98;hp=5f9884ad8cf6a66c3fabc2941d6ea534bffd3aab;hb=27cbedf1109d2d7ecc16c8845b6b94e100b84bde;hpb=009020449eecf3b71c575224c2051e166a17ab53 diff --git a/trace-path.pl b/trace-path.pl index 5f9884a..3611481 100755 --- a/trace-path.pl +++ b/trace-path.pl @@ -9,7 +9,7 @@ use SDL::Color; use SDL::Constants; use SDL::Event; use Math::CatmullRom; -#use Algorithm::Line::Bresenham; +use Algorithm::Line::Bresenham qw(line); use Carp qw(cluck); use Data::Dump qw(dump); @@ -20,12 +20,21 @@ my ( $w, $h ) = ( 800, 480 ); my $mouse_trashold = 10; my $max_path_length = 200; +our $mouse_color = SDL::Color->new( 0x00, 0x00, 0x80 ); +our $path_color = SDL::Color->new( 0xff, 0xff, 0x80 ); +our $black = SDL::Color->new( 0x00, 0x00, 0x00 ); + sub debug { return unless $debug; my ($package, $filename, $line) = caller; warn '# ', dump( @_ ), " $filename +$line\n"; } +my $mask = SDL::Surface->new( + -name => 'artwork/world1/a-mask.png', + -depth => 24, +); + our $app = SDL::App->new( -width => $w, -height => $h, @@ -34,30 +43,85 @@ our $app = SDL::App->new( -title => 'Trace mouse', ); +our $app_rect = SDL::Rect->new( -x => 0, -y => 0, -width => $w, -height => $h ); +$mask->blit( $mask->rect, $app, $app_rect ); +$app->sync; + + +my @landing; + +my $mask_step = 10; + +my $y = 0; +foreach ( 0 .. $mask->height / $mask_step ) { + printf "%3d: ", $_; + my $x = 0; + foreach ( 0 .. $mask->width / $mask_step ) { + my $col = $mask->pixel( $x, $y ); + my $nr = 0; + $nr += 4 if $col->r; + $nr += 2 if $col->g; + $nr += 1 if $col->b; + $landing[$nr] = [ $x, $y ] unless defined $landing[$nr]; + printf "%02x%02x%02x:%d ", $col->r, $col->g, $col->b, $nr; + $x += $mask_step; + } + print "\n"; + $y += $mask_step; +} + +warn 'lading ',dump(@landing); + our $event = SDL::Event->new; our $mouse_down = 0; -our $white = SDL::Color->new( 0xff, 0xff, 0xff ); -our $red = SDL::Color->new( 0xff, 0x00, 0x00 ); -our $black = SDL::Color->new( 0x00, 0x00, 0x00 ); - my ( $last_x, $last_y ) = ( 0,0 ); -my @path; +our @path; +sub reset_path { @path = () } 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 ); + + if ( $#path < 1 ) { + warn "path too short ", dump @path; + reset_path; + return; + } + + my $mask_col = $mask->pixel( $path[-2], $path[-1] ); + my $mask_hex = sprintf '%02x%02x%02x', $mask_col->r, $mask_col->g, $mask_col->b; + warn "mask $path[-2] $path[1] $mask_hex\n"; + + if ( $mask_hex eq '000000' ) { # push landing point at path end + foreach ( 1 .. 6 ) { + push @path, $landing[$_]->[0], $landing[$_]->[1]; + } + } + + if ( $#path < ( 4 * 2 - 1 ) ) { # less than 4 points + warn "path too short ", dump @path; + reset_path; + return; + } + + my $curve = Math::CatmullRom->new( @path ); + my $points = $#path + 1 - 4; # remove start/end points + my @curve = $curve->curve( $points ); debug 'curve' => @curve; my $i = 0; - while ( $i < $#curve ) { - my $rect = SDL::Rect->new( -x => int($curve[$i++]), -y => int($curve[$i++]), -w => 1, -h => 1 ); - $app->fill( $rect, $red ); - $app->update( $rect ); + while ( $i <= $#curve - 4 ) { + line( + int($curve[$i++]), + int($curve[$i++]), + int($curve[$i++]), + int($curve[$i++]), + sub { $app->pixel( @_, $path_color ) } + ); } + $app->sync; + reset_path; } sub handle_events { @@ -71,6 +135,7 @@ sub handle_events { } elsif ( $type == SDL_MOUSEBUTTONUP() ) { debug 'mouse up', $event->button_x, $event->button_y; $mouse_down = 0; + curve; } elsif ( $type == SDL_QUIT() ) { exit; @@ -80,11 +145,12 @@ sub handle_events { exit if $key =~ m/^[xq]$/; if ( $key eq 's' ) { # XXX draw curve curve; - } 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 'backspace' || $key eq 'c' ) { # XXX clean screen + reset_path; + $app->fill( $app->rect, $black ); +# $app->update( $rect ); + $mask->blit( $mask->rect, $app, $app_rect ); + $app->sync; } elsif ( $key eq 'd' ) { # XXX toggle debug $debug = ! $debug; warn "debug $debug\n"; @@ -95,14 +161,13 @@ sub handle_events { debug 'key up', $event->key_name; } elsif ( $type == SDL_MOUSEMOTION() ) { my ( $x, $y ) = ( $event->motion_x, $event->motion_y ); - 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 ) ) { + #debug 'mouse', $mouse_down, $x, $y; + my $d = sqrt( ( $x - $last_x ) ** 2 + ( $y - $last_y ) ** 2 ); + if ( $mouse_down && $d > $mouse_trashold ) { if ( $#path < $max_path_length ) { push @path, $x, $y; - my $rect = SDL::Rect->new( -x => $event->motion_x, -y => $event->motion_y, -w => 3, -h => 3 ); - $app->fill( $rect, $white ); + my $rect = SDL::Rect->new( -x => $event->motion_x - 1, -y => $event->motion_y -1 , -w => 3, -h => 3 ); + $app->fill( $rect, $mouse_color ); $app->update( $rect ); $last_x = $x; $last_y = $y;