| … | |
… | |
| 100 | |
100 | |
| 101 | sub new { |
101 | sub new { |
| 102 | my $class = shift; |
102 | my $class = shift; |
| 103 | my $size = shift; |
103 | my $size = shift; |
| 104 | |
104 | |
|
|
105 | unless ($size > 0) { |
|
|
106 | Carp::croak ("no board size given!"); |
|
|
107 | } |
|
|
108 | |
| 105 | bless { |
109 | bless { |
| 106 | max => $size - 1, |
110 | max => $size - 1, |
| 107 | size => $size, |
111 | size => $size, |
| 108 | board => [map [(0) x $size], 1 .. $size], |
112 | board => [map [(0) x $size], 1 .. $size], |
| 109 | captures => [0, 0], # captures |
113 | captures => [0, 0], # captures |
| … | |
… | |
| 126 | |
130 | |
| 127 | my $max = $self->{max}; |
131 | my $max = $self->{max}; |
| 128 | |
132 | |
| 129 | while (@nodes) { |
133 | while (@nodes) { |
| 130 | my ($x, $y) = @{pop @nodes}; |
134 | my ($x, $y) = @{pop @nodes}; |
|
|
135 | |
| 131 | unless ($seen{$x,$y}++) { |
136 | unless ($seen{$x,$y}++) { |
| 132 | if ($board->[$x][$y] & $mark) { |
137 | if ($board->[$x][$y] & $mark) { |
| 133 | push @found, [$x, $y]; |
138 | push @found, [$x, $y]; |
| 134 | |
139 | |
| 135 | push @nodes, [$x-1, $y] unless $seen{$x-1, $y} || $x <= 0; |
140 | push @nodes, [$x-1, $y] unless $seen{$x-1, $y} || $x <= 0; |
| … | |
… | |
| 247 | |
252 | |
| 248 | if ($set & MARK_MOVE) { |
253 | if ($set & MARK_MOVE) { |
| 249 | $$_ &= ~$mark_symbols for @{ $self->{unmark} || [] }; |
254 | $$_ &= ~$mark_symbols for @{ $self->{unmark} || [] }; |
| 250 | @{ $self->{unmark} } = $space; |
255 | @{ $self->{unmark} } = $space; |
| 251 | |
256 | |
|
|
257 | # remark the space, in case the move was on the same spot as the |
|
|
258 | # old mark |
|
|
259 | $$space |= $set; |
|
|
260 | |
| 252 | unless (${ $_->[5] ||= \my $hint }) { |
261 | unless (${ $_->[5] ||= \my $hint }) { |
| 253 | my ($own, $opp) = |
262 | my ($own, $opp) = |
| 254 | $set & MARK_B |
263 | $set & MARK_B |
| 255 | ? (MARK_B, MARK_W) |
264 | ? (MARK_B, MARK_W) |
| 256 | : (MARK_W, MARK_B); |
265 | : (MARK_W, MARK_B); |
| 257 | |
266 | |
| 258 | my (@capture, $suicide); |
267 | my (@capture, @suicide); |
| 259 | |
268 | |
| 260 | push @capture, $self->capture ($opp, $x-1, $y) if $x > 0 && $board->[$x-1][$y] & $opp; |
269 | push @capture, $self->capture ($opp, $x-1, $y) if $x > 0 && $board->[$x-1][$y] & $opp; |
| 261 | push @capture, $self->capture ($opp, $x+1, $y) if $x < $self->{max} && $board->[$x+1][$y] & $opp; |
270 | push @capture, $self->capture ($opp, $x+1, $y) if $x < $self->{max} && $board->[$x+1][$y] & $opp; |
| 262 | push @capture, $self->capture ($opp, $x, $y-1) if $y > 0 && $board->[$x][$y-1] & $opp; |
271 | push @capture, $self->capture ($opp, $x, $y-1) if $y > 0 && $board->[$x][$y-1] & $opp; |
| 263 | push @capture, $self->capture ($opp, $x, $y+1) if $y < $self->{max} && $board->[$x][$y+1] & $opp; |
272 | push @capture, $self->capture ($opp, $x, $y+1) if $y < $self->{max} && $board->[$x][$y+1] & $opp; |
| … | |
… | |
| 268 | # remove captured stones |
277 | # remove captured stones |
| 269 | $self->{captures}[$own == MARK_B ? COLOUR_BLACK : COLOUR_WHITE] += @capture; |
278 | $self->{captures}[$own == MARK_B ? COLOUR_BLACK : COLOUR_WHITE] += @capture; |
| 270 | $self->{board}[$_->[0]][$_->[1]] = 0 |
279 | $self->{board}[$_->[0]][$_->[1]] = 0 |
| 271 | for @capture; |
280 | for @capture; |
| 272 | |
281 | |
| 273 | $suicide += $self->capture ($own, $x, $y); |
282 | push @suicide, $self->capture ($own, $x, $y); |
| 274 | |
283 | |
| 275 | ${ $_->[5] } ||= !(@capture || $suicide); |
284 | ${ $_->[5] } ||= !(@capture || @suicide); |
| 276 | |
285 | |
|
|
286 | if (@suicide) { |
|
|
287 | $self->{board}[$_->[0]][$_->[1]] = 0 |
|
|
288 | for @suicide; |
|
|
289 | # count suicides as other sides stones |
|
|
290 | $self->{captures}[$opp == MARK_B ? COLOUR_BLACK : COLOUR_WHITE] += @suicide; |
|
|
291 | |
| 277 | if (!$suicide && @capture == 1) { |
292 | } elsif (!@suicide && @capture == 1) { |
| 278 | # possible ko. now check liberties on placed stone |
293 | # possible ko. now check liberties on placed stone |
| 279 | |
294 | |
| 280 | my $libs; |
295 | my $libs; |
| 281 | |
296 | |
| 282 | $libs++ if $x > 0 && !($board->[$x-1][$y] & $opp); |
297 | $libs++ if $x > 0 && !($board->[$x-1][$y] & $opp); |
| … | |
… | |
| 311 | sub is_valid_move { |
326 | sub is_valid_move { |
| 312 | my ($self, $colour, $x, $y, $may_suicide) = @_; |
327 | my ($self, $colour, $x, $y, $may_suicide) = @_; |
| 313 | |
328 | |
| 314 | my $board = $self->{board}; |
329 | my $board = $self->{board}; |
| 315 | |
330 | |
| 316 | return if $board->[$x][$y] & (MARK_B | MARK_W | MARK_KO); |
331 | return if $board->[$x][$y] & (MARK_B | MARK_W | MARK_KO) |
|
|
332 | && !($board->[$x][$y] & MARK_GRAYED); |
| 317 | |
333 | |
| 318 | if ($may_suicide) { |
334 | if ($may_suicide) { |
| 319 | return 1; |
335 | return 1; |
| 320 | } else { |
336 | } else { |
| 321 | my ($own, $opp) = $colour == COLOUR_BLACK |
337 | my ($own, $opp) = $colour == COLOUR_BLACK |
