commit 7d005c9883f0da11746f6307d2e82a82ad4235da (patch)
parent 9be2ea6f684e7e002341c2559d55248b00846c6e
Author: Alex Karle <alex@karle.co>
Date: Sat, 11 Apr 2020 17:54:55 -0400
lib/Euchre: [refactor] Change API to use char-style card/suits
Previously, the Euchre::Game subs all took int-style cards (i.e. suit
0-3 and card 0-23).
This was done before any work on the server, and it was fun to come up
with a minimal mathematical way to play the game.
In reality, this caused a lot of pain translating the cards between the
client websockets and server. Rather than put the onus on the server to
translate in communication with clients, the Game functions now need to
do the translation if they need the numeric value, and the Dealer never
knows what value the cards have (integer wise).
The Dealer deals with game state that now has human readable card and
trump values, and the Game logic handles the values if needed.
Tests have been updated accordingly. RIP Euchre::Card, you were too
complex.
Diffstat:
6 files changed, 57 insertions(+), 127 deletions(-)
diff --git a/Makefile b/Makefile
@@ -8,5 +8,4 @@ tags:
.PHONY: test
test:
perl -c gloat.pl
- perl t/Card.t
perl t/Game.t
diff --git a/lib/Euchre/Card.pm b/lib/Euchre/Card.pm
@@ -1,60 +0,0 @@
-# Euchre::Card -- Conversion routines for Cards
-use strict;
-use warnings;
-
-package Euchre::Card;
-
-require Exporter;
-our @ISA = qw(Exporter);
-our @EXPORT = qw(cid_to_name cname_to_id suit_to_id id_to_suit);
-
-our @SUITS = qw(H D S C);
-our @CARDS = qw(N T J Q K A);
-
-# Put the indices of the above in a hash for ~speed~
-our %SUIT_IDS = (
- H => 0,
- D => 1,
- S => 2,
- C => 3,
-);
-
-our %CARD_IDS = (
- N => 0,
- T => 1,
- J => 2,
- Q => 3,
- K => 4,
- A => 5,
-);
-
-sub cid_to_name {
- my $card_id = shift;
-
- my $suit = $SUITS[int($card_id / 6)];
- my $val = $CARDS[$card_id % 6];
-
- return "$val$suit";
-}
-
-sub cname_to_id {
- my $card_name = shift;
- my ($val, $suit) = split('', $card_name);
- return (6 * $SUIT_IDS{$suit}) + $CARD_IDS{$val};
-}
-
-sub suit_to_id {
- return $SUIT_IDS{$_[0]};
-}
-
-sub id_to_suit {
- my ($id) = @_;
- for my $k (keys %SUIT_IDS) {
- if ($SUIT_IDS{$k} == $id) {
- return $k;
- }
- }
- die "assert: bad suit";
-}
-
-1;
diff --git a/lib/Euchre/Dealer.pm b/lib/Euchre/Dealer.pm
@@ -6,7 +6,6 @@ package Euchre::Dealer;
use List::Util qw(sum);
-use Euchre::Card;
use Euchre::Game;
require Exporter;
@@ -31,13 +30,13 @@ our @EXPORT = qw(
# tricks => [ p1, p2, p3, p4 ], # ints per player
# dealer => 0-3,
# turn => 0-3,
-# trump => 0-3,
-# led => 0-3, # suit led
+# trump => suit,
+# led => suit,
# caller => 0-3,
# table => [ c1, c2, c3, c4 ], # exactly 4, undef if not played
# score => [X, Y],
# phase => 'lobby', 'play', 'vote', 'end'
-# trump_nominee => 0-23,
+# trump_nominee => card,
# pass_count => 0-7,
# out_player => -1-3, -1 if none, else idx of "out player"
# }
@@ -267,8 +266,7 @@ sub deal_players_hands {
my ($handsA, $kiddeyA) = deal();
$game->{trump_nominee} = shift @$kiddeyA;
for my $p (@{$game->{players}}) {
- my @hand = map { cid_to_name($_) } @{shift @$handsA};
- $p->{hand} = \@hand;
+ $p->{hand} = shift @$handsA;
}
}
@@ -288,9 +286,9 @@ sub order {
} else {
broadcast_gamestate($game);
}
- } elsif (defined suit_to_id($msg->{vote})) {
+ } elsif ($msg->{vote}) {
# TODO: add hand/suit validation?
- $game->{trump} = suit_to_id($msg->{vote});
+ $game->{trump} = $msg->{vote};
$game->{caller} = $p->{seat};
$game->{phase} = 'play';
if ($msg->{loner}) {
@@ -336,20 +334,15 @@ sub play_card {
if ($played_cards == 1) {
# First card!
my ($val, $suit) = split('', $msg->{card});
- $game->{led} = suit_to_id($suit);
+ $game->{led} = $suit;
}
# Adjust num cards on table by if there's an out player
my $out_adj = ($game->{out_player} >= 0 ? 1 : 0);
if ($played_cards >= (4 - $out_adj)) {
# End trick -- update tricks, clear table, and set current player
- my @table = map { defined($_) ? cname_to_id($_) : -1 } @{$game->{table}};
+ my @table = map { defined($_) ? $_ : 'X' } @{$game->{table}};
my $winner_id = trick_winner($game->{trump}, $game->{led}, @table);
- use Data::Dumper; print Dumper($game->{table});
- print Dumper($game->{trump});
- print Dumper($game->{led});
- print $winner_id;
-
$game->{tricks}->[$winner_id]++;
$game->{turn} = $winner_id;
@@ -398,17 +391,6 @@ sub broadcast_gamestate {
spectators => \@snames,
};
- # XXX: this is getting out of hand -- just store them as chars already!
- if (exists $game->{trump_nominee}) {
- $msg->{trump_nominee} = cid_to_name($game->{trump_nominee});
- }
- if (exists $game->{trump} && $game->{trump} >= 0) {
- $msg->{trump} = id_to_suit($game->{trump});
- }
- if (exists $game->{led} && $game->{led} >= 0) {
- $msg->{led} = id_to_suit($game->{led});
- }
-
for my $p (@{$game->{players}}, @{$game->{spectators}}) {
next unless defined $p;
diff --git a/lib/Euchre/Game.pm b/lib/Euchre/Game.pm
@@ -14,11 +14,30 @@ our @EXPORT = qw(
score_round
);
-use Euchre::Card;
use List::Util qw(shuffle);
+# Numeric values for trick_winner
+our %SUIT_VALS = (H => 0, D => 1, S => 2, C => 3);
+our %CARD_VALS = (N => 0, T => 1, J => 2, Q => 3, K => 4, A => 5);
+
+our @FULL_DECK = qw(
+ NH TH JH QH KH AH
+ ND TD JD QD KD AD
+ NS TS JS QS KS AS
+ NC TC JC QC KC AC
+);
+
+sub card_value {
+ my ($c) = @_;
+ if ($c eq 'X') {
+ return -1;
+ }
+ my ($val, $suit) = split('', $c);
+ return (6 * $SUIT_VALS{$suit} + $CARD_VALS{$val});
+}
+
sub deal {
- my @cards = shuffle (0 .. 23);
+ my @cards = shuffle @FULL_DECK;
my @hands;
for (my $i = 0; $i < 4; $i++) {
@@ -26,24 +45,37 @@ sub deal {
}
my @kiddey = @cards[20 .. 23];
-
return \@hands, \@kiddey;
}
+# This is the only sub left that uses the original numeric
+# approach to tracking cards, due to the convenience of
+# sorting by a numeric value. To provide a consistent interace,
+# it takes in the character representations, but immediately
+# "lowers" them to the integer counterparts
+#
+# 0 1 2 3 4 5
+# Suits: H D S C
+# Cards: N T J Q K A
+#
+# A card of 'X' denotes a loner
sub trick_winner {
my ($trump, $led, @cards) = @_;
+ $trump = $SUIT_VALS{$trump};
+ $led = $SUIT_VALS{$led};
+ my @values = map { card_value($_) } @cards;
+
# Assign each card a value based on trump + led, either
# Bower: card + 50
# Trump: card + 25 (including Bower)
# Suit Led: card
# Other: 0
- my @values = @cards;
for (my $i = 0; $i < @values; $i++) {
- next if $cards[$i] < 0; # indicates loner
+ next if $values[$i] < 0; # indicates loner
# Identify the card
- my $c = $cards[$i];
+ my $c = $values[$i];
my $suit = int($c / 6);
my $is_jack = ($c % 6 == 2);
my $is_tcolor = (int($suit / 2) == int($trump / 2));
diff --git a/t/Card.t b/t/Card.t
@@ -1,27 +0,0 @@
-#!/usr/bin/env perl
-# Card.t -- tests for Euchre::Card
-use strict;
-use warnings;
-
-use FindBin;
-use lib "$FindBin::Bin/../lib";
-
-use Euchre::Card;
-use Test::More;
-
-is(cname_to_id('AH'), 5, 'AH -> 5');
-is(cname_to_id('AD'), 11, 'AD -> 11');
-is(cname_to_id('NH'), 0, 'NH -> 0');
-is(cname_to_id('TS'), 13, 'TS -> 13');
-
-is(cid_to_name(5), 'AH', '5 -> AH');
-is(cid_to_name(11), 'AD', '11 -> AD');
-is(cid_to_name(0), 'NH', '0 -> NH');
-is(cid_to_name(13), 'TS', '13 -> TS');
-
-is(suit_to_id('H'), 0, 'Hearts suit to ID');
-is(suit_to_id('D'), 1, 'Diamonds suit to ID');
-is(suit_to_id('S'), 2, 'Spades suit to ID');
-
-
-done_testing();
diff --git a/t/Game.t b/t/Game.t
@@ -7,7 +7,6 @@ use FindBin;
use lib "$FindBin::Bin/../lib";
use Euchre::Game;
-use Euchre::Card;
use List::Util;
use Test::More;
@@ -20,8 +19,17 @@ sub test_deal {
push @cards, @{$_} for @{$handsA};
is(scalar @cards, 20, '20 cards dealt to hands');
- my @deck = sort { $a <=> $b } (@cards, @{$kiddey});
- is_deeply(\@deck, [0 .. 23], 'All 24 cards unique');
+ my @all_suits = qw(H D S C);
+ my @all_cards = qw(N T J Q K A);
+ my @full_deck;
+ for my $c (@all_cards) {
+ for my $s (@all_suits) {
+ push @full_deck, "$c$s";
+ }
+ }
+
+ my @dealt = sort(@cards, @{$kiddey});
+ is_deeply(\@dealt, [sort @full_deck], 'All 24 cards dealt');
}
@@ -38,11 +46,7 @@ sub test_trick_winner {
);
for my $t (@tests) {
- # Unpack, transform, test
my ($trump, $led, @cards) = @{$t->[0]};
- $trump = suit_to_id($trump);
- $led = suit_to_id($led);
- @cards = map { cname_to_id($_) } @cards;
is(trick_winner($trump, $led, @cards), $t->[1], $t->[2]);
}
