12 use Algorithm::Line::Bresenham qw(line);
15 use Data::Dump qw(dump);
22 my ( $w, $h ) = ( 800, 480 );
23 my $mouse_trashold = 10;
24 my $max_path_length = 200;
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 );
32 my ($package, $filename, $line) = caller;
33 warn '# ', dump( @_ ), " $filename +$line\n";
36 our $app = SDL::App->new(
40 # -flags=>SDL_DOUBLEBUF | SDL_HWSURFACE | SDL_HWACCEL,
41 -title => 'Trace mouse',
46 foreach my $path ( glob 'artwork/world1/*mask*.png' ) {
48 warn "mask $path ", -s $path, " bytes\n";
50 my $mask = SDL::Surface->new(
56 $mask->blit( $mask->rect, $app );
63 foreach ( 0 .. $mask->height / $mask_step ) {
66 foreach ( 0 .. $mask->width / $mask_step ) {
67 my $col = $mask->pixel( $x, $y );
72 $landing[$nr] = [ $x, $y ] unless defined $landing[$nr];
73 printf "%02x%02x%02x:%d ", $col->r, $col->g, $col->b, $nr;
80 warn "lading for $path ",dump(@landing);
82 push @landings, [ @landing ];
87 warn "# masks ",dump(@masks), " landings ", dump(@landings);
90 my ( $i, $x, $y ) = @_;
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";
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";
107 $landings[$i]->[$_]->[0],
108 $landings[$i]->[$_]->[1];
111 debug $x, $y, $i, $hex, 'ignored';
113 warn "mask $i points ",dump( @points );
118 our $event = SDL::Event->new;
122 my ( $last_x, $last_y ) = ( 0,0 );
125 sub reset_path { @path = () }
127 sub curve_catmull_rom {
129 if ( $#path < ( 4 * 2 - 1 ) ) { # less than 4 points
130 warn "path too short ", dump @path;
135 my $curve = Math::CatmullRom->new( @path );
136 my $points = $#path + 1 - 4; # remove start/end points
137 my @curve = $curve->curve( $points );
138 debug 'curve' => @curve;
141 while ( $i <= $#curve - 4 ) {
147 sub { $app->pixel( @_, $path_color ) }
150 push @airplanes, Airplane->new( $app );
151 $airplanes[-1]->set_path( @path );
157 # add landing path points
158 push @path, lading_points( $path[-2], $path[-1] ) if $#path > 1;
171 $app->fill( $app->rect, $black );
172 if ( defined $mask ) {
173 warn "clear_screen $mask";
174 $masks[$current_mask]->blit( $masks[$current_mask]->rect, $app, $app->rect );
176 warn "clear_screen all masks";
177 $_->blit( $_->rect, $app, $app->rect ) foreach @masks;
184 while ( $event->poll ) {
185 my $type = $event->type();
187 if ( $type == SDL_MOUSEBUTTONDOWN() ) {
188 debug 'mouse down', $event->button_x, $event->button_y;
190 } elsif ( $type == SDL_MOUSEBUTTONUP() ) {
191 debug 'mouse up', $event->button_x, $event->button_y;
194 } elsif ( $type == SDL_QUIT() ) {
196 } elsif ( $type == SDL_KEYDOWN() ) {
197 my $key = $event->key_name;
198 warn 'key down', $key, $/;
199 exit if $key =~ m/^[xq]$/;
200 if ( $key eq 's' ) { # XXX draw curve
202 } elsif ( $key eq 'backspace' || $key eq 'c' ) { # XXX clean screen
204 } elsif ( $key eq 'd' ) { # XXX toggle debug
206 warn "debug $debug\n";
207 } elsif ( $key eq 'm' ) { # XXX cycle masks
209 $current_mask = 0 if $current_mask > $#masks;
210 clear_screen $current_mask;
212 warn "unknown key $key";
214 } elsif ( $type == SDL_KEYUP() ) {
215 debug 'key up', $event->key_name;
216 } elsif ( $type == SDL_MOUSEMOTION() ) {
217 my ( $x, $y ) = ( $event->motion_x, $event->motion_y );
218 #debug 'mouse', $mouse_down, $x, $y;
219 my $d = sqrt( ( $x - $last_x ) ** 2 + ( $y - $last_y ) ** 2 );
220 if ( $mouse_down && $d > $mouse_trashold ) {
221 if ( $#path < $max_path_length ) {
223 my $rect = SDL::Rect->new( -x => $event->motion_x - 1, -y => $event->motion_y -1 , -w => 3, -h => 3 );
224 $app->fill( $rect, $mouse_color );
225 $app->update( $rect );
234 warn "unknown type $type\n";
241 $_->draw foreach @airplanes;