Deadlands/HOE Character Card Draw

This gadget was designed to speed up the drawing and referencing of cards during character creation. The draw routine sorts the 12 cards drawn in order of highest average roll to lowest, followed by lowest botch percentage to highest and provides the trait and coordination for each card drawn.

Other Deadlands/HOE Gadgets

• Deadlands/HOE Die Roller

Sample Code

The following Perl module can be used to simulate a Deadlands card deck and was used in the Card Draw gadget.

The module has two attributes and five methods:

• Attribute deck_wrap: This attribute enables you to have a deck which continually re-cycles itself (i.e. it puts the drawn card back on the bottom of the deck.) Default is 1 for wrapping.
• Attribute shuffle_times: This attribute controls how many times the deck is shuffled when the shuffle method is called. Default is 50 times.
• Method new: This method is the class constructor, and is called as:
  

  $deck       = DL_Deck -> new(deck_wrap     => 0,
                               shuffle_times => 25);
  

• Method shuffle: Shuffles the deck.
  

  $deck -> shuffle();
  

• Method draw_card: Draws a card from the top of the deck. Cards are defined as the suite (C, S, H, D) and the face (A, 2, 3, 4, 5, 6, 7, 9, J, K, Q). Jokers are defined as either RC or BC (red or black clown).
  

  $card = $deck -> draw_card();
  

• Method get_coord: Returns the die coordination for a specific card, in case of jokers the coordination is a random number 1-4.
  

  $coord = $deck -> get_coord($card);
  

• Method get_trait: Returns the die trait for a specific card.
  

  $trait = $deck -> get_trait($card);
  

• Method card_name: Translates the card code into a common name for the card. (i.e. CA becomes "Ace of Clubs".)
  

  $name = $deck -> card_name($card);
  

package DL_Deck;

$VERSION = 1.00;

use strict;

BEGIN { 
   $SIG{__WARN__} = sub { warn @_ unless $_[0] =~ /Use of uninitialized value/ }; 
}

{
    my %_attributes = (
                       deck_wrap     => [1,  'r' ], 
                       shuffle_times => [50, 'rw'],
                       );

    sub _accessible     { $_attributes{$_[1]}[1] =~ m/$_[2]/; }
    sub _default_value  { $_attributes{$_[1]}[0]; }
    sub _attribute_keys { keys %_attributes; }
}

my @_deck   = ();
my $_draw   = 0;
my $_bottom = 0;

# Constructor Method.

sub new {
    my ($class, %arg) = @_;
    my $self = bless {}, $class;
    foreach my $attr ($self->_attribute_keys()) { 
       (exists $arg{$attr})?($self->{$attr} = $arg{$attr}):($self->{$attr} = $self->_default_value($attr)); 
    }
    my $card  = 2;
    $_deck[0] = 'RC';
    $_deck[1] = 'BC';
    foreach my $suite (qw(C D H S)) {
        foreach my $face (qw(A 2 3 4 5 6 7 8 9 J Q K)) {
            $_deck[$card++] = $suite . $face;;
        }
    }
    $_bottom = $card;
    return $self;
}

# Attribute Accessor Methods

sub get_attr { $_[0]->{$_[1]}; }
sub set_attr { ($_[0]->_accessible($_[1], 'w'))?($_[0]->{$_[1]} = $_[2]):(undef); }

# Deck Methods

sub shuffle {
    for (my $iter = 1; $iter <= $_[0]->get_attr('shuffle_times'); $iter++) {
        for (my $i = @_deck; --$i; ) {
            my $j = int(rand($i+1));
            if ($i == $j) { next; }
            @_deck[$i,$j] = @_deck[$j,$i];
        }
    }
    1;
}

sub draw_card { 
    if ($_[0]->get_attr('wrap_deck')) { $_deck[$_bottom++] = $_deck[$_draw]; }  
    return $_deck[$_draw++];
}

sub get_coord {
    if    ($_[1] =~ m/^C/) { return 1; }
    elsif ($_[1] =~ m/^D/) { return 2; }
    elsif ($_[1] =~ m/^H/) { return 3; }
    elsif ($_[1] =~ m/^S/) { return 4; }
    else                   { return(int(rand(4)+1)); }
}

sub get_trait {
    if    ($_[1] =~ m/2$/)     { return 4;  }
    elsif ($_[1] =~ m/(A|C)$/) { return 12; }
    elsif ($_[1] =~ m/(9|J)$/) { return 8;  }
    elsif ($_[1] =~ m/(Q|K)$/) { return 10; }
    else                       { return 6;  }
}

sub card_name {
    my %face  = ('A' => 'Ace',   '5' => 'Five',  '9' => 'Nine',
                 '2' => 'Deuce', '6' => 'Six',   'J' => 'Jack',
                 '3' => 'Three', '7' => 'Seven', 'Q' => 'Queen',
                 '4' => 'Four',  '8' => 'Eight', 'K' => 'King');
    my %suite = ('C' => 'of Clubs',  
                 'D' => 'of Diamonds',
                 'H' => 'of Hearts',
                 'S' => 'of Spades');
    if    ($_[1] eq 'RC') { return 'Red Joker'; }
    elsif ($_[1] eq 'BC') { return 'Black Joker'; }
    else                  {
        my $temp = $_[1];
        $temp =~ s/^(.)(.)$/$face{$2} $suite{$1}/;
        return $temp;
    } 
}

1;