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.9 by root, Wed Jun 25 20:11:33 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_CROSS # cross mark
23 MARK_SMALL_B # small stone, used for scoring or marking 23 MARK_SMALL_B # small stone, used for scoring or marking
24 MARK_SMALL_W # small stone, used for scoring or marking 24 MARK_SMALL_W # small stone, used for scoring or marking
25 MARK_B # normal black stone 25 MARK_B # normal black stone
26 MARK_W # normal whit stone 26 MARK_W # normal whit stone
27 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
28 MARK_LABEL # a text label 29 MARK_LABEL # a text label
29 MARK_HOSHI # this is a hoshi point (not used much) 30 MARK_HOSHI # this is a hoshi point (not used much)
30 MARK_MOVE # this is a regular move 31 MARK_MOVE # this is a regular move
31 MARK_KO # this is a ko position 32 MARK_KO # this is a ko position
32 MARK_REDRAW # ignored, can be used for your own purposes 33 MARK_REDRAW # ignored, can be used for your own purposes
33 34
34 COLOUR_WHITE # guarenteed to be 0 35 COLOUR_WHITE # guarenteed to be 0
35 COLOUR_BLACK # guarenteed to be 1 36 COLOUR_BLACK # guarenteed to be 1
36 37
37 MOVE_HANDICAP # used as "x-coordinate" for handicap moves 38 MOVE_HANDICAP # used as "x-coordinate" for handicap moves
38 MOVE_PASS # can be used as "x-coordinate" for pass moves 39 MOVE_PASS # can be used as "x-coordinate" for pass moves
39 40
40=head2 METHODS 41=head2 METHODS
41 42
42=over 4 43=over 4
43 44
… …
52 53
53our $VERSION = '1.0'; 54our $VERSION = '1.0';
54 55
55our @EXPORT = qw( 56our @EXPORT = qw(
56 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
57 MARK_W MARK_GRAYED MARK_MOVE MARK_LABEL MARK_HOSHI MARK_KO MARK_CROSS 58 MARK_W MARK_GRAYED MARK_SMALL_GRAYED MARK_MOVE MARK_LABEL MARK_HOSHI MARK_KO MARK_CROSS
58 MARK_REDRAW 59 MARK_REDRAW
59 COLOUR_BLACK COLOUR_WHITE 60 COLOUR_BLACK COLOUR_WHITE
60 MOVE_HANDICAP MOVE_PASS 61 MOVE_HANDICAP MOVE_PASS
61); 62);
62 63
63# marker types for each board position (ORed together) 64# marker types for each board position (ORed together)
64 65
65sub MARK_TRIANGLE (){ 0x0001 } 66sub MARK_TRIANGLE (){ 0x0001 }
66sub MARK_SQUARE (){ 0x0002 } 67sub MARK_SQUARE (){ 0x0002 }
67sub MARK_CIRCLE (){ 0x0004 } 68sub MARK_CIRCLE (){ 0x0004 }
68sub MARK_SMALL_B (){ 0x0008 } # small stone, used for scoring or marking 69sub MARK_SMALL_B (){ 0x0008 } # small stone, used for scoring or marking
69sub MARK_SMALL_W (){ 0x0010 } # small stone, used for scoring or marking 70sub MARK_SMALL_W (){ 0x0010 } # small stone, used for scoring or marking
70sub MARK_B (){ 0x0020 } # normal black stone 71sub MARK_B (){ 0x0020 } # normal black stone
71sub MARK_W (){ 0x0040 } # normal whit stone 72sub MARK_W (){ 0x0040 } # normal whit stone
72sub 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 }
73sub MARK_LABEL (){ 0x0100 } 75sub MARK_LABEL (){ 0x0200 }
74sub MARK_HOSHI (){ 0x0200 } # this is a hoshi point (not used much) 76sub MARK_HOSHI (){ 0x0400 } # this is a hoshi point (not used much)
75sub MARK_MOVE (){ 0x0400 } # this is a regular move 77sub MARK_MOVE (){ 0x0800 } # this is a regular move
76sub MARK_KO (){ 0x0800 } # this is a ko position 78sub MARK_KO (){ 0x1000 } # this is a ko position
77sub MARK_CROSS (){ 0x1000 } 79sub MARK_CROSS (){ 0x2000 }
78sub MARK_REDRAW (){ 0x8000 } 80sub MARK_REDRAW (){ 0x8000 }
79 81
80sub COLOUR_WHITE (){ 0 } 82sub COLOUR_WHITE (){ 0 }
81sub COLOUR_BLACK (){ 1 } 83sub COLOUR_BLACK (){ 1 }
82 84
83sub MOVE_PASS (){ undef } 85sub MOVE_PASS (){ undef }
84sub MOVE_HANDICAP (){ -2 } 86sub MOVE_HANDICAP (){ -2 }
85 87
86=item my $board = new $size 88=item my $board = new $size
87 89
88Creates a new empty board of the given size. 90Creates a new empty board of the given size.
89 91
… …
99=cut 101=cut
100 102
101sub new { 103sub new {
102 my $class = shift; 104 my $class = shift;
103 my $size = shift; 105 my $size = shift;
106
107 unless ($size > 0) {
108 Carp::croak ("no board size given!");
109 }
104 110
105 bless { 111 bless {
106 max => $size - 1, 112 max => $size - 1,
107 size => $size, 113 size => $size,
108 board => [map [(0) x $size], 1 .. $size], 114 board => [map [(0) x $size], 1 .. $size],
109 captures => [0, 0], # captures 115 captures => [0, 0], # captures
110 #timer => [], 116 #timer => [],
111 #score => [], 117 #score => [],
112 @_, 118 @_,
113 unmark => [],
114 }, $class 119 }, $class
115} 120}
116 121
117# inefficient and primitive, I hear you say? 122# inefficient and primitive, I hear you say?
118# well... you are right :) 123# well... you are right :)
… …
127 132
128 my $max = $self->{max}; 133 my $max = $self->{max};
129 134
130 while (@nodes) { 135 while (@nodes) {
131 my ($x, $y) = @{pop @nodes}; 136 my ($x, $y) = @{pop @nodes};
137
132 unless ($seen{$x,$y}++) { 138 unless ($seen{$x,$y}++) {
133 if ($board->[$x][$y] & $mark) { 139 if ($board->[$x][$y] & $mark) {
134 push @found, [$x, $y]; 140 push @found, [$x, $y];
135 141
136 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;
… …
220 226
221 for (@$path) { 227 for (@$path) {
222 my ($x, $y, $clr, $set, $label) = @$_; 228 my ($x, $y, $clr, $set, $label) = @$_;
223 229
224 if (!defined $x) { 230 if (!defined $x) {
231 $$_ &= ~$mark_symbols for @{ delete $self->{unmark} || [] };
225 # pass 232 # pass
226 233
227 } elsif ($x == MOVE_HANDICAP) { 234 } elsif ($x == MOVE_HANDICAP) {
235 $$_ &= ~$mark_symbols for @{ delete $self->{unmark} || [] };
236
228 # $y = #handicap stones 237 # $y = #handicap stones
229 my $c = $HANDICAP_COORD{$self->{size}} 238 my $c = $HANDICAP_COORD{$self->{size}}
230 or Carp::croak "$self->{size}: illegal board size for handicap"; 239 or Carp::croak "$self->{size}: illegal board size for handicap";
231 my $h = $HANDICAP_XY{$y} 240 my $h = $HANDICAP_XY{$y}
232 or Carp::croak "$y: illegal number of handicap stones"; 241 or Carp::croak "$y: illegal number of handicap stones";
… …
242 $$space = $$space & ~$clr | $set; 251 $$space = $$space & ~$clr | $set;
243 252
244 $self->{label}[$x][$y] = $label if $set & MARK_LABEL; 253 $self->{label}[$x][$y] = $label if $set & MARK_LABEL;
245 254
246 if ($set & MARK_MOVE) { 255 if ($set & MARK_MOVE) {
247 $$_ &= ~$mark_symbols for @{ $self->{unmark} }; 256 $$_ &= ~$mark_symbols for @{ $self->{unmark} || [] };
248 @{ $self->{unmark} } = $space; 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;
249 262
250 unless (${ $_->[5] ||= \my $hint }) { 263 unless (${ $_->[5] ||= \my $hint }) {
251 my ($own, $opp) = 264 my ($own, $opp) =
252 $set & MARK_B 265 $set & MARK_B
253 ? (MARK_B, MARK_W) 266 ? (MARK_B, MARK_W)
254 : (MARK_W, MARK_B); 267 : (MARK_W, MARK_B);
255 268
256 my (@capture, $suicide); 269 my (@capture, @suicide);
257 270
258 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;
259 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;
260 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;
261 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;
… …
266 # remove captured stones 279 # remove captured stones
267 $self->{captures}[$own == MARK_B ? COLOUR_BLACK : COLOUR_WHITE] += @capture; 280 $self->{captures}[$own == MARK_B ? COLOUR_BLACK : COLOUR_WHITE] += @capture;
268 $self->{board}[$_->[0]][$_->[1]] = 0 281 $self->{board}[$_->[0]][$_->[1]] = 0
269 for @capture; 282 for @capture;
270 283
271 $suicide += $self->capture ($own, $x, $y); 284 push @suicide, $self->capture ($own, $x, $y);
272 285
273 ${ $_->[5] } ||= !(@capture || $suicide); 286 ${ $_->[5] } ||= !(@capture || @suicide);
274 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
275 if (!$suicide && @capture == 1) { 294 } elsif (!@suicide && @capture == 1) {
276 # possible ko. now check liberties on placed stone 295 # possible ko. now check liberties on placed stone
277 296
278 my $libs; 297 my $libs;
279 298
280 $libs++ if $x > 0 && !($board->[$x-1][$y] & $opp); 299 $libs++ if $x > 0 && !($board->[$x-1][$y] & $opp);
… …
309sub is_valid_move { 328sub is_valid_move {
310 my ($self, $colour, $x, $y, $may_suicide) = @_; 329 my ($self, $colour, $x, $y, $may_suicide) = @_;
311 330
312 my $board = $self->{board}; 331 my $board = $self->{board};
313 332
314 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);
315 335
316 if ($may_suicide) { 336 if ($may_suicide) {
317 return 1; 337 return 1;
318 } else { 338 } else {
319 my ($own, $opp) = $colour == COLOUR_BLACK 339 my ($own, $opp) = $colour == COLOUR_BLACK

Diff Legend

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