#!/usr/bin/perl -w

# SYNOPSIS:
#
# # Send only the arguments that you actually need to set.  Deck->new() with no arguments
# # will return a single shuffled standard (i.e. poker/bridge) deck with no jokers.
# my $d = Deck->new(
#           game => Deck->STD,  # STD is the standard 52-card deck, PINOCHLE is that game's 48-card deck.
#           jokers => 0,        # The number of jokers to include (in *each* of the 'num_decks' decks).
#           num_decks => 1,     # You can put together more than one deck, like they might do in a casino.
#           autoshuffle => 1,   # Set to 0 if for some reason you don't want the deck randomized.
#           stack => [],        # A reference to an array of Card objects.  This will override 'game' if you set them both.
#         );
#
# # Draw a five-card hand and print the full names of the cards:
# print $d->draw(5)->long_str(', '), "\n";

package Deck;

use File::Basename;  # for dirname()
use Moose;
use List::Util qw<!shuffle>;  # we need to use shuffle(), but want to create a shuffle() method for the Deck class as well

# Determine the current directory based on the filename of the script,
# then add it to the list of places where Perl will look for modules to include.
# This lets us find Deck.pm below.
# Apache & mod_perl (not sure which one is ultimately to blame) may not
# accurately report the current working directory if you use something like "use Cwd".
unshift @INC, dirname(__FILE__);

require "Card.pm";

# Invoke these constants via "Deck->", e.g. Deck->PINOCHLE (even though https://perldoc.perl.org/constant#NOTES
# says that you should be able to use Deck::PINOCHLE ...?)
use constant {
  NONE => 0,
  STD => 1,  # the 52-card deck used in poker and bridge
  PINOCHLE => 2,
};

# Should we shuffle the deck after it's created?
has 'autoshuffle' => (
  is => 'ro',
  isa => 'Bool',
  default => 1,
);

# What type of game is this deck for?  (Poker, Pinochle...)
has 'game' => (
  is => 'ro',
  isa => 'Int',
  default => Deck->STD,
);

# How many jokers should the deck include? (independent of game type)
has 'jokers' => (
  is => 'ro',
  isa => 'Int',
  default => 0,
);

# Are we using more than one deck (like a casino might)?
has 'num_decks' => (
  is => 'ro',
  isa => 'Int',
  default => 1,
);

# The pile of cards itself
has 'stack' => (
  is => 'rw',
  isa => 'ArrayRef[Card]',
  default => \&create_random_deck,
  lazy => 1,  # because we need to know about the other attributes before we can create the deck
);


# Initializes the stack
sub create_random_deck {
  my $self = shift;
  my @stk;  # the proto-stack
  my ($i, $n, $s, $r);  # loop variables

  for ($n = 0; $n < $self->num_decks(); $n++)  {
    # Standard (poker/bridge) decks
    if ($self->game() == STD)  {
      foreach $s (qw<C D H S>)  {
        foreach $r (qw<A 2 3 4 5 6 7 8 9 T J Q K>)  {
          push @stk, Card->new('rank' => $r, 'suit' => $s);
        }
      }

    # Pinochle decks have two copies of each card from 9 through Ace
    }  elsif ($self->game() == PINOCHLE)  {
      foreach $s (qw<C D H S>)  {
        foreach $r (qw<9 T J Q K A>)  {
          foreach (1..2)  {
            push @stk, Card->new('rank' => $r, 'suit' => $s);
          }
        }
      }

    # Unrecognized deck type
    }  elsif ($self->game() != 0)  {
      die ("Don't know what type of deck '$self->game()' is");
    }

    # Any jokers?
    foreach ($i = 0; $i < $self->jokers(); $i++)  {
      push @stk, Card->new('rank' => '*', 'suit' => '');
    }
  }

  # Shuffle?
  if ($self->autoshuffle()) { @stk = List::Util::shuffle( @stk ); }

  return \@stk;
}  # end of sub create_random_deck


# Returns another Deck object, even if only one card was requested.
sub draw {
  my $self = shift;
  my $how_many = (shift or 1);
  my @hand;

  if ($how_many < 1 || $how_many > @{ $self->stack() })  {
    die ("Tried to draw fewer than one card, or more cards than are left in the deck");
  }

  for (my $i = 0; $i < $how_many; $i++)  {
    push @hand, pop @{ $self->stack() };
  }

  return Deck->new( stack => \@hand );
}


# The names of the cards, in full English words.
# Default separator is a newline.
sub long_str {
  my $self = shift;
  my $separator = (shift or "\n");
  return join $separator, map { $_->long_str() } @{ $self->stack() };
}


# Add more cards to the deck
sub push {
  my $self = shift;
  my $additional = shift or return;

  if (ref $additional eq 'Card')  {
    $self->stack( [ @{ $self->stack() }, $additional ] );
  }  elsif (ref $additional eq 'Deck')  {
    $self->stack( [ @{ $self->stack() }, @{ $additional->stack() } ] );
  }
}


# Randomize the deck
sub shuffle {
  my $self = shift;
  $self->stack( [ List::Util::shuffle( @{ $self->stack() } ) ] );
}


# The number of cards in the deck
sub size {
  my $self = shift;
  return scalar( @{ $self->stack() } );
}


# The two-letter abbreviations for all of the cards.
# Default separator is a lone comma.
# Jokers are represented by a single asterisk (*).
sub str {
  my $self = shift;
  my $separator = (shift or ',');
  return join $separator, map { $_->str() } @{ $self->stack() };
}


no Moose;
__PACKAGE__->meta->make_immutable;
1;