--- Games-Go-SimpleBoard/SimpleBoard.pm 2008/06/22 15:05:59 1.1 +++ Games-Go-SimpleBoard/SimpleBoard.pm 2008/06/24 23:19:24 1.6 @@ -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 @@ -33,21 +34,30 @@ COLOUR_BLACK # used for $board->{last} COLOUR_WHITE # to mark the colour of the last move + MOVE_HANDICAP # used as "x-coordinate" for handicap moves + MOVE_PASS # can be used as "x-coordinate" for handicap moves + =head2 METHODS =over 4 =cut -use base Exporter; +no warnings; +use strict; + +use Carp (); + +use base Exporter::; our $VERSION = '1.0'; -@EXPORT = qw( +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_REDRAW COLOUR_BLACK COLOUR_WHITE + MOVE_HANDICAP MOVE_PASS ); # marker types for each board position (ORed together) @@ -64,15 +74,21 @@ 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_CIRCLE (){ 0x1000 } sub MARK_REDRAW (){ 0x8000 } sub COLOUR_BLACK (){ 0 } sub COLOUR_WHITE (){ 1 } +sub MOVE_PASS (){ undef } +sub MOVE_HANDICAP (){ -2 } + =item my $board = new $size Creates a new empty board of the given size. +C<< $board->{size} >> stores the board size. + C<< $board->{max} >> stores the maximum board coordinate (size-1). C<< $board->{captures}[COLOUR] >> stores the number of captured stones for @@ -89,6 +105,7 @@ my $size = shift; bless { max => $size - 1, + size => $size, board => [map [(0) x $size], 1 .. $size], captures => [0, 0], # captures #timer => [], @@ -131,32 +148,71 @@ @found } -=item $hint = $board->update ([update-structure...]) +=item $hint = $board->update ([update-structures...]) -Structure is +Each update-structure itself is also an array-ref: [$x, $y, $clr, $set, $label, $hint] # update or move - [] # pass + [MOVE_HANDICAP, $handicap] # black move, setup handicap + [MOVE_PASS] # pass + [] # also pass (deprecated!) -and changes the board or executes a move, by first clearing the bits +It changes the board or executes a move, by first clearing the bits specified in C<$clr>, then setting bits specified in C<$set>. If C<$set> includes C, the label text must be given in C<$label>. -This function modifies the hint member of the specified path to speed up -repeated board generation and updates with the same update structures. +If C<$set> contains C, then a circle symbol will be placed +at this coordinate. Also, surrounded stones will be removed from the +board and (simple) Kos are detected and marked with square symbols and +C. The circle and square markings are removed with the next +update 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 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 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 +our %HANDICAP_COORD = ( + 9 => [2, 4, 6], + 13 => [3, 6, 9], + 19 => [3, 9, 15], +); +our %HANDICAP_XY = ( + 2 => [qw(0,2 2,0 )], + 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)], +); + sub update { my ($self, $path) = @_; @@ -170,7 +226,23 @@ ? ~0 : ~(MARK_SQUARE | MARK_TRIANGLE | MARK_CIRCLE | MARK_LABEL | MARK_KO); - if (defined $x) { + if (!defined $x) { + # pass + $self->{last} = $set & MARK_B ? COLOUR_BLACK : COLOUR_WHITE; + + } elsif ($x == MOVE_HANDICAP) { + # $y = #handicap stones + my $c = $HANDICAP_COORD{$self->{size}} + or Carp::croak "$self->{size}: illegal board size for handicap"; + my $h = $HANDICAP_XY{$y} + or Carp::croak "$y: illegal number of handicap stones"; + + for (@$h) { + my ($x, $y) = map $c->[$_], split /,/; + $board->[$x][$y] = MARK_B | MARK_MOVE; + } + + } else { $board->[$x][$y] = $board->[$x][$y] & ~$clr @@ -225,8 +297,6 @@ } } } - } else { - $self->{last} = $set & MARK_B ? COLOUR_BLACK : COLOUR_WHITE; } } } @@ -234,7 +304,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 @@ -274,7 +346,7 @@ =head2 SEE ALSO -L, L, L. +L. =cut