Playing Cards

package Cards; # Cards.pm # copyright (C) 2003 Daniel Allen (da@coder.com) # This library is free software; you can redistribute it and/or # modify it under the same terms as Perl itself. use strict; use warnings; use Carp; my @valid_suits = qw(S H C D); my @valid_names = ((2 .. 10), qw(A K Q J)); my @valid_faces = qw(front back); my %htmlEntity = ( S => '♠', H => '♥', C => '♣', D => '♦' ); my %pips; { local $/ = ""; chomp (my @pips = ); foreach (@valid_names) { $pips{$_} = shift @pips; } } sub new { my ($class, %arg) = @_; $arg{name} ||= ""; $arg{suit} ||= ""; croak "$arg{suit} is a bad suit" unless (grep /$arg{suit}/, @valid_suits); croak "$arg{name} is a bad name" unless (grep /$arg{name}/, @valid_names); $arg{style} = "" unless ($arg{style}); $arg{face} = "front" unless ($arg{face}); my $self = { _suit => $arg{suit}, _name => $arg{name}, _face => $arg{face}, _style => $arg{style} }; bless $self => $class; return $self; } sub suit { $_[0]->{_suit}} sub name { $_[0]->{_name}} sub face { $_[0]->{_face}} sub style { $_[0]->{_style}} sub set_suit { my ($self, $suit) = @_; $self->{_suit} = $suit; croak "$suit is a bad suit" unless (grep /$suit/, @valid_suits); } sub set_name { my ($self, $name) = @_; $self->{_name} = $name; croak "$name is a bad name" unless (grep /$name/, @valid_names); } sub set_face { my ($self, $face) = @_; $self->{_face} = $face; croak "$face is a bad face" unless (grep /$face/, @valid_faces); } sub set_style { my ($self, $style) = @_; $self->{_style} = $style; } sub print { my $self = shift; my ($suit, $name, $face, $style) = ($self->suit, $self->name, $self->face, $self->style); # if face is "back", we only care about the style parameter. # print card and return. if ($face eq "back") { print qq{

}; return; } # validate, determine color and card-body, print, and return. unless ($suit and $name) { carp ("suit $suit and/or name $name don't exist."); return; } my $color = ""; $color = " red" if ($suit =~ /[HD]/); my $body = $pips{$name}; $body =~ s/SUIT/$htmlEntity{$suit}/g; print qq{

$body

}; } sub PrintHeader { return qq{ Playing Cards

} # end of included text } # end of method sub PrintFooter { return "

"; } =head1 NAME Cards - build representations of playing cards using HTML CSS =head1 SYNOPSIS use Cards; print Cards::PrintHeader; my $c = Cards->new( suit=>'H', name=>'Q' ) $c->set_face("back"); $c->set_suit("D"); $c->set_style("left:15em;top:0em;") $c->print; print Cards::PrintFooter; =head1 DESCRIPTION This module provides an object that represents playing cards, which are defined according to their suit, name, face, and a CSS style. The CSS style can be used to set the position of the card on a DIV region of a HTML page. The output HTML relies upon finding graphics files in a relative subdirectory named 'graphics'. =head1 METHODS =head2 Cards->new( attribute => value, ... ) Create a new object. Named arguments will be passed for initialization of the attributes. =head2 $c->set_suit( value ) Valid values are: ("S", "H", "C", "D") for Spade, Heart, Diamond, Club. =head2 $c->set_name( value ) Valid values are: ("A", 2-10, "J", "Q", "K") for Ace, 2-10, Jack, Queen, King. =head2 $c->set_face( value ) Valid values are: "front" or "back". Default is "front". =head2 $c->set_style( value ) Any value is valid and is turned into CSS; A typical useful value might be for a left-position of 4 em, a top-position of 0 em: =over 4 left:4em;top:0em; =back 4 =head2 $c->suit Return the suit. =head2 $c->name Return the card name. =head2 $c->face Return the face. =head2 $c->style Return the style. =head2 Cards::PrintHeader Return a proper HTML including CSS for the playing card elements, and the opening tag for a , including an absolute

to provide a top and left margin. Depends on finding a relative subdir called 'graphics' containing 'back.gif' =head2 $c->print Print the card CSS to the standard output. As a sample, the output for a 3 of Spades located at a left-position of 4 em and a top-position of 0 em: =over 4

3
♠

♠

=back 4 =head2 Cards::PrintFooter Return a proper closing for the including a closing

. =head1 NOTES Feel free to replace the PrintHeader to use your own CSS data: =over 4 package Cards; sub PrintHeader { return "your own header data" } =back 4 =head1 BUGS None known. =head1 TODO Integrate this into the Games::Cards namespace? Move the definitions for cards from the __DATA__ section to someplace more intuitive? Move the CSS definitions to a style-sheet file of its own? =head1 COPYRIGHT Copyright (c) 2003 Daniel Allen =head1 SEE ALSO L, L =cut 1; __DATA__

2
SUIT

SUIT

3
SUIT

SUIT

4
SUIT

SUIT

5
SUIT

SUIT

6
SUIT

SUIT

7
SUIT

SUIT

8
SUIT

SUIT

9
SUIT

SUIT

10
SUIT

SUIT

A
SUIT

SUIT

K
SUIT

SUIT

Q
SUIT

SUIT

J
SUIT

SUIT