commit 9be2ea6f684e7e002341c2559d55248b00846c6e (patch)
parent 64c119a10f6f2e4c1e3404896827f14da4d5f379
Author: Alex Karle <alex@karle.co>
Date: Sat, 11 Apr 2020 17:22:32 -0400
Euchre::Game: Fix bug with trick_winner and static table
The previous commit made it so that p0 always played in c0 in the table,
which simplified the rotation logic and picking who goes next based on
who won. What I had FORGOTTEN was that trick_winner depends on the first
card in the list being the suit that was led!
The solution here is to start tracking the suit led. This is needed for
trick_winner to function properly; however, it also has the benefit of
making it easier to validate that players are following suit (both for
client and server).
Diffstat:
4 files changed, 44 insertions(+), 13 deletions(-)
diff --git a/lib/Euchre/Card.pm b/lib/Euchre/Card.pm
@@ -6,7 +6,7 @@ package Euchre::Card;
require Exporter;
our @ISA = qw(Exporter);
-our @EXPORT = qw(cid_to_name cname_to_id suit_to_id);
+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);
@@ -47,4 +47,14 @@ 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
@@ -32,6 +32,7 @@ our @EXPORT = qw(
# dealer => 0-3,
# turn => 0-3,
# trump => 0-3,
+# led => 0-3, # suit led
# caller => 0-3,
# table => [ c1, c2, c3, c4 ], # exactly 4, undef if not played
# score => [X, Y],
@@ -330,13 +331,25 @@ sub play_card {
$game->{table}->[$seat] = $msg->{card};
next_turn($game);
- # Adjust num cards on table by if there's an out player
+
my $played_cards = scalar grep { defined } @{$game->{table}};
+ if ($played_cards == 1) {
+ # First card!
+ my ($val, $suit) = split('', $msg->{card});
+ $game->{led} = suit_to_id($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 $winner_id = trick_winner($game->{trump}, @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;
@@ -385,9 +398,16 @@ 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
@@ -31,14 +31,13 @@ sub deal {
}
sub trick_winner {
- my ($trump, @cards) = @_;
+ my ($trump, $led, @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 $led = int($cards[0] / 6);
my @values = @cards;
for (my $i = 0; $i < @values; $i++) {
next if $cards[$i] < 0; # indicates loner
diff --git a/t/Game.t b/t/Game.t
@@ -28,20 +28,22 @@ sub test_deal {
sub test_trick_winner {
my @tests = (
# [Trump, Cards], Winner Idx, Desc
- [['H', 'NH', 'TS', 'AS', 'QS'], 0, 'Trump suit led'],
- [['D', 'JH', 'TS', 'JD', 'QD'], 2, 'Jack trump beats all'],
- [['D', 'NC', 'JH', 'AD', 'AC'], 1, 'Jack color beats all others'],
- [['S', 'NS', 'JH', 'AD', 'JC'], 3, 'Jack color beats all others (2)'],
- [['C', 'NH', 'JH', 'QH', 'AH'], 3, 'No trump, highest of led'],
- [['C', 'NH', 'JH', 'AH'], 2, 'No trump, highest of led, 3 cards'],
+ [['H', 'H', 'NH', 'TS', 'AS', 'QS'], 0, 'Trump suit led'],
+ [['D', 'H', 'JH', 'TS', 'JD', 'QD'], 2, 'Jack trump beats all'],
+ [['D', 'C', 'NC', 'JH', 'AD', 'AC'], 1, 'Jack color beats all others'],
+ [['S', 'S', 'NS', 'JH', 'AD', 'JC'], 3, 'Jack color beats all others (2)'],
+ [['C', 'H', 'NH', 'JH', 'QH', 'AH'], 3, 'No trump, highest of led'],
+ [['C', 'H', 'NH', 'JH', 'AH'], 2, 'No trump, highest of led, 3 cards'],
+ [['C', 'S', 'NH', 'JH', 'AH', 'NS'], 3, 'No trump, suit led wins'],
);
for my $t (@tests) {
# Unpack, transform, test
- my ($trump, @cards) = @{$t->[0]};
+ 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, @cards), $t->[1], $t->[2]);
+ is(trick_winner($trump, $led, @cards), $t->[1], $t->[2]);
}
}
