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__ |