From 9be2ea6f684e7e002341c2559d55248b00846c6e Mon Sep 17 00:00:00 2001 From: Alex Karle Date: Sat, 11 Apr 2020 17:22:32 -0400 Subject: [PATCH] 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). --- lib/Euchre/Card.pm | 12 +++++++++++- lib/Euchre/Dealer.pm | 24 ++++++++++++++++++++++-- lib/Euchre/Game.pm | 3 +-- t/Game.t | 18 ++++++++++-------- 4 files changed, 44 insertions(+), 13 deletions(-) diff --git a/lib/Euchre/Card.pm b/lib/Euchre/Card.pm index 8763e2d..61ed4e4 100644 --- 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 index d87dd71..32f993f 100644 --- 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 index ff17ce1..81ce09b 100644 --- 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 index 3243822..a0602e8 100644 --- 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]); } } -- libgit2 1.1.1