File Coverage

blib/lib/Games/Board/Piece.pm

Criterion	Covered	Total	%
statement	36	37	97.3
branch	11	18	61.1
condition	2	3	66.6
subroutine	9	9	100.0
pod	6	6	100.0
total	64	73	87.6

use strict;
use warnings;
package Games::Board::Piece 1.014;
# ABSTRACT: a parent class for board game pieces

use Carp;

#pod =head1 SYNOPSIS
#pod
#pod   use Games::Board;
#pod
#pod   my $board = Games::Board->new;
#pod
#pod   $board->add_space(
#pod     id   => 'go',
#pod     dir  => { next => 'mediterranean', prev => 'boardwalk' },
#pod     cost => undef
#pod   );
#pod
#pod   my $tophat = Games::Board::Piece->new(id => 'tophat')->move(to => 'go');
#pod
#pod =head1 DESCRIPTION
#pod
#pod This module provides a base class for representing the pieces in a board game.
#pod
#pod =cut

#pod =method new
#pod
#pod This method constructs a new game piece and returns it.
#pod
#pod =cut

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

  return unless $args{id};
  return unless eval { $args{board}->isa('Games::Board') };

  my $piece = { %args };

  bless $piece => $class;
}

#pod =method id
#pod
#pod This returns the piece's id.
#pod
#pod =cut

sub id {
  my $self = shift;
  $self->{id};
}

#pod =method board
#pod
#pod This returns the board object to which the piece is related.
#pod
#pod =cut

sub board {
  my $self = shift;
  $self->{board};
}

#pod =method current_space_id
#pod
#pod This returns the id of the space on which the piece currently rests, if any.
#pod It it's not on any space, it returns undef.
#pod
#pod =cut

sub current_space_id {
  my $piece = shift;
  $piece->{current_space};
}

#pod =method current_space
#pod
#pod This returns the Space on which the piece currently rests, if any.  It it's not
#pod on any space, it returns undef.
#pod
#pod =cut

sub current_space {
  my $piece = shift;
  return unless $piece->{current_space};
  $piece->board->space($piece->{current_space});
}

#pod =method move
#pod
#pod   $piece->move(dir => 'up')
#pod
#pod   $piece->move(to  => $space)
#pod
#pod This method moves the piece to a new space on the board.  If the method call is
#pod in the first form, the piece is moved to the space in the given direction from
#pod the piece's current space.  If the method call is in the second form, and
#pod C<$space> is a Games::Board::Space object, the piece is moved to that space.
#pod
#pod =cut

sub move {
  my $piece = shift;
  my ($how, $which) = @_;
  my $new_space;
  my $old_space = $piece->current_space;

  if ($how eq 'dir') {
    return unless $old_space;
    return unless $new_space = $old_space->dir($which);
  } elsif ($how eq 'to') {
    return unless eval { $which->isa('Games::Board::Space') };
    $new_space = $which;
  } else {
    return;
  }

  return unless !$old_space || $old_space->take($piece);
  $new_space->receive($piece);
}

1;

__END__