in reply to Re^3: Battleship solitaire puzzle generator in thread Battleship solitaire puzzle generator
Thanks for the code. The Tk code should be a good starting point for anyone who wants to build a GUI version. It looks like your code creates a solution (with all 10 ships completely placed in the grid), but it does not create a puzzle grid (with only ship segments shown, along with row and column counts of the hidden ships as clues).
Re^5: Battleship solitaire puzzle generator
by Anonymous Monk on Aug 30, 2016 at 23:58 UTC
|
Try this one. Converted over to Canvas to draw ship parts. And of course it's in SeaGreen :)
Hey, still below 100 lines :)
#!/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;
}
for my $ship ( 4,3,3,2,2,2,1,1,1,1 )
{
$total += $ship;
my @places;
push @places, $-[0] while $sea =~ /(?= {$ship})/g;
substr $sea, $places[rand @places], $ship,
('O', '<>', '<#>', '<##>' )[$ship - 1];
$sea =~ s/(?<=[<>^v#O].{$_}) | (?=.{$_}[<>^v#O])/~/gs for 0, 9..11;
rand > 0.5 and transpose;
}
tr/ /~/ for $sea;
print $sea;
my @chars = $sea =~ /./g;
use Tk; # for http://perlmonks.org/?node_id=1170638
my $hits = my $misses = 0;
my $font = 'courier 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 {
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 24');
$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,
)->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;
| [reply] [d/l] |
|
| [reply] |
|
#!/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;
| [reply] [d/l] |
Re^5: Battleship solitaire puzzle generator
by Anonymous Monk on Aug 30, 2016 at 17:26 UTC
|
I'm not really interested in playing the game, I was just interested in generating the
starting grid as a programming puzzle.
Then I just wanted to see how hard it would be to display the grid in Tk (not too hard).
Hey, at least the buttons work...
| [reply] |
Re^5: Battleship solitaire puzzle generator
by Anonymous Monk on Aug 30, 2016 at 20:10 UTC
|
#!/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;
}
for my $ship ( 4,3,3,2,2,2,1,1,1,1 )
{
$total += $ship;
my @places;
push @places, $-[0] while $sea =~ /(?= {$ship})/g;
substr $sea, $places[rand @places], $ship,
('O', '<>', '<#>', '<##>' )[$ship - 1];
$sea =~ s/(?<=[<>^v#O].{$_}) | (?=.{$_}[<>^v#O])/~/gs for 0, 9..11;
rand > 0.5 and transpose;
}
tr/ /~/ for $sea;
print $sea;
my @chars = $sea =~ /./g;
use Tk; # for http://perlmonks.org/?node_id=1170638
my $hits = my $misses = 0;
my $font = 'courier 20';
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, $b) = shift @chars;
$cols[$x] += $char =~ /[<>^v#O]/;
$rows[$y] += $char =~ /[<>^v#O]/;
$b = $grid->Button( -font =>$font, -text => ' ',
-command => sub {
$b->configure(-text => $char);
($char =~ /[<>^v#O]/ ? $hits : $misses) += 1;
$hits == $total and $message = "You Win !",
$msg->configure(-fg => 'green', -font => 'courierbold 24');
$b->configure(-command => sub {});
},
)->grid(-row => $y, -column => $x);
}
}
for my $i (0..9)
{
$grid->Label(-text => $cols[$i], -font =>$font,
)->grid(-row => 11, -column => $i);
$grid->Label(-text => $rows[$i], -font =>$font,
)->grid(-row => $i, -column => 11);
}
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;
| [reply] [d/l] |
|
|