#!/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 opponent 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 first row, and the next two sections of it # in the second row. This doesn't really break the game at all, but 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 that 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 sanitation, etc # ** Optimze placement so we dont have to check it each time, ie check at placement # ** Consolidate redundant subs # # TODO: Improve readability, game play feel # # TODO: Break subs into modules? Based on the fact most subs operate on objects within the top level # program means I might have to rewrite how I am handling the references to those objects # # KNOWN BUGS: # TODO: &clearUnocTiles issue -- see sub comment # ** Not sure this is really an issue, but leaving it here to remind myself anyways # Basic implimentation of 'battleship' to teach myself more about programming # 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 it was on # is not reset despite the &shipPosition function reporting that it 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 location 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 input 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 INIT # ${$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 input 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 INIT # ${$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 occupied 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 = ; chomp $cruLoc; ### ### TODO : Not actually checking location on any of the below blocks ### For whatever reason, it doesn't work as expected, and return 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 again\n"; next; } print "Where do you want to place your carrier? : "; my $carLoc = ; 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 again\n"; next; } print "Where do you want to place your submarine? : "; my $submLoc = ; chomp $submLoc; if ( $submLoc !~ /^[0-9]*,[0-9]*$/ ) { # || ! eval &checkLocation($submLoc) ) { print "Input looks wrong, I need 2 comma seperated coordinates, 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: ", RESET; my $confirm = ; 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 ) - between 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 edges 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 player 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"; exit 0; } if ( ! eval &checkAILocation($carLoc) ) { ${$carHref}{loc} = $carLoc; } else { print "Something went wrong with AI init, exiting\n"; exit 0; } if ( ! eval &checkAILocation($carLoc) ) { ${$submHref}{loc} = $submLoc; } else { print "Something went wrong with AI init, exiting\n"; exit 0; } print "Done\n"; } sub AiTurn { # General subroute to have the AI do something after the player takes 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 it 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", RESET; 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 to 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 repopulating # the real map/ships hashes with the updated values from the working 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 <; 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{subm} && ! 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 = ; chomp $gameInput; if ( $gameInput eq "quit" ) { print "Are you sure? : "; my $answer = ; chomp $answer; if ( $answer eq "yes" ) { exit 0; } else { next; } } if ( $gameInput eq "move" ) { print "What ship do you want to move? : "; my $shipInput = ; 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 = ; 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 = ; 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 = ; chomp $atkCoor; my @validCoors = ( 0 .. 50 ); if ( ! grep { $_ eq $atkCoor } @validCoors ) { print "That doesn't look like a real coordinate, 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++; }