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