File Coverage

blib/lib/Chess/Piece/King.pm
Criterion Covered Total %
statement 41 43 95.3
branch 18 20 90.0
condition 5 6 83.3
subroutine 6 8 75.0
pod 3 3 100.0
total 73 80 91.2


line stmt bran cond sub pod time code
1             =head1 NAME
2              
3             Chess::Piece::King - an object representation of a king in a game of chess
4              
5             =head1 SYNOPSIS
6              
7             $king = Chess::Piece::King->new("e1", "white", "White King");
8             $true = $king->can_reach("d1");
9             $true = $king->can_reach("f1");
10             $true = $king->can_reach("d2");
11             $true = $king->can_reach("e2");
12             $true = $king->can_reach("f2");
13             $true = $king->can_reach("g1"); # O-O
14             $king->set_moved(1);
15             $false = $king->can_reach("g1");
16             $false = $king->can_reach("d4");
17             $king->set_captured(1); # dies with message
18             $king->set_checkmated(1); # use this instead
19             if ($king->checkmated()) {
20             # game over...
21             }
22              
23             =head1 DESCRIPTION
24              
25             The Chess module provides a framework for writing chess programs with Perl.
26             This class forms part of that framework, representing a bishop in a
27             L.
28              
29             =head1 METHODS
30              
31             =head2 Construction
32              
33             =item new()
34              
35             Constructs a new Chess::Piece::King. Requires two scalar parameters
36             containing the initial square and color of the piece. Optionally takes a
37             third parameter containing a description of the piece.
38              
39             =head2 Class methods
40              
41             There are no class methods for this class.
42              
43             =head2 Object methods
44              
45             =item can_reach()
46              
47             Overrides base class version. Returns a list of squares that this pawn can
48             reach from its current position. See L
49             for more details on this method.
50              
51             =item checkmated()
52              
53             Takes no parameters. Returns true if the checkmated flag has been set for this
54             king (as determined by L.
55              
56             =item set_checkmated()
57              
58             Takes a single scalar parameter containing a boolean value. Sets the checkmated
59             property of this king to that value.
60              
61             =head1 DIAGNOSTICS
62              
63             =item "King cannot be captured. Use set_checkmated() instead"
64              
65             The program contains a call to Chess::Piece::King::set_captured. This
66             method has been overridden to croak, as the rules don't allow for capturing
67             the king. See L.
68              
69             =item "Invalid Chess::Piece::King reference"
70              
71             The program contains a reference to a Chess::Piece::King that was not
72             obtained through L or L. Ensure that the
73             program obtains the reference correctly, and that it does not refer to
74             an undefined value.
75              
76             =head1 BUGS
77              
78             Please report any bugs to the author.
79              
80             =head1 AUTHOR
81              
82             Brian Richardson
83              
84             =head1 COPYRIGHT
85              
86             Copyright (c) 2002, 2005 Brian Richardson. All rights reserved. This module is
87             Free Software. It may be modified and redistributed under the same terms as
88             Perl itself.
89              
90             =cut
91             package Chess::Piece::King;
92              
93 4     4   19414 use Chess::Board;
  4         9  
  4         104  
94 4     4   665 use Chess::Piece;
  4         7  
  4         92  
95 4     4   20 use base 'Chess::Piece';
  4         8  
  4         365  
96 4     4   23 use Carp;
  4         7  
  4         261  
97 4     4   22 use strict;
  4         7  
  4         1746  
98              
99             sub captured {
100 0     0 1 0 croak "King can't be captured";
101             }
102              
103             sub set_captured {
104 0     0 1 0 croak "King can't be captured";
105             }
106              
107             sub reachable_squares {
108 39     39 1 63 my ($self) = @_;
109 39         126 my $csq = $self->get_current_square();
110 39         98 my @squares = ( );
111 39         138 my $sq1 = Chess::Board->square_left_of($csq);
112 39 50       123 if (defined($sq1)) {
113 39         92 push @squares, $sq1;
114 39         130 my $sq2 = Chess::Board->square_up_from($sq1);
115 39 100       110 push @squares, $sq2 if (defined($sq2));
116 39         297 $sq2 = Chess::Board->square_down_from($sq1);
117 39 100       123 push @squares, $sq2 if (defined($sq2));
118             }
119 39         134 $sq1 = Chess::Board->square_right_of($csq);
120 39 50       100 if (defined($sq1)) {
121 39         69 push @squares, $sq1;
122 39         287 my $sq2 = Chess::Board->square_up_from($sq1);
123 39 100       119 push @squares, $sq2 if (defined($sq2));
124 39         120 $sq2 = Chess::Board->square_down_from($sq1);
125 39 100       160 push @squares, $sq2 if (defined($sq2));
126             }
127 39         125 $sq1 = Chess::Board->square_up_from($csq);
128 39 100       109 push @squares, $sq1 if (defined($sq1));
129 39         118 $sq1 = Chess::Board->square_down_from($csq);
130 39 100       99 push @squares, $sq1 if (defined($sq1));
131 39         130 $sq1 = Chess::Board->add_horz_distance($csq, 2);
132 39 100 100     191 push @squares, $sq1 if (defined($sq1) and !$self->moved());
133 39         132 $sq1 = Chess::Board->add_horz_distance($csq, -2);
134 39 100 66     185 push @squares, $sq1 if (defined($sq1) and !$self->moved());
135 39         1033 return @squares;
136             }
137              
138             1;