ViewVC Help
View File | Revision Log | Show Annotations | Download File
/cvs/Games-Go-SimpleBoard/SimpleBoard.pm
(Generate patch)

Comparing Games-Go-SimpleBoard/SimpleBoard.pm (file contents):
Revision 1.2 by root, Mon Jun 23 00:38:35 2008 UTC vs.
Revision 1.15 by elmex, Thu Jul 24 09:14:12 2008 UTC

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

Diff Legend

– Removed lines
+ Added lines
< Changed lines
> Changed lines