view release on metacpan or  search on metacpan

lib/Games/Go/Referee.pm  view on Meta::CPAN

  return processmove($self, @_);
}

sub processtags {
  my ($self, $sgfnode) = @_;
  $self->{_node}{++$self->{_nodecount}} = makenode($self, $sgfnode->colour, $sgfnode->move);

  for (split (',',$sgfnode->tags)){
    if (($_ eq 'B') or ($_ eq 'W')) {
      return unless move($self, $sgfnode->colour, $sgfnode->move);
      next;
    }
    if (',AB,AW,AE,' =~ /,($_),/) {
      my $tag = $1;
      for (split (',', $sgfnode->$tag)) {
        if ( $_ =~ /(..):(..)/) {
          my $arrayref = generaterectangle($self, $1, $2);
          for (@$arrayref) {changecell($self, $tag, $_)};
        } else {
          changecell($self, $tag, $_);
        }
      }
      next;
    }
  }

  return 1
}

sub generaterectangle {
  my ($self, $topleft, $bottomright) = @_;
  my @pointlist;
  my ($tx, $ty) = extractpoints($self, $topleft);
  my ($bx, $by) = extractpoints($self, $bottomright);
  for my $x ($tx..$bx) {
    for my $y ($ty..$by) {
      push @pointlist, insertpoints($self, $x, $y);
    }
  }
  return \@pointlist;
}

# list all the stones of a particular colour

sub liststones {
  my ($self, $colour) = @_;
  my $stone = ($colour eq 'B') ? 'x' : 'o';
  my %hash;
  _iterboard {
    my ($x, $y) = @_;
    if ($self->{_cellfarm}{$x.','.$y} eq $stone) {
      $hash{$x.','.$y} = undef;
    }
  } $self->{_const}{size};
  return \%hash
}

# list all the live stones of a particular colour
# (as the set of all blocks adjacent to their opponent's illegal moves)

sub listalive {
  my ($self, $colour) = @_;

  # turn off alternation and passcount errors temporarily
  $self->{_const}{passcount} = 0;
  $self->{_const}{alternation} = 0;
  # first get the list of illegal moves for the other player
  my @illegallist = illegal($self, swapcolour($self, $colour));
  my $points = {};
  my $stone = ($colour eq 'B') ? 'x' : 'o';

  # now get the blocks attached to those illegal points
  for (@illegallist) {
    my ($x, $y) = extractpoints($self, $_);
    my @directions = ([1,0],[0,1],[-1,0],[0,-1]);
    for (0..3) {
      my $xdir = $directions[$_][0]+$x;
      my $ydir = $directions[$_][1]+$y;
      $points = block($self, $xdir, $ydir, $stone, $points);
    }
  }
  $self->{_const}{passcount} = 1;
  $self->{_const}{alternation} = 1;
  return $points
}

# list the dead stones of a particular colour
# (as the difference between their alive list
# and their total list)

sub listdead {
  my ($self, $colour) = @_;
  my $allref = liststones($self, $colour);
  my $aliveref = listalive($self, $colour);
  my @dead = ();
  for (keys %$allref) {
    push @dead, $_ unless exists $aliveref->{$_};
  }
  @dead = map {
    /(.*),(.*)/;
    insertpoints($self, $1, $2) 
  } @dead;
  return \@dead
}

# list all the dead stones on the board
# (as the union of the Black and White
# dead stone list)

sub listalldead {
  my ($self) = @_;
  my $bdead = listdead($self, 'B');
  my $wdead = listdead($self, 'W');
  my @dead = (@$bdead, @$wdead);
  return \@dead
}

sub ismove {
  testnode(shift, ',B,W,') ? return 1 : return 0
}

sub issetup {
  testnode(shift, ',AB,AW,AE,') ? return 1 : return 0
}

sub testnode{
  my ($sgfnode, $type) = @_;
  if ($sgfnode->tags){
    for (split (',',$sgfnode->tags)){
      if ($type =~ /,$_,/) {
        return 1;
      }
    }
  }
  return 0
}

sub restart {
  my $self = shift;
  $self->{_node}        = {};
  $self->{_boardstr}    = {};
  $self->{_nodecount}   = 0;
  $self->{_movecount}   = 0;
  $self->{_passcount}   = 0;
  $self->{_colour}      = 'None';
  $self->{_cellfarm}    = {};
  $self->{_errors}      = [];
  $self->{_prisonersB}  = 0;
  $self->{_prisonersW}  = 0;
  $self->{_sgf}         = {};
  $self->{_node}{0}     = makenode($self, $self->{_colour});
}

sub initrules {
  my $self = shift;
  my $rules = uc(shift);