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