package Games::Go::SimpleBoard;

=head1 NAME

Games::Go::SimpleBoard - represent a simple go board

=head1 SYNOPSIS

   use Games::Go::SimpleBoard;

=head1 DESCRIPTION

Please supply a description )

=head2 EXPORTED CONSTANTS

Marker types for each board position (ORed together):

   MARK_TRIANGLE # triangle mark
   MARK_SQUARE   # square mark
   MARK_CIRCLE   # circle 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
   MARK_W        # normal whit stone
   MARK_GRAYED   # in conjunction with MARK_[BW], grays the stone
   MARK_LABEL    # a text label
   MARK_HOSHI    # this is a hoshi point (not used much)
   MARK_MOVE     # this is a regular move
   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

=head2 METHODS

=over 4

=cut

use base Exporter;

our $VERSION = '1.0';

@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
);

# marker types for each board position (ORed together)

sub MARK_TRIANGLE (){ 0x0001 }
sub MARK_SQUARE   (){ 0x0002 }
sub MARK_CIRCLE   (){ 0x0004 }
sub MARK_SMALL_B  (){ 0x0008 } # small stone, used for scoring or marking
sub MARK_SMALL_W  (){ 0x0010 } # small stone, used for scoring or marking
sub MARK_B        (){ 0x0020 } # normal black stone
sub MARK_W        (){ 0x0040 } # normal whit stone
sub MARK_GRAYED   (){ 0x0080 } # in conjunction with MARK_[BW], grays the stone
sub MARK_LABEL    (){ 0x0100 }
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_REDRAW   (){ 0x8000 }

sub COLOUR_BLACK  (){ 0 }
sub COLOUR_WHITE  (){ 1 }

=item my $board = new $size

Creates a new empty board of the given size.

C<< $board->{max} >> stores the maximum board coordinate (size-1).

C<< $board->{captures}[COLOUR] >> 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

sub new {
   my $class = shift;
   my $size = shift;
   bless {
         max      => $size - 1,
         board    => [map [(0) x $size], 1 .. $size],
         captures => [0, 0], # captures
        #timer    => [],
        #score    => [],
        #last     => COLOUR_...,
         @_
      },
      $class;
}

# inefficient and primitive, I hear you say?
# well... you are right :)
# use an extremely dumb floodfill algorithm to get rid of captured stones
sub capture {
   my ($self, $mark, $x, $y) = @_;

   my %seen;
   my @found;
   my @nodes = ([$x,$y]);
   my $board = $self->{board};

   my $max = $self->{max};

   while (@nodes) {
      my ($x, $y) = @{pop @nodes};
      unless ($seen{$x,$y}++) {
         if ($board->[$x][$y] & $mark) {
            push @found, [$x, $y];

            push @nodes, [$x-1, $y] unless $seen{$x-1, $y} || $x <= 0;
            push @nodes, [$x+1, $y] unless $seen{$x+1, $y} || $x >= $max;
            push @nodes, [$x, $y-1] unless $seen{$x, $y-1} || $y <= 0;
            push @nodes, [$x, $y+1] unless $seen{$x, $y+1} || $y >= $max;
         } elsif (!($board->[$x][$y] & (MARK_B | MARK_W))) {
            return;
         }
      }
   }

   @found
}

=item $hint = $board->update ([update-structure...])

Structure is

   [$x, $y, $clr, $set, $label, $hint] # update or move
   []                                  # pass

and 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<MARK_LABEL>, 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 the hint member is a reference the scalar pointed to by the reference
is updated instead.

Example, make two silly moves:

  $board->update ([[0, 18, -1, MARK_B|MARK_MOVE],
                   [0, 17, -1, MARK_W|MARK_MOVE]);

=cut

sub update {
   my ($self, $path) = @_;

   my $board = $self->{board};

   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) {
         $board->[$x][$y] =
            $board->[$x][$y]
            & ~$clr
            | $set
            & $nodemask;

         $self->{label}[$x][$y] = $label if $set & MARK_LABEL;

         if ($set & MARK_MOVE) {
            $self->{last} = $set & MARK_B ? COLOUR_BLACK : COLOUR_WHITE;

            unless (${ $_->[5] ||= \my $hint }) {
               my ($own, $opp) =
                  $set & MARK_B
                     ? (MARK_B, MARK_W)
                     : (MARK_W, MARK_B);

               my (@capture, $suicide);

               push @capture, $self->capture ($opp, $x-1, $y) if $x > 0            && $board->[$x-1][$y] & $opp;
               push @capture, $self->capture ($opp, $x+1, $y) if $x < $self->{max} && $board->[$x+1][$y] & $opp;
               push @capture, $self->capture ($opp, $x, $y-1) if $y > 0            && $board->[$x][$y-1] & $opp;
               push @capture, $self->capture ($opp, $x, $y+1) if $y < $self->{max} && $board->[$x][$y+1] & $opp;

               # keep only unique coordinates
               @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)
                  for @capture;

               $suicide += $self->capture ($own, $x, $y);

               ${ $_->[5] } ||= !(@capture || $suicide);

               if (!$suicide && @capture == 1) {
                  # possible ko. now check liberties on placed stone

                  my $libs;

                  $libs++ if $x > 0            && !($board->[$x-1][$y] & $opp);
                  $libs++ if $x < $self->{max} && !($board->[$x+1][$y] & $opp);
                  $libs++ if $y > 0            && !($board->[$x][$y-1] & $opp);
                  $libs++ if $y < $self->{max} && !($board->[$x][$y+1] & $opp);
                  
                  if ($libs == 1) {
                     $board->[$x][$y] = $board->[$x][$y] & ~MARK_CIRCLE | (MARK_KO & $nodemask);
                     ($x, $y) = @{$capture[0]};
                     $board->[$x][$y] |= MARK_KO & $nodemask;
                  }
               }
            }
         }
      } else {
         $self->{last} = $set & MARK_B ? COLOUR_BLACK : COLOUR_WHITE;
      }
   }
}

=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.

=cut

sub is_valid_move {
   my ($self, $colour, $x, $y, $may_suicide) = @_;

   my $board = $self->{board};

   return if $board->[$x][$y] & (MARK_B | MARK_W | MARK_KO);

   if ($may_suicide) {
      return 1;
   } else {
      my ($own, $opp) = $colour == COLOUR_BLACK
                           ? (MARK_B, MARK_W)
                           : (MARK_W, MARK_B);

      # try the move
      local $board->[$x][$y] = $board->[$x][$y] | $own;

      return 1 if $x > 0            && $board->[$x-1][$y] & $opp && $self->capture ($opp, $x-1, $y, 1);
      return 1 if $x < $self->{max} && $board->[$x+1][$y] & $opp && $self->capture ($opp, $x+1, $y, 1);
      return 1 if $y > 0            && $board->[$x][$y-1] & $opp && $self->capture ($opp, $x, $y-1, 1);
      return 1 if $y < $self->{max} && $board->[$x][$y+1] & $opp && $self->capture ($opp, $x, $y+1, 1);

      return !$self->capture ($own, $x, $y, 1);
   }
}

1;

=back

=head2 AUTHOR

Marc Lehmann <schmorp@schmorp.de>

=head2 SEE ALSO

L<KGS::Protocol>, L<KGS::Game::Tree>, L<Gtk2::GoBoard>.

=cut