I've been creating classes relating to playing cards using the new Moxie module for the Perl programming language. The objective is to implement the card game Go Fish! as specified at Rosetta Code.
The Outside-In View
An actual program file should be simple; all the real code should be in testable modules. In this case, play_go_fish.pl takes this to an extreme.
#!/usr/bin/env perl
use warnings;
use strict;
use 5.026;
use lib '.';
use Game;
Game->new()->play();
As of Perl 5.26, the current directory is not automatically part of @INC, the search path for modules, so it is necessary to include it manually. That makes it possible to load the Game module, to instantiate an instance, and play a game.
package Game;
use Moxie;
use lib '.';
use Deck;
use Computer;
use Human;
use Const::Fast;
extends 'Moxie::Object';
const my @PLAYERS => qw( human computer );
const my $INITIAL_DEAL_COUNT => 9;
A Game.pm object begins like most other modules. We define a constant to specify the players; this will be useful in several places. The two players should take turns dealing, which affects who receives the first card, who gets the first chance to hunt for a card, but that's too much like work. I've settled for a fixed order.
has _deck => sub { Deck->new() };
sub deck : rw(_deck);
sub deal : handles(_deck->deal);
sub init : handles(_deck->init);
sub has_cards : handles(_deck->has_cards);
sub shuffle : handles(_deck->shuffle);
has _players => sub {
my $players = {
human => Human->new(),
computer => Computer->new() };
$players->{human}->name('human');
$players->{human}->opponent( $players->{'computer'} );
$players->{computer}->name('computer');
$players->{computer}->opponent( $players->{'human'} );
return $players;
};
sub players : ro(_players);
A game involves a deck of cards and two players, the human and the computer. Spoiler alert - the two players share much functionality, so they will be subclasses of a Player.pm base class.
The player objects are stored in a plain hash. Each player knows its name and has a reference to the opponent object. That makes it possible to ask the opponent for a rank of card, or to surrender cards if the opponent's guess matches cards in the player's hand.
# ......................................................................
#
sub deal_hands ($self) {
for my $Nth ( 1 .. $INITIAL_DEAL_COUNT ) {
for my $player (@PLAYERS) {
$self->players()->{$player}->add_card( $self->deal() );
}
}
$self->players()->{$_}->sort() for @PLAYERS;
return;
}
At the start of the game we deal out the initial hands, taking turns delivering a card to each player until they each have nine cards. The Hoyle web site disagrees with Rosetta Code, saying they should only get five cards, but it doesn't make much difference. When the cards are dealt, each hand is sorted by increasing rank.
# ......................................................................
# return TRUE-ish if game over, FALSE-ish if still playing.
#
sub find_winner ($self) {
# not over while either player has cards.
#
for my $player ( keys $self->players->%* ) {
return if $self->players->{$player}->has_cards;
}
my ( $hbooks, $cbooks ) =
( scalar $self->players()->{human}->books()->@*,
scalar $self->players()->{computer}->books()->@*,
);
return ( $hbooks > $cbooks ? 'human'
: $cbooks > scalar $hbooks ? 'computer'
: q{It's a tie!}
);
}
The game ends when the deck is empty and each player has run out of cards. So if either player has cards in their hand, we can return early. If they are both out of cards, then we compare the number of books - sets of all four cards of a rank - held by each player. The player with most books is the winner.
# ......................................................................
#
sub play ($self) {
$self->init;
$self->shuffle() unless $ENV{TESTING_ARTIFICIAL_GAME};
$self->deal_hands();
my $winner; # Can't win until deck used up
TURN:
while ( !$winner ) {
PLAY:
for my $player (@PLAYERS) {
if ( $ENV{TESTING_ARTIFICIAL_GAME} && $ENV{DEBUGGING} ) {
print "${player}'s hand: ";
$self->players->{$player}->print;
}
$self->players->{$player}->take_turn( $self->deck );
last PLAY unless $self->has_cards;
}
$winner = $self->find_winner();
}
for my $player (@PLAYERS) {
my $books = $self->players->{$player}->books;
say "$player has books: $books->@*.";
}
if ( -1 < index( $winner, 'tie' ) ) {
say "Game over! $winner"; # It's a tie!
}
else {
say "Game over! $winner wins!" # No tie, there's a winner.
}
} ## end sub play ($self)
1;
The first step is to install cards in the deck, and then to shuffle the cards. In the tests I re-define init() to install a predetermined set of cards, to verify the correct result is achieved. So in that case I don't want the deck shuffled; an environment variable handles that.
Then the hands can be dealt out.
Until someone wins, the players take turns. During debugging, I needed to monitor what cards were in each player's hand. Since it only takes effect when a couple of environment variables are defined, I let the code remain. The important part is that the player takes a turn, with control of the deck. Details of taking a turn are implemented in the Player, Computer & Human modules.
When a player runs out of cards after the deck is empty, the opponent must have just surrendered some cards, leading to an empty hand. After all, if a player had some cards but not a full book, there is nowhere for the matching cards to be. The opponent and the deck are both empty.
At the end, the books held by each player are listed, and the winner - or a tie game - is declared.
Comments