--- Games-Go-SimpleBoard/SimpleBoard.pm 2008/06/23 20:41:16 1.3 +++ Games-Go-SimpleBoard/SimpleBoard.pm 2008/07/24 08:50:53 1.13 @@ -19,6 +19,7 @@ MARK_TRIANGLE # triangle mark MARK_SQUARE # square mark MARK_CIRCLE # circle mark + MARK_CROSS # cross mark MARK_SMALL_B # small stone, used for scoring or marking MARK_SMALL_W # small stone, used for scoring or marking MARK_B # normal black stone @@ -30,11 +31,11 @@ MARK_KO # this is a ko position MARK_REDRAW # ignored, can be used for your own purposes - COLOUR_BLACK # used for $board->{last} - COLOUR_WHITE # to mark the colour of the last move + COLOUR_WHITE # guarenteed to be 0 + COLOUR_BLACK # guarenteed to be 1 MOVE_HANDICAP # used as "x-coordinate" for handicap moves - MOVE_PASS # can be used as "x-coordinate" for handicap moves + MOVE_PASS # can be used as "x-coordinate" for pass moves =head2 METHODS @@ -53,7 +54,7 @@ our @EXPORT = qw( MARK_TRIANGLE MARK_SQUARE MARK_CIRCLE MARK_SMALL_B MARK_SMALL_W MARK_B - MARK_W MARK_GRAYED MARK_MOVE MARK_LABEL MARK_HOSHI MARK_KO + MARK_W MARK_GRAYED MARK_MOVE MARK_LABEL MARK_HOSHI MARK_KO MARK_CROSS MARK_REDRAW COLOUR_BLACK COLOUR_WHITE MOVE_HANDICAP MOVE_PASS @@ -73,10 +74,11 @@ sub MARK_HOSHI (){ 0x0200 } # this is a hoshi point (not used much) sub MARK_MOVE (){ 0x0400 } # this is a regular move sub MARK_KO (){ 0x0800 } # this is a ko position +sub MARK_CROSS (){ 0x1000 } sub MARK_REDRAW (){ 0x8000 } -sub COLOUR_BLACK (){ 0 } -sub COLOUR_WHITE (){ 1 } +sub COLOUR_WHITE (){ 0 } +sub COLOUR_BLACK (){ 1 } sub MOVE_PASS (){ undef } sub MOVE_HANDICAP (){ -2 } @@ -89,11 +91,9 @@ C<< $board->{max} >> stores the maximum board coordinate (size-1). -C<< $board->{captures}[COLOUR] >> stores the number of captured stones for +C<< $board->{captures}[COLOUR_xxx] >> stores the number of captured stones for the given colour. -C<< $board->{last} >> stores the colour of the last move that was played. - C<< $board->{board} >> stores a two-dimensional array with board contents. =cut @@ -101,17 +101,20 @@ sub new { my $class = shift; my $size = shift; + + unless ($size > 0) { + Carp::croak ("no board size given!"); + } + bless { - max => $size - 1, - size => $size, - board => [map [(0) x $size], 1 .. $size], - captures => [0, 0], # captures - #timer => [], - #score => [], - #last => COLOUR_..., - @_ - }, - $class; + max => $size - 1, + size => $size, + board => [map [(0) x $size], 1 .. $size], + captures => [0, 0], # captures + #timer => [], + #score => [], + @_, + }, $class } # inefficient and primitive, I hear you say? @@ -151,9 +154,9 @@ Each update-structure itself is also an array-ref: [$x, $y, $clr, $set, $label, $hint] # update or move - [MOVE_HANDICAP, $handicap] # black move, set handicap + [MOVE_HANDICAP, $handicap] # black move, setup handicap [MOVE_PASS] # pass - [] # also pass + [] # also pass (deprecated!) It changes the board or executes a move, by first clearing the bits specified in C<$clr>, then setting bits specified in C<$set>. @@ -161,30 +164,37 @@ If C<$set> includes C, the label text must be given in C<$label>. -If C<$set> contains C, then a circle symbol will be placed on -this coordinate only if this is the last move done (which is useful for a -move marker). +If C<$set> contains C then surrounded stones will be removed +from the board and (simple) Kos are detected and marked with square +symbols and C, after removing other marking symbols. The +markings are also removed with the next next update structure that uses +C, so this flag is suited well for marking, well, moves. Note +that you can make invalid "moves" (such as suicide) and C will +try to cope with it. You can use C to avoid making illegal +moves. For handicap "moves", currently only board sizes 9, 13 and 19 are supported and only handicap values from 2 to 9. The placement follows the IGS rules, if you want other placements, you have to set it up yourself. -This function modifies the hint member of the specified path to speed up -repeated board generation and updates with the same update structures. +This function modifies the C<$hint> member of the specified structure +to speed up repeated board generation and updates with the same update +structures. If the hint member is a reference the scalar pointed to by the reference is updated instead. -If all this hint member thing is unclear, just ignore it and specify it -as C or leave it out of the array entirely. Do make sure that you -keep your update structures around, however, as regenerating a full board -position from hinted update structures is I faster then recreating -it from fresh update structures. +If all this hint member thing is confusing, just ignore it and specify +it as C or leave it out of the array entirely. Do make sure that +you keep your update structures around as long as previous updates don't +change, however, as regenerating a full board position from hinted +update structures is I faster then recreating it from fresh update +structures. Example, make two silly moves: - $board->update ([[0, 18, -1, MARK_B|MARK_MOVE], - [0, 17, -1, MARK_W|MARK_MOVE]]); + $board->update ([[0, 18, -1, MARK_B | MARK_MOVE], + [0, 17, -1, MARK_W | MARK_MOVE]]); =cut @@ -195,15 +205,17 @@ ); our %HANDICAP_XY = ( 2 => [qw(0,2 2,0 )], - 3 => [qw(0,2 2,0 2,2 )], - 4 => [qw(0,2 2,0 2,2 0,0 )], - 5 => [qw(0,2 2,0 2,2 0,0 1,1)], - 6 => [qw(0,2 2,0 2,2 0,0 0,1 2,1 )], - 7 => [qw(0,2 2,0 2,2 0,0 0,1 2,1 1,1)], - 8 => [qw(0,2 2,0 2,2 0,0 0,1 2,1 1,0 1,2 )], - 9 => [qw(0,2 2,0 2,2 0,0 0,1 2,1 1,0 1,2 1,1)], + 3 => [qw(0,2 2,0 0,0 )], + 4 => [qw(0,2 2,0 0,0 2,2 )], + 5 => [qw(0,2 2,0 0,0 2,2 1,1)], + 6 => [qw(0,2 2,0 0,0 2,2 0,1 2,1 )], + 7 => [qw(0,2 2,0 0,0 2,2 0,1 2,1 1,1)], + 8 => [qw(0,2 2,0 0,0 2,2 0,1 2,1 1,0 1,2 )], + 9 => [qw(0,2 2,0 0,0 2,2 0,1 2,1 1,0 1,2 1,1)], ); +our $mark_symbols = MARK_CIRCLE | MARK_SQUARE | MARK_TRIANGLE | MARK_CROSS | MARK_KO; + sub update { my ($self, $path) = @_; @@ -212,16 +224,13 @@ for (@$path) { my ($x, $y, $clr, $set, $label) = @$_; - my $nodemask = - $_ == $path->[-1] - ? ~0 - : ~(MARK_SQUARE | MARK_TRIANGLE | MARK_CIRCLE | MARK_LABEL | MARK_KO); - if (!defined $x) { + $$_ &= ~$mark_symbols for @{ delete $self->{unmark} || [] }; # pass - $self->{last} = $set & MARK_B ? COLOUR_BLACK : COLOUR_WHITE; } elsif ($x == MOVE_HANDICAP) { + $$_ &= ~$mark_symbols for @{ delete $self->{unmark} || [] }; + # $y = #handicap stones my $c = $HANDICAP_COORD{$self->{size}} or Carp::croak "$self->{size}: illegal board size for handicap"; @@ -234,16 +243,15 @@ } } else { - $board->[$x][$y] = - $board->[$x][$y] - & ~$clr - | $set - & $nodemask; + my $space = \$board->[$x][$y]; + + $$space = $$space & ~$clr | $set; $self->{label}[$x][$y] = $label if $set & MARK_LABEL; if ($set & MARK_MOVE) { - $self->{last} = $set & MARK_B ? COLOUR_BLACK : COLOUR_WHITE; + $$_ &= ~$mark_symbols for @{ $self->{unmark} || [] }; + @{ $self->{unmark} } = $space; unless (${ $_->[5] ||= \my $hint }) { my ($own, $opp) = @@ -262,15 +270,18 @@ @capture = do { my %seen; grep !$seen{"$_->[0],$_->[1]"}++, @capture }; # remove captured stones - $self->{captures}[$self->{last}] += @capture; - $self->{board}[$_->[0]][$_->[1]] &= ~(MARK_B | MARK_W | MARK_MOVE) + $self->{captures}[$own == MARK_B ? COLOUR_BLACK : COLOUR_WHITE] += @capture; + $self->{board}[$_->[0]][$_->[1]] = 0 for @capture; $suicide += $self->capture ($own, $x, $y); ${ $_->[5] } ||= !(@capture || $suicide); - if (!$suicide && @capture == 1) { + if ($suicide) { + $self->{board}[$x][$y] = 0 + + } elsif (!$suicide && @capture == 1) { # possible ko. now check liberties on placed stone my $libs; @@ -281,9 +292,12 @@ $libs++ if $y < $self->{max} && !($board->[$x][$y+1] & $opp); if ($libs == 1) { - $board->[$x][$y] = $board->[$x][$y] & ~MARK_CIRCLE | (MARK_KO & $nodemask); + $$space = $$space & ~$mark_symbols | MARK_KO; + ($x, $y) = @{$capture[0]}; - $board->[$x][$y] |= MARK_KO & $nodemask; + $board->[$x][$y] |= MARK_KO; + + push @{ $self->{unmark} }, \$board->[$x][$y]; } } } @@ -295,7 +309,9 @@ =item $board->is_valid_move ($colour, $x, $y[, $may_suicide]) Returns true if the move of the given colour on the given coordinates is -valid or not. +valid or not. Kos are taken into account as long as they are marked with +C. Suicides are invalid unless C<$may_suicide> is true (e.g. for +new zealand rules) =cut @@ -304,7 +320,8 @@ my $board = $self->{board}; - return if $board->[$x][$y] & (MARK_B | MARK_W | MARK_KO); + return if $board->[$x][$y] & (MARK_B | MARK_W | MARK_KO) + && !($board->[$x][$y] & MARK_GRAYED); if ($may_suicide) { return 1;