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.9 by root, Wed Jun 25 20:11:33 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
104 bless { 105 bless {
105 max => $size - 1, 106 max => $size - 1,
106 size => $size, 107 size => $size,
107 board => [map [(0) x $size], 1 .. $size], 108 board => [map [(0) x $size], 1 .. $size],
108 captures => [0, 0], # captures 109 captures => [0, 0], # captures
109 #timer => [], 110 #timer => [],
110 #score => [], 111 #score => [],
111 #last => COLOUR_...,
112 @_
113 }, 112 @_,
113 unmark => [],
114 $class; 114 }, $class
115} 115}
116 116
117# inefficient and primitive, I hear you say? 117# inefficient and primitive, I hear you say?
118# well... you are right :) 118# well... you are right :)
119# use an extremely dumb floodfill algorithm to get rid of captured stones 119# use an extremely dumb floodfill algorithm to get rid of captured stones
… …
149=item $hint = $board->update ([update-structures...]) 149=item $hint = $board->update ([update-structures...])
150 150
151Each update-structure itself is also an array-ref: 151Each update-structure itself is also an array-ref:
152 152
153 [$x, $y, $clr, $set, $label, $hint] # update or move 153 [$x, $y, $clr, $set, $label, $hint] # update or move
154 [MOVE_HANDICAP, $handicap] # black move, set handicap 154 [MOVE_HANDICAP, $handicap] # black move, setup handicap
155 [MOVE_PASS] # pass 155 [MOVE_PASS] # pass
156 [] # also pass 156 [] # also pass (deprecated!)
157 157
158It changes the board or executes a move, by first clearing the bits 158It changes the board or executes a move, by first clearing the bits
159specified in C<$clr>, then setting bits specified in C<$set>. 159specified in C<$clr>, then setting bits specified in C<$set>.
160 160
161If C<$set> includes C<MARK_LABEL>, the label text must be given in 161If C<$set> includes C<MARK_LABEL>, the label text must be given in
162C<$label>. 162C<$label>.
163 163
164If C<$set> contains C<MARK_MOVE>, then a circle symbol will be placed on 164If 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 165from the board and (simple) Kos are detected and marked with square
166move marker). 166symbols and C<MARK_KO>, after removing other marking symbols. The
167markings are also removed with the next next update structure that uses
168C<MARK_MOVE>, so this flag is suited well for marking, well, moves. Note
169that you can make invalid "moves" (such as suicide) and C<update> will
170try to cope with it. You can use C<is_valid_move> to avoid making illegal
171moves.
167 172
168For handicap "moves", currently only board sizes 9, 13 and 19 are 173For handicap "moves", currently only board sizes 9, 13 and 19 are
169supported and only handicap values from 2 to 9. The placement follows the 174supported 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. 175IGS rules, if you want other placements, you have to set it up yourself.
171 176
172This function modifies the hint member of the specified path to speed up 177This function modifies the C<$hint> member of the specified structure
173repeated board generation and updates with the same update structures. 178to speed up repeated board generation and updates with the same update
179structures.
174 180
175If the hint member is a reference the scalar pointed to by the reference 181If the hint member is a reference the scalar pointed to by the reference
176is updated instead. 182is updated instead.
177 183
178If all this hint member thing is unclear, just ignore it and specify it 184If 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 185it 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 186you keep your update structures around as long as previous updates don't
181position from hinted update structures is I<much> faster then recreating 187change, however, as regenerating a full board position from hinted
182it from fresh update structures. 188update structures is I<much> faster then recreating it from fresh update
189structures.
183 190
184Example, make two silly moves: 191Example, make two silly moves:
185 192
186 $board->update ([[0, 18, -1, MARK_B|MARK_MOVE], 193 $board->update ([[0, 18, -1, MARK_B | MARK_MOVE],
187 [0, 17, -1, MARK_W|MARK_MOVE]]); 194 [0, 17, -1, MARK_W | MARK_MOVE]]);
188 195
189=cut 196=cut
190 197
191our %HANDICAP_COORD = ( 198our %HANDICAP_COORD = (
192 9 => [2, 4, 6], 199 9 => [2, 4, 6],
193 13 => [3, 6, 9], 200 13 => [3, 6, 9],
194 19 => [3, 9, 15], 201 19 => [3, 9, 15],
195); 202);
196our %HANDICAP_XY = ( 203our %HANDICAP_XY = (
197 2 => [qw(0,2 2,0 )], 204 2 => [qw(0,2 2,0 )],
198 3 => [qw(0,2 2,0 2,2 )], 205 3 => [qw(0,2 2,0 0,0 )],
199 4 => [qw(0,2 2,0 2,2 0,0 )], 206 4 => [qw(0,2 2,0 0,0 2,2 )],
200 5 => [qw(0,2 2,0 2,2 0,0 1,1)], 207 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 )], 208 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)], 209 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 )], 210 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)], 211 9 => [qw(0,2 2,0 0,0 2,2 0,1 2,1 1,0 1,2 1,1)],
205); 212);
213
214our $mark_symbols = MARK_CIRCLE | MARK_SQUARE | MARK_TRIANGLE | MARK_CROSS | MARK_KO;
206 215
207sub update { 216sub update {
208 my ($self, $path) = @_; 217 my ($self, $path) = @_;
209 218
210 my $board = $self->{board}; 219 my $board = $self->{board};
211 220
212 for (@$path) { 221 for (@$path) {
213 my ($x, $y, $clr, $set, $label) = @$_; 222 my ($x, $y, $clr, $set, $label) = @$_;
214 223
215 my $nodemask =
216 $_ == $path->[-1]
217 ? ~0
218 : ~(MARK_SQUARE | MARK_TRIANGLE | MARK_CIRCLE | MARK_LABEL | MARK_KO);
219
220 if (!defined $x) { 224 if (!defined $x) {
221 # pass 225 # pass
222 $self->{last} = $set & MARK_B ? COLOUR_BLACK : COLOUR_WHITE;
223 226
224 } elsif ($x == MOVE_HANDICAP) { 227 } elsif ($x == MOVE_HANDICAP) {
225 # $y = #handicap stones 228 # $y = #handicap stones
226 my $c = $HANDICAP_COORD{$self->{size}} 229 my $c = $HANDICAP_COORD{$self->{size}}
227 or Carp::croak "$self->{size}: illegal board size for handicap"; 230 or Carp::croak "$self->{size}: illegal board size for handicap";
… …
232 my ($x, $y) = map $c->[$_], split /,/; 235 my ($x, $y) = map $c->[$_], split /,/;
233 $board->[$x][$y] = MARK_B | MARK_MOVE; 236 $board->[$x][$y] = MARK_B | MARK_MOVE;
234 } 237 }
235 238
236 } else { 239 } else {
237 $board->[$x][$y] = 240 my $space = \$board->[$x][$y];
238 $board->[$x][$y] 241
239 & ~$clr 242 $$space = $$space & ~$clr | $set;
240 | $set
241 & $nodemask;
242 243
243 $self->{label}[$x][$y] = $label if $set & MARK_LABEL; 244 $self->{label}[$x][$y] = $label if $set & MARK_LABEL;
244 245
245 if ($set & MARK_MOVE) { 246 if ($set & MARK_MOVE) {
246 $self->{last} = $set & MARK_B ? COLOUR_BLACK : COLOUR_WHITE; 247 $$_ &= ~$mark_symbols for @{ $self->{unmark} };
248 @{ $self->{unmark} } = $space;
247 249
248 unless (${ $_->[5] ||= \my $hint }) { 250 unless (${ $_->[5] ||= \my $hint }) {
249 my ($own, $opp) = 251 my ($own, $opp) =
250 $set & MARK_B 252 $set & MARK_B
251 ? (MARK_B, MARK_W) 253 ? (MARK_B, MARK_W)
… …
260 262
261 # keep only unique coordinates 263 # keep only unique coordinates
262 @capture = do { my %seen; grep !$seen{"$_->[0],$_->[1]"}++, @capture }; 264 @capture = do { my %seen; grep !$seen{"$_->[0],$_->[1]"}++, @capture };
263 265
264 # remove captured stones 266 # remove captured stones
265 $self->{captures}[$self->{last}] += @capture; 267 $self->{captures}[$own == MARK_B ? COLOUR_BLACK : COLOUR_WHITE] += @capture;
266 $self->{board}[$_->[0]][$_->[1]] &= ~(MARK_B | MARK_W | MARK_MOVE) 268 $self->{board}[$_->[0]][$_->[1]] = 0
267 for @capture; 269 for @capture;
268 270
269 $suicide += $self->capture ($own, $x, $y); 271 $suicide += $self->capture ($own, $x, $y);
270 272
271 ${ $_->[5] } ||= !(@capture || $suicide); 273 ${ $_->[5] } ||= !(@capture || $suicide);
… …
279 $libs++ if $x < $self->{max} && !($board->[$x+1][$y] & $opp); 281 $libs++ if $x < $self->{max} && !($board->[$x+1][$y] & $opp);
280 $libs++ if $y > 0 && !($board->[$x][$y-1] & $opp); 282 $libs++ if $y > 0 && !($board->[$x][$y-1] & $opp);
281 $libs++ if $y < $self->{max} && !($board->[$x][$y+1] & $opp); 283 $libs++ if $y < $self->{max} && !($board->[$x][$y+1] & $opp);
282 284
283 if ($libs == 1) { 285 if ($libs == 1) {
284 $board->[$x][$y] = $board->[$x][$y] & ~MARK_CIRCLE | (MARK_KO & $nodemask); 286 $$space = $$space & ~$mark_symbols | MARK_KO;
287
285 ($x, $y) = @{$capture[0]}; 288 ($x, $y) = @{$capture[0]};
286 $board->[$x][$y] |= MARK_KO & $nodemask; 289 $board->[$x][$y] |= MARK_KO;
290
291 push @{ $self->{unmark} }, \$board->[$x][$y];
287 } 292 }
288 } 293 }
289 } 294 }
290 } 295 }
291 } 296 }
… …
293} 298}
294 299
295=item $board->is_valid_move ($colour, $x, $y[, $may_suicide]) 300=item $board->is_valid_move ($colour, $x, $y[, $may_suicide])
296 301
297Returns true if the move of the given colour on the given coordinates is 302Returns true if the move of the given colour on the given coordinates is
298valid or not. 303valid or not. Kos are taken into account as long as they are marked with
304C<MARK_KO>. Suicides are invalid unless C<$may_suicide> is true (e.g. for
305new zealand rules)
299 306
300=cut 307=cut
301 308
302sub is_valid_move { 309sub is_valid_move {
303 my ($self, $colour, $x, $y, $may_suicide) = @_; 310 my ($self, $colour, $x, $y, $may_suicide) = @_;

Diff Legend

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