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_BLACK  # used for $board->{last}
   COLOUR_WHITE  # to mark the colour of the last move

   MOVE_HANDICAP # used as "x-coordinate" for handicap moves
   MOVE_PASS     # can be used as "x-coordinate" for handicap 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_BLACK  (){ 0 }
sub COLOUR_WHITE  (){ 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] >> stores the number of captured stones for
the given colour.

C<< $board->{last} >> stores the colour of the last move that was played.

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

=cut

sub new {
   my $class = shift;
   my $size = shift;
   bless {
         max      => $size - 1,
         size     => $size,
         board    => [map [(0) x $size], 1 .. $size],
         captures => [0, 0], # captures
        #timer    => [],
        #score    => [],
        #last     => COLOUR_...,
         @_
      },
      $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 a circle symbol will be placed
at this coordinate. Also, surrounded stones will be removed from the
board and (simple) Kos are detected and marked with square symbols and
C<MARK_KO>. The circle and square markings are removed with the next
update 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)],
);

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

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

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

      my $nodemask =
            $_ == $path->[-1]
               ? ~0
               : ~(MARK_SQUARE | MARK_TRIANGLE | MARK_CIRCLE | MARK_LABEL | MARK_KO);

      if (!defined $x) {
         # pass
         $self->{last} = $set & MARK_B ? COLOUR_BLACK : COLOUR_WHITE;

      } elsif ($x == MOVE_HANDICAP) {
         # $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 {
         $board->[$x][$y] =
            $board->[$x][$y]
            & ~$clr
            | $set
            & $nodemask;

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

         if ($set & MARK_MOVE) {
            $self->{last} = $set & MARK_B ? COLOUR_BLACK : COLOUR_WHITE;

            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}[$self->{last}] += @capture;
               $self->{board}[$_->[0]][$_->[1]] &= ~(MARK_B | MARK_W | MARK_MOVE)
                  for @capture;

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

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

               if (!$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) {
                     $board->[$x][$y] = $board->[$x][$y] & ~MARK_CIRCLE | (MARK_KO & $nodemask);
                     ($x, $y) = @{$capture[0]};
                     $board->[$x][$y] |= MARK_KO & $nodemask;
                  }
               }
            }
         }
      }
   }
}

=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);

   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.8
Committed:	Wed Jun 25 04:15:51 2008 UTC (18 years, 2 months ago) by root
Branch:	MAIN
Changes since 1.7:	+1 -1 lines
Log Message:	* empty log message *
#	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			COLOUR_BLACK # used for $board->{last}
35			COLOUR_WHITE # to mark the colour of the last move
36
37	root	1.3	MOVE_HANDICAP # used as "x-coordinate" for handicap moves
38			MOVE_PASS # can be used as "x-coordinate" for handicap moves
39
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			sub COLOUR_BLACK (){ 0 }
81			sub COLOUR_WHITE (){ 1 }
82
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			C<< $board->{captures}[COLOUR] >> stores the number of captured stones for
95			the given colour.
96
97			C<< $board->{last} >> stores the colour of the last move that was played.
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			bless {
107			max => $size - 1,
108	root	1.3	size => $size,
109	root	1.1	board => [map [(0) x $size], 1 .. $size],
110			captures => [0, 0], # captures
111			#timer => [],
112			#score => [],
113			#last => COLOUR_...,
114			@_
115			},
116			$class;
117			}
118
119			# inefficient and primitive, I hear you say?
120			# well... you are right :)
121			# use an extremely dumb floodfill algorithm to get rid of captured stones
122			sub capture {
123			my ($self, $mark, $x, $y) = @_;
124
125			my %seen;
126			my @found;
127			my @nodes = ([$x,$y]);
128			my $board = $self->{board};
129
130			my $max = $self->{max};
131
132			while (@nodes) {
133			my ($x, $y) = @{pop @nodes};
134			unless ($seen{$x,$y}++) {
135			if ($board->[$x][$y] & $mark) {
136			push @found, [$x, $y];
137
138			push @nodes, [$x-1, $y] unless $seen{$x-1, $y} \|\| $x <= 0;
139			push @nodes, [$x+1, $y] unless $seen{$x+1, $y} \|\| $x >= $max;
140			push @nodes, [$x, $y-1] unless $seen{$x, $y-1} \|\| $y <= 0;
141			push @nodes, [$x, $y+1] unless $seen{$x, $y+1} \|\| $y >= $max;
142			} elsif (!($board->[$x][$y] & (MARK_B \| MARK_W))) {
143			return;
144			}
145			}
146			}
147
148			@found
149			}
150
151	root	1.2	=item $hint = $board->update ([update-structures...])
152	root	1.1
153	root	1.2	Each update-structure itself is also an array-ref:
154	root	1.1
155			[$x, $y, $clr, $set, $label, $hint] # update or move
156	root	1.4	[MOVE_HANDICAP, $handicap] # black move, setup handicap
157	root	1.3	[MOVE_PASS] # pass
158	root	1.4	[] # also pass (deprecated!)
159	root	1.1
160	root	1.2	It changes the board or executes a move, by first clearing the bits
161	root	1.1	specified in C<$clr>, then setting bits specified in C<$set>.
162
163			If C<$set> includes C<MARK_LABEL>, the label text must be given in
164			C<$label>.
165
166	root	1.4	If C<$set> contains C<MARK_MOVE>, then a circle symbol will be placed
167			at this coordinate. Also, surrounded stones will be removed from the
168			board and (simple) Kos are detected and marked with square symbols and
169			C<MARK_KO>. The circle and square markings are removed with the next
170			update that uses C<MARK_MOVE>, so this flag is suited well for marking,
171			well, moves. Note that you can make invalid "moves" (such as suicide) and
172			C<update> will try to cope with it. You can use C<is_valid_move> to avoid
173			making illegal moves.
174	root	1.3
175			For handicap "moves", currently only board sizes 9, 13 and 19 are
176			supported and only handicap values from 2 to 9. The placement follows the
177			IGS rules, if you want other placements, you have to set it up yourself.
178
179	root	1.4	This function modifies the C<$hint> member of the specified structure
180			to speed up repeated board generation and updates with the same update
181			structures.
182	root	1.1
183			If the hint member is a reference the scalar pointed to by the reference
184			is updated instead.
185
186	root	1.4	If all this hint member thing is confusing, just ignore it and specify
187			it as C<undef> or leave it out of the array entirely. Do make sure that
188			you keep your update structures around as long as previous updates don't
189			change, however, as regenerating a full board position from hinted
190			update structures is I<much> faster then recreating it from fresh update
191			structures.
192	root	1.2
193	root	1.1	Example, make two silly moves:
194
195	root	1.4	$board->update ([[0, 18, -1, MARK_B \| MARK_MOVE],
196			[0, 17, -1, MARK_W \| MARK_MOVE]]);
197	root	1.1
198			=cut
199
200	root	1.3	our %HANDICAP_COORD = (
201			9 => [2, 4, 6],
202			13 => [3, 6, 9],
203			19 => [3, 9, 15],
204			);
205			our %HANDICAP_XY = (
206			2 => [qw(0,2 2,0 )],
207	root	1.5	3 => [qw(0,2 2,0 0,0 )],
208			4 => [qw(0,2 2,0 0,0 2,2 )],
209			5 => [qw(0,2 2,0 0,0 2,2 1,1)],
210			6 => [qw(0,2 2,0 0,0 2,2 0,1 2,1 )],
211			7 => [qw(0,2 2,0 0,0 2,2 0,1 2,1 1,1)],
212			8 => [qw(0,2 2,0 0,0 2,2 0,1 2,1 1,0 1,2 )],
213			9 => [qw(0,2 2,0 0,0 2,2 0,1 2,1 1,0 1,2 1,1)],
214	root	1.3	);
215
216	root	1.1	sub update {
217			my ($self, $path) = @_;
218
219			my $board = $self->{board};
220
221			for (@$path) {
222			my ($x, $y, $clr, $set, $label) = @$_;
223
224			my $nodemask =
225			$_ == $path->[-1]
226			? ~0
227			: ~(MARK_SQUARE \| MARK_TRIANGLE \| MARK_CIRCLE \| MARK_LABEL \| MARK_KO);
228
229	root	1.3	if (!defined $x) {
230			# pass
231			$self->{last} = $set & MARK_B ? COLOUR_BLACK : COLOUR_WHITE;
232
233			} elsif ($x == MOVE_HANDICAP) {
234			# $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.1	$board->[$x][$y] =
247			$board->[$x][$y]
248			& ~$clr
249			\| $set
250			& $nodemask;
251
252			$self->{label}[$x][$y] = $label if $set & MARK_LABEL;
253
254			if ($set & MARK_MOVE) {
255			$self->{last} = $set & MARK_B ? COLOUR_BLACK : COLOUR_WHITE;
256
257			unless (${ $_->[5] \|\|= \my $hint }) {
258			my ($own, $opp) =
259			$set & MARK_B
260			? (MARK_B, MARK_W)
261			: (MARK_W, MARK_B);
262
263			my (@capture, $suicide);
264
265			push @capture, $self->capture ($opp, $x-1, $y) if $x > 0 && $board->[$x-1][$y] & $opp;
266			push @capture, $self->capture ($opp, $x+1, $y) if $x < $self->{max} && $board->[$x+1][$y] & $opp;
267			push @capture, $self->capture ($opp, $x, $y-1) if $y > 0 && $board->[$x][$y-1] & $opp;
268			push @capture, $self->capture ($opp, $x, $y+1) if $y < $self->{max} && $board->[$x][$y+1] & $opp;
269
270			# keep only unique coordinates
271			@capture = do { my %seen; grep !$seen{"$_->[0],$_->[1]"}++, @capture };
272
273			# remove captured stones
274			$self->{captures}[$self->{last}] += @capture;
275			$self->{board}[$_->[0]][$_->[1]] &= ~(MARK_B \| MARK_W \| MARK_MOVE)
276			for @capture;
277
278			$suicide += $self->capture ($own, $x, $y);
279
280			${ $_->[5] } \|\|= !(@capture \|\| $suicide);
281
282			if (!$suicide && @capture == 1) {
283			# possible ko. now check liberties on placed stone
284
285			my $libs;
286
287			$libs++ if $x > 0 && !($board->[$x-1][$y] & $opp);
288			$libs++ if $x < $self->{max} && !($board->[$x+1][$y] & $opp);
289			$libs++ if $y > 0 && !($board->[$x][$y-1] & $opp);
290			$libs++ if $y < $self->{max} && !($board->[$x][$y+1] & $opp);
291
292			if ($libs == 1) {
293			$board->[$x][$y] = $board->[$x][$y] & ~MARK_CIRCLE \| (MARK_KO & $nodemask);
294			($x, $y) = @{$capture[0]};
295			$board->[$x][$y] \|= MARK_KO & $nodemask;
296			}
297			}
298			}
299			}
300			}
301			}
302			}
303
304			=item $board->is_valid_move ($colour, $x, $y[, $may_suicide])
305
306			Returns true if the move of the given colour on the given coordinates is
307	root	1.4	valid or not. Kos are taken into account as long as they are marked with
308			C<MARK_KO>. Suicides are invalid unless C<$may_suicide> is true (e.g. for
309			new zealand rules)
310	root	1.1
311			=cut
312
313			sub is_valid_move {
314			my ($self, $colour, $x, $y, $may_suicide) = @_;
315
316			my $board = $self->{board};
317
318			return if $board->[$x][$y] & (MARK_B \| MARK_W \| MARK_KO);
319
320			if ($may_suicide) {
321			return 1;
322			} else {
323			my ($own, $opp) = $colour == COLOUR_BLACK
324			? (MARK_B, MARK_W)
325			: (MARK_W, MARK_B);
326
327			# try the move
328			local $board->[$x][$y] = $board->[$x][$y] \| $own;
329
330			return 1 if $x > 0 && $board->[$x-1][$y] & $opp && $self->capture ($opp, $x-1, $y, 1);
331			return 1 if $x < $self->{max} && $board->[$x+1][$y] & $opp && $self->capture ($opp, $x+1, $y, 1);
332			return 1 if $y > 0 && $board->[$x][$y-1] & $opp && $self->capture ($opp, $x, $y-1, 1);
333			return 1 if $y < $self->{max} && $board->[$x][$y+1] & $opp && $self->capture ($opp, $x, $y+1, 1);
334
335			return !$self->capture ($own, $x, $y, 1);
336			}
337			}
338
339			1;
340
341			=back
342
343			=head2 AUTHOR
344
345			Marc Lehmann <schmorp@schmorp.de>
346
347			=head2 SEE ALSO
348
349	root	1.3	L<Gtk2::GoBoard>.
350	root	1.1
351			=cut
352