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.6 by root, Tue Jun 24 23:19:24 2008 UTC vs.
Revision 1.16 by elmex, Tue Jul 29 10:03:52 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 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_CROSS # cross mark
23 MARK_SMALL_B # small stone, used for scoring or marking 23 MARK_SMALL_B # small stone, used for scoring or marking
24 MARK_SMALL_W # small stone, used for scoring or marking 24 MARK_SMALL_W # small stone, used for scoring or marking
25 MARK_B # normal black stone 25 MARK_B # normal black stone
26 MARK_W # normal whit stone 26 MARK_W # normal whit stone
27 MARK_GRAYED # in conjunction with MARK_[BW], grays the stone 27 MARK_GRAYED # in conjunction with MARK_[BW], grays the stone
28 MARK_SMALL_GRAYED # in conjunction with MARK_SMALL_[BW], grays the stone
28 MARK_LABEL # a text label 29 MARK_LABEL # a text label
29 MARK_HOSHI # this is a hoshi point (not used much) 30 MARK_HOSHI # this is a hoshi point (not used much)
30 MARK_MOVE # this is a regular move 31 MARK_MOVE # this is a regular move
31 MARK_KO # this is a ko position 32 MARK_KO # this is a ko position
32 MARK_REDRAW # ignored, can be used for your own purposes 33 MARK_REDRAW # ignored, can be used for your own purposes
33 34
34 COLOUR_BLACK # used for $board->{last} 35 COLOUR_WHITE # guarenteed to be 0
35 COLOUR_WHITE # to mark the colour of the last move 36 COLOUR_BLACK # guarenteed to be 1
36 37
37 MOVE_HANDICAP # used as "x-coordinate" for handicap moves 38 MOVE_HANDICAP # used as "x-coordinate" for handicap moves
38 MOVE_PASS # can be used as "x-coordinate" for handicap moves 39 MOVE_PASS # can be used as "x-coordinate" for pass moves
39 40
40=head2 METHODS 41=head2 METHODS
41 42
42=over 4 43=over 4
43 44
… …
52 53
53our $VERSION = '1.0'; 54our $VERSION = '1.0';
54 55
55our @EXPORT = qw( 56our @EXPORT = qw(
56 MARK_TRIANGLE MARK_SQUARE MARK_CIRCLE MARK_SMALL_B MARK_SMALL_W MARK_B 57 MARK_TRIANGLE MARK_SQUARE MARK_CIRCLE MARK_SMALL_B MARK_SMALL_W MARK_B
57 MARK_W MARK_GRAYED MARK_MOVE MARK_LABEL MARK_HOSHI MARK_KO 58 MARK_W MARK_GRAYED MARK_SMALL_GRAYED MARK_MOVE MARK_LABEL MARK_HOSHI MARK_KO MARK_CROSS
58 MARK_REDRAW 59 MARK_REDRAW
59 COLOUR_BLACK COLOUR_WHITE 60 COLOUR_BLACK COLOUR_WHITE
60 MOVE_HANDICAP MOVE_PASS 61 MOVE_HANDICAP MOVE_PASS
61); 62);
62 63
63# marker types for each board position (ORed together) 64# marker types for each board position (ORed together)
64 65
65sub MARK_TRIANGLE (){ 0x0001 } 66sub MARK_TRIANGLE (){ 0x0001 }
66sub MARK_SQUARE (){ 0x0002 } 67sub MARK_SQUARE (){ 0x0002 }
67sub MARK_CIRCLE (){ 0x0004 } 68sub MARK_CIRCLE (){ 0x0004 }
68sub MARK_SMALL_B (){ 0x0008 } # small stone, used for scoring or marking 69sub MARK_SMALL_B (){ 0x0008 } # small stone, used for scoring or marking
69sub MARK_SMALL_W (){ 0x0010 } # small stone, used for scoring or marking 70sub MARK_SMALL_W (){ 0x0010 } # small stone, used for scoring or marking
70sub MARK_B (){ 0x0020 } # normal black stone 71sub MARK_B (){ 0x0020 } # normal black stone
71sub MARK_W (){ 0x0040 } # normal whit stone 72sub MARK_W (){ 0x0040 } # normal whit stone
72sub MARK_GRAYED (){ 0x0080 } # in conjunction with MARK_[BW], grays the stone 73sub MARK_GRAYED (){ 0x0080 } # in conjunction with MARK_[BW], grays the stone
74sub MARK_SMALL_GRAYED (){ 0x0100 }
73sub MARK_LABEL (){ 0x0100 } 75sub MARK_LABEL (){ 0x0200 }
74sub MARK_HOSHI (){ 0x0200 } # this is a hoshi point (not used much) 76sub MARK_HOSHI (){ 0x0400 } # this is a hoshi point (not used much)
75sub MARK_MOVE (){ 0x0400 } # this is a regular move 77sub MARK_MOVE (){ 0x0800 } # this is a regular move
76sub MARK_KO (){ 0x0800 } # this is a ko position 78sub MARK_KO (){ 0x1000 } # this is a ko position
77sub MARK_CIRCLE (){ 0x1000 } 79sub MARK_CROSS (){ 0x2000 }
78sub MARK_REDRAW (){ 0x8000 } 80sub MARK_REDRAW (){ 0x8000 }
79 81
80sub COLOUR_BLACK (){ 0 }
81sub COLOUR_WHITE (){ 1 } 82sub COLOUR_WHITE (){ 0 }
83sub COLOUR_BLACK (){ 1 }
82 84
83sub MOVE_PASS (){ undef } 85sub MOVE_PASS (){ undef }
84sub MOVE_HANDICAP (){ -2 } 86sub MOVE_HANDICAP (){ -2 }
85 87
86=item my $board = new $size 88=item my $board = new $size
87 89
88Creates a new empty board of the given size. 90Creates a new empty board of the given size.
89 91
90C<< $board->{size} >> stores the board size. 92C<< $board->{size} >> stores the board size.
91 93
92C<< $board->{max} >> stores the maximum board coordinate (size-1). 94C<< $board->{max} >> stores the maximum board coordinate (size-1).
93 95
94C<< $board->{captures}[COLOUR] >> stores the number of captured stones for 96C<< $board->{captures}[COLOUR_xxx] >> stores the number of captured stones for
95the given colour. 97the given colour.
96
97C<< $board->{last} >> stores the colour of the last move that was played.
98 98
99C<< $board->{board} >> stores a two-dimensional array with board contents. 99C<< $board->{board} >> stores a two-dimensional array with board contents.
100 100
101=cut 101=cut
102 102
103sub new { 103sub new {
104 my $class = shift; 104 my $class = shift;
105 my $size = shift; 105 my $size = shift;
106
107 unless ($size > 0) {
108 Carp::croak ("no board size given!");
109 }
110
106 bless { 111 bless {
107 max => $size - 1, 112 max => $size - 1,
108 size => $size, 113 size => $size,
109 board => [map [(0) x $size], 1 .. $size], 114 board => [map [(0) x $size], 1 .. $size],
110 captures => [0, 0], # captures 115 captures => [0, 0], # captures
111 #timer => [], 116 #timer => [],
112 #score => [], 117 #score => [],
113 #last => COLOUR_...,
114 @_
115 }, 118 @_,
116 $class; 119 }, $class
117} 120}
118 121
119# inefficient and primitive, I hear you say? 122# inefficient and primitive, I hear you say?
120# well... you are right :) 123# well... you are right :)
121# use an extremely dumb floodfill algorithm to get rid of captured stones 124# use an extremely dumb floodfill algorithm to get rid of captured stones
… …
129 132
130 my $max = $self->{max}; 133 my $max = $self->{max};
131 134
132 while (@nodes) { 135 while (@nodes) {
133 my ($x, $y) = @{pop @nodes}; 136 my ($x, $y) = @{pop @nodes};
137
134 unless ($seen{$x,$y}++) { 138 unless ($seen{$x,$y}++) {
135 if ($board->[$x][$y] & $mark) { 139 if ($board->[$x][$y] & $mark) {
136 push @found, [$x, $y]; 140 push @found, [$x, $y];
137 141
138 push @nodes, [$x-1, $y] unless $seen{$x-1, $y} || $x <= 0; 142 push @nodes, [$x-1, $y] unless $seen{$x-1, $y} || $x <= 0;
… …
161specified in C<$clr>, then setting bits specified in C<$set>. 165specified in C<$clr>, then setting bits specified in C<$set>.
162 166
163If C<$set> includes C<MARK_LABEL>, the label text must be given in 167If C<$set> includes C<MARK_LABEL>, the label text must be given in
164C<$label>. 168C<$label>.
165 169
166If C<$set> contains C<MARK_MOVE>, then a circle symbol will be placed 170If C<$set> contains C<MARK_MOVE> then surrounded stones will be removed
167at this coordinate. Also, surrounded stones will be removed from the
168board and (simple) Kos are detected and marked with square symbols and 171from the board and (simple) Kos are detected and marked with square
169C<MARK_KO>. The circle and square markings are removed with the next 172symbols and C<MARK_KO>, after removing other marking symbols. The
173markings are also removed with the next next update structure that uses
170update that uses C<MARK_MOVE>, so this flag is suited well for marking, 174C<MARK_MOVE>, so this flag is suited well for marking, well, moves. Note
171well, moves. Note that you can make invalid "moves" (such as suicide) and 175that you can make invalid "moves" (such as suicide) and C<update> will
172C<update> will try to cope with it. You can use C<is_valid_move> to avoid 176try to cope with it. You can use C<is_valid_move> to avoid making illegal
173making illegal moves. 177moves.
174 178
175For handicap "moves", currently only board sizes 9, 13 and 19 are 179For handicap "moves", currently only board sizes 9, 13 and 19 are
176supported and only handicap values from 2 to 9. The placement follows the 180supported and only handicap values from 2 to 9. The placement follows the
177IGS rules, if you want other placements, you have to set it up yourself. 181IGS rules, if you want other placements, you have to set it up yourself.
178 182
… …
211 7 => [qw(0,2 2,0 0,0 2,2 0,1 2,1 1,1)], 215 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 )], 216 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)], 217 9 => [qw(0,2 2,0 0,0 2,2 0,1 2,1 1,0 1,2 1,1)],
214); 218);
215 219
220our $mark_symbols = MARK_CIRCLE | MARK_SQUARE | MARK_TRIANGLE | MARK_CROSS | MARK_KO;
221
216sub update { 222sub update {
217 my ($self, $path) = @_; 223 my ($self, $path) = @_;
218 224
219 my $board = $self->{board}; 225 my $board = $self->{board};
220 226
221 for (@$path) { 227 for (@$path) {
222 my ($x, $y, $clr, $set, $label) = @$_; 228 my ($x, $y, $clr, $set, $label) = @$_;
223 229
224 my $nodemask =
225 $_ == $path->[-1]
226 ? ~0
227 : ~(MARK_SQUARE | MARK_TRIANGLE | MARK_CIRCLE | MARK_LABEL | MARK_KO);
228
229 if (!defined $x) { 230 if (!defined $x) {
231 $$_ &= ~$mark_symbols for @{ delete $self->{unmark} || [] };
230 # pass 232 # pass
231 $self->{last} = $set & MARK_B ? COLOUR_BLACK : COLOUR_WHITE;
232 233
233 } elsif ($x == MOVE_HANDICAP) { 234 } elsif ($x == MOVE_HANDICAP) {
235 $$_ &= ~$mark_symbols for @{ delete $self->{unmark} || [] };
236
234 # $y = #handicap stones 237 # $y = #handicap stones
235 my $c = $HANDICAP_COORD{$self->{size}} 238 my $c = $HANDICAP_COORD{$self->{size}}
236 or Carp::croak "$self->{size}: illegal board size for handicap"; 239 or Carp::croak "$self->{size}: illegal board size for handicap";
237 my $h = $HANDICAP_XY{$y} 240 my $h = $HANDICAP_XY{$y}
238 or Carp::croak "$y: illegal number of handicap stones"; 241 or Carp::croak "$y: illegal number of handicap stones";
… …
241 my ($x, $y) = map $c->[$_], split /,/; 244 my ($x, $y) = map $c->[$_], split /,/;
242 $board->[$x][$y] = MARK_B | MARK_MOVE; 245 $board->[$x][$y] = MARK_B | MARK_MOVE;
243 } 246 }
244 247
245 } else { 248 } else {
246 $board->[$x][$y] = 249 my $space = \$board->[$x][$y];
247 $board->[$x][$y] 250
248 & ~$clr 251 $$space = $$space & ~$clr | $set;
249 | $set
250 & $nodemask;
251 252
252 $self->{label}[$x][$y] = $label if $set & MARK_LABEL; 253 $self->{label}[$x][$y] = $label if $set & MARK_LABEL;
253 254
254 if ($set & MARK_MOVE) { 255 if ($set & MARK_MOVE) {
255 $self->{last} = $set & MARK_B ? COLOUR_BLACK : COLOUR_WHITE; 256 $$_ &= ~$mark_symbols for @{ $self->{unmark} || [] };
257 @{ $self->{unmark} } = $space;
258
259 # remark the space, in case the move was on the same spot as the
260 # old mark
261 $$space |= $set;
256 262
257 unless (${ $_->[5] ||= \my $hint }) { 263 unless (${ $_->[5] ||= \my $hint }) {
258 my ($own, $opp) = 264 my ($own, $opp) =
259 $set & MARK_B 265 $set & MARK_B
260 ? (MARK_B, MARK_W) 266 ? (MARK_B, MARK_W)
261 : (MARK_W, MARK_B); 267 : (MARK_W, MARK_B);
262 268
263 my (@capture, $suicide); 269 my (@capture, @suicide);
264 270
265 push @capture, $self->capture ($opp, $x-1, $y) if $x > 0 && $board->[$x-1][$y] & $opp; 271 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; 272 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; 273 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; 274 push @capture, $self->capture ($opp, $x, $y+1) if $y < $self->{max} && $board->[$x][$y+1] & $opp;
269 275
270 # keep only unique coordinates 276 # keep only unique coordinates
271 @capture = do { my %seen; grep !$seen{"$_->[0],$_->[1]"}++, @capture }; 277 @capture = do { my %seen; grep !$seen{"$_->[0],$_->[1]"}++, @capture };
272 278
273 # remove captured stones 279 # remove captured stones
274 $self->{captures}[$self->{last}] += @capture; 280 $self->{captures}[$own == MARK_B ? COLOUR_BLACK : COLOUR_WHITE] += @capture;
275 $self->{board}[$_->[0]][$_->[1]] &= ~(MARK_B | MARK_W | MARK_MOVE) 281 $self->{board}[$_->[0]][$_->[1]] = 0
276 for @capture; 282 for @capture;
277 283
278 $suicide += $self->capture ($own, $x, $y); 284 push @suicide, $self->capture ($own, $x, $y);
279 285
280 ${ $_->[5] } ||= !(@capture || $suicide); 286 ${ $_->[5] } ||= !(@capture || @suicide);
281 287
288 if (@suicide) {
289 $self->{board}[$_->[0]][$_->[1]] = 0
290 for @suicide;
291 # count suicides as other sides stones
292 $self->{captures}[$opp == MARK_B ? COLOUR_BLACK : COLOUR_WHITE] += @suicide;
293
282 if (!$suicide && @capture == 1) { 294 } elsif (!@suicide && @capture == 1) {
283 # possible ko. now check liberties on placed stone 295 # possible ko. now check liberties on placed stone
284 296
285 my $libs; 297 my $libs;
286 298
287 $libs++ if $x > 0 && !($board->[$x-1][$y] & $opp); 299 $libs++ if $x > 0 && !($board->[$x-1][$y] & $opp);
288 $libs++ if $x < $self->{max} && !($board->[$x+1][$y] & $opp); 300 $libs++ if $x < $self->{max} && !($board->[$x+1][$y] & $opp);
289 $libs++ if $y > 0 && !($board->[$x][$y-1] & $opp); 301 $libs++ if $y > 0 && !($board->[$x][$y-1] & $opp);
290 $libs++ if $y < $self->{max} && !($board->[$x][$y+1] & $opp); 302 $libs++ if $y < $self->{max} && !($board->[$x][$y+1] & $opp);
291 303
292 if ($libs == 1) { 304 if ($libs == 1) {
293 $board->[$x][$y] = $board->[$x][$y] & ~MARK_CIRCLE | (MARK_KO & $nodemask); 305 $$space = $$space & ~$mark_symbols | MARK_KO;
306
294 ($x, $y) = @{$capture[0]}; 307 ($x, $y) = @{$capture[0]};
295 $board->[$x][$y] |= MARK_KO & $nodemask; 308 $board->[$x][$y] |= MARK_KO;
309
310 push @{ $self->{unmark} }, \$board->[$x][$y];
296 } 311 }
297 } 312 }
298 } 313 }
299 } 314 }
300 } 315 }
… …
313sub is_valid_move { 328sub is_valid_move {
314 my ($self, $colour, $x, $y, $may_suicide) = @_; 329 my ($self, $colour, $x, $y, $may_suicide) = @_;
315 330
316 my $board = $self->{board}; 331 my $board = $self->{board};
317 332
318 return if $board->[$x][$y] & (MARK_B | MARK_W | MARK_KO); 333 return if $board->[$x][$y] & (MARK_B | MARK_W | MARK_KO)
334 && !($board->[$x][$y] & MARK_GRAYED);
319 335
320 if ($may_suicide) { 336 if ($may_suicide) {
321 return 1; 337 return 1;
322 } else { 338 } else {
323 my ($own, $opp) = $colour == COLOUR_BLACK 339 my ($own, $opp) = $colour == COLOUR_BLACK

Diff Legend

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