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;

            # 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.15
Committed:	Thu Jul 24 09:14:12 2008 UTC (15 years, 9 months ago) by elmex
Branch:	MAIN
CVS Tags:	rel-1_0
Changes since 1.14:	+6 -0 lines
Log Message:	remark current move and count suicides as captures
#	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	elmex	1.14
136	root	1.1	unless ($seen{$x,$y}++) {
137			if ($board->[$x][$y] & $mark) {
138			push @found, [$x, $y];
139
140			push @nodes, [$x-1, $y] unless $seen{$x-1, $y} \|\| $x <= 0;
141			push @nodes, [$x+1, $y] unless $seen{$x+1, $y} \|\| $x >= $max;
142			push @nodes, [$x, $y-1] unless $seen{$x, $y-1} \|\| $y <= 0;
143			push @nodes, [$x, $y+1] unless $seen{$x, $y+1} \|\| $y >= $max;
144			} elsif (!($board->[$x][$y] & (MARK_B \| MARK_W))) {
145			return;
146			}
147			}
148			}
149
150			@found
151			}
152
153	root	1.2	=item $hint = $board->update ([update-structures...])
154	root	1.1
155	root	1.2	Each update-structure itself is also an array-ref:
156	root	1.1
157			[$x, $y, $clr, $set, $label, $hint] # update or move
158	root	1.4	[MOVE_HANDICAP, $handicap] # black move, setup handicap
159	root	1.3	[MOVE_PASS] # pass
160	root	1.4	[] # also pass (deprecated!)
161	root	1.1
162	root	1.2	It changes the board or executes a move, by first clearing the bits
163	root	1.1	specified in C<$clr>, then setting bits specified in C<$set>.
164
165			If C<$set> includes C<MARK_LABEL>, the label text must be given in
166			C<$label>.
167
168	root	1.9	If C<$set> contains C<MARK_MOVE> then surrounded stones will be removed
169			from the board and (simple) Kos are detected and marked with square
170			symbols and C<MARK_KO>, after removing other marking symbols. The
171			markings are also removed with the next next update structure that uses
172			C<MARK_MOVE>, so this flag is suited well for marking, well, moves. Note
173			that you can make invalid "moves" (such as suicide) and C<update> will
174			try to cope with it. You can use C<is_valid_move> to avoid making illegal
175			moves.
176	root	1.3
177			For handicap "moves", currently only board sizes 9, 13 and 19 are
178			supported and only handicap values from 2 to 9. The placement follows the
179			IGS rules, if you want other placements, you have to set it up yourself.
180
181	root	1.4	This function modifies the C<$hint> member of the specified structure
182			to speed up repeated board generation and updates with the same update
183			structures.
184	root	1.1
185			If the hint member is a reference the scalar pointed to by the reference
186			is updated instead.
187
188	root	1.4	If all this hint member thing is confusing, just ignore it and specify
189			it as C<undef> or leave it out of the array entirely. Do make sure that
190			you keep your update structures around as long as previous updates don't
191			change, however, as regenerating a full board position from hinted
192			update structures is I<much> faster then recreating it from fresh update
193			structures.
194	root	1.2
195	root	1.1	Example, make two silly moves:
196
197	root	1.4	$board->update ([[0, 18, -1, MARK_B \| MARK_MOVE],
198			[0, 17, -1, MARK_W \| MARK_MOVE]]);
199	root	1.1
200			=cut
201
202	root	1.3	our %HANDICAP_COORD = (
203			9 => [2, 4, 6],
204			13 => [3, 6, 9],
205			19 => [3, 9, 15],
206			);
207			our %HANDICAP_XY = (
208			2 => [qw(0,2 2,0 )],
209	root	1.5	3 => [qw(0,2 2,0 0,0 )],
210			4 => [qw(0,2 2,0 0,0 2,2 )],
211			5 => [qw(0,2 2,0 0,0 2,2 1,1)],
212			6 => [qw(0,2 2,0 0,0 2,2 0,1 2,1 )],
213			7 => [qw(0,2 2,0 0,0 2,2 0,1 2,1 1,1)],
214			8 => [qw(0,2 2,0 0,0 2,2 0,1 2,1 1,0 1,2 )],
215			9 => [qw(0,2 2,0 0,0 2,2 0,1 2,1 1,0 1,2 1,1)],
216	root	1.3	);
217
218	root	1.9	our $mark_symbols = MARK_CIRCLE \| MARK_SQUARE \| MARK_TRIANGLE \| MARK_CROSS \| MARK_KO;
219
220	root	1.1	sub update {
221			my ($self, $path) = @_;
222
223			my $board = $self->{board};
224
225			for (@$path) {
226			my ($x, $y, $clr, $set, $label) = @$_;
227
228	root	1.3	if (!defined $x) {
229	root	1.10	$$_ &= ~$mark_symbols for @{ delete $self->{unmark} \|\| [] };
230	root	1.3	# pass
231
232			} elsif ($x == MOVE_HANDICAP) {
233	root	1.10	$$_ &= ~$mark_symbols for @{ delete $self->{unmark} \|\| [] };
234
235	root	1.3	# $y = #handicap stones
236			my $c = $HANDICAP_COORD{$self->{size}}
237			or Carp::croak "$self->{size}: illegal board size for handicap";
238			my $h = $HANDICAP_XY{$y}
239			or Carp::croak "$y: illegal number of handicap stones";
240
241			for (@$h) {
242			my ($x, $y) = map $c->[$_], split /,/;
243			$board->[$x][$y] = MARK_B \| MARK_MOVE;
244			}
245
246			} else {
247	root	1.9	my $space = \$board->[$x][$y];
248
249			$$space = $$space & ~$clr \| $set;
250	root	1.1
251			$self->{label}[$x][$y] = $label if $set & MARK_LABEL;
252
253			if ($set & MARK_MOVE) {
254	root	1.10	$$_ &= ~$mark_symbols for @{ $self->{unmark} \|\| [] };
255	root	1.9	@{ $self->{unmark} } = $space;
256	root	1.1
257	elmex	1.15	# remark the space, in case the move was on the same spot as the
258			# old mark
259			$$space \|= $set;
260
261	root	1.1	unless (${ $_->[5] \|\|= \my $hint }) {
262			my ($own, $opp) =
263			$set & MARK_B
264			? (MARK_B, MARK_W)
265			: (MARK_W, MARK_B);
266
267	elmex	1.14	my (@capture, @suicide);
268	root	1.1
269			push @capture, $self->capture ($opp, $x-1, $y) if $x > 0 && $board->[$x-1][$y] & $opp;
270			push @capture, $self->capture ($opp, $x+1, $y) if $x < $self->{max} && $board->[$x+1][$y] & $opp;
271			push @capture, $self->capture ($opp, $x, $y-1) if $y > 0 && $board->[$x][$y-1] & $opp;
272			push @capture, $self->capture ($opp, $x, $y+1) if $y < $self->{max} && $board->[$x][$y+1] & $opp;
273
274			# keep only unique coordinates
275			@capture = do { my %seen; grep !$seen{"$_->[0],$_->[1]"}++, @capture };
276
277			# remove captured stones
278	root	1.9	$self->{captures}[$own == MARK_B ? COLOUR_BLACK : COLOUR_WHITE] += @capture;
279			$self->{board}[$_->[0]][$_->[1]] = 0
280	root	1.1	for @capture;
281
282	elmex	1.14	push @suicide, $self->capture ($own, $x, $y);
283	root	1.1
284	elmex	1.14	${ $_->[5] } \|\|= !(@capture \|\| @suicide);
285	root	1.1
286	elmex	1.14	if (@suicide) {
287			$self->{board}[$_->[0]][$_->[1]] = 0
288			for @suicide;
289	elmex	1.15	# count suicides as other sides stones
290			$self->{captures}[$opp == MARK_B ? COLOUR_BLACK : COLOUR_WHITE] += @suicide;
291	elmex	1.13
292	elmex	1.14	} elsif (!@suicide && @capture == 1) {
293	root	1.1	# possible ko. now check liberties on placed stone
294
295			my $libs;
296
297			$libs++ if $x > 0 && !($board->[$x-1][$y] & $opp);
298			$libs++ if $x < $self->{max} && !($board->[$x+1][$y] & $opp);
299			$libs++ if $y > 0 && !($board->[$x][$y-1] & $opp);
300			$libs++ if $y < $self->{max} && !($board->[$x][$y+1] & $opp);
301
302			if ($libs == 1) {
303	root	1.9	$$space = $$space & ~$mark_symbols \| MARK_KO;
304
305	root	1.1	($x, $y) = @{$capture[0]};
306	root	1.9	$board->[$x][$y] \|= MARK_KO;
307
308			push @{ $self->{unmark} }, \$board->[$x][$y];
309	root	1.1	}
310			}
311			}
312			}
313			}
314			}
315			}
316
317			=item $board->is_valid_move ($colour, $x, $y[, $may_suicide])
318
319			Returns true if the move of the given colour on the given coordinates is
320	root	1.4	valid or not. Kos are taken into account as long as they are marked with
321			C<MARK_KO>. Suicides are invalid unless C<$may_suicide> is true (e.g. for
322			new zealand rules)
323	root	1.1
324			=cut
325
326			sub is_valid_move {
327			my ($self, $colour, $x, $y, $may_suicide) = @_;
328
329			my $board = $self->{board};
330
331	elmex	1.12	return if $board->[$x][$y] & (MARK_B \| MARK_W \| MARK_KO)
332			&& !($board->[$x][$y] & MARK_GRAYED);
333	root	1.1
334			if ($may_suicide) {
335			return 1;
336			} else {
337			my ($own, $opp) = $colour == COLOUR_BLACK
338			? (MARK_B, MARK_W)
339			: (MARK_W, MARK_B);
340
341			# try the move
342			local $board->[$x][$y] = $board->[$x][$y] \| $own;
343
344			return 1 if $x > 0 && $board->[$x-1][$y] & $opp && $self->capture ($opp, $x-1, $y, 1);
345			return 1 if $x < $self->{max} && $board->[$x+1][$y] & $opp && $self->capture ($opp, $x+1, $y, 1);
346			return 1 if $y > 0 && $board->[$x][$y-1] & $opp && $self->capture ($opp, $x, $y-1, 1);
347			return 1 if $y < $self->{max} && $board->[$x][$y+1] & $opp && $self->capture ($opp, $x, $y+1, 1);
348
349			return !$self->capture ($own, $x, $y, 1);
350			}
351			}
352
353			1;
354
355			=back
356
357			=head2 AUTHOR
358
359			Marc Lehmann <schmorp@schmorp.de>
360
361			=head2 SEE ALSO
362
363	root	1.3	L<Gtk2::GoBoard>.
364	root	1.1
365			=cut
366