Games-Go-SimpleBoard/SimpleBoard.pm

package Games::Go::SimpleBoard;

=head1 NAME

Games::Go::SimpleBoard - represent a simple go board

=head1 SYNOPSIS

   use Games::Go::SimpleBoard;

=head1 DESCRIPTION

Please supply a description )

=head2 EXPORTED CONSTANTS

Marker types for each board position (ORed together):

   MARK_TRIANGLE # triangle mark
   MARK_SQUARE   # square mark
   MARK_CIRCLE   # circle mark
   MARK_CROSS    # cross mark
   MARK_SMALL_B  # small stone, used for scoring or marking
   MARK_SMALL_W  # small stone, used for scoring or marking
   MARK_B        # normal black stone
   MARK_W        # normal whit stone
   MARK_GRAYED   # in conjunction with MARK_[BW], grays the stone
   MARK_LABEL    # a text label
   MARK_HOSHI    # this is a hoshi point (not used much)
   MARK_MOVE     # this is a regular move
   MARK_KO       # this is a ko position
   MARK_REDRAW   # ignored, can be used for your own purposes

   COLOUR_WHITE  # guarenteed to be 0
   COLOUR_BLACK  # guarenteed to be 1

   MOVE_HANDICAP # used as "x-coordinate" for handicap moves
   MOVE_PASS     # can be used as "x-coordinate" for pass moves

=head2 METHODS

=over 4

=cut

no warnings;
use strict;

use Carp ();

use base Exporter::;

our $VERSION = '1.0';

our @EXPORT = qw(
   MARK_TRIANGLE MARK_SQUARE MARK_CIRCLE MARK_SMALL_B MARK_SMALL_W MARK_B
   MARK_W MARK_GRAYED MARK_MOVE MARK_LABEL MARK_HOSHI MARK_KO MARK_CROSS
   MARK_REDRAW
   COLOUR_BLACK COLOUR_WHITE
   MOVE_HANDICAP MOVE_PASS
);

# marker types for each board position (ORed together)

sub MARK_TRIANGLE (){ 0x0001 }
sub MARK_SQUARE   (){ 0x0002 }
sub MARK_CIRCLE   (){ 0x0004 }
sub MARK_SMALL_B  (){ 0x0008 } # small stone, used for scoring or marking
sub MARK_SMALL_W  (){ 0x0010 } # small stone, used for scoring or marking
sub MARK_B        (){ 0x0020 } # normal black stone
sub MARK_W        (){ 0x0040 } # normal whit stone
sub MARK_GRAYED   (){ 0x0080 } # in conjunction with MARK_[BW], grays the stone
sub MARK_LABEL    (){ 0x0100 }
sub MARK_HOSHI    (){ 0x0200 } # this is a hoshi point (not used much)
sub MARK_MOVE     (){ 0x0400 } # this is a regular move
sub MARK_KO       (){ 0x0800 } # this is a ko position
sub MARK_CROSS    (){ 0x1000 }
sub MARK_REDRAW   (){ 0x8000 }

sub COLOUR_WHITE  (){ 0 }
sub COLOUR_BLACK  (){ 1 }

sub MOVE_PASS     (){ undef }
sub MOVE_HANDICAP (){ -2 }

=item my $board = new $size

Creates a new empty board of the given size.

C<< $board->{size} >> stores the board size.

C<< $board->{max} >> stores the maximum board coordinate (size-1).

C<< $board->{captures}[COLOUR_xxx] >> stores the number of captured stones for
the given colour.

C<< $board->{board} >> stores a two-dimensional array with board contents.

=cut

sub new {
   my $class = shift;
   my $size = shift;

   unless ($size > 0) {
      Carp::croak ("no board size given!");
   }

   bless {
      max       => $size - 1,
      size      => $size,
      board     => [map [(0) x $size], 1 .. $size],
      captures  => [0, 0], # captures
     #timer     => [],
     #score     => [],
      @_,
   }, $class
}

# inefficient and primitive, I hear you say?
# well... you are right :)
# use an extremely dumb floodfill algorithm to get rid of captured stones
sub capture {
   my ($self, $mark, $x, $y) = @_;

   my %seen;
   my @found;
   my @nodes = ([$x,$y]);
   my $board = $self->{board};

   my $max = $self->{max};

   while (@nodes) {
      my ($x, $y) = @{pop @nodes};
      unless ($seen{$x,$y}++) {
         if ($board->[$x][$y] & $mark) {
            push @found, [$x, $y];

            push @nodes, [$x-1, $y] unless $seen{$x-1, $y} || $x <= 0;
            push @nodes, [$x+1, $y] unless $seen{$x+1, $y} || $x >= $max;
            push @nodes, [$x, $y-1] unless $seen{$x, $y-1} || $y <= 0;
            push @nodes, [$x, $y+1] unless $seen{$x, $y+1} || $y >= $max;
         } elsif (!($board->[$x][$y] & (MARK_B | MARK_W))) {
            return;
         }
      }
   }

   @found
}

=item $hint = $board->update ([update-structures...])

Each update-structure itself is also an array-ref:

   [$x, $y, $clr, $set, $label, $hint] # update or move
   [MOVE_HANDICAP, $handicap]          # black move, setup handicap
   [MOVE_PASS]                         # pass
   []                                  # also pass (deprecated!)

It changes the board or executes a move, by first clearing the bits
specified in C<$clr>, then setting bits specified in C<$set>.

If C<$set> includes C<MARK_LABEL>, the label text must be given in
C<$label>.

If C<$set> contains C<MARK_MOVE> then surrounded stones will be removed
from the board and (simple) Kos are detected and marked with square
symbols and C<MARK_KO>, after removing other marking symbols. The
markings are also removed with the next next update structure that uses
C<MARK_MOVE>, so this flag is suited well for marking, well, moves. Note
that you can make invalid "moves" (such as suicide) and C<update> will
try to cope with it. You can use C<is_valid_move> to avoid making illegal
moves.

For handicap "moves", currently only board sizes 9, 13 and 19 are
supported and only handicap values from 2 to 9. The placement follows the
IGS rules, if you want other placements, you have to set it up yourself.

This function modifies the C<$hint> member of the specified structure
to speed up repeated board generation and updates with the same update
structures.

If the hint member is a reference the scalar pointed to by the reference
is updated instead.

If all this hint member thing is confusing, just ignore it and specify
it as C<undef> or leave it out of the array entirely. Do make sure that
you keep your update structures around as long as previous updates don't
change, however, as regenerating a full board position from hinted
update structures is I<much> faster then recreating it from fresh update
structures.

Example, make two silly moves:

  $board->update ([[0, 18, -1, MARK_B | MARK_MOVE],
                   [0, 17, -1, MARK_W | MARK_MOVE]]);

=cut

our %HANDICAP_COORD =  (
    9 => [2, 4,  6],
   13 => [3, 6,  9],
   19 => [3, 9, 15],
);
our %HANDICAP_XY = (
   2 => [qw(0,2 2,0                            )],
   3 => [qw(0,2 2,0 0,0                        )],
   4 => [qw(0,2 2,0 0,0 2,2                    )],
   5 => [qw(0,2 2,0 0,0 2,2                 1,1)],
   6 => [qw(0,2 2,0 0,0 2,2 0,1 2,1            )],
   7 => [qw(0,2 2,0 0,0 2,2 0,1 2,1         1,1)],
   8 => [qw(0,2 2,0 0,0 2,2 0,1 2,1 1,0 1,2    )],
   9 => [qw(0,2 2,0 0,0 2,2 0,1 2,1 1,0 1,2 1,1)],
);

our $mark_symbols = MARK_CIRCLE | MARK_SQUARE | MARK_TRIANGLE | MARK_CROSS | MARK_KO;

sub update {
   my ($self, $path) = @_;

   my $board = $self->{board};

   for (@$path) {
      my ($x, $y, $clr, $set, $label) = @$_;

      if (!defined $x) {
         $$_ &= ~$mark_symbols for @{ delete $self->{unmark} || [] };
         # pass

      } elsif ($x == MOVE_HANDICAP) {
         $$_ &= ~$mark_symbols for @{ delete $self->{unmark} || [] };

         # $y = #handicap stones
         my $c = $HANDICAP_COORD{$self->{size}}
            or Carp::croak "$self->{size}: illegal board size for handicap";
         my $h = $HANDICAP_XY{$y}
            or Carp::croak "$y: illegal number of handicap stones";

         for (@$h) {
            my ($x, $y) = map $c->[$_], split /,/;
            $board->[$x][$y] = MARK_B | MARK_MOVE;
         }

      } else {
         my $space = \$board->[$x][$y];

         $$space = $$space & ~$clr | $set;

         $self->{label}[$x][$y] = $label if $set & MARK_LABEL;

         if ($set & MARK_MOVE) {
            $$_ &= ~$mark_symbols for @{ $self->{unmark} || [] };
            @{ $self->{unmark} } = $space;

            unless (${ $_->[5] ||= \my $hint }) {
               my ($own, $opp) =
                  $set & MARK_B
                     ? (MARK_B, MARK_W)
                     : (MARK_W, MARK_B);

               my (@capture, $suicide);

               push @capture, $self->capture ($opp, $x-1, $y) if $x > 0            && $board->[$x-1][$y] & $opp;
               push @capture, $self->capture ($opp, $x+1, $y) if $x < $self->{max} && $board->[$x+1][$y] & $opp;
               push @capture, $self->capture ($opp, $x, $y-1) if $y > 0            && $board->[$x][$y-1] & $opp;
               push @capture, $self->capture ($opp, $x, $y+1) if $y < $self->{max} && $board->[$x][$y+1] & $opp;

               # keep only unique coordinates
               @capture = do { my %seen; grep !$seen{"$_->[0],$_->[1]"}++, @capture };

               # remove captured stones
               $self->{captures}[$own == MARK_B ? COLOUR_BLACK : COLOUR_WHITE] += @capture;
               $self->{board}[$_->[0]][$_->[1]] = 0
                  for @capture;

               $suicide += $self->capture ($own, $x, $y);

               ${ $_->[5] } ||= !(@capture || $suicide);

               if ($suicide) {
                  $self->{board}[$x][$y] = 0
                  
               } elsif (!$suicide && @capture == 1) {
                  # possible ko. now check liberties on placed stone

                  my $libs;

                  $libs++ if $x > 0            && !($board->[$x-1][$y] & $opp);
                  $libs++ if $x < $self->{max} && !($board->[$x+1][$y] & $opp);
                  $libs++ if $y > 0            && !($board->[$x][$y-1] & $opp);
                  $libs++ if $y < $self->{max} && !($board->[$x][$y+1] & $opp);
                  
                  if ($libs == 1) {
                     $$space = $$space & ~$mark_symbols | MARK_KO;

                     ($x, $y) = @{$capture[0]};
                     $board->[$x][$y] |= MARK_KO;

                     push @{ $self->{unmark} }, \$board->[$x][$y];
                  }
               }
            }
         }
      }
   }
}

=item $board->is_valid_move ($colour, $x, $y[, $may_suicide])

Returns true if the move of the given colour on the given coordinates is
valid or not. Kos are taken into account as long as they are marked with
C<MARK_KO>. Suicides are invalid unless C<$may_suicide> is true (e.g. for
new zealand rules)

=cut

sub is_valid_move {
   my ($self, $colour, $x, $y, $may_suicide) = @_;

   my $board = $self->{board};

   return if $board->[$x][$y] & (MARK_B | MARK_W | MARK_KO)
             && !($board->[$x][$y] & MARK_GRAYED);

   if ($may_suicide) {
      return 1;
   } else {
      my ($own, $opp) = $colour == COLOUR_BLACK
                           ? (MARK_B, MARK_W)
                           : (MARK_W, MARK_B);

      # try the move
      local $board->[$x][$y] = $board->[$x][$y] | $own;

      return 1 if $x > 0            && $board->[$x-1][$y] & $opp && $self->capture ($opp, $x-1, $y, 1);
      return 1 if $x < $self->{max} && $board->[$x+1][$y] & $opp && $self->capture ($opp, $x+1, $y, 1);
      return 1 if $y > 0            && $board->[$x][$y-1] & $opp && $self->capture ($opp, $x, $y-1, 1);
      return 1 if $y < $self->{max} && $board->[$x][$y+1] & $opp && $self->capture ($opp, $x, $y+1, 1);

      return !$self->capture ($own, $x, $y, 1);
   }
}

1;

=back

=head2 AUTHOR

Marc Lehmann <schmorp@schmorp.de>

=head2 SEE ALSO

L<Gtk2::GoBoard>.

=cut

Revision:	1.13
Committed:	Thu Jul 24 08:50:53 2008 UTC (15 years, 9 months ago) by elmex
Branch:	MAIN
Changes since 1.12:	+4 -1 lines
Log Message:	removing suicide stones
#	User	Rev	Content
1	root	1.1	package Games::Go::SimpleBoard;
2
3			=head1 NAME
4
5			Games::Go::SimpleBoard - represent a simple go board
6
7			=head1 SYNOPSIS
8
9			use Games::Go::SimpleBoard;
10
11			=head1 DESCRIPTION
12
13			Please supply a description )
14
15			=head2 EXPORTED CONSTANTS
16
17			Marker types for each board position (ORed together):
18
19			MARK_TRIANGLE # triangle mark
20			MARK_SQUARE # square mark
21			MARK_CIRCLE # circle mark
22	root	1.6	MARK_CROSS # cross mark
23	root	1.1	MARK_SMALL_B # small stone, used for scoring or marking
24			MARK_SMALL_W # small stone, used for scoring or marking
25			MARK_B # normal black stone
26			MARK_W # normal whit stone
27			MARK_GRAYED # in conjunction with MARK_[BW], grays the stone
28			MARK_LABEL # a text label
29			MARK_HOSHI # this is a hoshi point (not used much)
30			MARK_MOVE # this is a regular move
31			MARK_KO # this is a ko position
32			MARK_REDRAW # ignored, can be used for your own purposes
33
34	root	1.9	COLOUR_WHITE # guarenteed to be 0
35			COLOUR_BLACK # guarenteed to be 1
36	root	1.1
37	root	1.3	MOVE_HANDICAP # used as "x-coordinate" for handicap moves
38	root	1.9	MOVE_PASS # can be used as "x-coordinate" for pass moves
39	root	1.3
40	root	1.1	=head2 METHODS
41
42			=over 4
43
44			=cut
45
46	root	1.3	no warnings;
47			use strict;
48
49			use Carp ();
50
51			use base Exporter::;
52	root	1.1
53			our $VERSION = '1.0';
54
55	root	1.3	our @EXPORT = qw(
56	root	1.1	MARK_TRIANGLE MARK_SQUARE MARK_CIRCLE MARK_SMALL_B MARK_SMALL_W MARK_B
57	root	1.7	MARK_W MARK_GRAYED MARK_MOVE MARK_LABEL MARK_HOSHI MARK_KO MARK_CROSS
58	root	1.1	MARK_REDRAW
59			COLOUR_BLACK COLOUR_WHITE
60	root	1.3	MOVE_HANDICAP MOVE_PASS
61	root	1.1	);
62
63			# marker types for each board position (ORed together)
64
65			sub MARK_TRIANGLE (){ 0x0001 }
66			sub MARK_SQUARE (){ 0x0002 }
67			sub MARK_CIRCLE (){ 0x0004 }
68			sub MARK_SMALL_B (){ 0x0008 } # small stone, used for scoring or marking
69			sub MARK_SMALL_W (){ 0x0010 } # small stone, used for scoring or marking
70			sub MARK_B (){ 0x0020 } # normal black stone
71			sub MARK_W (){ 0x0040 } # normal whit stone
72			sub MARK_GRAYED (){ 0x0080 } # in conjunction with MARK_[BW], grays the stone
73			sub MARK_LABEL (){ 0x0100 }
74			sub MARK_HOSHI (){ 0x0200 } # this is a hoshi point (not used much)
75			sub MARK_MOVE (){ 0x0400 } # this is a regular move
76			sub MARK_KO (){ 0x0800 } # this is a ko position
77	root	1.8	sub MARK_CROSS (){ 0x1000 }
78	root	1.1	sub MARK_REDRAW (){ 0x8000 }
79
80	root	1.9	sub COLOUR_WHITE (){ 0 }
81			sub COLOUR_BLACK (){ 1 }
82	root	1.1
83	root	1.3	sub MOVE_PASS (){ undef }
84			sub MOVE_HANDICAP (){ -2 }
85
86	root	1.1	=item my $board = new $size
87
88			Creates a new empty board of the given size.
89
90	root	1.3	C<< $board->{size} >> stores the board size.
91
92	root	1.1	C<< $board->{max} >> stores the maximum board coordinate (size-1).
93
94	root	1.9	C<< $board->{captures}[COLOUR_xxx] >> stores the number of captured stones for
95	root	1.1	the given colour.
96
97			C<< $board->{board} >> stores a two-dimensional array with board contents.
98
99			=cut
100
101			sub new {
102			my $class = shift;
103			my $size = shift;
104	root	1.9
105	elmex	1.11	unless ($size > 0) {
106			Carp::croak ("no board size given!");
107			}
108
109	root	1.1	bless {
110	root	1.9	max => $size - 1,
111			size => $size,
112			board => [map [(0) x $size], 1 .. $size],
113			captures => [0, 0], # captures
114			#timer => [],
115			#score => [],
116			@_,
117			}, $class
118	root	1.1	}
119
120			# inefficient and primitive, I hear you say?
121			# well... you are right :)
122			# use an extremely dumb floodfill algorithm to get rid of captured stones
123			sub capture {
124			my ($self, $mark, $x, $y) = @_;
125
126			my %seen;
127			my @found;
128			my @nodes = ([$x,$y]);
129			my $board = $self->{board};
130
131			my $max = $self->{max};
132
133			while (@nodes) {
134			my ($x, $y) = @{pop @nodes};
135			unless ($seen{$x,$y}++) {
136			if ($board->[$x][$y] & $mark) {
137			push @found, [$x, $y];
138
139			push @nodes, [$x-1, $y] unless $seen{$x-1, $y} \|\| $x <= 0;
140			push @nodes, [$x+1, $y] unless $seen{$x+1, $y} \|\| $x >= $max;
141			push @nodes, [$x, $y-1] unless $seen{$x, $y-1} \|\| $y <= 0;
142			push @nodes, [$x, $y+1] unless $seen{$x, $y+1} \|\| $y >= $max;
143			} elsif (!($board->[$x][$y] & (MARK_B \| MARK_W))) {
144			return;
145			}
146			}
147			}
148
149			@found
150			}
151
152	root	1.2	=item $hint = $board->update ([update-structures...])
153	root	1.1
154	root	1.2	Each update-structure itself is also an array-ref:
155	root	1.1
156			[$x, $y, $clr, $set, $label, $hint] # update or move
157	root	1.4	[MOVE_HANDICAP, $handicap] # black move, setup handicap
158	root	1.3	[MOVE_PASS] # pass
159	root	1.4	[] # also pass (deprecated!)
160	root	1.1
161	root	1.2	It changes the board or executes a move, by first clearing the bits
162	root	1.1	specified in C<$clr>, then setting bits specified in C<$set>.
163
164			If C<$set> includes C<MARK_LABEL>, the label text must be given in
165			C<$label>.
166
167	root	1.9	If C<$set> contains C<MARK_MOVE> then surrounded stones will be removed
168			from the board and (simple) Kos are detected and marked with square
169			symbols and C<MARK_KO>, after removing other marking symbols. The
170			markings are also removed with the next next update structure that uses
171			C<MARK_MOVE>, so this flag is suited well for marking, well, moves. Note
172			that you can make invalid "moves" (such as suicide) and C<update> will
173			try to cope with it. You can use C<is_valid_move> to avoid making illegal
174			moves.
175	root	1.3
176			For handicap "moves", currently only board sizes 9, 13 and 19 are
177			supported and only handicap values from 2 to 9. The placement follows the
178			IGS rules, if you want other placements, you have to set it up yourself.
179
180	root	1.4	This function modifies the C<$hint> member of the specified structure
181			to speed up repeated board generation and updates with the same update
182			structures.
183	root	1.1
184			If the hint member is a reference the scalar pointed to by the reference
185			is updated instead.
186
187	root	1.4	If all this hint member thing is confusing, just ignore it and specify
188			it as C<undef> or leave it out of the array entirely. Do make sure that
189			you keep your update structures around as long as previous updates don't
190			change, however, as regenerating a full board position from hinted
191			update structures is I<much> faster then recreating it from fresh update
192			structures.
193	root	1.2
194	root	1.1	Example, make two silly moves:
195
196	root	1.4	$board->update ([[0, 18, -1, MARK_B \| MARK_MOVE],
197			[0, 17, -1, MARK_W \| MARK_MOVE]]);
198	root	1.1
199			=cut
200
201	root	1.3	our %HANDICAP_COORD = (
202			9 => [2, 4, 6],
203			13 => [3, 6, 9],
204			19 => [3, 9, 15],
205			);
206			our %HANDICAP_XY = (
207			2 => [qw(0,2 2,0 )],
208	root	1.5	3 => [qw(0,2 2,0 0,0 )],
209			4 => [qw(0,2 2,0 0,0 2,2 )],
210			5 => [qw(0,2 2,0 0,0 2,2 1,1)],
211			6 => [qw(0,2 2,0 0,0 2,2 0,1 2,1 )],
212			7 => [qw(0,2 2,0 0,0 2,2 0,1 2,1 1,1)],
213			8 => [qw(0,2 2,0 0,0 2,2 0,1 2,1 1,0 1,2 )],
214			9 => [qw(0,2 2,0 0,0 2,2 0,1 2,1 1,0 1,2 1,1)],
215	root	1.3	);
216
217	root	1.9	our $mark_symbols = MARK_CIRCLE \| MARK_SQUARE \| MARK_TRIANGLE \| MARK_CROSS \| MARK_KO;
218
219	root	1.1	sub update {
220			my ($self, $path) = @_;
221
222			my $board = $self->{board};
223
224			for (@$path) {
225			my ($x, $y, $clr, $set, $label) = @$_;
226
227	root	1.3	if (!defined $x) {
228	root	1.10	$$_ &= ~$mark_symbols for @{ delete $self->{unmark} \|\| [] };
229	root	1.3	# pass
230
231			} elsif ($x == MOVE_HANDICAP) {
232	root	1.10	$$_ &= ~$mark_symbols for @{ delete $self->{unmark} \|\| [] };
233
234	root	1.3	# $y = #handicap stones
235			my $c = $HANDICAP_COORD{$self->{size}}
236			or Carp::croak "$self->{size}: illegal board size for handicap";
237			my $h = $HANDICAP_XY{$y}
238			or Carp::croak "$y: illegal number of handicap stones";
239
240			for (@$h) {
241			my ($x, $y) = map $c->[$_], split /,/;
242			$board->[$x][$y] = MARK_B \| MARK_MOVE;
243			}
244
245			} else {
246	root	1.9	my $space = \$board->[$x][$y];
247
248			$$space = $$space & ~$clr \| $set;
249	root	1.1
250			$self->{label}[$x][$y] = $label if $set & MARK_LABEL;
251
252			if ($set & MARK_MOVE) {
253	root	1.10	$$_ &= ~$mark_symbols for @{ $self->{unmark} \|\| [] };
254	root	1.9	@{ $self->{unmark} } = $space;
255	root	1.1
256			unless (${ $_->[5] \|\|= \my $hint }) {
257			my ($own, $opp) =
258			$set & MARK_B
259			? (MARK_B, MARK_W)
260			: (MARK_W, MARK_B);
261
262			my (@capture, $suicide);
263
264			push @capture, $self->capture ($opp, $x-1, $y) if $x > 0 && $board->[$x-1][$y] & $opp;
265			push @capture, $self->capture ($opp, $x+1, $y) if $x < $self->{max} && $board->[$x+1][$y] & $opp;
266			push @capture, $self->capture ($opp, $x, $y-1) if $y > 0 && $board->[$x][$y-1] & $opp;
267			push @capture, $self->capture ($opp, $x, $y+1) if $y < $self->{max} && $board->[$x][$y+1] & $opp;
268
269			# keep only unique coordinates
270			@capture = do { my %seen; grep !$seen{"$_->[0],$_->[1]"}++, @capture };
271
272			# remove captured stones
273	root	1.9	$self->{captures}[$own == MARK_B ? COLOUR_BLACK : COLOUR_WHITE] += @capture;
274			$self->{board}[$_->[0]][$_->[1]] = 0
275	root	1.1	for @capture;
276
277			$suicide += $self->capture ($own, $x, $y);
278
279			${ $_->[5] } \|\|= !(@capture \|\| $suicide);
280
281	elmex	1.13	if ($suicide) {
282			$self->{board}[$x][$y] = 0
283
284			} elsif (!$suicide && @capture == 1) {
285	root	1.1	# possible ko. now check liberties on placed stone
286
287			my $libs;
288
289			$libs++ if $x > 0 && !($board->[$x-1][$y] & $opp);
290			$libs++ if $x < $self->{max} && !($board->[$x+1][$y] & $opp);
291			$libs++ if $y > 0 && !($board->[$x][$y-1] & $opp);
292			$libs++ if $y < $self->{max} && !($board->[$x][$y+1] & $opp);
293
294			if ($libs == 1) {
295	root	1.9	$$space = $$space & ~$mark_symbols \| MARK_KO;
296
297	root	1.1	($x, $y) = @{$capture[0]};
298	root	1.9	$board->[$x][$y] \|= MARK_KO;
299
300			push @{ $self->{unmark} }, \$board->[$x][$y];
301	root	1.1	}
302			}
303			}
304			}
305			}
306			}
307			}
308
309			=item $board->is_valid_move ($colour, $x, $y[, $may_suicide])
310
311			Returns true if the move of the given colour on the given coordinates is
312	root	1.4	valid or not. Kos are taken into account as long as they are marked with
313			C<MARK_KO>. Suicides are invalid unless C<$may_suicide> is true (e.g. for
314			new zealand rules)
315	root	1.1
316			=cut
317
318			sub is_valid_move {
319			my ($self, $colour, $x, $y, $may_suicide) = @_;
320
321			my $board = $self->{board};
322
323	elmex	1.12	return if $board->[$x][$y] & (MARK_B \| MARK_W \| MARK_KO)
324			&& !($board->[$x][$y] & MARK_GRAYED);
325	root	1.1
326			if ($may_suicide) {
327			return 1;
328			} else {
329			my ($own, $opp) = $colour == COLOUR_BLACK
330			? (MARK_B, MARK_W)
331			: (MARK_W, MARK_B);
332
333			# try the move
334			local $board->[$x][$y] = $board->[$x][$y] \| $own;
335
336			return 1 if $x > 0 && $board->[$x-1][$y] & $opp && $self->capture ($opp, $x-1, $y, 1);
337			return 1 if $x < $self->{max} && $board->[$x+1][$y] & $opp && $self->capture ($opp, $x+1, $y, 1);
338			return 1 if $y > 0 && $board->[$x][$y-1] & $opp && $self->capture ($opp, $x, $y-1, 1);
339			return 1 if $y < $self->{max} && $board->[$x][$y+1] & $opp && $self->capture ($opp, $x, $y+1, 1);
340
341			return !$self->capture ($own, $x, $y, 1);
342			}
343			}
344
345			1;
346
347			=back
348
349			=head2 AUTHOR
350
351			Marc Lehmann <schmorp@schmorp.de>
352
353			=head2 SEE ALSO
354
355	root	1.3	L<Gtk2::GoBoard>.
356	root	1.1
357			=cut
358