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_B            # normal black stone
   MARK_W            # normal whit stone
   MARK_GRAYED       # in conjunction with MARK_[BW], grays the stone

   MARK_SMALL_B      # small stone, used for scoring or marking
   MARK_SMALL_W      # small stone, used for scoring or marking
   MARK_SMALL_GRAYED # in conjunction with MARK_SMALL_[BW], grays the stone

   MARK_TRIANGLE     # triangle mark
   MARK_SQUARE       # square mark
   MARK_CIRCLE       # circle mark
   MARK_CROSS        # cross mark

   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      # guaranteed to be 0
   COLOUR_BLACK      # guaranteed 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.01';

our @EXPORT = qw(
   MARK_TRIANGLE MARK_SQUARE MARK_CIRCLE MARK_SMALL_B MARK_SMALL_W MARK_B
   MARK_W MARK_GRAYED MARK_SMALL_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_CROSS        (){ 0x0008 }

sub MARK_SMALL_B      (){ 0x0010 } # small stone, used for scoring or marking
sub MARK_SMALL_W      (){ 0x0020 } # small stone, used for scoring or marking
sub MARK_SMALL_GRAYED (){ 0x0040 }

sub MARK_B            (){ 0x0080 } # normal black stone
sub MARK_W            (){ 0x0100 } # normal whit stone
sub MARK_GRAYED       (){ 0x0200 } # in conjunction with MARK_[BW], grays the stone

sub MARK_LABEL        (){ 0x0400 }
sub MARK_HOSHI        (){ 0x0800 } # this is a hoshi point (not used much)
sub MARK_MOVE         (){ 0x1000 } # this is a regular move
sub MARK_KO           (){ 0x2000 } # this is a ko position
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;

            # remark the space, in case the move was on the same spot as the
            # old mark
            $$space |= $set;

            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;

               push @suicide, $self->capture ($own, $x, $y);

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

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