File Coverage

blib/lib/Chess/Piece/Pawn.pm

Criterion	Covered	Total	%
statement	41	43	95.3
branch	22	26	84.6
condition	7	15	46.6
subroutine	8	8	100.0
pod	3	3	100.0
total	81	95	85.2

=head1 NAME

Chess::Piece::Pawn - a class representing a pawn in a chess game

=head1 SYNOPSIS

    $pawn = Chess::Piece::Pawn->new("e2", "White King's pawn");
    $true = $pawn->can_reach("e4");
    $true = $pawn->can_reach("e3");
    $true = $pawn->can_reach("f3");
    $false = $pawn->can_reach("e5");
    $queen = $pawn->promote("queen");

=head1 DESCRIPTION

The Chess module provides a framework for writing chess programs with Perl.
This class is part of that framework, representing a pawn in a
L.

=head1 METHODS

=head2 Construction

=over 4

=item new()

Constructs a new Chess::Piece::Pawn. Requires a two scalar parameters
containing the square on which the pawn is to be constucted and its color,
Optionally takes a third parameter containing a text description of the pawn.

    $pawn = Chess::Piece::Pawn->new("d2", "white");
    $pawn = Chess::Piece::Pawn->new("e2", "white",
                                    "White King's pawn");

=head2 Class methods

There are no class methods for this class.

=head2 Object methods

=item reachable_squares()

Overrides base class version. Returns a list of squares that this pawn can
reach from its current position. See L
for more details on this method.

=item promote()

Takes a parameter containing the type of piece to promote to. Returns itself
blessed as that type of piece. Returns undef and produces a warning (see
L if the piece is not one of 'bishop', 'knight', 'queen' or
'rook'.

=head1 DIAGNOSTICS

=over 4

=item Can't promote a pawn to a 'king'

You may only promote a pawn to a 'bishop', 'knight', 'queen' or 'rook'.

=back

=head1 BUGS

Please report any bugs to the author.

=head1 AUTHOR

Brian Richardson

=head1 COPYRIGHT

Copyright (c) 2002, 2005 Brian Richardson. All rights reserved. This module
is Free Software. It may be modified and redistributed under the same terms as
Perl itself.

=cut
package Chess::Piece::Pawn;

use Chess::Piece;
use Chess::Board;
use base 'Chess::Piece';
use Carp;
use strict;

sub new {
    my ($caller, $sq, $color, $desc) = @_;
    my $class = ref($caller) || $caller;
    my $self = $caller->SUPER::new($sq, $color, $desc);
    return bless $self, $class;
}

sub reachable_squares {
    my ($self) = @_;
    my $color = $self->get_player();
    my $csq = $self->get_current_square();
    my $tsq1;
    my @squares = ( );
    if ($color eq 'white') {
	$tsq1 = Chess::Board->square_up_from($csq) if defined($csq);
    }
    else {
	$tsq1 = Chess::Board->square_down_from($csq) if defined($csq);
    }
    push @squares, $tsq1 if defined($tsq1);
    my $tsq2;
    if ($color eq 'white') {
	$tsq2 = Chess::Board->square_up_from($tsq1) if defined($tsq1);
    }
    else {
	$tsq2 = Chess::Board->square_down_from($tsq1) if defined($tsq1);
    }
    push @squares, $tsq2 if (!$self->moved() and defined($tsq2));
    $tsq2 = Chess::Board->square_left_of($tsq1) if defined($tsq1);
    push @squares, $tsq2 if (defined($tsq2));
    $tsq2 = Chess::Board->square_right_of($tsq1) if defined($tsq1);
    push @squares, $tsq2 if (defined($tsq2));
    return @squares;
}

sub promote {
    my ($self, $new_rank) = @_;
    unless (lc($new_rank) eq 'bishop' || lc($new_rank) eq 'knight' ||
            lc($new_rank) eq 'rook' || lc($new_rank) eq 'queen') {
	carp "Can't promote a pawn to a '$new_rank'";
	return undef;
    }
    return bless $self, ('Chess::Piece::' . ucfirst($new_rank));
}

1;