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

Diff Legend

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