The Perl Toolchain Summit needs more sponsors. If your company depends on Perl, please support this very important event.
package Games::Go::Cinderblock::State;
use Moose;
use Games::Go::Cinderblock::MoveResult;


# basilisk::state,
# long overdue.
# describes board pos, turn, caps, etc.
# serializable & deserializable.
# doesn't serialize ruleset...; dunno how to handle that. if at all.
has rulemap => (
   is => 'ro',
   isa => 'Games::Go::Cinderblock::Rulemap',
   required => 1,
);

has board => (
   isa => 'ArrayRef',
   is => 'rw',
);
has turn => (
   is => 'rw',
   isa => 'Str',
);
has _captures => (
   isa => 'HashRef',
   is => 'ro',
   default => sub{{w=>0,b=>0}},
);

around BUILDARGS => sub {
   my $orig  = shift;
   my $class = shift;
   my %args = @_;
   if($args{captures}){
      $args{_captures} = delete $args{captures};
   }
   return $class->$orig(%args);
};

sub attempt_move{
   my $self = shift;
   my %args = @_;
   my $success = 1;
   my $attempt = Games::Go::Cinderblock::MoveAttempt->new(
      basis_state => $self,
      rulemap => $self->rulemap,
      node => $args{node},
      color => $args{color},
      move_attempt => \%args,
   );
   my $result = $self->rulemap->evaluate_move_attempt($attempt);
   return $result;
}

sub scorable{ #new? args? scorable_from_json?
   my $self = shift;
   my $scorable = Games::Go::Cinderblock::Scorable->new(
      state => $self,
      rulemap => $self->rulemap,
   );
}

sub at_node{
   my ($self,$node) = @_;
   return $self->rulemap->stone_at_node($self->board,$node);
}

sub floodfill{
   my ($self, $cond, $progenitor) = @_;
   my $set = $self->rulemap->nodeset($progenitor);
   my $seen = $self->rulemap->nodeset($progenitor);
   my @q = $self->rulemap->adjacent_nodes($progenitor);
   my $unseen = $self->rulemap->nodeset(@q);
   local($_);
   while($unseen->count){
      my $node = $unseen->choose;
      $unseen->remove($node);
      $seen->add($node);
      #next if $seen->has_node($node);
      #$seen->add($node);
      $_ = $self->at_node($node);
      #warn ($_ ? @$_ : '');
      #Carp::confess;
      next unless $cond->($node);
      $set->add($node);
      for my $n ( $self->rulemap->adjacent_nodes($node)) {
         next if ($seen->has_node($n));
         $unseen->add($n);
      }
      #     push @q, $self->rulemap->adjacent_nodes($node);
   }
   return $set;
}


sub grep_nodeset{
   my ($self,$cond,$ns) = @_;
   my $new_ns = $self->rulemap->nodeset;
   local($_);
   for my $node ($ns->nodes){
      my $at = $self->at_node($node);
      $_ = $at;
      if($cond->()){
         $new_ns->add($node);
      }
   }
   return $new_ns;
}


sub num_colors_in_nodeset{
   my $self = shift;
   return scalar ($self->colors_in_nodeset(@_));
}
sub colors_in_nodeset{
   my ($self, $nodeset) = @_;
   my %colors;
   for my $node ($nodeset->nodes){
      my $stone = $self->at_node($node);
      next unless $stone;
      $colors{$stone}++;
   }
   return keys %colors;
}

sub captures{
   my ($self,$color) = @_;
   if($color){return $self->_captures->{$color} }
   return $self->_captures;
}

sub delta_to{
   my ($self, $to) = @_;
   my $delta = $self->rulemap->delta($self,$to);
   return $delta;
   # my %changes;
   # {board}, {turn}, {captures}
}
sub delta_from{
   my ($self,$from) = @_;
   return $from->delta_to($self);
}

1;

__END__

=head1 NAME

Games::Go::Cinderblock::State - A game state representation

=head1 SYNOPSIS

 my $rulemap = Games::Go::Cinderblock::Rulemap::Rect->new(
   w => 5,
   h => 3,
 );
 my $board = [
   [qw/0 w 0 b 0],
   [qw/w w 0 b b],
   [qw/0 w 0 b 0]
 ];
 my $state = Games::Go::Cinderblock::State->new(
   rulemap => $rulemap,
   board => $board,
   turn => 'b',
 );
 # b expertly fills in an eye
 my $move_result = $state->attempt_move(
   color => 'b',
   node => [2,4],
 );
 $state = $move_result->resulting_state;
 say "Current turn: ' . $state->turn;
 # Current turn: w

=head1 DESCRIPTION

Unless you want bad things to happen, do not modify the state directly
while using it as the basis of a scorable. States are generally immutable,
but you do have the power to change them directly. Don't, though.

Use attempt_move, instead. In the future, move attempts will have 
special categories for passes & other tricky shenanigans.

=head1 METHODS

=head2 attempt_move

Usage: C<< my $move_result = $state->attempt_move(node=>$node,color=>$color >>

Return a L<MoveResult|Games::Go::Cinderblock::MoveResult>, which contains
a resulting state if the move attempt is successful.

=head2 scorable

Returns a new L<Games::Go::Cinderblock::Scorable>
with this state as its basis.

=head2 floodfill

 # a chain of black stones, starting at [10,10].
 my $chain = $state->floodfill( sub{$_ eq 'b'}, [10,10]);

Usage: C<< my $nodeset = $state->floodfill($condition, $progenitor) >>

This returns a nodeset of connected nodes where the condition evaluates
to true, beginning at a progenitor node.

To get a chain of white stones starting at $node
    $state->floodfill( $sub{ $_ eq 'w' }, $node);

To get a region of empty space, starting at $node
    $state->floodfill( $sub{ ! $_ }, $node);

=head2 grep_nodeset

 my $not_larger_nodeset = $state->grep_nodeset(sub{$_ =~ /[wb]/}, $nodeset)

Another awkward functional thing.

=cut