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

Diff Legend

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