I have been playing it some, it's slightly addictive :)
Here's the latest version with slight tweaks:
#!/usr/bin/perl
# http://perlmonks.org/?node_id=1170733
use strict;
use warnings;
my $total = 0;
my $sea = ((' ' x 10) . "\n") x 10;
sub transpose
{
local $_ = $sea;
tr/<>^v/^v<>/;
$sea = '';
$sea .= "\n" while s/^(.)/ $sea .= $1; '' /gem;
}
my @allplaces;
for my $ship ( 4,3,3,2,2,2,1,1,1,1 )
{
$total += $ship;
my @places;
push @places, $-[0] while $sea =~ /(?= {$ship})/g;
push @allplaces, scalar @places;
substr $sea, $places[rand @places], $ship,
('O', '<>', '<#>', '<##>' )[$ship - 1];
$sea =~ s/(?<=[<>^v#O].{$_}) | (?=.{$_}[<>^v#O])/~/gs for 0, 9..11;
$ship > 1 and rand > 0.5 and transpose;
}
tr/ /~/ for $sea;
print "\n@allplaces";
print "\n", $sea;
my @chars = $sea =~ /./g;
use Tk; # for http://perlmonks.org/?node_id=1170638
my $hits = my $misses = 0;
my $font = 'courierbold 20';
my $canvassize = 40;
my $message = 'Click Square to Play';
my $msg;
my $mw = MainWindow->new( -title => "Battleship" );
my $grid = $mw->Frame()->pack;
my (@cols, @rows);
for my $y (0..9)
{
for my $x (0..9)
{
my ($char, $c) = shift @chars;
$cols[$x] += $char =~ /[<>^v#O]/;
$rows[$y] += $char =~ /[<>^v#O]/;
$c = $grid->Canvas( -bg => 'SeaGreen3',
-width => $canvassize, -height => $canvassize,
-highlightthickness => 1, -highlightbackground => 'black',
)->grid(-row => $y, -column => $x);
$c->Tk::bind('<ButtonRelease-1>' => sub {
$hits == $total and return;
if( $char eq '~') {$c->configure(-bg => 'SeaGreen4'); }
if( $char =~ /[<>^v#O]/ ) {
$c->createOval(1, 1, $canvassize, $canvassize, -fill => 'black
+') }
if($char eq '#') {$c->createRectangle(0, 0,
$canvassize, $canvassize, -fill => 'black') }
elsif($char eq '<') {$c->createRectangle($canvassize / 2, 0,
$canvassize, $canvassize, -fill => 'black') }
elsif($char eq '>') {$c->createRectangle(0, 0,
$canvassize / 2, $canvassize, -fill => 'black') }
elsif($char eq 'v') {$c->createRectangle(0, 0,
$canvassize, $canvassize / 2, -fill => 'black') }
elsif($char eq '^') {$c->createRectangle(0, $canvassize / 2,
$canvassize, $canvassize, -fill => 'black') }
($char =~ /[<>^v#O]/ ? $hits : $misses) += 1;
$hits == $total and $message = "You Win !",
$msg->configure(-fg => 'green3', -font => 'courierbold 36');
$c->Tk::bind('<ButtonRelease-1>'=> sub {});
});
}
}
for my $i (0..9)
{
$grid->Label(-text => $cols[$i], -font =>$font,
)->grid(-row => 11, -column => $i, -sticky => 'nsew');
$grid->Label(-text => $rows[$i], -font =>$font, -padx => 6,
)->grid(-row => $i, -column => 11, -sticky => 'nsew');
}
$grid->Label(-text => ' ',
)->grid(-row => 11, -column => 11, -sticky => 'nsew');
my $frame = $mw->Frame->pack;
$frame->Label(-text => 'Hits: ', -font => $font)->pack(-side => 'left'
+);
$frame->Label(-textvariable => \$hits, -font => $font)->pack(-side =>
+'left');
$frame->Label(-text => " of $total Misses: ", -font => $font,
)->pack(-side => 'left');
$frame->Label(-textvariable => \$misses, -font => $font)->pack(-side =
+> 'left');
$msg = $mw->Label(-textvariable => \$message, -font => $font)->pack;
MainLoop;
|