Beefy Boxes and Bandwidth Generously Provided by pair Networks
Perl: the Markov chain saw
 
PerlMonks  

Another perl battleship

by spesk (Novice)
on Jan 07, 2019 at 22:52 UTC ( #1228171=perlquestion: print w/replies, xml ) Need Help??

spesk has asked for the wisdom of the Perl Monks concerning the following question:

Hello monks,

Forgive me if this is the wrong place to be posting... I've been using Perl for a few years now as part of my day to day sysadmin job, for typical 'Perlish' glue tasks and back-end utilities, but I've recently been looking more into doing some larger scale Perl projects on my own time.

My first is a shoddy implementation of Battleship -- or something similar to it, I'm not clear on the exact rules of the original game so I've made something like it. At this point the game is more or less playable and "stable". The AI pretty much just behaves randomly, but so far the game is engaging enough.

I'm here to solicit some feedback for anyone who has time/care to do so, in the hope to become a better Perl programmer. Specifically, are there any choices I am making that would lead to optimization issues in a larger scale game/program? Additionally, is the code poorly managed/too repetitive, etc. I appreciate any wisdom you have to offer.

I considered omitting the comments I've put in the code, but figured it would be valuable to leave them there, as I point out problems I think the code has, though I'm sure I've missed some.

Thank you again for any wisdom/insights you have to offer:

-Spesk (A perl newb)

#!/usr/bin/perl # TODO: More work on AI, make it smarter and less random # ** Keep track of where it's already missed and whether or not op +ponent moves # # TODO: Handle situation where player or AI can place ships that 'wrap +' around the map, ie coordinates # like 20,21,22 which would place the end of a cruiser in the firs +t row, and the next two sections of it # in the second row. This doesn't really break the game at all, bu +t it does look weird on the map and doesn't seem # to be a mature implimentation if it exists # # TODO: Handle the fact that player can input random coordinates so th +at they could potentially have 1 third # of a ship in 3 different coordinates, or just have a ship occupy + 1 tile by entering the same coordinate # ** Whether or not this gives the player an advantage or whether +it's a disadvantage is unclear to me # # TODO: 'Productionize' the code: error handling, more input sanitatio +n, etc # ** Optimze placement so we dont have to check it each time, ie c +heck at placement # ** Consolidate redundant subs # # TODO: Improve readability, game play feel # # TODO: Break subs into modules? Based on the fact most subs operate o +n objects within the top level # program means I might have to rewrite how I am handling the refe +rences to those objects # # KNOWN BUGS: # TODO: &clearUnocTiles issue -- see sub comment # ** Not sure this is really an issue, but leaving it here to remi +nd myself anyways # Basic implimentation of 'battleship' to teach myself more about prog +ramming # I don't know the actual rules of the game, this is my stab at # something in the 'spirit' of it # # Player takes turns against computer trying to hit one of their ships +. # Can only perform 1 action per turn: # - Move # - Attack # # Three types of ships: # * Cruiser # - Hull Points: 2 # - Size: 3x1 # - Attack Power: 1 # * Carrier # - Hull Points: 3 # - Size: 5x1 # - Attack Power: 2 # * Submarine # - Hull Points: 1 # - Size 2x1 # - Attack Power: 3 # # 5x5 map grid for each player # Cruiser = * # Carrier = @ # Submarine = ~ # Ocean/Empty Space = . use strict; use warnings; use Term::ANSIColor qw(:constants); my $version = 0.1; if ( $ARGV[0] && $ARGV[0] =~ /version/ ) { print "$version\n"; exit 0; } # Maps my %p1map; my %p2map; # Stats trackers my @p1Attacks; my @p2Attacks; # Ships - surely there is a better way to do this my %p1cruiser = ( 'hp' => '2', 'size' => '3', 'ap' => '1', 'loc' => '' +, 'sym' => '*', 'mc' => 0 ); my %p1carrier = ( 'hp' => '3', 'size' => '5', 'ap' => '2', 'loc' => '' +, 'sym' => '@', 'mc' => 0 ); my %p1subm = ( 'hp' => '1', 'size' => '2', 'ap' => '3', 'loc' => '' +, 'sym' => '~', 'mc' => 0 ); my %p1ships = ( 'cru' => \%p1cruiser, 'car' => \%p1carrier, 'subm' => +\%p1subm ); my %p2cruiser = ( 'hp' => '2', 'size' => '3', 'ap' => '1', 'loc' => '' +, 'sym' => '*', 'mc' => 0 ); my %p2carrier = ( 'hp' => '3', 'size' => '5', 'ap' => '2', 'loc' => '' +, 'sym' => '@', 'mc' => 0 ); my %p2subm = ( 'hp' => '1', 'size' => '2', 'ap' => '3', 'loc' => '' +, 'sym' => '~', 'mc' => 0 ); my %p2ships = ( 'cru' => \%p2cruiser, 'car' => \%p2carrier, 'subm' => +\%p2subm ); sub initMap { foreach my $number ( 1 .. 50 ) { $p1map{$number} = "."; $p2map{$number} = "."; } } sub clearUnocTiles { # Bug where sometimes after a ship is moved one of the old tiles i +t was on # is not reset despite the &shipPosition function reporting that i +t is # Thus far, I've been unable to figure out why that is happening, +so # for now am providing this function, which will check the locatio +n of all ships # and reset any incorrect tiles for both the player and the AI my @p1usedTiles; my @p2usedTiles; # Get in use tiles for ship hashes foreach my $ship ( keys %p1ships ) { if ( ! $p1ships{$ship} ) { next; } my $shipRef = $p1ships{$ship}; my $location = ${$shipRef}{loc}; my @inUseTiles = split(",", $location); foreach my $iut ( @inUseTiles ) { push(@p1usedTiles, $iut); } } # Clean the tiles foreach my $key ( keys %p1map ) { if ( grep { $_ eq $key } @p1usedTiles ) { next; } else { $p1map{$key} = "."; } } # Now the same for the AI map foreach my $ship ( keys %p2ships ) { if ( ! $p2ships{$ship} ) { next; } my $shipRef = $p2ships{$ship}; my $location = ${$shipRef}{loc}; my @inUseTiles = split(",", $location); foreach my $iut ( @inUseTiles ) { push(@p2usedTiles, $iut); } } # Clean the tiles foreach my $key ( keys %p2map ) { if ( grep { $_ eq $key } @p2usedTiles ) { next; } else { $p2map{$key} = "."; } } } sub printMap { my $count = 1; print "^ Player Map ^\n"; foreach my $key ( sort { $a <=> $b } keys %p1map ) { # Probably a better way to do this if ( $count != 10 && $count != 20 && $count != 30 && $ +count != 40 && $count != 50 ) { if ( $p1map{$key} eq "*" ) { print YELLOW, "$p1map{$key}", RESET; } elsif ( $p1map{$key} eq "@" ) { print RED, "$p1map{$key}", RESET; } elsif ( $p1map{$key} eq "~" ) { print CYAN, "$p1map{$key}", RESET; } else { print "$p1map{$key}"; } } else { if ( $p1map{$key} eq "*" ) { print YELLOW, "$p1map{$key}\n", RESET; } elsif ( $p1map{$key} eq "@" ) { print RED, "$p1map{$key}\n", RESET; } elsif ( $p1map{$key} eq "~" ) { print CYAN, "$p1map{$key}\n", RESET; } else { print "$p1map{$key}\n"; } } $count++; } } sub printPlayerStats { # Print stats from main turn menu print "\n"; foreach my $key ( keys %p1ships ) { my $shipHref = $p1ships{$key}; if ( ! defined $p1ships{$key} ) { print MAGENTA, "^^^ Ship: $key ^^^ \n", RESET; print RED, "| SUNK! | \n", RESET; } else { print MAGENTA, "^^^ Ship: $key ^^^ \n", RESET; print RED, "| HP: ${$shipHref}{hp} | AP: ${$shipHref}{ap} +| Location: ${$shipHref}{loc} |\n", RESET; } } print MAGENTA, "Coordinates attacked since last AI move:\n", RESET +; my $atkArSize = scalar @p1Attacks; if ( $atkArSize > 0 ) { foreach my $coor ( @p1Attacks ) { print RED, "$coor ", RESET; } } else { print "No attacks since last AI move"; } print "\n"; } sub shipPosition { # Map ship to position via grid mapping # 1 2 3 4 5 6 7 8 9 10 # . . . . . . . . . . # 11 12 13 14 15 16 17 18 19 20 # . . . . . . . . . . # Etc. # Function should recieve ship hashRef and new grid location as in +put my $shipHref = shift; my $newLocation = shift; my $currentLocation = ${$shipHref}{loc}; my @currentLoc = split(/,/, $currentLocation); my @newLoc = split(/,/, $newLocation); # This ended up working better than old loop &clearUnocTiles; # Now update new positon foreach my $tile ( @newLoc ) { $p1map{$tile} = ${$shipHref}{sym}; } # Update shipHref with valid location ${$shipHref}{loc} = join(',', @newLoc); # Update move counter -- CANT DO THIS HERE AS WE USE THIS SUB IN I +NIT # ${$shipHref}{mc} = 1; } # TODO: Consolidate with above sub sub AiShipPosition { # Map ship to position via grid mapping # 1 2 3 4 5 6 7 8 9 10 # . . . . . . . . . . # 11 12 13 14 15 16 17 18 19 20 # . . . . . . . . . . # Etc. # Function should recieve ship hashRef and new grid location as in +put my $shipHref = shift; my $newLocation = shift; my $currentLocation = ${$shipHref}{loc}; my @currentLoc = split(/,/, $currentLocation); my @newLoc = split(/,/, $newLocation); # This ended up working better than old loop &clearUnocTiles; # Now update new positon foreach my $tile ( @newLoc ) { $p2map{$tile} = ${$shipHref}{sym}; } # Update shipHref with valid location ${$shipHref}{loc} = join(',', @newLoc); # Update move counter -- CANT DO THIS HERE AS WE USE THIS SUB IN I +NIT # ${$shipHref}{mc} = 1; } sub updateMap { foreach my $key ( keys %p1ships ) { my $shipHref = $p1ships{$key}; my @mapPoints = split(/,/, ${$shipHref}{loc}); foreach my $mpoint ( @mapPoints ) { my $symbol = ${$shipHref}{sym}; $p1map{$mpoint} = $symbol; } } foreach my $key ( keys %p2ships ) { my $shipHref = $p2ships{$key}; my @mapPoints = split(/,/, ${$shipHref}{loc}); foreach my $mpoint ( @mapPoints ) { my $symbol = ${$shipHref}{sym}; $p1map{$mpoint} = $symbol; } } } sub checkLocation { # Given a set of coordinates, determine if they are already occupi +ed my $taken = 0; my $coordinates = shift; if ( $coordinates !~ /^[0-9]*,[0-9]*$/ && $coordinates !~ /^[0-9]* +,[0-9]*,[0-9]*$/ && $coordinates !~ /^[0-9]*,[0-9]*,[0-9]*,[0-9]*,[0- +9]*$/ ) { print "These coordinates look incorrect, you shouldnt see this + error...\n"; $taken = $taken + 1; } my @coors = split(/,/, $coordinates); foreach my $coor ( @coors ) { if ( $p1map{$coor} ne "." ) { print "coordinate $coor contains $p1map{$coor}\n"; $taken = $taken + 1; } } if ( $taken >= 1 ) { return 1; } else { return 0; } } sub placeShips { while() { # Init map at the top as failure will kick you back here &initMap; print "Where do you want to place your cruiser? : "; my $cruLoc = <STDIN>; chomp $cruLoc; ### ### TODO : Not actually checking location on any of the below +blocks ### For whatever reason, it doesn't work as expected, and retu +rn coordinates that ### are taken despite them being empty. I don't understand the + behavior, and need to revisit this ### if ( $cruLoc !~ /^[0-9]*,[0-9]*,[0-9]*$/ ) { #|| ! eval &checkLocation($cruLoc) ) { print "Input looks wrong, or coordinates are taken, try ag +ain\n"; next; } print "Where do you want to place your carrier? : "; my $carLoc = <STDIN>; chomp $carLoc; if ( $carLoc !~ /^[0-9]*,[0-9]*,[0-9]*,[0-9]*,[0-9]*$/ ) { # || ! eval &checkLocation($carLoc) ) { print "Input looks wrong, or coordiantes are taken, try ag +ain\n"; next; } print "Where do you want to place your submarine? : "; my $submLoc = <STDIN>; chomp $submLoc; if ( $submLoc !~ /^[0-9]*,[0-9]*$/ ) { # || ! eval &checkLocation($submLoc) ) { print "Input looks wrong, I need 2 comma seperated coordin +ates, try again\n"; next; } print "Coordinates are:\n"; print "Cruiser: $cruLoc\n"; print "Carrier: $carLoc\n"; print "Submarine: $submLoc\n"; print GREEN, "Type yes to confirm or type redo to redo: ", RES +ET; my $confirm = <STDIN>; chomp $confirm; if ( $confirm eq "redo" ) { next; } elsif ( $confirm eq "yes" ) { my $cruRef = $p1ships{cru}; my $carRef = $p1ships{car}; my $submRef = $p1ships{subm}; if ( ! eval &checkLocation($cruLoc) ) { &shipPosition($cruRef, $cruLoc); } else { print "Cruiser eval check failed\n"; &printMap; next; } if ( ! eval &checkLocation($carLoc) ) { &shipPosition($carRef, $carLoc); } else { print "Carrier eval check failed\n"; &printMap; next; } if ( ! eval &checkLocation($submLoc) ) { &shipPosition($submRef, $submLoc); } else { print "Submarine eval check failed\n"; &printMap; next; } last; } } } sub randomLocation { # Used by AI # Pass in ship type and come up with a random location my $shipType = shift; my $size; if ( $shipType eq "cru" ) { $size = 3; } if ( $shipType eq "car" ) { $size = 5; } if ( $shipType eq "subm" ) { $size = 2; } # Where to randomly look in the map index ( keys %p2map ) - betwee +n 1 and 50 my @fakeMap = ( 1 .. 50 ); my $random_num = int(1 + rand(50 - 1)); # Need to use splice so that numbers are sequential # TODO: Can still cause a situation where ships 'wrap' around edge +s of the map my @newLocs = splice(@fakeMap, $random_num, $size); # Make sure we don't end up with an empty/short location set while ( scalar(@newLocs) < $size ) { print "Re-rolling AI ship position due to conflict\n"; $random_num = int(1 + rand(50 - 1)); @newLocs = splice(@fakeMap, $random_num, $size); } my $newLocs = join(",", @newLocs); return $newLocs; } # TODO: This is stupid, main subroutine should be adjusted to take pla +yer map arg sub checkAILocation { my $coor = shift; my @coors = split(/,/, $coor); my $taken = 0; foreach my $coor ( @coors ) { if ( $p2map{$coor} ne "." ) { print "coordinate $coor contains $p2map{$coor}\n"; $taken = $taken + 1; } } if ( $taken >= 1 ) { return 1; } else { return 0; } } sub initAI { print MAGENTA, "Initialzing opponent..\n", RESET; # AI equivelant of placeShips() my $cruLoc = &randomLocation("cru"); my $carLoc = &randomLocation("car"); my $submLoc = &randomLocation("subm"); #print "AI cru loc = $cruLoc\n"; #print "AI car loc = $carLoc\n"; #print "AI subm loc = $submLoc\n"; # Hash refs for ships my $cruHref = $p2ships{cru}; my $carHref = $p2ships{car}; my $submHref = $p2ships{subm}; # Update Locations with new locations if ( ! eval &checkAILocation($cruLoc) ) { ${$cruHref}{loc} = $cruLoc; } else { print "Something went wrong with AI init, exiting\n"; exi +t 0; } if ( ! eval &checkAILocation($carLoc) ) { ${$carHref}{loc} = $carLoc; } else { print "Something went wrong with AI init, exiting\n"; exi +t 0; } if ( ! eval &checkAILocation($carLoc) ) { ${$submHref}{loc} = $submLoc; } else { print "Something went wrong with AI init, exiting\n"; exi +t 0; } print "Done\n"; } sub AiTurn { # General subroute to have the AI do something after the player ta +kes their turn # Main AI turn logic lives here -- extremely basic to start # Should not take any arguments print MAGENTA, "Starting AI's turn\n", RESET; sleep 1; # This used to be 50/50, but testing has found having the AI # constantly moving around makes the game pretty boring, so make i +t less likely the AI will move my @outcomes = (0,1,2,3,4); my $randomNum = int(rand(@outcomes)); #my $randomNum = 1; # Get random ship key and href my @availShips; foreach my $key ( keys %p2ships ) { if ( ! defined $p2ships{$key} ) { next; } else { push(@availShips,$key); } } my $randomShipKey = $availShips[rand @availShips]; #print "AI's random ship is : $randomShipKey\n"; my $shipHref = $p2ships{$randomShipKey}; # Make sure AI doesn't try to 'move' if it has no available moves +left print "Checking available AI moves\n"; my @availMovers; foreach my $key ( keys %p2ships ) { my $shipRef = $p2ships{$key}; if ( ! defined $p2ships{$key} ) { next; } elsif ( ${$shipRef}{mc} == 1 ) { next; } else { push(@availMovers, $key); } } my $availM = scalar @availMovers; if ( $availM == 0 ) { #print "Bumping random number because we're out of moves\n"; $randomNum = 1; } if ( $randomNum == 0 ) { # Move print MAGENTA, "AI is moving!\n", RESET; # Get new random location my $newRandomLocation = &randomLocation($randomShipKey); while ( eval &checkAILocation($newRandomLocation) ) { #print "Conflict in AI random location, rerolling\n"; $newRandomLocation = &randomLocation($randomShipKey); } #print "AI's new random location is : $newRandomLocation\n"; # Move ship to that location if ( ! eval &checkAILocation($newRandomLocation) ) { #print "Setting AI's new location to $newRandomLocation\n" +; ${$shipHref}{loc} = $newRandomLocation; ${$shipHref}{mc} = 1; print "Updating/cleaning maps\n"; @p1Attacks = ("Coors: "); &clearUnocTiles; } } else { # Attack # Same logic copy and pasted from player attack sub, with vars + changed print RED, "AI is attacking!\n", RESET; my $randomCoor = int(1 + rand(50 - 1)); print RED, "AI's chosen attack coordinate is $randomCoor\n", R +ESET; my $ap = ${$shipHref}{ap}; foreach my $key ( keys %p1ships ) { if ( ! $p1ships{$key} ) { next; } my $playerShipRef = $p1ships{$key}; my $playerShipLocation = ${$playerShipRef}{loc}; my @playerShipCoors = split(",", $playerShipLocation); if ( grep { $_ eq $randomCoor } @playerShipCoors ) { # Hit ! print RED, "Hit!\n", RESET; print RED, "The AI hit your $key for $ap !\n", RESET; # Deterime damage to hull my $playerShipHp = ${$playerShipRef}{hp}; my $newPlayerHullValue = $playerShipHp - $ap; if ( $newPlayerHullValue <= 0 ) { print RED, "The AI sunk your $key !\n", RESET; # Clear player map of ship and then set ship key t +o undef my @sunkenLocation = split(",", ${$playerShipRef}{ +loc}); foreach my $tile (@sunkenLocation) { $p1map{$tile} = "."; } $p1ships{$key} = undef; } else { ${$playerShipRef}{hp} = $newPlayerHullValue; print RED, "Your $key now has ${$playerShipRef}{hp +} hp !\n", RESET; } last; } else { # Miss print GREEN, "AI Miss\n", RESET; } } } print "\n"; } sub playerAttackAI { # Perform attack against AI. Takes a coordinate, and ship hashRef +as an arg # atkCoor is the coordinate to attack # $shipHref is a href to the ship that * is attacking * # # NOTE: This was a more generalized &attack subroutine, but perl # didn't like me trying to iterate over a scalar hash dereference, + so # figured seperate subroutes for each player attack would be the ' +easiest' way to # do this, as opposed to building a working hash and then repopula +ting # the real map/ships hashes with the updated values from the worki +ng hash # ... open to suggestions for better ways to do this # my $atkCoor = shift; my $shipHref = shift; # Grab attack power my $ap = ${$shipHref}{ap}; # Look at opponents ships and figure out where they are -- # if the supplied coordinate matches any ship location, start the +'hit' logic, else, miss foreach my $key ( keys %p2ships ) { if ( ! $p2ships{$key} ) { next; } my $aiShipRef = $p2ships{$key}; my $aiShipLocation = ${$aiShipRef}{loc}; my @AiShipCoors = split(",", $aiShipLocation); if ( grep { $_ eq $atkCoor } @AiShipCoors ) { # Hit ! print GREEN, "Hit!\n", RESET; print "You hit the AI's $key for $ap !\n"; # Deterime damage to hull my $aiShipHp = ${$aiShipRef}{hp}; my $newAiHullValue = $aiShipHp - $ap; if ( $newAiHullValue <= 0 ) { print "You sunk the AI's $key !\n"; $p2ships{$key} = undef; } else { ${$aiShipRef}{hp} = $newAiHullValue; print "AI's $key now has ${$aiShipRef}{hp} hp !\n"; } last; } else { # Miss print RED, "Player Miss\n", RESET; } } } sub printMenu { print <<EOF Swatson Battleship Type 'start','help', or 'quit' EOF } sub printHelp { print <<EOF How To Play: This is a turn based battleship game. Your objective is to destory the + AI ships. Each turn you can either attack with 1 ship or move 1 ship. To attack type: attack To move type: move To see stats type: stats Press Ctrl+C to exit any time. You have 3 ships: * Cruiser - Hull Points 2, Size 3, Attack Power 1 * Carrier - Hull Points 3, Size 5, Attack Power 2 * Submarine - Hull Points 1, Size 2, Attack Power 3 Each turn you will be prompted to either move or attack. * When attacking, provide a coordinate number ( 1 - 50 ) to fire at * When moving, provide a comma seperated list of coordinates to move t +o * * For cruiser, provide 3 coordinates * * For carrier, provide 5 coordinates * * For submarine, provide 2 coordinates EOF } &initMap; &updateMap; # Menu loop while () { my $count = 0; if ( $count == 0 ) { &printMenu; } print "Select option: "; my $input = <STDIN>; chomp $input; if ( $input eq "quit" ) { print "Quitting\n"; exit 0; } if ( $input eq "help" ) { &printHelp; } if ( $input eq "start" ) { my $gameCounter = 0; my $aiCounter = 1; while () { print "\n\n"; # Main game loop if ( $gameCounter == 0 ) { &initAI; &placeShips; &clearUnocTiles; $gameCounter++; next; } if ( ! defined $p2ships{cru} && ! defined $p2ships{subm} & +& ! defined $p2ships{car} ) { print "You won! Exiting...\n"; exit 0; } elsif ( ! defined $p1ships{cru} && ! defined $p1ships{su +bm} && ! defined $p1ships{car} ) { print "The brain dead AI beat you! Exiting...\n"; exit 0; } print GREEN, "! TURN: $gameCounter !\n", RESET; sleep 1; my @opponentRemaining; foreach my $key ( keys %p2ships ) { if ( defined $p2ships{$key} ) { push(@opponentRemaining, $key) } } # Make sure the AI doesn't take an additional turn if # the player makes a typing mistake or calls the stats sub if ( $aiCounter == $gameCounter ) { &AiTurn; $aiCounter++; } my $opShipsLeft = scalar @opponentRemaining; print "\n"; print GREEN, "--AI has $opShipsLeft ships left--\n", RESET +; &printMap; print "Move or attack: "; my $gameInput = <STDIN>; chomp $gameInput; if ( $gameInput eq "quit" ) { print "Are you sure? : "; my $answer = <STDIN>; chomp $answer; if ( $answer eq "yes" ) { exit 0; } else { next; } } if ( $gameInput eq "move" ) { print "What ship do you want to move? : "; my $shipInput = <STDIN>; chomp $shipInput; my @validInputs; foreach my $key ( keys %p1ships ) { my $shipHref = $p1ships{$key}; my $moveCounter = ${$shipHref}{mc}; if ( ! defined $p1ships{$key} ) { next; } elsif ( $moveCounter == 1 ) { next; } else { push(@validInputs,$key); } } if ( ! grep { $_ eq $shipInput } @validInputs ) { print "That input looks wrong, try again\n"; next; } else { print "New coordinates: "; my $newCoor = <STDIN>; chomp $newCoor; if ( $shipInput eq "cru" && $newCoor !~ /^[0-9]*,[ +0-9]*,[0-9]*$/ ) { print "Bad coordinates, try again\n"; next; } elsif ( $shipInput eq "car" && $newCoor !~ /^[0- +9]*,[0-9]*,[0-9]*,[0-9]*,[0-9]*$/ ) { print "Bad coordiantes, try again\n"; next; } elsif ( $shipInput eq "subm" && $newCoor !~ /^[0 +-9]*,[0-9]*$/ ) { print "Bad coordinates, try again\n"; next; } if ( eval &checkLocation($newCoor) ) { print "Coordinates occupied, try again\n"; next; } my $shipHref = $p1ships{$shipInput}; &shipPosition($shipHref, $newCoor); ${$shipHref}{mc} = 1; &clearUnocTiles; print "\n"; } } elsif ( $gameInput eq "attack" ) { print "What ship do you want to attack with? : "; my $attackShip = <STDIN>; chomp $attackShip; my @validInputs; foreach my $key ( keys %p1ships ) { if ( ! defined $p1ships{$key} ) { next; } else { push(@validInputs,$key); } } if ( ! grep { $_ eq $attackShip } @validInputs ) { print "That input looks wrong, try again\n"; next; } else { print "Select a single coordinate to attack: "; my $atkCoor = <STDIN>; chomp $atkCoor; my @validCoors = ( 0 .. 50 ); if ( ! grep { $_ eq $atkCoor } @validCoors ) { print "That doesn't look like a real coordinat +e, try again\n"; next; } else { &playerAttackAI($atkCoor,$p1ships{$attackShip} +); push(@p1Attacks,$atkCoor); print "\n"; } } } elsif ( $gameInput eq "stats" ) { &printPlayerStats; next; } elsif ( $gameInput eq "help" ) { &printHelp; print "\n"; next; } else { next; } $gameCounter++; } } $count++; }

Replies are listed 'Best First'.
Re: Another perl battleship
by jwkrahn (Monsignor) on Jan 09, 2019 at 00:27 UTC
    # # 5x5 map grid for each player # Cruiser = * # Carrier = @ # Submarine = ~ # Ocean/Empty Space = .

    Your grid is actually 10x5.


    # Stats trackers my @p1Attacks; my @p2Attacks;

    The variable @p2Attacks is never used anywhere so it could be removed.


    # Ships - surely there is a better way to do this my %p1cruiser = ( 'hp' => '2', 'size' => '3', 'ap' => '1', 'loc' => '' +, 'sym' => '*', 'mc' => 0 ); my %p1carrier = ( 'hp' => '3', 'size' => '5', 'ap' => '2', 'loc' => '' +, 'sym' => '@', 'mc' => 0 ); my %p1subm = ( 'hp' => '1', 'size' => '2', 'ap' => '3', 'loc' => '' +, 'sym' => '~', 'mc' => 0 ); my %p1ships = ( 'cru' => \%p1cruiser, 'car' => \%p1carrier, 'subm' => +\%p1subm ); my %p2cruiser = ( 'hp' => '2', 'size' => '3', 'ap' => '1', 'loc' => '' +, 'sym' => '*', 'mc' => 0 ); my %p2carrier = ( 'hp' => '3', 'size' => '5', 'ap' => '2', 'loc' => '' +, 'sym' => '@', 'mc' => 0 ); my %p2subm = ( 'hp' => '1', 'size' => '2', 'ap' => '3', 'loc' => '' +, 'sym' => '~', 'mc' => 0 ); my %p2ships = ( 'cru' => \%p2cruiser, 'car' => \%p2carrier, 'subm' => +\%p2subm );

    The hashes %p1cruiser, %p1carrier, %p1subm, %p2cruiser, %p2carrier and %p2subm aren't really needed:

    # Ships - surely there is a better way to do this my %p1ships = ( cru => { hp => 2, size => 3, ap => 1, loc => '', sym => '*', mc = +> 0 }, car => { hp => 3, size => 5, ap => 2, loc => '', sym => '@', mc = +> 0 }, subm => { hp => 1, size => 2, ap => 3, loc => '', sym => '~', mc = +> 0 }, ); my %p2ships = ( cru => { hp => 2, size => 3, ap => 1, loc => '', sym => '*', mc = +> 0 }, car => { hp => 3, size => 5, ap => 2, loc => '', sym => '@', mc = +> 0 }, subm => { hp => 1, size => 2, ap => 3, loc => '', sym => '~', mc = +> 0 }, );

    # Get in use tiles for ship hashes foreach my $ship ( keys %p1ships ) { if ( ! $p1ships{$ship} ) { next; } my $shipRef = $p1ships{$ship}; my $location = ${$shipRef}{loc}; my @inUseTiles = split(",", $location); foreach my $iut ( @inUseTiles ) { push(@p1usedTiles, $iut); } }

    push is a list operator so you don't need a foreach loop.   And you don't really need all those intermediary variables.

    # Get in use tiles for ship hashes foreach my $ship ( keys %p1ships ) { next unless $p1ships{ $ship }; push @p1usedTiles, split /,/, $p1ships{ $ship }{ loc }; }

    sub checkLocation { # Given a set of coordinates, determine if they are already occupi +ed my $taken = 0; my $coordinates = shift; if ( $coordinates !~ /^[0-9]*,[0-9]*$/ && $coordinates !~ /^[0-9]* +,[0-9]*,[0-9]*$/ && $coordinates !~ /^[0-9]*,[0-9]*,[0-9]*,[0-9]*,[0- +9]*$/ ) { print "These coordinates look incorrect, you shouldnt see this + error...\n"; $taken = $taken + 1; } my @coors = split(/,/, $coordinates); foreach my $coor ( @coors ) { if ( $p1map{$coor} ne "." ) { print "coordinate $coor contains $p1map{$coor}\n"; $taken = $taken + 1; } } if ( $taken >= 1 ) { return 1; } else { return 0; } }

    You are checking $coordinates for either one, two or four commas, with optional numbers.   Perhaps you should change [0-9]* to [0-9]+.

    $taken = $taken + 1 could be shortened to $taken += 1 or even ++$taken.

    The return code could be shortened to return $taken >= 1 ? 1 : 0 or even return $taken >= 1.


    # Get random ship key and href my @availShips; foreach my $key ( keys %p2ships ) { if ( ! defined $p2ships{$key} ) { next; } else { push(@availShips,$key); } }

    That can be shortened a bit:

    # Get random ship key and href my @availShips = grep defined( $p2ships{ $_ } ), keys %p2ships;

    # Make sure AI doesn't try to 'move' if it has no available moves +left print "Checking available AI moves\n"; my @availMovers; foreach my $key ( keys %p2ships ) { my $shipRef = $p2ships{$key}; if ( ! defined $p2ships{$key} ) { next; } elsif ( ${$shipRef}{mc} == 1 ) { next; } else { push(@availMovers, $key); } }

    Same as with above:

    # Make sure AI doesn't try to 'move' if it has no available moves +left print "Checking available AI moves\n"; my @availMovers = grep defined( $p2ships{ $_ } ) && $p2ships{ $_ } +{ mc } != 1, keys %p2ships;

    # Menu loop while () { my $count = 0; if ( $count == 0 ) { &printMenu; } ... $count++; }

    The $count variable should be defined outside the loop if you want it to work correctly:

    # Menu loop my $count = 0; while () { if ( $count == 0 ) {

    &printMenu should be printMenu().


    my @opponentRemaining; foreach my $key ( keys %p2ships ) { if ( defined $p2ships{$key} ) { push(@opponentRemaining, $key) } }

    Same as with above:

    my @opponentRemaining = grep defined( $p2ships{ $_ } ), ke +ys %p2ships;

    my @validInputs; foreach my $key ( keys %p1ships ) { my $shipHref = $p1ships{$key}; my $moveCounter = ${$shipHref}{mc}; if ( ! defined $p1ships{$key} ) { next; } elsif ( $moveCounter == 1 ) { next; } else { push(@validInputs,$key); } }

    Same as with above:

    my @validInputs = grep defined( $p1ships{ $_ } ) && $p +1ships{ $_ }{ mc } != 1, keys %p1ships;

    Dereferencing like ${$shipHref}{mc} are usualy written as $shipHref->{mc}.

      Excellent review (++). Permit me to make just one more tiny DRY suggestion to turn

      # Ships - surely there is a better way to do this my %p1ships = ( cru => { hp => 2, size => 3, ap => 1, loc => '', sym => '*', mc = +> 0 }, car => { hp => 3, size => 5, ap => 2, loc => '', sym => '@', mc = +> 0 }, subm => { hp => 1, size => 2, ap => 3, loc => '', sym => '~', mc = +> 0 }, ); my %p2ships = ( cru => { hp => 2, size => 3, ap => 1, loc => '', sym => '*', mc = +> 0 }, car => { hp => 3, size => 5, ap => 2, loc => '', sym => '@', mc = +> 0 }, subm => { hp => 1, size => 2, ap => 3, loc => '', sym => '~', mc = +> 0 }, );

      into

      # Ships sub ships_init { return ( cru => { hp => 2, size => 3, ap => 1, loc => '', sym => '*', +mc => 0 }, car => { hp => 3, size => 5, ap => 2, loc => '', sym => '@', +mc => 0 }, subm => { hp => 1, size => 2, ap => 3, loc => '', sym => '~', +mc => 0 }, ); } my %p1ships = ships_init (); my %p2ships = ships_init ();
      Wow, thank you jwkrahn for this incredibly detailed and thoughtful analysis, it's teaching me a ton. I will be implementing these changes.
Re: Another perl battleship
by jwkrahn (Monsignor) on Jan 08, 2019 at 05:05 UTC
    362: #|| ! eval &checkLocation($cruLoc) ) { 371: # || ! eval &checkLocation($carLoc) ) { 380: # || ! eval &checkLocation($submLoc) ) { 400: if ( ! eval &checkLocation($cruLoc) ) { 407: if ( ! eval &checkLocation($carLoc) ) { 414: if ( ! eval &checkLocation($submLoc) ) { 494: if ( ! eval &checkAILocation($cruLoc) ) { 497: if ( ! eval &checkAILocation($carLoc) ) { 500: if ( ! eval &checkAILocation($carLoc) ) { 561: while ( eval &checkAILocation($newRandomLocation) ) { 569: if ( ! eval &checkAILocation($newRandomLocation) ) { 826: if ( eval &checkLocation($newC +oor) ) {

    Both checkLocation and checkAILocation return either 0 or 1 so the use of eval is definitely NOT required!!

    Also, the ampersands are not required on function calls.

      Thanks jwkrahn, appreciate the feedback

      My understanding was using ' & ' was best style practice, based on some of the code bases/people I've worked with, perhaps that is just an idiomatic thing where I work though.

        My understanding was using ' & ' was best style practice

        In "modern" Perl, that is no longer the case. Calling a sub with & disables prototype checking, and also calling a sub as &foo; leaves @_ unmodified. Since both of these behaviors fall in the "one should only do this if one knows what one is doing" category, calling subs without the & is generally recommended (unless one knows what one is doing :-) ). From perlsub (emphasis mine):

        A subroutine may be called using an explicit & prefix. The & is optional in modern Perl, as are parentheses if the subroutine has been predeclared. The & is not optional when just naming the subroutine, such as when it's used as an argument to defined() or undef(). Nor is it optional when you want to do an indirect subroutine call with a subroutine name or reference using the &$subref() or &{$subref}() constructs, although the $subref->() notation solves that problem. See perlref for more about all that.

        Subroutines may be called recursively. If a subroutine is called using the & form, the argument list is optional, and if omitted, no @_ array is set up for the subroutine: the @_ array at the time of the call is visible to subroutine instead. This is an efficiency mechanism that new users may wish to avoid.

        &foo(1,2,3); # pass three arguments foo(1,2,3); # the same foo(); # pass a null list &foo(); # the same &foo; # foo() get current args, like foo(@_) !! foo; # like foo() IFF sub foo predeclared, else "foo"

        Not only does the & form make the argument list optional, it also disables any prototype checking on arguments you do provide. This is partly for historical reasons, and partly for having a convenient way to cheat if you know what you're doing. See Prototypes below.

        Update: For even more, see "Pitfalls and Misfeatures" in Modern Perl.

        The document perlsub appears to say that the & form is always optional. However, it then specifies a few special cases where it is required. The practice of using the & only when necessary has the advantage of alerting human readers that special argument handling is intended. Casual use of the & form for calling subroutines which specify signatures could lead to subtle errors.
        Bill
Re: Another perl battleship
by tybalt89 (Parson) on Jan 08, 2019 at 19:22 UTC
Re: Another perl battleship
by bliako (Vicar) on Jan 09, 2019 at 10:47 UTC

    tiny one: didn't know what the format of the coordinates I was asked for was.

      Yah the help menu/explanation of the rules of the game is poor/non-existent. Will definitely address that .. might have been something to do before posting online lol.

Log In?
Username:
Password:

What's my password?
Create A New User
Node Status?
node history
Node Type: perlquestion [id://1228171]
Approved by stevieb
Front-paged by haukex
help
Chatterbox?
and the web crawler heard nothing...

How do I use this? | Other CB clients
Other Users?
Others taking refuge in the Monastery: (4)
As of 2019-10-16 17:43 GMT
Sections?
Information?
Find Nodes?
Leftovers?
    Voting Booth?
    Notices?