added landing strip extractor

[perl-landing-airplanes.git] / trace-path.pl

diff --git a/trace-path.pl b/trace-path.pl
index c0d695d..3fd2935 100755 (executable)
--- a/trace-path.pl
+++ b/trace-path.pl
@@ -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,14 +43,41 @@ 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 );
+
+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);
+
+exit;
+
+$app->sync;
+
 our $event = SDL::Event->new;
 
 our $mouse_down = 0;
 
-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 );
-
 my ( $last_x, $last_y ) = ( 0,0 );
 
 our @path;