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.4 by root, Tue Jun 24 04:39:07 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
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;
… …
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 168If C<$set> contains C<MARK_MOVE> then surrounded stones will be removed
165at this coordinate. Also, surrounded stones will be removed from the
166board and (simple) Kos are detected and marked with square symbols and 169from the board and (simple) Kos are detected and marked with square
167C<MARK_KO>. The circle and square markings are removed with the next 170symbols and C<MARK_KO>, after removing other marking symbols. The
171markings are also removed with the next next update structure that uses
168update that uses C<MARK_MOVE>, so this flag is suited well for marking, 172C<MARK_MOVE>, so this flag is suited well for marking, well, moves. Note
169well, moves. Note that you can make invalid "moves" (such as suicide) and 173that you can make invalid "moves" (such as suicide) and C<update> will
170C<update> will try to cope with it. You can use C<is_valid_move> to avoid 174try to cope with it. You can use C<is_valid_move> to avoid making illegal
171making illegal moves. 175moves.
172 176
173For handicap "moves", currently only board sizes 9, 13 and 19 are 177For handicap "moves", currently only board sizes 9, 13 and 19 are
174supported 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
175IGS 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.
176 180
… …
200 13 => [3, 6, 9], 204 13 => [3, 6, 9],
201 19 => [3, 9, 15], 205 19 => [3, 9, 15],
202); 206);
203our %HANDICAP_XY = ( 207our %HANDICAP_XY = (
204 2 => [qw(0,2 2,0 )], 208 2 => [qw(0,2 2,0 )],
205 3 => [qw(0,2 2,0 2,2 )], 209 3 => [qw(0,2 2,0 0,0 )],
206 4 => [qw(0,2 2,0 2,2 0,0 )], 210 4 => [qw(0,2 2,0 0,0 2,2 )],
207 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)],
208 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 )],
209 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)],
210 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 )],
211 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)],
212); 216);
217
218our $mark_symbols = MARK_CIRCLE | MARK_SQUARE | MARK_TRIANGLE | MARK_CROSS | MARK_KO;
213 219
214sub update { 220sub update {
215 my ($self, $path) = @_; 221 my ($self, $path) = @_;
216 222
217 my $board = $self->{board}; 223 my $board = $self->{board};
218 224
219 for (@$path) { 225 for (@$path) {
220 my ($x, $y, $clr, $set, $label) = @$_; 226 my ($x, $y, $clr, $set, $label) = @$_;
221 227
222 my $nodemask =
223 $_ == $path->[-1]
224 ? ~0
225 : ~(MARK_SQUARE | MARK_TRIANGLE | MARK_CIRCLE | MARK_LABEL | MARK_KO);
226
227 if (!defined $x) { 228 if (!defined $x) {
229 $$_ &= ~$mark_symbols for @{ delete $self->{unmark} || [] };
228 # pass 230 # pass
229 $self->{last} = $set & MARK_B ? COLOUR_BLACK : COLOUR_WHITE;
230 231
231 } elsif ($x == MOVE_HANDICAP) { 232 } elsif ($x == MOVE_HANDICAP) {
233 $$_ &= ~$mark_symbols for @{ delete $self->{unmark} || [] };
234
232 # $y = #handicap stones 235 # $y = #handicap stones
233 my $c = $HANDICAP_COORD{$self->{size}} 236 my $c = $HANDICAP_COORD{$self->{size}}
234 or Carp::croak "$self->{size}: illegal board size for handicap"; 237 or Carp::croak "$self->{size}: illegal board size for handicap";
235 my $h = $HANDICAP_XY{$y} 238 my $h = $HANDICAP_XY{$y}
236 or Carp::croak "$y: illegal number of handicap stones"; 239 or Carp::croak "$y: illegal number of handicap stones";
… …
239 my ($x, $y) = map $c->[$_], split /,/; 242 my ($x, $y) = map $c->[$_], split /,/;
240 $board->[$x][$y] = MARK_B | MARK_MOVE; 243 $board->[$x][$y] = MARK_B | MARK_MOVE;
241 } 244 }
242 245
243 } else { 246 } else {
244 $board->[$x][$y] = 247 my $space = \$board->[$x][$y];
245 $board->[$x][$y] 248
246 & ~$clr 249 $$space = $$space & ~$clr | $set;
247 | $set
248 & $nodemask;
249 250
250 $self->{label}[$x][$y] = $label if $set & MARK_LABEL; 251 $self->{label}[$x][$y] = $label if $set & MARK_LABEL;
251 252
252 if ($set & MARK_MOVE) { 253 if ($set & MARK_MOVE) {
253 $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;
254 260
255 unless (${ $_->[5] ||= \my $hint }) { 261 unless (${ $_->[5] ||= \my $hint }) {
256 my ($own, $opp) = 262 my ($own, $opp) =
257 $set & MARK_B 263 $set & MARK_B
258 ? (MARK_B, MARK_W) 264 ? (MARK_B, MARK_W)
259 : (MARK_W, MARK_B); 265 : (MARK_W, MARK_B);
260 266
261 my (@capture, $suicide); 267 my (@capture, @suicide);
262 268
263 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;
264 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;
265 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;
266 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;
267 273
268 # keep only unique coordinates 274 # keep only unique coordinates
269 @capture = do { my %seen; grep !$seen{"$_->[0],$_->[1]"}++, @capture }; 275 @capture = do { my %seen; grep !$seen{"$_->[0],$_->[1]"}++, @capture };
270 276
271 # remove captured stones 277 # remove captured stones
272 $self->{captures}[$self->{last}] += @capture; 278 $self->{captures}[$own == MARK_B ? COLOUR_BLACK : COLOUR_WHITE] += @capture;
273 $self->{board}[$_->[0]][$_->[1]] &= ~(MARK_B | MARK_W | MARK_MOVE) 279 $self->{board}[$_->[0]][$_->[1]] = 0
274 for @capture; 280 for @capture;
275 281
276 $suicide += $self->capture ($own, $x, $y); 282 push @suicide, $self->capture ($own, $x, $y);
277 283
278 ${ $_->[5] } ||= !(@capture || $suicide); 284 ${ $_->[5] } ||= !(@capture || @suicide);
279 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
280 if (!$suicide && @capture == 1) { 292 } elsif (!@suicide && @capture == 1) {
281 # possible ko. now check liberties on placed stone 293 # possible ko. now check liberties on placed stone
282 294
283 my $libs; 295 my $libs;
284 296
285 $libs++ if $x > 0 && !($board->[$x-1][$y] & $opp); 297 $libs++ if $x > 0 && !($board->[$x-1][$y] & $opp);
286 $libs++ if $x < $self->{max} && !($board->[$x+1][$y] & $opp); 298 $libs++ if $x < $self->{max} && !($board->[$x+1][$y] & $opp);
287 $libs++ if $y > 0 && !($board->[$x][$y-1] & $opp); 299 $libs++ if $y > 0 && !($board->[$x][$y-1] & $opp);
288 $libs++ if $y < $self->{max} && !($board->[$x][$y+1] & $opp); 300 $libs++ if $y < $self->{max} && !($board->[$x][$y+1] & $opp);
289 301
290 if ($libs == 1) { 302 if ($libs == 1) {
291 $board->[$x][$y] = $board->[$x][$y] & ~MARK_CIRCLE | (MARK_KO & $nodemask); 303 $$space = $$space & ~$mark_symbols | MARK_KO;
304
292 ($x, $y) = @{$capture[0]}; 305 ($x, $y) = @{$capture[0]};
293 $board->[$x][$y] |= MARK_KO & $nodemask; 306 $board->[$x][$y] |= MARK_KO;
307
308 push @{ $self->{unmark} }, \$board->[$x][$y];
294 } 309 }
295 } 310 }
296 } 311 }
297 } 312 }
298 } 313 }
… …
311sub is_valid_move { 326sub is_valid_move {
312 my ($self, $colour, $x, $y, $may_suicide) = @_; 327 my ($self, $colour, $x, $y, $may_suicide) = @_;
313 328
314 my $board = $self->{board}; 329 my $board = $self->{board};
315 330
316 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);
317 333
318 if ($may_suicide) { 334 if ($may_suicide) {
319 return 1; 335 return 1;
320 } else { 336 } else {
321 my ($own, $opp) = $colour == COLOUR_BLACK 337 my ($own, $opp) = $colour == COLOUR_BLACK

Diff Legend

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