File Coverage

blib/lib/Games/Euchre/Trick.pm

Criterion	Covered	Total	%
statement	9	92	9.7
branch	0	20	0.0
condition	0	12	0.0
subroutine	3	16	18.7
pod	13	13	100.0
total	25	153	16.3

package Games::Euchre::Trick;

=head1 NAME

Games::Euchre::Trick - Trick class for Euchre card game

=head1 DESCRIPTION

Only one Trick instance is alive at one time per Euchre game.  The
Trick keeps track of which cards have been played, and provides useful
functions to determine which cards are legal plays, as well as who
is the winner of the trick.  The trick class makes the determination
of which card beats which card, given the current trump and lead.  The
trick class knows how to handle an alone hand and it calls the
playCard() method for each player in turn in it's play() method,
usually called from the Games::Euchre->playHand() method.

=cut

use strict;
use warnings;
use Games::Cards;

=head1 CLASS METHODS

=over 4

=item new GAME LEAD NAME NUMBER

Create and initialize a new Euchre trick.  The lead is a
Games::Euchre::Player instance.  The name is any string.  The number
is a one-based index of which trick this is (from 1 to 5).

=cut

sub new {
   my $pkg = shift;
   my $game = shift;
   my $lead = shift;
   my $name = shift;
   my $number = shift;  # 1-based
   my $self =  bless({
      game => $game,
      name => $name,
      number => $number,
      players => [$game->getPlayers()],
      hand => Games::Cards::Queue->new($game->{game}, $name),
      play => 0,
      leadIndex => undef,
   }, $pkg);
   for (my $i=$#{$self->{players}}; $i >= 0; $i--) {
      my $player = $self->{players}->[$i];
      if ((!$player->wentAlone()) && $player->getTeam()->wentAlone()) {
         # Remove teammate of alone-goer
         splice @{$self->{players}}, $i, 1;
      }
   }

   for (my $i=0; $i < @{$self->{players}}; $i++) {
      last if ($lead->getName() eq $self->{players}->[0]->getName());
      push @{$self->{players}}, shift(@{$self->{players}}); # rotate
   }
   return $self;
}

=back

=head1 CLASS METHODS

=over 4

=item getGame

Return the Euchre game instance to which this trick belongs.

=cut

sub getGame {
   my $self = shift;
   return $self->{game};
}

=item getName

Return the name of this trick.

=cut

sub getName {
   my $self = shift;
   return $self->{name};
}

=item getNumber

Return the number of this trick (from 1 to 5).

=cut

sub getNumber {
   my $self = shift;
   return $self->{number};
}

=item getHand

Return the Games::Cards::Hand object representing this trick.

=cut

sub getHand {
   my $self = shift;
   return $self->{hand};
}

=item getCards

Return an array of the Games::Cards::Card objects played in this trick.

=cut

sub getCards {
   my $self = shift;
   return @{$self->getHand()->cards()};
}

=item getPlayers

Return an array of the players in the order they will play in this
trick.  If someone went alone, this array will have three entries.
Otherwise it will always have four.

=cut

sub getPlayers {
   my $self = shift;
   return @{$self->{players}};
}

=item getPlayerIndex PLAYER

Returns the 0-based index of the specified player in the order that he
would play in the current trick.  This is crucial for figuring out who
played which card.  Returns undef in the case that the player did not
play (yet, or not at all if the partner went alone).

=cut

sub getPlayerIndex {
   my $self = shift;
   my $player = shift;
   for (my $i=0; $i < @{$self->{players}}; $i++) {
      if ($player->getName() eq $self->{players}->[$i]->getName()) {
         return $i;
      }
   }
   return undef;
}

=item recordTrick

Record the result of this trick by informing the winning team.

=cut

sub recordTrick {
   my $self = shift;
   my $winner = $self->getWinner();
   $winner->getTeam()->addTrick();
}

=item getWinner

Returns the player who played the card that won the trick.

=cut

sub getWinner {
   my $self = shift;

   my @cards = $self->getCards();
   my $leader = 0;
   for (my $i=1; $i<@cards; $i++) {
      if ($self->cmpCards($cards[$leader], $cards[$i]) < 0) {
         $leader = $i;
      }
   }
   #print "winner: " . $self->{players}->[$leader]->getName() . "\n"
   #    if ($self->getGame()->{debug});
   return $self->{players}->[$leader];
}

=item cmpCards CARD1 CARD2

Returns -1, 0, or 1 indicating the relative rank of the two cards.
Like the string 'cmp' operator -1 means that CARD2 beats CARD1, 1
means that CARD1 beats CARD2 and 0 means that they are equivalent
(i.e. both worthless!).

=cut

sub cmpCards {
   my $self = shift;
   my @cards = (shift, shift);

   my $leadcard = ($self->getCards())[0];
   my $leadsuit = $self->getGame()->getCardSuit($leadcard);
   my $trumpsuit = $self->getGame()->{trump};
   my $othertrumpsuit = $self->getGame()->{othertrump};
   # This is valid for NT too, since the "JN" for trump is never referenced
   my %ranks = (
                "A$leadsuit"  => 6,
                "K$leadsuit"  => 5,
                "Q$leadsuit"  => 4,
                "J$leadsuit"  => 3,
                "10$leadsuit" => 2,
                "9$leadsuit"  => 1,

                # Order matters:
                # trump has to be after lead in case lead IS trump
                # or if lead suit holds left jack
                "J$trumpsuit"  => 13,
                "J$othertrumpsuit"  => 12,
                "A$trumpsuit"  => 11,
                "K$trumpsuit"  => 10,
                "Q$trumpsuit"  => 9,
                "10$trumpsuit" => 8,
                "9$trumpsuit"  => 7,
                );

   my @cardranks = map {$ranks{$_->truename()} || 0} @cards;
   #print "cmp " . join(" vs. ", map{$cards[$_]->truename()." $cardranks[$_]"} 0,1) . "\n"
   #    if ($self->getGame()->{debug});
   return $cardranks[0] <=> $cardranks[1];
}

=item play

Calls the playCard() method for the player whose turn it is to play.

=cut

sub play {
   my $self = shift;
   my $player = $self->{players}->[$self->{play}++];
   $player->playCard($self);
   return $self;
}

=item isLegalPlay PLAYER CHOICE

Returns a boolean indicating whether the selected card to play is
legal, given the specified player's hand.  CHOICE is a 0-based index
into the array of cards held by the player's hand.

Checks if the choice is an actual card in the player's hand and
whether the card follows suit.

=cut

sub isLegalPlay {
   my $self = shift;
   my $player = shift;
   my $choice = shift; # 0-based

   my @cards = $player->getCards();

   # Enforce valid choice values
   return undef unless (defined $choice && $choice =~ /^\d$/ &&
                        $choice >= 0 && $choice < @cards);
   my $card = $cards[$choice];
   return undef if (!$card);

   # Is it the first card led?
   my $leadcard = ($self->getCards())[0];
   return $self if (!$leadcard);  # lead card can be anything

   # Is it following suit?
   my $cardsuit = $self->getGame()->getCardSuit($card);
   my $leadsuit = $self->getGame()->getCardSuit($leadcard);
   return $self if ($cardsuit eq $leadsuit);

   # Is the player out of the lead suit?
   my $hasLeadSuit = undef;
   foreach my $card (@cards) {
      my $cardsuit = $self->getGame()->getCardSuit($card);
      if ($cardsuit eq $leadsuit) {
         $hasLeadSuit = $self;
         last;
      }
   }
   return !$hasLeadSuit;
}

1;
__END__