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.3 by root, Mon Jun 23 20:41:16 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, set handicap
155 [MOVE_PASS] # pass
139 [] # pass 156 [] # also pass
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>.
163
164If C<$set> contains C<MARK_MOVE>, then a circle symbol will be placed on
165this coordinate only if this is the last move done (which is useful for a
166move marker).
167
168For handicap "moves", currently only board sizes 9, 13 and 19 are
169supported 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.
146 171
147This function modifies the hint member of the specified path to speed up 172This function modifies the hint member of the specified path to speed up
148repeated board generation and updates with the same update structures. 173repeated board generation and updates with the same update structures.
149 174
150If the hint member is a reference the scalar pointed to by the reference 175If the hint member is a reference the scalar pointed to by the reference
… …
157it from fresh update structures. 182it from fresh update structures.
158 183
159Example, make two silly moves: 184Example, make two silly moves:
160 185
161 $board->update ([[0, 18, -1, MARK_B|MARK_MOVE], 186 $board->update ([[0, 18, -1, MARK_B|MARK_MOVE],
162 [0, 17, -1, MARK_W|MARK_MOVE]); 187 [0, 17, -1, MARK_W|MARK_MOVE]]);
163 188
164=cut 189=cut
190
191our %HANDICAP_COORD = (
192 9 => [2, 4, 6],
193 13 => [3, 6, 9],
194 19 => [3, 9, 15],
195);
196our %HANDICAP_XY = (
197 2 => [qw(0,2 2,0 )],
198 3 => [qw(0,2 2,0 2,2 )],
199 4 => [qw(0,2 2,0 2,2 0,0 )],
200 5 => [qw(0,2 2,0 2,2 0,0 1,1)],
201 6 => [qw(0,2 2,0 2,2 0,0 0,1 2,1 )],
202 7 => [qw(0,2 2,0 2,2 0,0 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 )],
204 9 => [qw(0,2 2,0 2,2 0,0 0,1 2,1 1,0 1,2 1,1)],
205);
165 206
166sub update { 207sub update {
167 my ($self, $path) = @_; 208 my ($self, $path) = @_;
168 209
169 my $board = $self->{board}; 210 my $board = $self->{board};
… …
174 my $nodemask = 215 my $nodemask =
175 $_ == $path->[-1] 216 $_ == $path->[-1]
176 ? ~0 217 ? ~0
177 : ~(MARK_SQUARE | MARK_TRIANGLE | MARK_CIRCLE | MARK_LABEL | MARK_KO); 218 : ~(MARK_SQUARE | MARK_TRIANGLE | MARK_CIRCLE | MARK_LABEL | MARK_KO);
178 219
179 if (defined $x) { 220 if (!defined $x) {
221 # pass
222 $self->{last} = $set & MARK_B ? COLOUR_BLACK : COLOUR_WHITE;
223
224 } elsif ($x == MOVE_HANDICAP) {
225 # $y = #handicap stones
226 my $c = $HANDICAP_COORD{$self->{size}}
227 or Carp::croak "$self->{size}: illegal board size for handicap";
228 my $h = $HANDICAP_XY{$y}
229 or Carp::croak "$y: illegal number of handicap stones";
230
231 for (@$h) {
232 my ($x, $y) = map $c->[$_], split /,/;
233 $board->[$x][$y] = MARK_B | MARK_MOVE;
234 }
235
236 } else {
180 $board->[$x][$y] = 237 $board->[$x][$y] =
181 $board->[$x][$y] 238 $board->[$x][$y]
182 & ~$clr 239 & ~$clr
183 | $set 240 | $set
184 & $nodemask; 241 & $nodemask;
… …
229 $board->[$x][$y] |= MARK_KO & $nodemask; 286 $board->[$x][$y] |= MARK_KO & $nodemask;
230 } 287 }
231 } 288 }
232 } 289 }
233 } 290 }
234 } else {
235 $self->{last} = $set & MARK_B ? COLOUR_BLACK : COLOUR_WHITE;
236 } 291 }
237 } 292 }
238} 293}
239 294
240=item $board->is_valid_move ($colour, $x, $y[, $may_suicide]) 295=item $board->is_valid_move ($colour, $x, $y[, $may_suicide])
… …
278 333
279Marc Lehmann <schmorp@schmorp.de> 334Marc Lehmann <schmorp@schmorp.de>
280 335
281=head2 SEE ALSO 336=head2 SEE ALSO
282 337
283L<KGS::Protocol>, L<KGS::Game::Tree>, L<Gtk2::GoBoard>. 338L<Gtk2::GoBoard>.
284 339
285=cut 340=cut
286 341

Diff Legend

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