airplane bitmap
[perl-landing-airplanes.git] / trace-path.pl
1 #!/usr/bin/perl
2
3 use warnings;
4 use strict;
5
6 use SDL::App;
7 use SDL::Rect;
8 use SDL::Color;
9 use SDL::Constants;
10 use SDL::Event;
11 use Math::CatmullRom;
12 use Algorithm::Line::Bresenham qw(line);
13
14 use Carp qw(cluck);
15 use Data::Dump qw(dump);
16
17 use Airplane;
18 our @airplanes;
19
20 our $debug = 0;
21
22 my ( $w, $h ) = ( 800, 480 );
23 my $mouse_trashold = 10;
24 my $max_path_length = 200;
25
26 our $mouse_color = SDL::Color->new( 0x00, 0x00, 0x80 );
27 our $path_color  = SDL::Color->new( 0xff, 0xff, 0x80 );
28 our $black       = SDL::Color->new( 0x00, 0x00, 0x00 );
29
30 sub debug {
31         return unless $debug;
32         my ($package, $filename, $line) = caller;
33         warn '# ', dump( @_ ), " $filename +$line\n";
34 }
35
36 our $app = SDL::App->new(
37         -width  => $w,
38         -height => $h,
39         -depth  => 16,
40 #       -flags=>SDL_DOUBLEBUF | SDL_HWSURFACE | SDL_HWACCEL,
41         -title  => 'Trace mouse',
42 );
43
44 our @masks;
45 our @landings;
46 foreach my $path ( glob 'artwork/world1/*mask*.png' ) {
47
48         warn "mask $path ", -s $path, " bytes\n";
49
50         my $mask = SDL::Surface->new(
51                 -name => $path,
52                 -depth => 24,
53         );
54         push @masks, $mask;
55
56         $mask->blit( $mask->rect, $app );
57         $app->sync;
58
59         my @landing;
60         my $mask_step = 10;
61
62         my $y = 0;
63         foreach ( 0 .. $mask->height / $mask_step ) {
64                 printf "%3d: ", $_;
65                 my $x = 0;
66                 foreach ( 0 .. $mask->width / $mask_step ) {
67                         my $col = $mask->pixel( $x, $y );
68                         my $nr = 0;
69                         $nr += 4 if $col->r;
70                         $nr += 2 if $col->g;
71                         $nr += 1 if $col->b;
72                         $landing[$nr] = [ $x, $y ] unless defined $landing[$nr];
73                         printf "%02x%02x%02x:%d ", $col->r, $col->g, $col->b, $nr;
74                         $x += $mask_step;
75                 }
76                 print "\n";
77                 $y += $mask_step;
78         }
79
80         warn "lading for $path ",dump(@landing);
81
82         push @landings, [ @landing ];
83 }
84
85 my $current_mask = 0;
86
87 warn "# masks ",dump(@masks), " landings ", dump(@landings);
88
89 sub mask_hex {
90         my ( $i, $x, $y ) = @_;
91
92         my $col = $masks[$i]->pixel( $x, $y );
93         my $hex = sprintf '%02x%02x%02x', $col->r, $col->g, $col->b;
94         warn "mask $x $y $hex\n";
95         return $hex;
96 }
97
98 sub lading_points {
99         my ( $x, $y ) = @_;
100         my @points;
101         foreach my $i ( 0 .. $#masks ) {
102                 my $hex = mask_hex( $i, $x, $y );
103                 if ( $hex eq '000000' ) {
104                         warn "lading point $x $y from mask $i hex $hex\n";
105                         foreach ( 1 .. 6 ) {
106                                 push @points,
107                                         $landings[$i]->[$_]->[0],
108                                         $landings[$i]->[$_]->[1];
109                         }
110                 } else {
111                         debug $x, $y, $i, $hex, 'ignored';
112                 }
113                 warn "mask $i points ",dump( @points );
114         }
115         return @points;
116 }
117
118 our $event = SDL::Event->new;
119
120 our $mouse_down = 0;
121
122 my ( $last_x, $last_y ) = ( 0,0 );
123
124 our @path;
125 sub reset_path { @path = () }
126
127 sub curve {
128
129         push @path, lading_points( $path[-2], $path[-1] ) if $#path > 1;
130
131         if ( $#path < ( 4 * 2 - 1 ) ) { # less than 4 points
132                 warn "path too short ", dump @path;
133                 reset_path;
134                 return;
135         }
136
137         my $curve = Math::CatmullRom->new( @path );
138         my $points = $#path + 1 - 4; # remove start/end points
139         my @curve = $curve->curve( $points );
140         debug 'curve' => @curve;
141
142         my $i = 0;
143         while ( $i <= $#curve - 4 ) {
144                 line(
145                         int($curve[$i++]),
146                         int($curve[$i++]),
147                         int($curve[$i++]),
148                         int($curve[$i++]),
149                         sub { $app->pixel( @_, $path_color ) }
150                 );
151         }
152         push @airplanes, Airplane->new( $app );
153         $airplanes[-1]->set_path( @path );
154         $app->sync;
155         reset_path;
156 }
157
158 sub clear_screen {
159         my ( $mask ) = @_;
160         reset_path;
161         $app->fill( $app->rect, $black );
162         if ( defined $mask ) {
163                 warn "clear_screen $mask";
164                 $masks[$current_mask]->blit( $masks[$current_mask]->rect, $app, $app->rect );
165         } else {
166                 warn "clear_screen all masks";
167                 $_->blit( $_->rect, $app, $app->rect ) foreach @masks;
168         }
169         $app->sync;
170 }
171
172 sub handle_events {
173
174         while ( $event->poll ) {
175                 my $type = $event->type();
176
177                 if ( $type == SDL_MOUSEBUTTONDOWN() ) {
178                         debug 'mouse down', $event->button_x, $event->button_y;
179                         $mouse_down = 1;
180                 } elsif ( $type == SDL_MOUSEBUTTONUP() ) {
181                         debug 'mouse up', $event->button_x, $event->button_y;
182                         $mouse_down = 0;
183         
184                         curve;
185                 } elsif ( $type == SDL_QUIT() ) {
186                         exit;
187                 } elsif ( $type == SDL_KEYDOWN() ) {
188                         my $key = $event->key_name;
189                         warn 'key down', $key, $/;
190                         exit if $key =~ m/^[xq]$/;
191                         if ( $key eq 's' ) { # XXX draw curve
192                                 curve;
193                         } elsif ( $key eq 'backspace' || $key eq 'c' ) { # XXX clean screen
194                                 clear_screen;
195                         } elsif ( $key eq 'd' ) { # XXX toggle debug
196                                 $debug = ! $debug;
197                                 warn "debug $debug\n";
198                         } elsif ( $key eq 'm' ) { # XXX cycle masks
199                                 $current_mask++;
200                                 $current_mask = 0 if $current_mask > $#masks;
201                                 clear_screen $current_mask;
202                         } else {
203                                 warn "unknown key $key";
204                         }
205                 } elsif ( $type == SDL_KEYUP() ) {
206                         debug 'key up', $event->key_name;
207                 } elsif ( $type == SDL_MOUSEMOTION() ) {
208                         my ( $x, $y ) = ( $event->motion_x, $event->motion_y );
209                         #debug 'mouse', $mouse_down, $x, $y;
210                         my $d = sqrt( ( $x - $last_x ) ** 2 + ( $y - $last_y ) ** 2 );
211                         if ( $mouse_down && $d > $mouse_trashold ) {
212                                 if ( $#path < $max_path_length ) {
213                                         push @path, $x, $y;
214                                         my $rect = SDL::Rect->new( -x => $event->motion_x - 1, -y => $event->motion_y -1 , -w => 3, -h => 3 );
215                                         $app->fill( $rect, $mouse_color );
216                                         $app->update( $rect );
217                                         $last_x = $x;
218                                 $last_y = $y;
219                                 } else {
220                                         $mouse_down = 0;
221                                         curve;
222                                 }
223                         }
224                 } else {
225                         warn "unknown type $type\n";
226                 }
227         }
228 };
229
230 while(1) {
231         handle_events;
232         $_->draw foreach @airplanes;
233         $app->delay(50);
234         $app->sync;
235 }
236
237 1;