From 7d005c9883f0da11746f6307d2e82a82ad4235da Mon Sep 17 00:00:00 2001 From: Alex Karle Date: Sat, 11 Apr 2020 17:54:55 -0400 Subject: [PATCH] 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. --- Makefile | 1 - lib/Euchre/Card.pm | 60 ------------------------------------------------------------ lib/Euchre/Dealer.pm | 34 ++++++++-------------------------- lib/Euchre/Game.pm | 44 ++++++++++++++++++++++++++++++++++++++------ t/Card.t | 27 --------------------------- t/Game.t | 18 +++++++++++------- 6 files changed, 57 insertions(+), 127 deletions(-) delete mode 100644 lib/Euchre/Card.pm delete mode 100644 t/Card.t diff --git a/Makefile b/Makefile index c9e6064..e7ccf96 100644 --- 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 deleted file mode 100644 index 61ed4e4..0000000 --- a/lib/Euchre/Card.pm +++ /dev/null @@ -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 index 32f993f..f47cd1c 100644 --- 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 index 81ce09b..521f168 100644 --- 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 deleted file mode 100644 index 111c67d..0000000 --- a/t/Card.t +++ /dev/null @@ -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 index a0602e8..8458c94 100644 --- 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]); } -- libgit2 1.1.1