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 3 4 75.0
total 88 103 85.4


line stmt bran cond sub pod time code
1             package Game::Battleship::Player;
2             $Game::Battleship::Player::VERSION = '0.0602';
3             our $AUTHORITY = 'cpan:GENE';
4              
5 1     1   6 use Carp;
  1         3  
  1         57  
6 1     1   542 use Game::Battleship::Craft;
  1         5  
  1         42  
7 1     1   567 use Game::Battleship::Grid;
  1         3  
  1         44  
8 1     1   8 use Moo;
  1         2  
  1         4  
9 1     1   306 use Types::Standard qw( ArrayRef Int Str );
  1         2  
  1         6  
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 0 183 my $self = shift;
67              
68             $self->{grid} =
69 3         51 Game::Battleship::Grid->new(
70             fleet => $self->fleet,
71             dimensions => $self->dimensions,
72             );
73              
74             # Compute the life points for this player.
75 3         5 $self->{life} += $_->points for @{ $self->fleet };
  3         29  
76             }
77              
78             # The enemy must be a G::B::Player object.
79             sub matrix {
80 4     4 1 1882 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       10 map { "@$_" } @{ $self->{grid}{matrix} };
  40         111  
  4         15  
86             }
87              
88             # The enemy must be a G::B::Player object.
89             sub strike {
90 101     101 1 58778 my ($self, $enemy, $x, $y) = @_;
91              
92 101 50       288 croak "No opponent to strike.\n" unless $enemy;
93 101 50 33     366 croak "No coordinate at which to strike.\n"
94             unless defined $x && defined $y;
95              
96 101 50       301 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       293 unless exists $self->{$enemy->name};
100              
101 101         252 my $enemy_pos = \$enemy->{grid}{matrix}[$x][$y];
102 101         239 my $map_pos = \$self->{$enemy->name}{matrix}[$x][$y];
103              
104 101 100       288 if ($$map_pos ne '.') {
    100          
105 1         16 warn "Duplicate strike on ", $enemy->name, ' by ', $self->name, " at $x, $y.\n";
106 1         6 return -1;
107             }
108             elsif ($enemy->_is_a_hit($x, $y)) { # Set the enemy grid map coordinate char to 'hit'.
109 22         44 $$map_pos = 'x';
110              
111             # What craft was hit?
112 22         45 my $craft = $self->craft(id => $$enemy_pos);
113              
114 22         277 warn $self->name, ' hit ', $enemy->name, "'s ", $craft->name, "!\n";
115              
116             # How much is left on this craft?
117 22         132 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 22 100       85 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 22         53 $$enemy_pos = lc $$enemy_pos;
127              
128             # Increment the player's score.
129 22         47 $self->{score}++;
130              
131             # Decrement the opponent's life.
132             warn $enemy->name, " is out of the game.\n"
133 22 50       52 if --$enemy->{life} <= 0;
134              
135 22         67 return 1;
136             }
137             else {
138             # Set the enemy grid map coordinate char to 'miss'.
139 78         971 warn $self->name, ' missed ', $enemy->name, " at $x, $y.\n";
140 78         284 $$map_pos = 'o';
141 78         248 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   171 my ($self, $x, $y) = @_;
152 100 100       293 return $self->{grid}{matrix}[$x][$y] ne '.'
153             ? 1 : 0;
154             }
155              
156             sub craft {
157 24     24 1 765 my ($self, $key, $val) = @_;
158              
159             # If the key is not defined, assume it's supposed to be the id.
160 24 50       54 unless (defined $val) {
161 0         0 $val = $key;
162 0         0 $key = 'id';
163             }
164              
165 24         42 my $craft;
166              
167 24         40 for (@{ $self->{fleet} }) {
  24         52  
168 51 100       124 if ($val eq $_->{$key}) {
169 24         30 $craft = $_;
170 24         44 last;
171             }
172             }
173              
174 24         47 return $craft;
175             }
176              
177             1;
178              
179             __END__