47 |
# path traversed |
# path traversed |
48 |
my @directions; |
my @directions; |
49 |
|
|
50 |
my @found; |
my @shapes_found; |
51 |
|
|
52 |
|
my @shapes_start = ( '0,0' ); #( qw/0,0 1,0 0,3/ ); |
53 |
|
|
54 |
sub draw { |
sub draw { |
55 |
my $o = 0; |
my $o = 0; |
69 |
$trace[ $pos ] = $board[ $pos ]; |
$trace[ $pos ] = $board[ $pos ]; |
70 |
} |
} |
71 |
|
|
72 |
|
my ( $tr_x, $tr_y ); |
73 |
|
|
74 |
|
sub pos_x_y { |
75 |
|
my $y = int($pos / ($ll*2)); |
76 |
|
my $x = int(($pos % $ll) / 2); |
77 |
|
|
78 |
|
$tr_x = $x unless defined $tr_x; |
79 |
|
$tr_y = $y unless defined $tr_y; |
80 |
|
|
81 |
|
$tr_x = $x if $x > $tr_x && $y == $tr_y; |
82 |
|
$tr_y = $y if $y < $tr_y && $x == $tr_x; |
83 |
|
|
84 |
|
warn "## pos_x_y $pos -> $x,$y\n"; |
85 |
|
|
86 |
|
return ($x,$y) if wantarray; |
87 |
|
return "$x,$y"; |
88 |
|
} |
89 |
|
|
90 |
sub move { |
sub move { |
|
warn "move $step $step_name[$step]\n"; |
|
91 |
$pos += $move_by[ $step ]; |
$pos += $move_by[ $step ]; |
92 |
trace; |
trace; |
93 |
$pos += $move_by[ $step ]; |
$pos += $move_by[ $step ]; |
94 |
trace; |
trace; |
95 |
push @directions, $step; |
push @directions, $step; |
96 |
|
warn "move $step $step_name[$step] to ", scalar pos_x_y, "\n"; |
97 |
} |
} |
98 |
|
|
99 |
sub follow { |
sub follow { |
118 |
$trace[ $turn_pos ] = $old; |
$trace[ $turn_pos ] = $old; |
119 |
|
|
120 |
if ( $board[ $turn_pos ] =~ $ok_path ) { |
if ( $board[ $turn_pos ] =~ $ok_path ) { |
121 |
warn "OK can_turn $try_step $step_name[$try_step] turn_pos = $turn_pos b($board[$turn_pos]) t($trace[$turn_pos])"; |
warn "OK can_turn $try_step $step_name[$try_step] turn_pos = $turn_pos b($board[$turn_pos]) t($trace[$turn_pos])\n"; |
122 |
$step = $try_step; |
$step = $try_step; |
123 |
return 1; |
return 1; |
124 |
} else { |
} else { |
125 |
warn "NOPE can_turn $try_step $step_name[$try_step] turn_pos = $turn_pos b($board[$turn_pos]) t($trace[$turn_pos])"; |
warn "NOPE can_turn $try_step $step_name[$try_step] turn_pos = $turn_pos b($board[$turn_pos]) t($trace[$turn_pos])\n"; |
126 |
return 0; |
return 0; |
127 |
} |
} |
128 |
} |
} |
170 |
warn draw( @trace ); |
warn draw( @trace ); |
171 |
|
|
172 |
if ( $debug ) { |
if ( $debug ) { |
173 |
|
warn "## tr: $tr_x,$tr_y\n"; |
174 |
print "WAIT> press enter | ",show_directions; my $foo = <STDIN>; |
print "WAIT> press enter | ",show_directions; my $foo = <STDIN>; |
175 |
} |
} |
176 |
} |
} |
177 |
|
|
178 |
push @found, { x => $x, y => $y, len => $len, directions => show_directions }; |
push @shapes_found, { x => $x, y => $y, len => $len, directions => show_directions }; |
179 |
|
|
180 |
warn ">>> ended at $pos, line length: $len, directions traversed: ",show_directions,"\n"; |
warn ">>> ended at $pos, line length: $len, directions traversed: ",show_directions,"\n"; |
181 |
|
|
182 |
|
my $tr = "$tr_x,$tr_y"; |
183 |
|
if ( ! grep( /\Q$tr\E/, @shapes_start ) && $tr_x < 8 ) { |
184 |
|
print "INFO: added top-right $tr\n"; |
185 |
|
push @shapes_start, $tr; |
186 |
|
} |
187 |
|
|
188 |
print "WAIT> press enter"; my $foo = <STDIN>; |
print "WAIT> press enter"; my $foo = <STDIN>; |
189 |
|
|
190 |
return $len; |
return $len; |
191 |
} |
} |
192 |
|
|
193 |
my $shapes = '0,0 1,0 0,3'; |
foreach my $start ( @shapes_start ) { |
|
|
|
|
foreach my $start ( split(/\s/,$shapes) ) { |
|
194 |
my $len = shape( split(/,/,$start) ); |
my $len = shape( split(/,/,$start) ); |
195 |
warn "## $start has $len elements\n"; |
warn "## $start has $len elements\n"; |
196 |
} |
} |
197 |
|
|
198 |
print ">>> RESULTS:\n"; |
print ">>> RESULTS:\n"; |
199 |
foreach my $r ( @found ) { |
foreach my $r ( @shapes_found ) { |
200 |
printf "%2d,%-2d len: %-4d directions: %s\n", $r->{x}, $r->{y}, $r->{len}, $r->{directions}; |
printf "%2d,%-2d len: %-4d directions: %s\n", $r->{x}, $r->{y}, $r->{len}, $r->{directions}; |
201 |
} |
} |