blackjack.pl

use strict;
use warnings;

# imports 'shuffle' on global scope, alternatively I could use List::Util::shuffle when I need it
use List::Util ("shuffle", "reduce"); 
use Data::Dumper; # Useful for debugging 'print Dumper \@array';

=pod
  This is an attempt at implementing a super simple version of BlackJack 
  in order to learn Perl syntax and the athena coding conventions.
=cut


#############################
# Global state
#############################
my @card_ranks  = ('2', '3', '4', '5', '6', '7', '10', 'J', 'Q', 'K', 'A');
my @card_suits  = ('♦', '♣', '♠', '♥');
my $player_name = Prompt('What is your name?: ');
my @deck;
my @player_hand;
my @computer_hand;

#############################
# Create and shuffle deck
#############################
foreach my $suit (@card_suits) {
  foreach my $rank (@card_ranks) {
    my $card = "$rank$suit\n";
    push @deck, $card
  }
}

@deck = shuffle @deck;

#############################
# Play simple BlackJack!
#############################
DealPlayer(2);
DealComputer(2);

PrintPlayerHand();
PrintComputerHand();

while (1) {
  my $choice = Prompt('Would you like to hit or stay? [h|s|q]: ');

  if ($choice =~ /h/i) {
    DealPlayer(1);
    PrintPlayerHand();
    if (CalcHand(\@player_hand) > 21) {
      print "BUST - better luck next time!\n";
      last;
    }
  } elsif ($choice =~ /s/i) {
    until (CalcHand(\@computer_hand) >= 21) {
      DealComputer(1);
      PrintComputerHand();
    }

    my $player_score = CalcHand(\@player_hand);
    my $computer_score = CalcHand(\@computer_hand);

    if ($player_score > $computer_score && $player_score < 22 || $computer_score > 21) {
      print "$player_name wins!!!\n";
    } else {
      print "Computer wins :(";
    }
    last;
  } elsif ($choice =~ /q/i) {
    print "Have a great day!  Come back again.\n";
    last;
  } else {
    print "Please only choose 'h', 's', or 'q' to quit. \n";
  }
}

#############################
# Subroutine Helpers
#############################
# athena Code Conventions states to drop-case sub's starting with capital letter
# from what I've read, subroutines usually belong at the bottom of the file...
sub DealCards {
  my %args  = @_;
  my $count = $args{"card_count"};

  for (my $i = 0; $i < $count; $i++) {
    my $card = pop @{ $args{"deck_ref"} };
    push @{ $args{"hand_ref"} }, $card;
  }
  return;
}

sub DealPlayer {
  my ($num_of_cards) = @_;
  return DealCards(
    "deck_ref" => \@deck,
    "hand_ref" => \@player_hand,
    "card_count" => $num_of_cards
  );
}

sub DealComputer {
  my ($num_of_cards) = @_;
  return DealCards(
    "deck_ref" => \@deck,
    "hand_ref" => \@computer_hand,
    "card_count" => $num_of_cards
  );
}

sub PrintHand {
  my ( $hand_ref, $player_name ) = @_;
  my @hand = @{$hand_ref};
  my $hand_total = CalcHand(\@hand);

  print "\n";
  print "$player_name"."'s hand: $hand_total\n";
  print @hand;
  return;
}

sub PrintPlayerHand   { PrintHand(\@player_hand, $player_name); }
sub PrintComputerHand { PrintHand(\@computer_hand, 'Computer'); }

sub GetAnswer {
  my $answer = <STDIN>;
  chomp $answer;
  return $answer;
}

sub Prompt {
   my ($text) = @_;
   print $text;

   return GetAnswer();
}

sub FaceToNum {
  my ($rank) = @_;
  if ($rank =~ /j|k|q/i) {
    return 10;
  } elsif ($rank =~ /a/i) {
    return 11; # just force aces to 11 for now even though that's not correct...
  } elsif ($rank =~ /1/) {
    return 10; # this is super hacky, can't figure out proper way 
  } else {
    return $rank;
  }
}

sub CalcHand {
  my ($hand_ref) = @_;
  my @hand = @{$hand_ref};

  my @ranks = map { substr $_, 0, 1 } @hand;
  @ranks = map { FaceToNum($_) } @ranks;
  return reduce { $a + $b } @ranks;
}