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

Diff Legend

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