added landing strip extractor
authorDobrica Pavlinusic <dpavlin@rot13.org>
Wed, 19 May 2010 21:40:28 +0000 (23:40 +0200)
committerDobrica Pavlinusic <dpavlin@rot13.org>
Wed, 19 May 2010 21:40:28 +0000 (23:40 +0200)
basically, it's a mask, with drop-point in black, 000, and than
one by one lading points 00f, 0f0, 0ff, f00, f0f, ff0 while fff is
reserved for background. 808080 is used to mask lading strip size
if needed.

trace-path.pl

index c0d695d..3fd2935 100755 (executable)
@@ -20,12 +20,21 @@ my ( $w, $h ) = ( 800, 480 );
 my $mouse_trashold = 10;
 my $max_path_length = 200;
 
 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";
 }
 
 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,
 our $app = SDL::App->new(
        -width  => $w,
        -height => $h,
@@ -34,14 +43,41 @@ our $app = SDL::App->new(
        -title  => 'Trace mouse',
 );
 
        -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 $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;
 my ( $last_x, $last_y ) = ( 0,0 );
 
 our @path;