euchre-live

Euchre web-app for the socially distant family
git clone git://git.alexkarle.com/euchre-live.git
Log | Files | Refs | README | LICENSE

commit 41d77f292fd149615afdac2bce410a937db4f6d4 (patch)
parent 8e31a0593451211450cd2276cb6a445d0d0acb33
Author: Alex Karle <alex@karle.co>
Date:   Mon, 23 Mar 2020 00:10:07 -0400

Implement first pass at core game logic

This commit steps away from the webserver stuff and just focuses on the
core game logic. I've detailed in NOTES my thoughts on how the game
plays out. In particular, my first instinct was to reach to OOP to
create objects of cards, people, teams, games, etc. But I wanted to push
myself to try to create a super-minimal number based game (after all,
math is fun!).

One can deduce the value and suit of a card just from the value 0..23,
which opens nice doors into how to determine the winner of a trick (just
use the card value!).

I _believe_ the game state is simple enough to be held in a primitive
structure with "globals", and without the need for objects. I reserve
the right to double back and rewrite this in Moo though :)

Set up some basic testing to ensure the math is all correct.

Diffstat:
AMakefile | 3+++
ANOTES | 49+++++++++++++++++++++++++++++++++++++++++++++++++
Acli.pl | 24++++++++++++++++++++++++
Mgloat.pl | 2+-
Alib/Euchre/Card.pm | 50++++++++++++++++++++++++++++++++++++++++++++++++++
Mlib/Euchre/Game.pm | 104++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++---
At/Card.t | 27+++++++++++++++++++++++++++
At/Game.t | 68++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
8 files changed, 323 insertions(+), 4 deletions(-)

diff --git a/Makefile b/Makefile @@ -0,0 +1,3 @@ +test: + perl t/Card.t + perl t/Game.t diff --git a/NOTES b/NOTES @@ -0,0 +1,49 @@ +NOTES +===== + +Just some implementation details / thoughts. + + +In an OOP world... +------------------ + +Game has + Teams has + score + Players have + is_dealer + will_start + tricks_won + Hand has + Cards has + id + name + +In a functional world... +------------------------ +Key: cards are just ints (can derive class/value from int) + +subs: + trick_winner + score_tricks/round + deal_hands + +global state: + leader + dealer_id + calling_team + trump_suit + scores[2] + tricks[4] + +Round: + 1. deal cards + 2. <Vote trump> + 3. leader = 1 + 4. for i 0..5 # play hand + a. <accept input x 4> + b. leader = trick_winner, tricks[$winner]++ + 5. scores += score_round(tricks) + 6. If max(scores) >= 10 -- DONE + +(note: <> means interactive) diff --git a/cli.pl b/cli.pl @@ -0,0 +1,24 @@ +#!/usr/bin/env perl +# cli.pl -- CLI version of the game +# good for testing +use strict; +use warnings; +use FindBin; +use lib "$FindBin::RealBin/lib"; +use Euchre::Game; +use Euchre::Card; + +my ($hands, $kiddey) = deal(); + +my %players = ( + Alex => $hands->[0], + Dad => $hands->[1], + Jennie => $hands->[2], + Mom => $hands->[3], +); + +for my $p (sort keys %players) { + print "$p\t"; + print map { "\t" . cid_to_name($_) } @{$players{$p}}; + print "\n"; +} diff --git a/gloat.pl b/gloat.pl @@ -9,6 +9,6 @@ use lib "$FindBin::RealBin/lib"; use Euchre::Game; -get '/' => { text => play() }; +get '/' => { text => deal() }; app->start; diff --git a/lib/Euchre/Card.pm b/lib/Euchre/Card.pm @@ -0,0 +1,50 @@ +# 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); + +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]}; +} + +1; diff --git a/lib/Euchre/Game.pm b/lib/Euchre/Game.pm @@ -1,4 +1,6 @@ # Euchre::Game -- the Game Logic +# All card interactions are based on ID for ~speed~ +# Leaves it to client to map from 'names' (i.e. AH -> 5) use strict; use warnings; @@ -6,11 +8,107 @@ package Euchre::Game; require Exporter; our @ISA = qw(Exporter); +our @EXPORT = qw( + deal + trick_winner + score_round +); -our @EXPORT = qw(play); +use Euchre::Card; +use List::Util qw(shuffle); -sub play { - return "Let's play some Euchre!"; +sub deal { + my @cards = shuffle (0 .. 23); + + my @hands; + for (my $i = 0; $i < 4; $i++) { + push @{$hands[$i]}, @cards[((5*$i) .. (5*($i+1)-1))]; + } + my @kiddey = @cards[20 .. 23]; + + + return \@hands, \@kiddey; +} + +sub trick_winner { + my ($trump, @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++) { + # Identify the card + my $c = $cards[$i]; + my $suit = int($c / 6); + my $is_jack = ($c % 6 == 2); + my $is_tcolor = (int($suit / 2) == int($trump / 2)); + my $is_bower = ($is_jack && $is_tcolor); + + # Assign it a value + if ($is_bower) { + $values[$i] += 50; + } + if ($suit == $trump) { + $values[$i] += 25; + } elsif ($suit != $led && !$is_bower) { + # throwoff -> set value to zero + $values[$i] = 0; + } else { + # non-trump led card -> use regular value + } + } + + my $winning_ind = -1; + my $winning_val = -1; + for (my $i = 0; $i < @values; $i++) { + if ($values[$i] > $winning_val) { + $winning_ind = $i; + $winning_val = $values[$i]; + } + } + + return $winning_ind; +} + +# Given # tricks per player, who won? What score? +# Use X to indicate sat-out. $callers either 0 or 1 +sub score_round { + my ($callers, @tricks) = @_; + + my $setters = 1 - $callers; + my $loner = 0; + my @totals; + for (my $i = 0; $i < 4; $i++) { + if ($tricks[$i] eq 'X') { + $loner = 1; + } else { + $totals[$i % 2] += $tricks[$i]; + } + } + + my @points = (0, 0); + $DB::single = 1; + if ($totals[$callers] == 5) { + if ($loner) { + # Hot diggity dog! + $points[$callers] = 4; + } else { + # Respectable + $points[$callers] = 2; + } + } elsif($totals[$callers] > $totals[$setters]) { + # Made your point... + $points[$callers] = 1; + } else { + # We've been Euched, Bill! + $points[$setters] = 2; + } + + return \@points; } 1; diff --git a/t/Card.t b/t/Card.t @@ -0,0 +1,27 @@ +#!/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 @@ -0,0 +1,68 @@ +#!/usr/bin/env perl +# Game.t -- tests for Euchre::Game +use strict; +use warnings; + +use FindBin; +use lib "$FindBin::Bin/../lib"; + +use Euchre::Game; +use Euchre::Card; +use List::Util; +use Test::More; + +sub test_deal { + my ($handsA, $kiddey) = deal(); + is(scalar @{$handsA}, 4, '4 hands dealt'); + is(scalar @{$kiddey}, 4, '4 cards in kiddey'); + + my @cards; + 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'); + +} + +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'], + ); + + for my $t (@tests) { + # Unpack, transform, test + my ($trump, @cards) = @{$t->[0]}; + $trump = suit_to_id($trump); + @cards = map { cname_to_id($_) } @cards; + is(trick_winner($trump, @cards), $t->[1], $t->[2]); + } + +} + +sub test_score_round { + my @tests = ( + [[0, 1,2,1,1], [0, 2], 'Euched!'], + [[1, 2,1,1,1], [2, 0], 'Euched again!'], + [[1, 2,3,0,0], [0,1], 'Made your point'], + [[1, 0,3,0,2], [0,2], 'Got em all!'], + [[0, 5,0,'X',0], [4,0], 'Loneeeer!'], + [[0, 3,1,'X',1], [1,0], 'Failed loner'], + ); + + for my $t (@tests) { + is_deeply(score_round(@{$t->[0]}), $t->[1], $t->[2]); + } +} + +test_deal(); +test_trick_winner(); +test_score_round(); + +done_testing();