File Coverage

blib/lib/Games/Board/Grid.pm

Criterion	Covered	Total	%
statement	42	43	97.6
branch	7	10	70.0
condition	6	6	100.0
subroutine	12	13	92.3
pod	7	7	100.0
total	74	79	93.6

use strict;
use warnings;

package Games::Board::Grid 1.014;
use parent qw(Games::Board);
# ABSTRACT: a grid-shaped gameboard

use Carp;

#pod =head1 SYNOPSIS
#pod
#pod   use Games::Board::Grid;
#pod
#pod   my $chess = Games::Board->new(size => 8);
#pod
#pod   my $rook = Games::Board::Piece->new(id => 'KR')->move(to => '7 7');
#pod
#pod =head1 DESCRIPTION
#pod
#pod This module provides a base class for representing a board made up of spaces on
#pod a right-angled grid.
#pod
#pod =cut

#pod =method new
#pod
#pod   my $board = Games::Board::Grid->new(size => $size);
#pod
#pod This method constructs a new game board and returns it.  As constructed it has
#pod no spaces or pieces on it.  The C argument may be an integer, to produce
#pod a square board, or an arrayref containing two integers, to produce a
#pod rectangular board.
#pod
#pod =cut

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

  croak "no size given to construct grid" unless $args{size};

  $args{size} = [ ($args{size}) x 2 ] unless ref $args{size};

  my $board = { size => $args{size} };
  bless $board => $class;
  $board->init;
}

#pod =method init
#pod
#pod This method sets up the spaces on the board.
#pod
#pod =cut

sub init {
  my $board = shift;

  $board->{spaces} = {};

  for my $x (0 .. ($board->{size}[0] - 1)) {
  for my $y (0 .. ($board->{size}[1] - 1)) {
    my $id = $board->index2id([$x,$y]);
    $board->{spaces}{$id} = Games::Board::Grid::Space->new(id => $id, board => $board);
  }
  }

  $board;
}

#pod =method size
#pod
#pod =cut

sub size { (shift)->{size} }

#pod =method id2index
#pod
#pod   my $index = $board->id2index($id);
#pod
#pod This method returns the grid location of an identified space, in the format
#pod C<[$x, $y]>.  In Games::Board::Grid, the index C<[x,y]> becomes the id C<'x
#pod y'>.  Yeah, it's ugly, but it works.
#pod
#pod Reimplementing this method on a subclass can allow the use of idiomatic space
#pod identifiers on a grid.  (See, for example, the chess-custom.t test in this
#pod distribution.)
#pod
#pod =cut

sub id2index { [ split(/ /,$_[1]) ] }

#pod =method index2id
#pod
#pod   my $id = $board->index2id($index);
#pod
#pod This method performs the same translation as C, but in reverse.
#pod
#pod =cut

sub index2id { join(q{ }, @{$_[1]}) }

#pod =method space
#pod
#pod   my $space = $board->space($id);
#pod
#pod This method returns the space with the given C<$id>.  If no space with that id
#pod exists, undef is returned.
#pod
#pod =cut

sub space {
  my $board = shift;
  my $id    = shift;

  return $board->{spaces}{$id};
}

#pod =method add_space
#pod
#pod This method, provided by Games::Board, will croak immediately if called.
#pod
#pod =cut

sub add_space { croak "spaces can't be added to grid board" }

#pod =head2 Games::Board::Grid::Space
#pod
#pod The spaces on a grid board are blessed into this class.  It acts like a
#pod L object, but directions are given as arrayrefs with x-
#pod and y-offsets.  For example, a knight's move might be represented as:
#pod
#pod   $board->space('1 0')->dir([2,1]);
#pod
#pod =cut

package Games::Board::Grid::Space 1.014;
use parent qw(Games::Board::Space);

sub dir_id {
  my ($self, $dir) = @_;
  return unless ref $dir eq 'ARRAY';

  my $pos = $self->board->id2index($self->id);

  my $newpos = [
    $pos->[0] + $dir->[0],
    $pos->[1] + $dir->[1]
  ];

  return if $newpos->[0] < 0 or $newpos->[1] < 0;
  return
    if $newpos->[0] >= $self->board->size->[0]
    or $newpos->[1] >= $self->board->size->[1];
  return $self->board->index2id($newpos);
}

"Family fun night!";

__END__