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

Diff Legend

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