Merge pull request #245 from markyocom/main

Add a Perl port of Acey Ducey

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 = <STDIN>;
+    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 = <STDIN>;
+    chomp $input;
+
+    my $keepGoing;
+    if (uc($input) eq 'Y')
+    {
+        $keepGoing = 1;
+    }
+    elsif (uc($input) eq 'N')
+    {
+        $keepGoing = 0;
+    }
+    else
+    {
+        $keepGoing = promptUserToKeepPlaying();
+    }
+
+    return $keepGoing;
+}