diff --git a/01 Acey Ducey/perl/aceyducey.pl b/01 Acey Ducey/perl/aceyducey.pl new file mode 100644 index 00000000..e2de13df --- /dev/null +++ b/01 Acey Ducey/perl/aceyducey.pl @@ -0,0 +1,174 @@ +#!/usr/bin/perl + +use strict; +use warnings; + +# The List::Util module is part of the core Perl distribution. Using this +# means we don't need to re-invent the wheel and create a way to shuffle +# a list. +use List::Util qw(shuffle); + +# Rather than put in a number of print (or say) statements here, we use a +# "here document". This is very useful for long strings of text. In this +# case, everything between the end of the "print" line and the line with +# "END_INSTRUCTIONS" on it will be printed verbatim. +print << 'END_INSTRUCTIONS'; + +Acey-Ducey +Adapted from Creative Computing, Morristown, New Jersey + + +Acey-Ducey is played as follows. The dealer (computer) deals two cards face up. +You have an option to bet or not bet, depending on whether or not you feel that +the next card drawn will have a value between the first two. Aces are low. + +Bets must be in whole-dollar amounts only. + +If you do not want to bet, input a 0. If you want to quit, input a -1. + +END_INSTRUCTIONS + +my @cards = (1 .. 13); # That is, Ace through King. +my $keepPlaying = 1; + +GAME: +while ($keepPlaying) +{ + my $playerBalance = 100; # The player starts with $100 + + HAND: + while (1) + { + print "\nYou now have $playerBalance dollars.\n\n"; + + # We'll create a new array that is a shuffled version of the deck. + my @shuffledDeck = shuffle(@cards); + + # Then, by taking the two "top cards" off the deck, we're guaranteed + # that those will be unique. This way we don't have to keep drawing + # if we get, say, two queens. We sort them as we pull them to make + # sure that the first card is lower than the second one. + my ($firstCard, $secondCard) = sort { $a <=> $b } @shuffledDeck[ 0 .. 1 ]; + + print "I drew ", nameOfCard($firstCard), " and ", nameOfCard($secondCard), ".\n"; + + my $bet = getValidBet($playerBalance); + if ($bet == 0) + { + print "Chicken!\n\n"; + next HAND; + } + + if ($bet < 0) + { + last GAME; + } + + # Now we re-shuffle the whole deck again and choose a third card. + # (Note: This is how the odds get stacked in favor of the dealer since + # the third card can be exactly the same as the first or second.) + @shuffledDeck = shuffle(@cards); + my $thirdCard = $shuffledDeck[0]; + + print "I drew ", nameOfCard($thirdCard), "!\n"; + + if (($firstCard < $thirdCard) && ($thirdCard < $secondCard)) + { + print "You win!\n\n"; + $playerBalance += $bet; + } + else + { + print "You lose!\n\n"; + $playerBalance -= $bet; + } + + if ($playerBalance <= 0) + { + print "Sorry, buddy, you blew your wad!\n\n"; + last HAND; + } + } + + $keepPlaying = promptUserToKeepPlaying(); +} + +print "Thanks for playing!\n"; + +############### +sub getValidBet +{ + my $maxBet = shift; + + print "\nWhat's your bet? "; + + my $input = ; + chomp $input; + + # This regular expression will validate that the player entered an integer. + # The !~ match operate *negates* the match, so if the player did NOT enter + # an integer, they'll be given an error and prompted again. + if ($input !~ /^ # Match the beginning of the string + [+-]? # Optional plus or minus... + \d+ # followed by one more more digits... + $ # and then the end of the string + /x # The x modifier ignores whitespace in this regex... + ) + { + print "Sorry, numbers only!\n"; + $input = getValidBet($maxBet); + } + + if ($input > $maxBet) + { + print "Sorry, my friend, you can't bet more money than you have.\n"; + print "You only have $maxBet dollars to spend!\n"; + $input = getValidBet($maxBet); + } + + if ($input != int($input)) + { + print "Sorry, you must bet in whole dollars. No change!\n"; + $input = getValidBet($maxBet); + } + + return $input; +} + +# Since arrays in Perl are 0-based, we need to convert the value that we drew from +# the array to its proper position in the deck. +sub nameOfCard +{ + my $value = shift; + + # Note that the Joker isn't used in this game, but since arrays in Perl are + # 0-based, it's useful to have something there to represent the "0th" + # position. This way the rest of the elements match their expected values + # (e.g., element 1 is Ace, element 7 is 7, and element 12 is Queen). + + my @cardlist = qw(Joker Ace 2 3 4 5 6 7 8 9 10 Jack Queen King); + return $cardlist[$value]; +} + +sub promptUserToKeepPlaying +{ + print "Try again (Y/N)? "; + my $input = ; + chomp $input; + + my $keepGoing; + if (uc($input) eq 'Y') + { + $keepGoing = 1; + } + elsif (uc($input) eq 'N') + { + $keepGoing = 0; + } + else + { + $keepGoing = promptUserToKeepPlaying(); + } + + return $keepGoing; +}