X-Git-Url: http://git.rot13.org/?p=perl-landing-airplanes.git;a=blobdiff_plain;f=trace-path.pl;h=afb304dec7a17a75d68cc67d7301d74552343298;hp=3611481d31779f5f53a2c114127463547c296f98;hb=80b4de017abe49c07dc34e57a430d3b8fa3421b7;hpb=88873314ed5427f7eb71ab8a3d175fedff746506 diff --git a/trace-path.pl b/trace-path.pl index 3611481..afb304d 100755 --- a/trace-path.pl +++ b/trace-path.pl @@ -30,11 +30,6 @@ sub debug { 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, @@ -43,34 +38,79 @@ 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; +our @masks; +our @landings; +foreach my $path ( glob 'artwork/world1/*mask*.png' ) { + warn "mask $path ", -s $path, " bytes\n"; -my @landing; + my $mask = SDL::Surface->new( + -name => $path, + -depth => 24, + ); + push @masks, $mask; -my $mask_step = 10; + $mask->blit( $mask->rect, $app ); + $app->sync; -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; + 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; } - print "\n"; - $y += $mask_step; + + warn "lading for $path ",dump(@landing); + + push @landings, [ @landing ]; } -warn 'lading ',dump(@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; @@ -83,21 +123,7 @@ sub reset_path { @path = () } sub curve { - 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]; - } - } + push @path, lading_points( $path[-2], $path[-1] ) if $#path > 1; if ( $#path < ( 4 * 2 - 1 ) ) { # less than 4 points warn "path too short ", dump @path; @@ -124,6 +150,20 @@ sub curve { 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 ) { @@ -141,19 +181,19 @@ sub handle_events { exit; } elsif ( $type == SDL_KEYDOWN() ) { my $key = $event->key_name; - debug 'key down', $key; + 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 - reset_path; - $app->fill( $app->rect, $black ); -# $app->update( $rect ); - $mask->blit( $mask->rect, $app, $app_rect ); - $app->sync; + 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; } else { warn "unknown key $key"; }