File Coverage

blib/lib/Games/Goban/Board.pm

Criterion	Covered	Total	%
statement	39	40	97.5
branch	6	6	100.0
condition	1	3	33.3
subroutine	13	14	92.8
pod	4	4	100.0
total	63	67	94.0

use strict;
use warnings;

package Games::Goban::Board 1.103;
use parent qw(Games::Board::Grid);
# ABSTRACT: a go board built from Games::Board

#pod =head1 SYNOPSIS
#pod
#pod   use Games::Goban::Board;
#pod
#pod   my $board = Games::Goban::Board->new(size => 19);
#pod
#pod   # etc
#pod
#pod This class exists is primarily for use (for now) by Games::Goban, which
#pod currently implements its own board, badly.
#pod
#pod =head1 DESCRIPTION
#pod
#pod This module provides a class for representing a go board and pieces.
#pod
#pod =cut

#pod =head1 METHODS
#pod
#pod The methods of this class are not substantially changed from those of
#pod Games::Board.  Space id's are more go-like.  New pieces are blessed into the
#pod class Games::Goban::Piece, which provides a few historical methods for
#pod Games::Goban's consumption.
#pod
#pod =cut

my $origin = ord('a');

sub piececlass { 'Games::Goban::Piece' }

sub new {
  my ($self, %opts) = @_;

  my $board = $self->SUPER::new(%opts);
  $board->{skip_i} = defined $opts{skip_i} ? $opts{skip_i} : 0;

  $board;
}

sub index2id {
  my ($self, $loc) = @_;

  my $id = chr($origin + $loc->[0]) . chr($origin + $loc->[1]);

  $id =~ tr/[i-s]/[j-t]/ if $self->{skip_i};

  $id;
}

sub id2index {
  my ($self, $id) = @_;

  $id =~ tr/[j-t]/[i-s]/ if $self->{skip_i};

  my @loc = split //, $id;

  $_ = ord($_) - $origin for @loc;
  \@loc;
}

package Games::Goban::Piece 1.103;
use base qw(Games::Board::Piece);

my $next_id = 0;

sub new {
  my ($class, %args) = @_;

  $args{id} ||= ++$next_id;

  my $self = $class->SUPER::new(%args);

  $self->{color} = $args{color};
  $self->{notes} = $args{notes};
  $self->{move}  = $args{move};

  bless $self => $class;
}

sub notes    { (shift)->{notes} }
sub position { (shift)->current_space_id }

sub moved_on { (shift)->{move} }

sub color  { my $self = shift; $self->{color} }
sub colour { my $self = shift; $self->{color} }

1;

__END__