I had another software install over the weekend, and spent my slack time twiddling around with the Battleship game again. I've addressed a couple of the issues, and undoubtedly added some new issues. The current version displays the computer's ships for debugging, but I haven't tweaked the code to let me turn off the computer ship display yet.
I'm posting the updated version just in case I get pulled away again and never see it again. Hopefully someone else will tweak it a little too.
I really need finish tuning it before playing with it, but I couldn't help myself. So there are chunks that I still need to work on, but I had fun modifying the layout and such. Ah, well, it was more interesting than listening to a bunch of people doing database deployments over the weekend.
#!/usr/bin/perl
#
# Battleship.pl
#
# From www.perlmonks.com
#
use v5.10.1;
use strict;
use warnings;
use Data::Dumper;
use Getopt::Long;
my $dbg=0; # Set to 1 to show computer's board
my $fl_print_boards = 'H';
my $shots_per_turn = 3;
my $turn;
my %Pieces = (
Battleship => 4, Carrier => 5, Destroyer => 3,
Patrol => 2, Submarine => 3,
);
my @mnu_who_goes_first = (
[ "You", sub { $turn = 'HUMAN' } ],
[ "Computer", sub { $turn = 'Computer' }],
[ "Random", sub { int(rand(1000)) } ],
);
my @mnu_game_mode = (
[ "Regular (one-shot mode)", sub { $shots_per_turn = 1 } ],
[ "Salvo (three-shot mode)", sub { $shots_per_turn = 3 } ],
);
main::startup();
#*********************************************************************
+*********
#*******************************STARTUP FUNCTION**********************
+*********
#*********************************************************************
+*********
sub main::startup {
local $main::startup::name = "";
print "\n\nPlease enter your name: ";
chomp($main::startup::name = <STDIN>);
main::call();
}
#*********************************************************************
+**********
#******************************MAIN CALL FUNCTION*********************
+**********
#*********************************************************************
+**********
sub main::call {
srand;
local @main::com_ships::com_all_ships = ();
local @main::user_ships::user_all_ships = ();
local @main::com_ships::com_board = generate_board();
local @main::user_ships::user_board = generate_board();
local @main::letters::letters = ("A" .. "J");
local $main::game_play::whos_first = '';
local $main::game_play::mode = '';
local @main::game_play::user_shots_check;
local $main::com_ships::hits = '';
local $main::user_ships::hits = '';
generate_ship_pos::start();
get_user_ship_pos::start();
game_play::start();
}
#*********************************************************************
+**********
#***************************SECONDARY CALL FUNCTIONS******************
+**********
#*********************************************************************
+**********
sub generate_ship_pos::start {
for my $k (keys %Pieces) {
generate_ship_pos::any_ship($Pieces{$k}, $k);
}
print_board(\@::main::com_ships::com_board) if $dbg;
# Reset the board, we used it as a scratchpad
# @main::com_ships::com_board = generate_board();
}
sub get_user_ship_pos::start {
for my $k (keys %Pieces) {
get_user_ship_pos::any_size($k, $Pieces{$k});
}
print_board(\@::main::user_ships::user_board);
}
sub game_play::start {
game_play::decide();
game_play::mode();
play_game();
}
#*********************************************************************
+**********
#********************* BOARD HELPER FUNCTIONS ************************
+**********
#*********************************************************************
+**********
sub gen_ship_list {
my ($rC, $orient, $size) = @_;
my ($x, $y) = @$rC;
my $rShip;
given ($orient) {
when (0) { push @$rShip, [ $x, $y++ ] for 1 .. $size; }
when (1) { push @$rShip, [ $x++, $y ] for 1 .. $size; }
}
return undef if $x>10 or $y>10;
$rShip;
}
sub does_ship_fit {
my ($rBoard, $rShip) = @_;
my $collisions = 0;
for my $P (@$rShip) {
my ($x, $y) = @$P;
++$collisions if $$rBoard[$x][$y] ne '0';
}
return 0 if $collisions;
1;
}
#*********************************************************************
+**********
#*********************COMPUTER SHIP GENERATION FUNCTIONS**************
+**********
#*********************************************************************
+**********
sub generate_ship_pos::any_ship {
my ($size, $type) = @_;
my $rShip;
while (1) {
# Randomly place a ship
my $x = int(rand(10));
my $y = int(rand(10));
my $orient = int(rand(2));
$rShip = gen_ship_list([$x,$y], $orient, $size);
redo if ! defined $rShip;
last if does_ship_fit(\@main::com_ships::com_board, $rShip);
}
for my $P (@$rShip) {
my ($x, $y) = @$P;
$main::com_ships::com_board[$x][$y] = uc(substr $type, 0, 1);
push @main::com_ships::com_all_ships, "$x$y";
}
}
#*********************************************************************
+**********
#************************USER SHIP GENERATION FUNCTIONS***************
+**********
#*********************************************************************
+**********
sub place_ship {
my ($x, $y, $size, $orient, $type) = @_;
given (uc $orient) {
when ('U') { $x-=$size-1; $orient=1 }
when ('D') { $orient=1 }
when ('L') { $y-=$size-1; $orient=0 }
when ('R') { $orient=0 }
}
return 0 if $x<0 or $y<0;
my $rShip = gen_ship_list([$x,$y], $orient, $size);
if (! defined $rShip) {
print "Ship can't go off the edge of the board!\n";
return 0;
}
if (! does_ship_fit(\@main::user_ships::user_board, $rShip)) {
print "Can't overlap ships!\n";
return 0;
}
for my $P (@$rShip) {
($x, $y) = @$P;
$main::user_ships::user_board[$x][$y] = substr($type,0,1);
push @main::user_ships::user_all_ships, "$x$y";
}
1;
}
sub get_user_ship_pos::any_size {
my ($name, $size) = @_;
print_board(\@main::user_ships::user_board);
while (1) {
print "Position your $name: ('A5 r' starts at A5 and goes righ
+t):";
chomp(my $input = <STDIN>);
if ($input =~ m/([A-J]\d0?)\s*([UDLRXY])/i) {
# Coordinates look good, try placing the ship
my ($start, $dir) = ($1, $2);
my $rC = parse_coordinate($1);
redo unless defined $rC;
last if place_ship($$rC[0], $$rC[1], $size, $dir, $name);
}
print "You have entered invalid input. Please try again.\n\n";
}
}
#*********************************************************************
+**********
#*******************************GAME-PLAY FUNCTIONS*******************
+**********
#*********************************************************************
+**********
sub handle_menu {
my ($ar, $prompt) = @_;
while (1) {
print "\n", $prompt, "\n";
for (my $i=0; $i<@$ar; ++$i) {
print $i+1, ". ", $$ar[$i][0], "\n";
}
print "\n\nYour choice: ";
chomp(my $decide = <STDIN>);
if ($decide>0 and $decide <= @$ar) {
return $decide if ! defined $$ar[$decide-1][1];
return &{$$ar[$decide-1][1]}();
}
print "Inrecognized choice, please try again.\n";
}
}
sub game_play::decide {
return handle_menu(\@mnu_who_goes_first, "Who goes first?");
}
sub game_play::mode {
return handle_menu(\@mnu_game_mode, "Please enter game mode: ");
}
sub play_game {
while (!game_play::dead_yet()) {
if ($turn eq "Computer") {
computer_shots($shots_per_turn);
$turn = "HUMAN";
}
else {
print_both_boards();
player_shots($shots_per_turn);
$turn = "Computer";
}
}
}
sub generate_computer_shots {
my $num_shots = shift;
my %shots;
while ($num_shots) { # < @{keys %shots}) {
my ($x, $y) = (int(rand(10)), int(rand(10)));
my $k = "$x$y";
next if $main::user_ships::user_board[$x][$y] eq 'X'
or $main::user_ships::user_board[$x][$y] eq 'O';
next if exists $shots{$k};
$shots{$k} = [ $x, $y ];
--$num_shots;
}
return values %shots;
}
sub computer_shots { #game_play::reg_mode::com_shot {
my $num_shots = shift;
my @shots = generate_computer_shots($num_shots);
print "COMPUTER: ";
for my $rs (@shots) {
my ($x, $y) = @$rs;
my $s = coord_to_str($rs);
if ($main::user_ships::user_board[$x][$y] =~ /[BCDPS]/) {
print "$s:BOOM! ";
++$main::user_ships::hits;
$main::user_ships::user_board[$x][$y] = 'X';
}
elsif ($main::user_ships::user_board[$x][$y] eq 'X') {
print "$s:Boom. ";
}
else {
print "$s: splash ";
$main::user_ships::user_board[$x][$y] = 'O';
}
}
print "\n";
}
sub get_player_shots {
my $num_shots = shift;
while (1) {
my @retval;
my %shots;
print "\nPlease enter your shot(s): ";
chomp(my $input = <STDIN>);
my @shot_list = ($input =~ m/([A-J]\d0?)/gi);
for my $shot (@shot_list) {
my $r = parse_coordinate($shot);
my ($x, $y) = @$r;
my $k = coord_to_str($r);
if (exists $shots{$k}) {
print "Duplicate entry: $shot\n";
next;
}
elsif ($main::com_ships::com_board[$x][$y] eq 'X'
or $main::com_ships::com_board[$x][$y] eq 'O') {
print "You've already shot location $shot\n";
next;
}
else {
push @retval, [ $x, $y ];
$shots{$k} = [ $x, $y ];
}
}
my @t = keys %shots;
if (@t < $num_shots) {
print "Not enough shots entered, please try again.\n";
next;
}
else {
return @retval[0 .. $num_shots-1];
}
}
}
sub player_shots {
my $num_shots = shift;
my @shots = get_player_shots($num_shots);
print $main::startup::name, ": ";
for my $rs (@shots) {
my $s = coord_to_str($rs);
my ($x, $y) = @$rs;
if ($main::com_ships::com_board[$x][$y] =~ /[BCDPS]/) {
print "$s:BOOM! ";
++$main::com_ships::hits;
$main::com_ships::com_board[$x][$y] = 'X';
}
elsif ($main::com_ships::com_board[$x][$y] eq 'X') {
print "$s:Boom. ";
}
else {
print "$s:splash ";
$main::com_ships::com_board[$x][$y] = 'O';
}
}
print "\n";
}
=h1
sub xplayer_shots {
my $num_shots = shift;
INPUT: while (1) {
my %shots;
if ($num_shots == 1) {
print "\nPlease enter your shot: ";
}
else {
print "\nPlease enter your salvo: ";
}
chomp(my $input = <STDIN>);
for my $shot (split '', $input) {
my $r = parse_coordinate($shot);
next INPUT unless defined $r;
my ($x, $y) = @$r;
my $k = "$x.$y";
if (exists $shots{$k}) {
print "You've already entered $k!\n";
next INPUT;
}
if (grep { $k eq $_ } @main::game_play::user_shots_check)
+{
print "You have entered invalid input. Please try agai
+n.\n";
next INPUT;
}
if ($main::com_ships::com_board[$x][$y] eq 'X') {
}
elsif ($main::com_ships::com_board[$x][$y] eq 'X') {
}
else {
}
}
}
}
=cut
=h1
sub xgame_play::salvo_mode::user_salvo {
my $input = '';
print "\nPlease enter your three salvo shots: ";
chomp($input = <STDIN>);
my @user_shots = split(" ", $input);
if ($input !~ /^[A-J]\d0?\s[A-J]\d0?\s[A-J]\d0?$/i) {
print "You've entered invalid input. Please try again.\n";
game_play::salvo_mode::user_salvo();
return 0;
}
if ($user_shots[0] eq ($user_shots[1] or $user_shots[2]) or $user_
+shots[1] eq $user_shots[2]) {
print "You have entered a co-ordinate twice. Please try again.
+\n";
game_play::salvo_mode::user_salvo();
return 0;
}
foreach my $el (@user_shots) {
my $rC = parse_coordinate($el);
die "how did I get here?" if ! defined $rC;
$el = "$$rC[0]$$rC[1]";
foreach my $lee (@main::game_play::user_shots_check) {
if ($el eq $lee) {
print "You have entered invalid input. Please try agai
+n.\n";
game_play::salvo_mode::user_salvo();
return;
}
}
foreach my $lee (@main::com_ships::com_all_ships) {
if ($el eq $lee) {
print "Computer ship hit!\n";
$main::com_ships::com_board[$$rC[0]][$$rC[1]] = 'X';
$main::com_ships::hits++;
last;
} elsif ($el ne $lee) {
$main::com_ships::com_board[$$rC[0]][$$rC[1]] = 'O';
}
}
}
push @main::game_play::user_shots_check, @user_shots;
}
sub xgame_play::reg_mode::user_shot {
my $input = '';
print "\nPlease enter your target: ";
chomp($input = <STDIN>);
if ($input !~ /^[A-J]\d0?$/i) {
print "You've entered invalid input. Please try again.\n";
game_play::reg_mode::user_shot();
return 0;
}
my $rC = parse_coordinate($input);
die "eh?" unless defined $rC;
my ($let, $num) = (@$rC);
$input = "$let" . "$num";
given ($num) {
when ($num > 9) {
print "Your input is invalid. Please try again.\n\n";
$input = '';
game_play::reg_mode::user_shot();
return;
}
}
foreach my $lee (@main::game_play::user_shots_check) {
if ($input eq $lee) {
print "You have entered invalid input. Please try again.\n
+";
game_play::reg_mode::user_shot();
return;
}
}
foreach my $lee (@main::com_ships::com_all_ships) {
if ($input eq $lee) {
print "Computer ship hit!\n";
$main::com_ships::com_board[$let][$num] = 'X';
$main::com_ships::hits++;
last;
} elsif ($input ne $lee) {
$main::com_ships::com_board[$let][$num] = 'O';
}
}
push @main::game_play::user_shots_check, $input;
}
=cut
sub game_play::dead_yet {
if ($main::com_ships::hits eq '17') {
print "Congratulations! You won, $main::startup::name!\n\n";
exit;
}
if ($main::user_ships::hits eq '17') {
print "Computer won. Better luck next time!\n";
print "Computer used:\n";
print_board(\@main::com_ships::com_board);
exit;
}
}
sub get_board_rows {
my $ar = shift;
my @retval;
for (my $i=0; $i<@$ar; ++$i) {
push @retval, join(" ", map { $_ eq '0' ? '-' : $_ } @{$$ar[$i
+]});
}
return @retval;
}
sub print_both_boards {
if ($fl_print_boards eq 'H') {
print_both_boards_H();
}
else {
print_both_boards_V();
}
}
sub print_both_boards_H {
my @U = get_board_rows(\@main::user_ships::user_board);
my @C = get_board_rows(\@main::com_ships::com_board);
printf <<EOHDR, center_text($main::startup::name,20), center_text(
+'Computer',20);
%-20.20s %-20.20s
1 2 3 4 5 6 7 8 9 10 1 2 3 4 5 6 7 8 9 10
-------------------- --------------------
EOHDR
for (my $i=0; $i<@U; ++$i) {
print "$main::letters::letters[$i]| ";
print $U[$i];
print " |$main::letters::letters[$i]| ";
print $C[$i];
print " |$main::letters::letters[$i]\n";
}
}
sub print_both_boards_V {
print center_text($main::startup::name,20);
print_board(\@main::user_ships::user_board);
print center_text("COMPUTER BOARD:", 20);;
print_board(\@main::com_ships::com_board);
}
sub print_board {
my $ar = shift;
my @rows = get_board_rows($ar);
print "\n 1 2 3 4 5 6 7 8 9 10\n";
print " --------------------\n";
for (my $i=0; $i<@$ar; ++$i) {
print "$main::letters::letters[$i]| ";
print $rows[$i], "\n";
}
}
sub coord_to_str {
my $r = shift;
return substr("ABCDEFGHIJ",$$r[0],1) . sprintf("%u",1+$$r[1]);
}
sub generate_board {
my @t;
push @t, [ (0) x 10 ] for 0..9;
return @t;
}
sub parse_coordinate {
# converts /[A-J]([1-9]|10)/i to [ [0..9], [0..9] ]
my $coord = uc shift;
return [ ord($1)-ord('A'), $2-1 ] if $coord =~ /^([A-J])([1-9]|10)
+$/;
print "Invalid coordinate $coord!\n";
return undef;
}
sub center_text {
my ($text, $len) = @_;
return substr($text, 0, $len) if length($text) >= $len;
$text = ' ' x ( ($len-length($text))/2 ) . $text;
return $text .= ' ' x ($len - length($text));
}
...roboticus
When your only tool is a hammer, all problems look like your thumb.