File Coverage

blib/lib/Game/Battleship/Player.pm
Criterion Covered Total %
statement 62 68 91.1
branch 18 24 75.0
condition 1 3 33.3
subroutine 12 12 100.0
pod 4 4 100.0
total 97 111 87.3


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