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.14 by elmex, Thu Jul 24 08:58:02 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
35 36
36 MOVE_HANDICAP # used as "x-coordinate" for handicap moves 37 MOVE_HANDICAP # used as "x-coordinate" for handicap moves
37 MOVE_PASS # can be used as "x-coordinate" for handicap moves 38 MOVE_PASS # can be used as "x-coordinate" for pass moves
38 39
39=head2 METHODS 40=head2 METHODS
40 41
41=over 4 42=over 4
42 43
51 52
52our $VERSION = '1.0'; 53our $VERSION = '1.0';
53 54
54our @EXPORT = qw( 55our @EXPORT = qw(
55 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
56 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
57 MARK_REDRAW 58 MARK_REDRAW
58 COLOUR_BLACK COLOUR_WHITE 59 COLOUR_BLACK COLOUR_WHITE
59 MOVE_HANDICAP MOVE_PASS 60 MOVE_HANDICAP MOVE_PASS
60); 61);
61 62
71sub MARK_GRAYED (){ 0x0080 } # in conjunction with MARK_[BW], grays the stone 72sub MARK_GRAYED (){ 0x0080 } # in conjunction with MARK_[BW], grays the stone
72sub MARK_LABEL (){ 0x0100 } 73sub MARK_LABEL (){ 0x0100 }
73sub MARK_HOSHI (){ 0x0200 } # this is a hoshi point (not used much) 74sub MARK_HOSHI (){ 0x0200 } # this is a hoshi point (not used much)
74sub MARK_MOVE (){ 0x0400 } # this is a regular move 75sub MARK_MOVE (){ 0x0400 } # this is a regular move
75sub MARK_KO (){ 0x0800 } # this is a ko position 76sub MARK_KO (){ 0x0800 } # this is a ko position
77sub MARK_CROSS (){ 0x1000 }
76sub MARK_REDRAW (){ 0x8000 } 78sub MARK_REDRAW (){ 0x8000 }
77 79
78sub COLOUR_BLACK (){ 0 }
79sub COLOUR_WHITE (){ 1 } 80sub COLOUR_WHITE (){ 0 }
81sub COLOUR_BLACK (){ 1 }
80 82
81sub MOVE_PASS (){ undef } 83sub MOVE_PASS (){ undef }
82sub MOVE_HANDICAP (){ -2 } 84sub MOVE_HANDICAP (){ -2 }
83 85
84=item my $board = new $size 86=item my $board = new $size
87 89
88C<< $board->{size} >> stores the board size. 90C<< $board->{size} >> stores the board size.
89 91
90C<< $board->{max} >> stores the maximum board coordinate (size-1). 92C<< $board->{max} >> stores the maximum board coordinate (size-1).
91 93
92C<< $board->{captures}[COLOUR] >> stores the number of captured stones for 94C<< $board->{captures}[COLOUR_xxx] >> stores the number of captured stones for
93the given colour. 95the given colour.
94
95C<< $board->{last} >> stores the colour of the last move that was played.
96 96
97C<< $board->{board} >> stores a two-dimensional array with board contents. 97C<< $board->{board} >> stores a two-dimensional array with board contents.
98 98
99=cut 99=cut
100 100
101sub new { 101sub new {
102 my $class = shift; 102 my $class = shift;
103 my $size = shift; 103 my $size = shift;
104
105 unless ($size > 0) {
106 Carp::croak ("no board size given!");
107 }
108
104 bless { 109 bless {
105 max => $size - 1, 110 max => $size - 1,
106 size => $size, 111 size => $size,
107 board => [map [(0) x $size], 1 .. $size], 112 board => [map [(0) x $size], 1 .. $size],
108 captures => [0, 0], # captures 113 captures => [0, 0], # captures
109 #timer => [], 114 #timer => [],
110 #score => [], 115 #score => [],
111 #last => COLOUR_...,
112 @_
113 }, 116 @_,
114 $class; 117 }, $class
115} 118}
116 119
117# inefficient and primitive, I hear you say? 120# inefficient and primitive, I hear you say?
118# well... you are right :) 121# well... you are right :)
119# 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
127 130
128 my $max = $self->{max}; 131 my $max = $self->{max};
129 132
130 while (@nodes) { 133 while (@nodes) {
131 my ($x, $y) = @{pop @nodes}; 134 my ($x, $y) = @{pop @nodes};
135
132 unless ($seen{$x,$y}++) { 136 unless ($seen{$x,$y}++) {
133 if ($board->[$x][$y] & $mark) { 137 if ($board->[$x][$y] & $mark) {
134 push @found, [$x, $y]; 138 push @found, [$x, $y];
135 139
136 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;
149=item $hint = $board->update ([update-structures...]) 153=item $hint = $board->update ([update-structures...])
150 154
151Each update-structure itself is also an array-ref: 155Each update-structure itself is also an array-ref:
152 156
153 [$x, $y, $clr, $set, $label, $hint] # update or move 157 [$x, $y, $clr, $set, $label, $hint] # update or move
154 [MOVE_HANDICAP, $handicap] # black move, set handicap 158 [MOVE_HANDICAP, $handicap] # black move, setup handicap
155 [MOVE_PASS] # pass 159 [MOVE_PASS] # pass
156 [] # also pass 160 [] # also pass (deprecated!)
157 161
158It 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
159specified in C<$clr>, then setting bits specified in C<$set>. 163specified in C<$clr>, then setting bits specified in C<$set>.
160 164
161If 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
162C<$label>. 166C<$label>.
163 167
164If C<$set> contains C<MARK_MOVE>, then a circle symbol will be placed on 168If 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 169from the board and (simple) Kos are detected and marked with square
166move marker). 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.
167 176
168For handicap "moves", currently only board sizes 9, 13 and 19 are 177For handicap "moves", currently only board sizes 9, 13 and 19 are
169supported and only handicap values from 2 to 9. The placement follows the 178supported 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. 179IGS rules, if you want other placements, you have to set it up yourself.
171 180
172This function modifies the hint member of the specified path to speed up 181This function modifies the C<$hint> member of the specified structure
173repeated board generation and updates with the same update structures. 182to speed up repeated board generation and updates with the same update
183structures.
174 184
175If 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
176is updated instead. 186is updated instead.
177 187
178If 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
179as 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
180keep your update structures around, however, as regenerating a full board 190you keep your update structures around as long as previous updates don't
181position from hinted update structures is I<much> faster then recreating 191change, however, as regenerating a full board position from hinted
182it from fresh update structures. 192update structures is I<much> faster then recreating it from fresh update
193structures.
183 194
184Example, make two silly moves: 195Example, make two silly moves:
185 196
186 $board->update ([[0, 18, -1, MARK_B|MARK_MOVE], 197 $board->update ([[0, 18, -1, MARK_B | MARK_MOVE],
187 [0, 17, -1, MARK_W|MARK_MOVE]]); 198 [0, 17, -1, MARK_W | MARK_MOVE]]);
188 199
189=cut 200=cut
190 201
191our %HANDICAP_COORD = ( 202our %HANDICAP_COORD = (
192 9 => [2, 4, 6], 203 9 => [2, 4, 6],
193 13 => [3, 6, 9], 204 13 => [3, 6, 9],
194 19 => [3, 9, 15], 205 19 => [3, 9, 15],
195); 206);
196our %HANDICAP_XY = ( 207our %HANDICAP_XY = (
197 2 => [qw(0,2 2,0 )], 208 2 => [qw(0,2 2,0 )],
198 3 => [qw(0,2 2,0 2,2 )], 209 3 => [qw(0,2 2,0 0,0 )],
199 4 => [qw(0,2 2,0 2,2 0,0 )], 210 4 => [qw(0,2 2,0 0,0 2,2 )],
200 5 => [qw(0,2 2,0 2,2 0,0 1,1)], 211 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 )], 212 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)], 213 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 )], 214 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)], 215 9 => [qw(0,2 2,0 0,0 2,2 0,1 2,1 1,0 1,2 1,1)],
205); 216);
217
218our $mark_symbols = MARK_CIRCLE | MARK_SQUARE | MARK_TRIANGLE | MARK_CROSS | MARK_KO;
206 219
207sub update { 220sub update {
208 my ($self, $path) = @_; 221 my ($self, $path) = @_;
209 222
210 my $board = $self->{board}; 223 my $board = $self->{board};
211 224
212 for (@$path) { 225 for (@$path) {
213 my ($x, $y, $clr, $set, $label) = @$_; 226 my ($x, $y, $clr, $set, $label) = @$_;
214 227
215 my $nodemask =
216 $_ == $path->[-1]
217 ? ~0
218 : ~(MARK_SQUARE | MARK_TRIANGLE | MARK_CIRCLE | MARK_LABEL | MARK_KO);
219
220 if (!defined $x) { 228 if (!defined $x) {
229 $$_ &= ~$mark_symbols for @{ delete $self->{unmark} || [] };
221 # pass 230 # pass
222 $self->{last} = $set & MARK_B ? COLOUR_BLACK : COLOUR_WHITE;
223 231
224 } elsif ($x == MOVE_HANDICAP) { 232 } elsif ($x == MOVE_HANDICAP) {
233 $$_ &= ~$mark_symbols for @{ delete $self->{unmark} || [] };
234
225 # $y = #handicap stones 235 # $y = #handicap stones
226 my $c = $HANDICAP_COORD{$self->{size}} 236 my $c = $HANDICAP_COORD{$self->{size}}
227 or Carp::croak "$self->{size}: illegal board size for handicap"; 237 or Carp::croak "$self->{size}: illegal board size for handicap";
228 my $h = $HANDICAP_XY{$y} 238 my $h = $HANDICAP_XY{$y}
229 or Carp::croak "$y: illegal number of handicap stones"; 239 or Carp::croak "$y: illegal number of handicap stones";
232 my ($x, $y) = map $c->[$_], split /,/; 242 my ($x, $y) = map $c->[$_], split /,/;
233 $board->[$x][$y] = MARK_B | MARK_MOVE; 243 $board->[$x][$y] = MARK_B | MARK_MOVE;
234 } 244 }
235 245
236 } else { 246 } else {
237 $board->[$x][$y] = 247 my $space = \$board->[$x][$y];
238 $board->[$x][$y] 248
239 & ~$clr 249 $$space = $$space & ~$clr | $set;
240 | $set
241 & $nodemask;
242 250
243 $self->{label}[$x][$y] = $label if $set & MARK_LABEL; 251 $self->{label}[$x][$y] = $label if $set & MARK_LABEL;
244 252
245 if ($set & MARK_MOVE) { 253 if ($set & MARK_MOVE) {
246 $self->{last} = $set & MARK_B ? COLOUR_BLACK : COLOUR_WHITE; 254 $$_ &= ~$mark_symbols for @{ $self->{unmark} || [] };
255 @{ $self->{unmark} } = $space;
247 256
248 unless (${ $_->[5] ||= \my $hint }) { 257 unless (${ $_->[5] ||= \my $hint }) {
249 my ($own, $opp) = 258 my ($own, $opp) =
250 $set & MARK_B 259 $set & MARK_B
251 ? (MARK_B, MARK_W) 260 ? (MARK_B, MARK_W)
252 : (MARK_W, MARK_B); 261 : (MARK_W, MARK_B);
253 262
254 my (@capture, $suicide); 263 my (@capture, @suicide);
255 264
256 push @capture, $self->capture ($opp, $x-1, $y) if $x > 0 && $board->[$x-1][$y] & $opp; 265 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; 266 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; 267 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; 268 push @capture, $self->capture ($opp, $x, $y+1) if $y < $self->{max} && $board->[$x][$y+1] & $opp;
260 269
261 # keep only unique coordinates 270 # keep only unique coordinates
262 @capture = do { my %seen; grep !$seen{"$_->[0],$_->[1]"}++, @capture }; 271 @capture = do { my %seen; grep !$seen{"$_->[0],$_->[1]"}++, @capture };
263 272
264 # remove captured stones 273 # remove captured stones
265 $self->{captures}[$self->{last}] += @capture; 274 $self->{captures}[$own == MARK_B ? COLOUR_BLACK : COLOUR_WHITE] += @capture;
266 $self->{board}[$_->[0]][$_->[1]] &= ~(MARK_B | MARK_W | MARK_MOVE) 275 $self->{board}[$_->[0]][$_->[1]] = 0
267 for @capture; 276 for @capture;
268 277
269 $suicide += $self->capture ($own, $x, $y); 278 push @suicide, $self->capture ($own, $x, $y);
270 279
271 ${ $_->[5] } ||= !(@capture || $suicide); 280 ${ $_->[5] } ||= !(@capture || @suicide);
272 281
282 if (@suicide) {
283 $self->{board}[$_->[0]][$_->[1]] = 0
284 for @suicide;
285
273 if (!$suicide && @capture == 1) { 286 } elsif (!@suicide && @capture == 1) {
274 # possible ko. now check liberties on placed stone 287 # possible ko. now check liberties on placed stone
275 288
276 my $libs; 289 my $libs;
277 290
278 $libs++ if $x > 0 && !($board->[$x-1][$y] & $opp); 291 $libs++ if $x > 0 && !($board->[$x-1][$y] & $opp);
279 $libs++ if $x < $self->{max} && !($board->[$x+1][$y] & $opp); 292 $libs++ if $x < $self->{max} && !($board->[$x+1][$y] & $opp);
280 $libs++ if $y > 0 && !($board->[$x][$y-1] & $opp); 293 $libs++ if $y > 0 && !($board->[$x][$y-1] & $opp);
281 $libs++ if $y < $self->{max} && !($board->[$x][$y+1] & $opp); 294 $libs++ if $y < $self->{max} && !($board->[$x][$y+1] & $opp);
282 295
283 if ($libs == 1) { 296 if ($libs == 1) {
284 $board->[$x][$y] = $board->[$x][$y] & ~MARK_CIRCLE | (MARK_KO & $nodemask); 297 $$space = $$space & ~$mark_symbols | MARK_KO;
298
285 ($x, $y) = @{$capture[0]}; 299 ($x, $y) = @{$capture[0]};
286 $board->[$x][$y] |= MARK_KO & $nodemask; 300 $board->[$x][$y] |= MARK_KO;
301
302 push @{ $self->{unmark} }, \$board->[$x][$y];
287 } 303 }
288 } 304 }
289 } 305 }
290 } 306 }
291 } 307 }
293} 309}
294 310
295=item $board->is_valid_move ($colour, $x, $y[, $may_suicide]) 311=item $board->is_valid_move ($colour, $x, $y[, $may_suicide])
296 312
297Returns true if the move of the given colour on the given coordinates is 313Returns true if the move of the given colour on the given coordinates is
298valid or not. 314valid or not. Kos are taken into account as long as they are marked with
315C<MARK_KO>. Suicides are invalid unless C<$may_suicide> is true (e.g. for
316new zealand rules)
299 317
300=cut 318=cut
301 319
302sub is_valid_move { 320sub is_valid_move {
303 my ($self, $colour, $x, $y, $may_suicide) = @_; 321 my ($self, $colour, $x, $y, $may_suicide) = @_;
304 322
305 my $board = $self->{board}; 323 my $board = $self->{board};
306 324
307 return if $board->[$x][$y] & (MARK_B | MARK_W | MARK_KO); 325 return if $board->[$x][$y] & (MARK_B | MARK_W | MARK_KO)
326 && !($board->[$x][$y] & MARK_GRAYED);
308 327
309 if ($may_suicide) { 328 if ($may_suicide) {
310 return 1; 329 return 1;
311 } else { 330 } else {
312 my ($own, $opp) = $colour == COLOUR_BLACK 331 my ($own, $opp) = $colour == COLOUR_BLACK

Diff Legend

Removed lines
+ Added lines
< Changed lines
> Changed lines