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.10 by root, Wed Jun 25 20:49:38 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],
… …
126 132
127 my $max = $self->{max}; 133 my $max = $self->{max};
128 134
129 while (@nodes) { 135 while (@nodes) {
130 my ($x, $y) = @{pop @nodes}; 136 my ($x, $y) = @{pop @nodes};
137
131 unless ($seen{$x,$y}++) { 138 unless ($seen{$x,$y}++) {
132 if ($board->[$x][$y] & $mark) { 139 if ($board->[$x][$y] & $mark) {
133 push @found, [$x, $y]; 140 push @found, [$x, $y];
134 141
135 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;
… …
247 254
248 if ($set & MARK_MOVE) { 255 if ($set & MARK_MOVE) {
249 $$_ &= ~$mark_symbols for @{ $self->{unmark} || [] }; 256 $$_ &= ~$mark_symbols for @{ $self->{unmark} || [] };
250 @{ $self->{unmark} } = $space; 257 @{ $self->{unmark} } = $space;
251 258
259 # remark the space, in case the move was on the same spot as the
260 # old mark
261 $$space |= $set;
262
252 unless (${ $_->[5] ||= \my $hint }) { 263 unless (${ $_->[5] ||= \my $hint }) {
253 my ($own, $opp) = 264 my ($own, $opp) =
254 $set & MARK_B 265 $set & MARK_B
255 ? (MARK_B, MARK_W) 266 ? (MARK_B, MARK_W)
256 : (MARK_W, MARK_B); 267 : (MARK_W, MARK_B);
257 268
258 my (@capture, $suicide); 269 my (@capture, @suicide);
259 270
260 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;
261 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;
262 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;
263 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;
… …
268 # remove captured stones 279 # remove captured stones
269 $self->{captures}[$own == MARK_B ? COLOUR_BLACK : COLOUR_WHITE] += @capture; 280 $self->{captures}[$own == MARK_B ? COLOUR_BLACK : COLOUR_WHITE] += @capture;
270 $self->{board}[$_->[0]][$_->[1]] = 0 281 $self->{board}[$_->[0]][$_->[1]] = 0
271 for @capture; 282 for @capture;
272 283
273 $suicide += $self->capture ($own, $x, $y); 284 push @suicide, $self->capture ($own, $x, $y);
274 285
275 ${ $_->[5] } ||= !(@capture || $suicide); 286 ${ $_->[5] } ||= !(@capture || @suicide);
276 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
277 if (!$suicide && @capture == 1) { 294 } elsif (!@suicide && @capture == 1) {
278 # possible ko. now check liberties on placed stone 295 # possible ko. now check liberties on placed stone
279 296
280 my $libs; 297 my $libs;
281 298
282 $libs++ if $x > 0 && !($board->[$x-1][$y] & $opp); 299 $libs++ if $x > 0 && !($board->[$x-1][$y] & $opp);
… …
311sub is_valid_move { 328sub is_valid_move {
312 my ($self, $colour, $x, $y, $may_suicide) = @_; 329 my ($self, $colour, $x, $y, $may_suicide) = @_;
313 330
314 my $board = $self->{board}; 331 my $board = $self->{board};
315 332
316 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);
317 335
318 if ($may_suicide) { 336 if ($may_suicide) {
319 return 1; 337 return 1;
320 } else { 338 } else {
321 my ($own, $opp) = $colour == COLOUR_BLACK 339 my ($own, $opp) = $colour == COLOUR_BLACK

Diff Legend

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