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.3 by root, Mon Jun 23 20:41:16 2008 UTC vs.
Revision 1.17 by root, Tue Jul 29 10:07:08 2008 UTC

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

Diff Legend

Removed lines
+ Added lines
< Changed lines
> Changed lines