File Coverage

blib/lib/Game/Battleship/Player.pm
Criterion Covered Total %
statement 56 62 90.3
branch 18 24 75.0
condition 1 3 33.3
subroutine 10 10 100.0
pod 4 4 100.0
total 89 103 86.4


line stmt bran cond sub pod time code
1             package Game::Battleship::Player;
2             $Game::Battleship::Player::VERSION = '0.0601';
3             our $AUTHORITY = 'cpan:GENE';
4              
5 2     2   9 use Carp;
  2         3  
  2         108  
6 2     2   1147 use Game::Battleship::Craft;
  2         6  
  2         71  
7 2     2   1314 use Game::Battleship::Grid;
  2         6  
  2         68  
8 2     2   13 use Moo;
  2         3  
  2         8  
9 2     2   589 use Types::Standard qw( ArrayRef Int Str );
  2         78  
  2         12  
10              
11             has id => (
12             is => 'ro',
13             isa => Str,
14             );
15              
16             has name => (
17             is => 'ro',
18             isa => Str,
19             );
20              
21             has life => (
22             is => 'ro',
23             isa => Int,
24             );
25              
26             has fleet => (
27             is => 'ro',
28             isa => ArrayRef,
29             default => sub {
30             [
31             Game::Battleship::Craft->new(
32             name => 'aircraft carrier',
33             points => 5,
34             ),
35             Game::Battleship::Craft->new(
36             name => 'battleship',
37             points => 4,
38             ),
39             Game::Battleship::Craft->new(
40             name => 'cruiser',
41             points => 3,
42             ),
43             Game::Battleship::Craft->new(
44             name => 'submarine',
45             points => 3,
46             ),
47             Game::Battleship::Craft->new(
48             name => 'destroyer',
49             points => 2,
50             ),
51             ]
52             },
53             );
54              
55             has dimensions => (
56             is => 'ro',
57             isa => ArrayRef[Int],
58             );
59              
60             has grid => (
61             is => 'ro',
62             isa => ArrayRef,
63             );
64              
65             sub BUILD {
66 3     3 1 225 my $self = shift;
67              
68             $self->{grid} =
69 3         54 Game::Battleship::Grid->new(
70             fleet => $self->fleet,
71             dimensions => $self->dimensions,
72             );
73              
74             # Compute the life points for this player.
75 3         19 $self->{life} += $_->points for @{ $self->fleet };
  3         82  
76             }
77              
78             # The enemy must be a G::B::Player object.
79             sub matrix {
80 4     4 1 3079 my ($self, $enemy) = @_;
81             return $enemy
82             ? join "\n",
83 0         0 map { "@$_" } @{ $self->{$enemy->name}{matrix} }
  0         0  
84             : join "\n",
85 4 50       12 map { "@$_" } @{ $self->{grid}{matrix} };
  40         123  
  4         12  
86             }
87              
88             # The enemy must be a G::B::Player object.
89             sub strike {
90 101     101 1 79924 my ($self, $enemy, $x, $y) = @_;
91              
92 101 50       255 croak "No opponent to strike.\n" unless $enemy;
93 101 50 33     432 croak "No coordinate at which to strike.\n"
94             unless defined $x && defined $y;
95              
96 101 50       268 if ($enemy->life > 0) {
97             # Initialize the enemy grid map if we need to.
98             $self->{$enemy->name} = Game::Battleship::Grid->new
99 101 100       351 unless exists $self->{$enemy->name};
100              
101 101         232 my $enemy_pos = \$enemy->{grid}{matrix}[$x][$y];
102 101         248 my $map_pos = \$self->{$enemy->name}{matrix}[$x][$y];
103              
104 101 100       301 if ($$map_pos ne '.') {
    100          
105 1         60 warn "Duplicate strike on ", $enemy->name, ' by ', $self->name, " at $x, $y.\n";
106 1         5 return -1;
107             }
108             elsif ($enemy->_is_a_hit($x, $y)) { # Set the enemy grid map coordinate char to 'hit'.
109 13         19 $$map_pos = 'x';
110              
111             # What craft was hit?
112 13         39 my $craft = $self->craft(id => $$enemy_pos);
113              
114 13         748 warn $self->name, ' hit ', $enemy->name, "'s ", $craft->name, "!\n";
115              
116             # How much is left on this craft?
117 13         68 my $remainder = $craft->hit;
118              
119             # Tally the hit in the craft object, itself and emit a happy
120             # warning if it was totally destroyed.
121 13 100       188 warn $self->name, ' sunk ', $enemy->name, "'s ", $craft->name, "!\n"
122             unless $remainder;
123              
124             # Indicate the hit on the enemy grid by lowercasing the craft
125             # id.
126 13         24 $$enemy_pos = lc $$enemy_pos;
127              
128             # Increment the player's score.
129 13         22 $self->{score}++;
130              
131             # Decrement the opponent's life.
132             warn $enemy->name, " is out of the game.\n"
133 13 50       31 if --$enemy->{life} <= 0;
134              
135 13         38 return 1;
136             }
137             else {
138             # Set the enemy grid map coordinate char to 'miss'.
139 87         5014 warn $self->name, ' missed ', $enemy->name, " at $x, $y.\n";
140 87         235 $$map_pos = 'o';
141 87         276 return 0;
142             }
143             }
144             else {
145 0         0 warn $enemy->name, " is already out of the game. Strike another opponent.\n";
146 0         0 return -1;
147             }
148             }
149              
150             sub _is_a_hit {
151 100     100   147 my ($self, $x, $y) = @_;
152 100 100       361 return $self->{grid}{matrix}[$x][$y] ne '.'
153             ? 1 : 0;
154             }
155              
156             sub craft {
157 15     15 1 878 my ($self, $key, $val) = @_;
158              
159             # If the key is not defined, assume it's supposed to be the id.
160 15 50       34 unless (defined $val) {
161 0         0 $val = $key;
162 0         0 $key = 'id';
163             }
164              
165 15         18 my $craft;
166              
167 15         19 for (@{ $self->{fleet} }) {
  15         41  
168 34 100       92 if ($val eq $_->{$key}) {
169 15         18 $craft = $_;
170 15         26 last;
171             }
172             }
173              
174 15         41 return $craft;
175             }
176              
177             1;
178              
179             __END__