Beefy Boxes and Bandwidth Generously Provided by pair Networks
Pathologically Eclectic Rubbish Lister
 
PerlMonks  

Re^4: Battleship solitaire puzzle generator

by toolic (Bishop)
on Aug 30, 2016 at 17:10 UTC ( [id://1170799]=note: print w/replies, xml ) Need Help??


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).

Replies are listed 'Best First'.
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;
      Your GUI looks beautiful!
      I'm not really interested in playing the game
      But, if your goal is to create a fully functioning puzzle, you should play a few practices puzzles to see how the whole thing works. The reason I created an ugly ASCII version is that a GUI version was going to take me too long. But, you are on your way to a nice GUI.

      Take a look at this online version.

        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;
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...

Re^5: Battleship solitaire puzzle generator
by Anonymous Monk on Aug 30, 2016 at 20:10 UTC

    Better ? ( It took less work than I thought to add some features :)

    #!/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;

Log In?
Username:
Password:

What's my password?
Create A New User
Domain Nodelet?
Node Status?
node history
Node Type: note [id://1170799]
help
Chatterbox?
and the web crawler heard nothing...

How do I use this?Last hourOther CB clients
Other Users?
Others avoiding work at the Monastery: (4)
As of 2024-03-29 05:29 GMT
Sections?
Information?
Find Nodes?
Leftovers?
    Voting Booth?

    No recent polls found