Games::Goban::Board - a go board built from Games::Board

Games-Goban documentation Contained in the Games-Goban distribution.

Index

Code Index:

NAME

Top

Games::Goban::Board -- a go board built from Games::Board

VERSION

Top

  $Id: /my/cs/projects/goban/trunk/lib/Games/Goban/Board.pm 28023 2006-11-14T22:56:30.198282Z rjbs  $

SYNOPSIS

Top

  use Games::Goban::Board;

  my $board = Games::Goban::Board->new(size => 19);

  # etc

This class exists is primarily for use (for now) by Games::Goban, which currently implements its own board, badly.

DESCRIPTION

Top

This module provides a class for representing a go board and pieces.

METHODS

Top

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

AUTHOR

Top

Ricardo SIGNES <rjbs@cpan.org>

COPYRIGHT

Top

Copyright 2004 by Ricardo Signes <rjbs@cpan.org>

This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself.

See http://www.perl.com/perl/misc/Artistic.html

Games-Goban documentation Contained in the Games-Goban distribution. 
use strict;
use warnings;

package Games::Goban::Board;
use base qw(Games::Board::Grid);


our $VERSION = '1.100';


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