Beefy Boxes and Bandwidth Generously Provided by pair Networks
Keep It Simple, Stupid
 
PerlMonks  

Comment on

( #3333=superdoc: print w/ replies, xml ) Need Help??

Hello, all--

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.


In reply to Re: ASCII Battleship Program by roboticus
in thread ASCII Battleship Program by perlStuck

Title:
Use:  <p> text here (a paragraph) </p>
and:  <code> code here </code>
to format your post; it's "PerlMonks-approved HTML":



  • Posts are HTML formatted. Put <p> </p> tags around your paragraphs. Put <code> </code> tags around your code and data!
  • Read Where should I post X? if you're not absolutely sure you're posting in the right place.
  • Please read these before you post! —
  • Posts may use any of the Perl Monks Approved HTML tags:
    a, abbr, b, big, blockquote, br, caption, center, col, colgroup, dd, del, div, dl, dt, em, font, h1, h2, h3, h4, h5, h6, hr, i, ins, li, ol, p, pre, readmore, small, span, spoiler, strike, strong, sub, sup, table, tbody, td, tfoot, th, thead, tr, tt, u, ul, wbr
  • Outside of code tags, you may need to use entities for some characters:
            For:     Use:
    & &amp;
    < &lt;
    > &gt;
    [ &#91;
    ] &#93;
  • Link using PerlMonks shortcuts! What shortcuts can I use for linking?
  • See Writeup Formatting Tips and other pages linked from there for more info.
  • Log In?
    Username:
    Password:

    What's my password?
    Create A New User
    Chatterbox?
    and the web crawler heard nothing...

    How do I use this? | Other CB clients
    Other Users?
    Others perusing the Monastery: (7)
    As of 2014-12-26 03:48 GMT
    Sections?
    Information?
    Find Nodes?
    Leftovers?
      Voting Booth?

      Is guessing a good strategy for surviving in the IT business?





      Results (164 votes), past polls