12 use Algorithm::Line::Bresenham qw(line);
15 use Data::Dump qw(dump);
19 my ( $w, $h ) = ( 800, 480 );
20 my $mouse_trashold = 10;
21 my $max_path_length = 200;
23 our $mouse_color = SDL::Color->new( 0x00, 0x00, 0x80 );
24 our $path_color = SDL::Color->new( 0xff, 0xff, 0x80 );
25 our $black = SDL::Color->new( 0x00, 0x00, 0x00 );
29 my ($package, $filename, $line) = caller;
30 warn '# ', dump( @_ ), " $filename +$line\n";
33 our $app = SDL::App->new(
37 # -flags=>SDL_DOUBLEBUF | SDL_HWSURFACE | SDL_HWACCEL,
38 -title => 'Trace mouse',
43 foreach my $path ( glob 'artwork/world1/*mask*.png' ) {
45 warn "mask $path ", -s $path, " bytes\n";
47 my $mask = SDL::Surface->new(
53 $mask->blit( $mask->rect, $app );
60 foreach ( 0 .. $mask->height / $mask_step ) {
63 foreach ( 0 .. $mask->width / $mask_step ) {
64 my $col = $mask->pixel( $x, $y );
69 $landing[$nr] = [ $x, $y ] unless defined $landing[$nr];
70 printf "%02x%02x%02x:%d ", $col->r, $col->g, $col->b, $nr;
77 warn "lading for $path ",dump(@landing);
79 push @landings, [ @landing ];
84 warn "# masks ",dump(@masks), " landings ", dump(@landings);
87 my ( $i, $x, $y ) = @_;
89 my $col = $masks[$i]->pixel( $x, $y );
90 my $hex = sprintf '%02x%02x%02x', $col->r, $col->g, $col->b;
91 warn "mask $x $y $hex\n";
98 foreach my $i ( 0 .. $#masks ) {
99 my $hex = mask_hex( $i, $x, $y );
100 if ( $hex eq '000000' ) {
101 warn "lading point $x $y from mask $i hex $hex\n";
104 $landings[$i]->[$_]->[0],
105 $landings[$i]->[$_]->[1];
108 debug $x, $y, $i, $hex, 'ignored';
110 warn "mask $i points ",dump( @points );
115 our $event = SDL::Event->new;
119 my ( $last_x, $last_y ) = ( 0,0 );
122 sub reset_path { @path = () }
126 push @path, lading_points( $path[-2], $path[-1] ) if $#path > 1;
128 if ( $#path < ( 4 * 2 - 1 ) ) { # less than 4 points
129 warn "path too short ", dump @path;
134 my $curve = Math::CatmullRom->new( @path );
135 my $points = $#path + 1 - 4; # remove start/end points
136 my @curve = $curve->curve( $points );
137 debug 'curve' => @curve;
140 while ( $i <= $#curve - 4 ) {
146 sub { $app->pixel( @_, $path_color ) }
156 $app->fill( $app->rect, $black );
157 if ( defined $mask ) {
158 warn "clear_screen $mask";
159 $masks[$current_mask]->blit( $masks[$current_mask]->rect, $app, $app->rect );
161 warn "clear_screen all masks";
162 $_->blit( $_->rect, $app, $app->rect ) foreach @masks;
169 while ( $event->wait ) {
170 my $type = $event->type();
172 if ( $type == SDL_MOUSEBUTTONDOWN() ) {
173 debug 'mouse down', $event->button_x, $event->button_y;
175 } elsif ( $type == SDL_MOUSEBUTTONUP() ) {
176 debug 'mouse up', $event->button_x, $event->button_y;
180 } elsif ( $type == SDL_QUIT() ) {
182 } elsif ( $type == SDL_KEYDOWN() ) {
183 my $key = $event->key_name;
184 warn 'key down', $key, $/;
185 exit if $key =~ m/^[xq]$/;
186 if ( $key eq 's' ) { # XXX draw curve
188 } elsif ( $key eq 'backspace' || $key eq 'c' ) { # XXX clean screen
190 } elsif ( $key eq 'd' ) { # XXX toggle debug
192 warn "debug $debug\n";
193 } elsif ( $key eq 'm' ) { # XXX cycle masks
195 $current_mask = 0 if $current_mask > $#masks;
196 clear_screen $current_mask;
198 warn "unknown key $key";
200 } elsif ( $type == SDL_KEYUP() ) {
201 debug 'key up', $event->key_name;
202 } elsif ( $type == SDL_MOUSEMOTION() ) {
203 my ( $x, $y ) = ( $event->motion_x, $event->motion_y );
204 #debug 'mouse', $mouse_down, $x, $y;
205 my $d = sqrt( ( $x - $last_x ) ** 2 + ( $y - $last_y ) ** 2 );
206 if ( $mouse_down && $d > $mouse_trashold ) {
207 if ( $#path < $max_path_length ) {
209 my $rect = SDL::Rect->new( -x => $event->motion_x - 1, -y => $event->motion_y -1 , -w => 3, -h => 3 );
210 $app->fill( $rect, $mouse_color );
211 $app->update( $rect );
220 warn "unknown type $type\n";