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__ =back =head1 SEE ALSO Games::Euchre =head1 LICENSE GNU Public License, version 2 =head1 AUTHOR Chris Dolan, I =cut