87 |
$visited[$pos]++; |
$visited[$pos]++; |
88 |
} |
} |
89 |
|
|
|
my ( $tr_x, $tr_y ); |
|
|
my ( $bl_x, $bl_y ); |
|
|
|
|
90 |
sub x_y { |
sub x_y { |
91 |
my $p = shift; |
my $p = shift; |
92 |
|
|
93 |
my $update = 0; |
$p ||= $pos; |
|
if ( ! defined( $p ) ) { |
|
|
$p = $pos; |
|
|
$update = 1; |
|
|
} |
|
94 |
|
|
95 |
my $y = int($p / ($ll*2)); |
my $y = int($p / ($ll*2)); |
96 |
my $x = int(($p % $ll) / 2); |
my $x = int(($p % $ll) / 2); |
97 |
|
|
98 |
warn "??? x_y($p) $x,$y tr: $tr_x,$tr_y bl: $bl_x,$bl_y\n"; |
warn "## x_y($p) -> $x,$y\n"; |
|
|
|
|
if ( $update ) { |
|
|
|
|
|
# $tr_x = $x if $x > $tr_x && $y == $tr_y; |
|
|
# $tr_y = $y if $y < $tr_y && $x == $tr_x; |
|
|
|
|
|
if ( |
|
|
$y < $tr_y |
|
|
|| |
|
|
$y <= $tr_y && $x > $tr_x |
|
|
) { |
|
|
( $tr_x, $tr_y ) = ( $x, $y ); |
|
|
warn "## UPDATED tr: $tr_x,$tr_y\n"; |
|
|
} |
|
|
|
|
|
if ( |
|
|
$x < $bl_x |
|
|
|| |
|
|
$y > $bl_y |
|
|
) { |
|
|
( $bl_x, $bl_y ) = ( $x, $y ); |
|
|
warn "## UPDATED bl: $bl_x,$bl_y\n"; |
|
|
} |
|
|
|
|
|
# $bl_x = $x if $x < $bl_x; # && $y == $bl_y; |
|
|
# $bl_y = $y if $y > $bl_y; # && $x == $bl_x; |
|
|
|
|
|
} |
|
|
|
|
|
warn "## x_y($p) -> $x,$y ", |
|
|
$update ? " tr: $tr_x,$tr_y bl: $bl_x,$bl_y" : '', |
|
|
"\n"; |
|
99 |
|
|
100 |
# return ($x,$y) if wantarray; |
# return ($x,$y) if wantarray; |
101 |
return "$x,$y"; |
return "$x,$y"; |
118 |
|
|
119 |
my $ok_path = qr/[\|\-]/; |
my $ok_path = qr/[\|\-]/; |
120 |
|
|
121 |
|
my @corners; |
122 |
|
|
123 |
sub can_turn { |
sub can_turn { |
124 |
my $try_step = shift; |
my $try_step = shift; |
125 |
die "no step?" unless defined $try_step; |
die "no step?" unless defined $try_step; |
135 |
$trace[ $turn_pos ] = $old; |
$trace[ $turn_pos ] = $old; |
136 |
|
|
137 |
if ( $board[ $turn_pos ] =~ $ok_path ) { |
if ( $board[ $turn_pos ] =~ $ok_path ) { |
138 |
warn "OK can_turn $try_step $step_name[$try_step] turn_pos = $turn_pos b($board[$turn_pos]) t($trace[$turn_pos])\n"; |
my $xy = x_y($turn_pos); |
139 |
|
warn "OK can_turn $try_step $step_name[$try_step] turn_pos = $turn_pos b($board[$turn_pos]) t($trace[$turn_pos]) to $xy\n"; |
140 |
$step = $try_step; |
$step = $try_step; |
141 |
|
push @corners, $xy; |
142 |
return 1; |
return 1; |
143 |
} else { |
} else { |
144 |
warn "NOPE can_turn $try_step $step_name[$try_step] turn_pos = $turn_pos b($board[$turn_pos]) t($trace[$turn_pos])\n"; |
warn "NOPE can_turn $try_step $step_name[$try_step] turn_pos = $turn_pos b($board[$turn_pos]) t($trace[$turn_pos])\n"; |
164 |
|
|
165 |
@trace = ($unknown) x ( $#board + 1 ); |
@trace = ($unknown) x ( $#board + 1 ); |
166 |
@directions = (); |
@directions = (); |
167 |
|
@corners = (); |
168 |
trace; |
trace; |
169 |
|
|
170 |
my $len = 0; |
my $len = 0; |
|
( $tr_x, $tr_y ) = ( $x,$y ); |
|
|
( $bl_x, $bl_y ) = ( $x,$y ); |
|
171 |
$step = 0; |
$step = 0; |
172 |
|
|
|
if ( $visited[$pos] > 3 ) { |
|
|
warn "*** shape from $x,$y pos: $pos iterated 4 times, skipping\n"; |
|
|
return; |
|
|
} |
|
|
|
|
173 |
warn "<<< shape from $x,$y pos: $pos\n"; |
warn "<<< shape from $x,$y pos: $pos\n"; |
174 |
|
|
175 |
while( 1 ) { |
while( 1 ) { |
191 |
} |
} |
192 |
warn draw; |
warn draw; |
193 |
|
|
|
warn "## tr: $tr_x,$tr_y bl: $bl_x,$bl_y\n"; |
|
|
|
|
194 |
if ( $debug ) { |
if ( $debug ) { |
195 |
print "WAIT> press enter | ",show_directions; my $foo = <STDIN>; |
print "WAIT> press enter | ",show_directions; my $foo = <STDIN>; |
196 |
} |
} |
198 |
|
|
199 |
push @shapes_found, { x => $x, y => $y, len => $len, directions => show_directions }; |
push @shapes_found, { x => $x, y => $y, len => $len, directions => show_directions }; |
200 |
|
|
201 |
my $tr = "$tr_x,$tr_y"; |
warn "### corners: ",join(' ', @corners),"\n"; |
202 |
my $bl = "$bl_x,$bl_y"; |
warn ">>> ended at $pos, line length: $len, directions traversed: ",show_directions,"\n"; |
203 |
|
|
204 |
warn ">>> ended at $pos, line length: $len, directions traversed: ",show_directions," tr: $tr bl: $bl\n"; |
foreach my $c ( @corners ) { |
205 |
|
if ( ! grep( /\Q$c\E/, @shapes_start ) ) { |
206 |
if ( ! grep( /\Q$tr\E/, @shapes_start ) && $tr_x < 8 ) { |
warn "INFO: added corner $c as shape start\n"; |
207 |
warn "INFO: added $tr top-right\n"; |
push @shapes_start, $c; |
208 |
push @shapes_start, $tr; |
} |
|
} |
|
|
if ( ! grep( /\Q$bl\E/, @shapes_start ) && $bl_y < 8 ) { |
|
|
warn "INFO: added $bl bottom-left\n"; |
|
|
push @shapes_start, $bl; |
|
209 |
} |
} |
210 |
|
|
211 |
print "WAIT> press enter"; my $foo = <STDIN>; |
print "WAIT> press enter"; my $foo = <STDIN>; |
214 |
} |
} |
215 |
|
|
216 |
foreach my $start ( @shapes_start ) { |
foreach my $start ( @shapes_start ) { |
217 |
my $len = shape( split(/,/,$start) ); |
my ($x,$y) = split(/,/,$start); |
218 |
warn "## $start has $len elements\n"; |
if ( $x < 8 && $y < 8 ) { |
219 |
|
my $len = shape( split(/,/,$start) ); |
220 |
|
warn "## $start has $len elements\n"; |
221 |
|
} else { |
222 |
|
warn "SKIPPED $start\n"; |
223 |
|
} |
224 |
} |
} |
225 |
|
|
226 |
print ">>> RESULTS:\n"; |
print ">>> RESULTS:\n"; |