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.5 by root, Tue Jun 24 19:22:08 2008 UTC

… …
31 MARK_REDRAW # ignored, can be used for your own purposes 31 MARK_REDRAW # ignored, can be used for your own purposes
32 32
33 COLOUR_BLACK # used for $board->{last} 33 COLOUR_BLACK # used for $board->{last}
34 COLOUR_WHITE # to mark the colour of the last move 34 COLOUR_WHITE # to mark the colour of the last move
35 35
36 MOVE_HANDICAP # used as "x-coordinate" for handicap moves
37 MOVE_PASS # can be used as "x-coordinate" for handicap moves
38
36=head2 METHODS 39=head2 METHODS
37 40
38=over 4 41=over 4
39 42
40=cut 43=cut
41 44
45no warnings;
46use strict;
47
48use Carp ();
49
42use base Exporter; 50use base Exporter::;
43 51
44our $VERSION = '1.0'; 52our $VERSION = '1.0';
45 53
46@EXPORT = qw( 54our @EXPORT = qw(
47 MARK_TRIANGLE MARK_SQUARE MARK_CIRCLE MARK_SMALL_B MARK_SMALL_W MARK_B 55 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 56 MARK_W MARK_GRAYED MARK_MOVE MARK_LABEL MARK_HOSHI MARK_KO
49 MARK_REDRAW 57 MARK_REDRAW
50 COLOUR_BLACK COLOUR_WHITE 58 COLOUR_BLACK COLOUR_WHITE
59 MOVE_HANDICAP MOVE_PASS
51); 60);
52 61
53# marker types for each board position (ORed together) 62# marker types for each board position (ORed together)
54 63
55sub MARK_TRIANGLE (){ 0x0001 } 64sub MARK_TRIANGLE (){ 0x0001 }
… …
67sub MARK_REDRAW (){ 0x8000 } 76sub MARK_REDRAW (){ 0x8000 }
68 77
69sub COLOUR_BLACK (){ 0 } 78sub COLOUR_BLACK (){ 0 }
70sub COLOUR_WHITE (){ 1 } 79sub COLOUR_WHITE (){ 1 }
71 80
81sub MOVE_PASS (){ undef }
82sub MOVE_HANDICAP (){ -2 }
83
72=item my $board = new $size 84=item my $board = new $size
73 85
74Creates a new empty board of the given size. 86Creates a new empty board of the given size.
87
88C<< $board->{size} >> stores the board size.
75 89
76C<< $board->{max} >> stores the maximum board coordinate (size-1). 90C<< $board->{max} >> stores the maximum board coordinate (size-1).
77 91
78C<< $board->{captures}[COLOUR] >> stores the number of captured stones for 92C<< $board->{captures}[COLOUR] >> stores the number of captured stones for
79the given colour. 93the given colour.
… …
87sub new { 101sub new {
88 my $class = shift; 102 my $class = shift;
89 my $size = shift; 103 my $size = shift;
90 bless { 104 bless {
91 max => $size - 1, 105 max => $size - 1,
106 size => $size,
92 board => [map [(0) x $size], 1 .. $size], 107 board => [map [(0) x $size], 1 .. $size],
93 captures => [0, 0], # captures 108 captures => [0, 0], # captures
94 #timer => [], 109 #timer => [],
95 #score => [], 110 #score => [],
96 #last => COLOUR_..., 111 #last => COLOUR_...,
… …
134=item $hint = $board->update ([update-structures...]) 149=item $hint = $board->update ([update-structures...])
135 150
136Each update-structure itself is also an array-ref: 151Each update-structure itself is also an array-ref:
137 152
138 [$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, setup handicap
155 [MOVE_PASS] # pass
139 [] # pass 156 [] # also pass (deprecated!)
140 157
141It 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
142specified in C<$clr>, then setting bits specified in C<$set>. 159specified in C<$clr>, then setting bits specified in C<$set>.
143 160
144If 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
145C<$label>. 162C<$label>.
146 163
164If C<$set> contains C<MARK_MOVE>, then a circle symbol will be placed
165at this coordinate. Also, surrounded stones will be removed from the
166board and (simple) Kos are detected and marked with square symbols and
167C<MARK_KO>. The circle and square markings are removed with the next
168update that uses C<MARK_MOVE>, so this flag is suited well for marking,
169well, moves. Note that you can make invalid "moves" (such as suicide) and
170C<update> will try to cope with it. You can use C<is_valid_move> to avoid
171making illegal moves.
172
173For handicap "moves", currently only board sizes 9, 13 and 19 are
174supported and only handicap values from 2 to 9. The placement follows the
175IGS rules, if you want other placements, you have to set it up yourself.
176
147This function modifies the hint member of the specified path to speed up 177This function modifies the C<$hint> member of the specified structure
148repeated board generation and updates with the same update structures. 178to speed up repeated board generation and updates with the same update
179structures.
149 180
150If 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
151is updated instead. 182is updated instead.
152 183
153If 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
154as 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
155keep your update structures around, however, as regenerating a full board 186you keep your update structures around as long as previous updates don't
156position from hinted update structures is I<much> faster then recreating 187change, however, as regenerating a full board position from hinted
157it from fresh update structures. 188update structures is I<much> faster then recreating it from fresh update
189structures.
158 190
159Example, make two silly moves: 191Example, make two silly moves:
160 192
161 $board->update ([[0, 18, -1, MARK_B|MARK_MOVE], 193 $board->update ([[0, 18, -1, MARK_B | MARK_MOVE],
162 [0, 17, -1, MARK_W|MARK_MOVE]); 194 [0, 17, -1, MARK_W | MARK_MOVE]]);
163 195
164=cut 196=cut
197
198our %HANDICAP_COORD = (
199 9 => [2, 4, 6],
200 13 => [3, 6, 9],
201 19 => [3, 9, 15],
202);
203our %HANDICAP_XY = (
204 2 => [qw(0,2 2,0 )],
205 3 => [qw(0,2 2,0 0,0 )],
206 4 => [qw(0,2 2,0 0,0 2,2 )],
207 5 => [qw(0,2 2,0 0,0 2,2 1,1)],
208 6 => [qw(0,2 2,0 0,0 2,2 0,1 2,1 )],
209 7 => [qw(0,2 2,0 0,0 2,2 0,1 2,1 1,1)],
210 8 => [qw(0,2 2,0 0,0 2,2 0,1 2,1 1,0 1,2 )],
211 9 => [qw(0,2 2,0 0,0 2,2 0,1 2,1 1,0 1,2 1,1)],
212);
165 213
166sub update { 214sub update {
167 my ($self, $path) = @_; 215 my ($self, $path) = @_;
168 216
169 my $board = $self->{board}; 217 my $board = $self->{board};
… …
174 my $nodemask = 222 my $nodemask =
175 $_ == $path->[-1] 223 $_ == $path->[-1]
176 ? ~0 224 ? ~0
177 : ~(MARK_SQUARE | MARK_TRIANGLE | MARK_CIRCLE | MARK_LABEL | MARK_KO); 225 : ~(MARK_SQUARE | MARK_TRIANGLE | MARK_CIRCLE | MARK_LABEL | MARK_KO);
178 226
179 if (defined $x) { 227 if (!defined $x) {
228 # pass
229 $self->{last} = $set & MARK_B ? COLOUR_BLACK : COLOUR_WHITE;
230
231 } elsif ($x == MOVE_HANDICAP) {
232 # $y = #handicap stones
233 my $c = $HANDICAP_COORD{$self->{size}}
234 or Carp::croak "$self->{size}: illegal board size for handicap";
235 my $h = $HANDICAP_XY{$y}
236 or Carp::croak "$y: illegal number of handicap stones";
237
238 for (@$h) {
239 my ($x, $y) = map $c->[$_], split /,/;
240 $board->[$x][$y] = MARK_B | MARK_MOVE;
241 }
242
243 } else {
180 $board->[$x][$y] = 244 $board->[$x][$y] =
181 $board->[$x][$y] 245 $board->[$x][$y]
182 & ~$clr 246 & ~$clr
183 | $set 247 | $set
184 & $nodemask; 248 & $nodemask;
… …
229 $board->[$x][$y] |= MARK_KO & $nodemask; 293 $board->[$x][$y] |= MARK_KO & $nodemask;
230 } 294 }
231 } 295 }
232 } 296 }
233 } 297 }
234 } else {
235 $self->{last} = $set & MARK_B ? COLOUR_BLACK : COLOUR_WHITE;
236 } 298 }
237 } 299 }
238} 300}
239 301
240=item $board->is_valid_move ($colour, $x, $y[, $may_suicide]) 302=item $board->is_valid_move ($colour, $x, $y[, $may_suicide])
241 303
242Returns true if the move of the given colour on the given coordinates is 304Returns true if the move of the given colour on the given coordinates is
243valid or not. 305valid or not. Kos are taken into account as long as they are marked with
306C<MARK_KO>. Suicides are invalid unless C<$may_suicide> is true (e.g. for
307new zealand rules)
244 308
245=cut 309=cut
246 310
247sub is_valid_move { 311sub is_valid_move {
248 my ($self, $colour, $x, $y, $may_suicide) = @_; 312 my ($self, $colour, $x, $y, $may_suicide) = @_;
… …
278 342
279Marc Lehmann <schmorp@schmorp.de> 343Marc Lehmann <schmorp@schmorp.de>
280 344
281=head2 SEE ALSO 345=head2 SEE ALSO
282 346
283L<KGS::Protocol>, L<KGS::Game::Tree>, L<Gtk2::GoBoard>. 347L<Gtk2::GoBoard>.
284 348
285=cut 349=cut
286 350

Diff Legend

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