X-Git-Url: http://git.rot13.org/?p=perl-landing-airplanes.git;a=blobdiff_plain;f=trace-path.pl;h=b97779ca9fa014b072c3958f0c8aa8984c1abb25;hp=9a27b35349363a7cf69903e6408cb26cb6e40cfb;hb=a8d7e58705cae0a43cbbc3b996630a1877c81f26;hpb=bf08ab193ba6aeed8d356123374505f543bb67a0 diff --git a/trace-path.pl b/trace-path.pl index 9a27b35..b97779c 100755 --- a/trace-path.pl +++ b/trace-path.pl @@ -8,12 +8,31 @@ use SDL::Rect; use SDL::Color; use SDL::Constants; use SDL::Event; +use Math::CatmullRom; +use Algorithm::Line::Bresenham qw(line); +use Math::Bezier; -use Carp qw/confess/; -use Data::Dump qw/dump/; +use Carp qw(cluck); +use Data::Dump qw(dump); + +use Airplane; +our @airplanes; + +our $debug = 0; 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"; +} our $app = SDL::App->new( -width => $w, @@ -23,55 +42,213 @@ our $app = SDL::App->new( -title => 'Trace mouse', ); +our @masks; +our @landings; +foreach my $path ( glob 'artwork/world1/*mask*.png' ) { + + warn "mask $path ", -s $path, " bytes\n"; + + my $mask = SDL::Surface->new( + -name => $path, + -depth => 24, + ); + push @masks, $mask; + + $mask->blit( $mask->rect, $app ); + $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 for $path ",dump(@landing); + + push @landings, [ @landing ]; +} + +my $current_mask = 0; + +warn "# masks ",dump(@masks), " landings ", dump(@landings); + +sub mask_hex { + my ( $i, $x, $y ) = @_; + + my $col = $masks[$i]->pixel( $x, $y ); + my $hex = sprintf '%02x%02x%02x', $col->r, $col->g, $col->b; + warn "mask $x $y $hex\n"; + return $hex; +} + +sub lading_points { + my ( $x, $y ) = @_; + my @points; + foreach my $i ( 0 .. $#masks ) { + my $hex = mask_hex( $i, $x, $y ); + if ( $hex eq '000000' ) { + warn "lading point $x $y from mask $i hex $hex\n"; + foreach ( 1 .. 6 ) { + push @points, + $landings[$i]->[$_]->[0], + $landings[$i]->[$_]->[1]; + } + } else { + debug $x, $y, $i, $hex, 'ignored'; + } + warn "mask $i points ",dump( @points ); + } + return @points; +} + our $event = SDL::Event->new; our $mouse_down = 0; -our $white = SDL::Color->new( 0xff, 0xff, 0xff ); - my ( $last_x, $last_y ) = ( 0,0 ); +our @path; +sub reset_path { @path = () } + +sub curve_catmull_rom { + + 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 + return $curve->curve( $points ); +} + +sub curve_bezier { + my $curve = Math::Bezier->new( @path ); + return $curve->curve( $#path + 1 ); +} + +our $curve_type = 0; + +sub curve { + # add landing path points + push @path, lading_points( $path[-2], $path[-1] ) if $#path > 1; + + my $type = 1; + + my @curve = $curve_type ? curve_catmull_rom : curve_bezier; + debug 'curve' => @curve; + + my $i = 0; + while ( $i <= $#curve - 4 ) { + line( + int($curve[$i++]), + int($curve[$i++]), + int($curve[$i++]), + int($curve[$i++]), + sub { $app->pixel( @_, $path_color ) } + ); + } + $app->sync; + + push @airplanes, Airplane->new( $app ); + $airplanes[-1]->set_path( @path ); + reset_path; +} + +sub clear_screen { + my ( $mask ) = @_; + reset_path; + $app->fill( $app->rect, $black ); + if ( defined $mask ) { + warn "clear_screen $mask"; + $masks[$current_mask]->blit( $masks[$current_mask]->rect, $app, $app->rect ); + } else { + warn "clear_screen all masks"; + $_->blit( $_->rect, $app, $app->rect ) foreach @masks; + } + $app->sync; +} + sub handle_events { - while ( $event->wait ) { + while ( $event->poll ) { 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() ) { - warn "key down ", $event->key_name,$/; - exit if $event->key_name =~ m/^[xq]$/; + my $key = $event->key_name; + warn 'key down', $key, $/; + exit if $key =~ m/^[xq]$/; + if ( $key eq 's' ) { # XXX draw curve + curve; + } elsif ( $key eq 'backspace' || $key eq 'c' ) { # XXX clean screen + clear_screen; + } elsif ( $key eq 'd' ) { # XXX toggle debug + $debug = ! $debug; + warn "debug $debug\n"; + } elsif ( $key eq 'm' ) { # XXX cycle masks + $current_mask++; + $current_mask = 0 if $current_mask > $#masks; + clear_screen $current_mask; + } elsif ( $key eq 't' ) { # XXX curve type + $curve_type = ! $curve_type; + } 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"; - my $dx = abs( $last_x - $x ); - my $dy = abs( $last_y - $y ); - if ( $mouse_down && ( $dx > $mouse_trashold || $dy > $mouse_trashold ) ) { - my $rect = SDL::Rect->new( -x => $event->motion_x, -y => $event->motion_y, -w => 3, -h => 3 ); - $app->fill( $rect, $white ); - $app->update( $rect ); - $last_x = $x; + #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 - 1, -y => $event->motion_y -1 , -w => 3, -h => 3 ); + $app->fill( $rect, $mouse_color ); + $app->update( $rect ); + $last_x = $x; $last_y = $y; + } else { + $mouse_down = 0; + curve; + } } } else { - warn "unknown $type\n"; + warn "unknown type $type\n"; } } }; while(1) { handle_events; + $_->draw foreach @airplanes; + $app->delay(50); $app->sync; - $app->delay(1); } 1;