euchre-live

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

Game.pm (7643B) [raw]


      1 # Euchre::Game -- the Game object
      2 # Knows NOTHING about players, simply modifies game state based on seat num and
      3 # actions (leaves it up to Table to coordinate between who can play when).
      4 use strict;
      5 use warnings;
      6 
      7 package Euchre::Game;
      8 
      9 use List::Util qw(sum);
     10 use Mojo::IOLoop;
     11 
     12 use Euchre::Errors;
     13 use Euchre::Rules;
     14 
     15 use Class::Tiny qw(trump out_player turn dealer caller pass_count led trump_nominee), {
     16     phase      => 'lobby',
     17     hands      => sub { [[],[],[],[]] },
     18     tricks     => sub { [0, 0, 0, 0] },
     19     table      => sub { [undef, undef, undef, undef] },
     20     score      => sub { $ENV{END_DEBUG} ? [9, 9] : [0, 0] },
     21 };
     22 
     23 sub BUILD {
     24     # Access some of the fields so that they are present in game_state from
     25     # the get-go (not waiting for lazy creation)
     26     my ($self) = @_;
     27     $self->$_ for qw(phase hands tricks table score);
     28 }
     29 
     30 sub next_turn {
     31     my ($self) = @_;
     32 
     33     my $turn = ($self->turn + 1) % 4;
     34     if ($turn == $self->out_player) {
     35         # It's a loner! Only gonna be one of these...
     36         $turn = ($turn + 1) % 4;
     37     }
     38     $self->turn($turn);
     39 }
     40 
     41 sub reset_turn {
     42     my ($self) = @_;
     43     $self->turn($self->dealer);
     44     $self->next_turn();
     45 }
     46 
     47 sub start_new_round {
     48     my ($self) = @_;
     49 
     50     # Shift dealer and deal
     51     $self->dealer(($self->dealer + 1) % 4);
     52     $self->trump(undef);
     53     $self->tricks([0,0,0,0]);
     54     $self->out_player(-1);
     55     $self->deal_hands();
     56 
     57     # Signal vote of player next to dealer...
     58     $self->reset_turn();
     59     $self->phase('vote');
     60     $self->pass_count(0);
     61 }
     62 
     63 sub deal_hands {
     64     my ($self) = @_;
     65 
     66     my ($handsA, $kiddeyA) = deal();
     67     $self->trump_nominee(shift @$kiddeyA);
     68     $self->hands($handsA);
     69     $self->sort_hands();
     70 }
     71 
     72 # We only need this when trump suit voted, not every broadcast
     73 sub sort_hands {
     74     my ($self) = @_;
     75 
     76     my $t = $self->trump;
     77     for (my $i = 0; $i < 4; $i++) {
     78         my $hand = $self->hands->[$i];
     79         my @sorted = sort { card_value($a, $t) <=> card_value($b, $t) } @{$hand};
     80         $self->hands->[$i] = \@sorted;
     81     }
     82 }
     83 
     84 
     85 sub play_card {
     86     my ($self, $card) = @_;
     87 
     88     # HACK: Return 1 if Table needs to send a second delayed broadcast
     89     # Assume we don't
     90     my $do_update = 0;
     91 
     92     my %colors = (H => 'D', D => 'H', S => 'C', C => 'S');
     93     # Validate they follow suit if they CAN
     94     if (defined $self->led) {
     95         # Build up a list of valid cards
     96         my @followers = map { $_ . $self->led } qw(N T Q K A); # no jack
     97         if ($self->led eq $self->trump) {
     98             # Trump led, both jacks valid
     99             push @followers, "J" . $self->led;
    100             push @followers, "J" . $colors{$self->led};
    101         } elsif ($colors{$self->led} ne $self->trump) {
    102             # Off-color, jack is OK
    103             push @followers, "J" . $self->led;
    104         } else {
    105             # Played same color as trump, don't add jack
    106         }
    107         my $follower_re = join("|", @followers);
    108 
    109         # Now validate that they are EITHER:
    110         #   1) Following Suit
    111         #   2) Can't follow suit
    112         # By checking negative of both
    113         if ($card !~ /$follower_re/ &&
    114             grep { $_ =~ /$follower_re/ } @{$self->curr_hand}) {
    115             return FOLLOW_SUIT;
    116         }
    117     }
    118 
    119     $self->take_card($card) or return DONT_HAVE_CARD;
    120 
    121     # Update the table and current player
    122     $self->add_to_table($card);
    123     $self->next_turn();
    124 
    125 
    126     my $played_cards = scalar grep { defined } @{$self->table};
    127     if ($played_cards == 1) {
    128         # First card!
    129         my ($val, $suit) = split('', $card);
    130 
    131         # Special case Jack of Color == trump
    132         if ($val eq 'J' && $suit eq $colors{$self->trump}) {
    133             $self->led($self->trump);
    134         } else {
    135             $self->led($suit);
    136         }
    137     }
    138 
    139     # Adjust num cards on table by if there's an out player
    140     my $out_adj = ($self->out_player >= 0 ? 1 : 0);
    141     if ($played_cards >= (4 - $out_adj)) {
    142         # End trick -- update tricks, clear table, and set current player
    143         my @table = map { defined($_) ? $_ : 'X' } @{$self->table};
    144         my $winner_id = trick_winner($self->trump, $self->led, @table);
    145 
    146         # Update the gamestate and pause so all can see
    147         $self->tricks->[$winner_id]++;
    148         $self->turn($winner_id);
    149         $self->phase('pause');
    150 
    151         # Sub to call after pause
    152         my $post_pause = sub {};
    153 
    154         my @num_tricks = grep { /^\d+$/ } @{$self->tricks};
    155         if (sum(@num_tricks) >= 5) {
    156             # End round -- update scores, clear tricks, push dealer
    157             my ($team_id, $score) = score_round($self->caller, @{$self->tricks});
    158             $self->score->[$team_id] += $score;
    159 
    160             if ($self->score->[$team_id] >= 10) {
    161                 $post_pause = sub { $self->phase('end') };
    162             } else {
    163                 $post_pause = sub { $self->start_new_round() };
    164             }
    165         }
    166 
    167 
    168         $do_update = 1;
    169         Mojo::IOLoop->timer(1.5 => sub {
    170             $self->table([undef, undef, undef, undef]);
    171             $self->led(undef);
    172             $self->phase('play');
    173 
    174             $post_pause->();
    175         });
    176 
    177     }
    178 
    179     return SUCCESS, $do_update;
    180 }
    181 
    182 sub take_card {
    183     my ($self, $card) = @_;
    184 
    185     my $hand = $self->curr_hand;
    186 
    187     # Make sure they have the card, and update their hand
    188     for (my $i = 0; $i < scalar @{$hand}; $i++) {
    189         if ($hand->[$i] eq $card) {
    190             splice(@{$hand}, $i, 1);
    191             return 1;
    192         }
    193     }
    194 
    195     return 0;
    196 }
    197 
    198 
    199 sub dealer_swap {
    200     my ($self, $card) = @_;
    201 
    202     # Exchange the cards
    203     $self->take_card($card) or return DONT_HAVE_CARD;
    204 
    205     push @{$self->hands->[$self->dealer]}, $self->trump_nominee;
    206     $self->sort_hands();
    207 
    208     # Start the game
    209     $self->phase('play');
    210     $self->reset_turn();
    211 
    212     return SUCCESS;
    213 }
    214 
    215 
    216 sub order {
    217     my ($self, $vote, $loner) = @_;
    218 
    219     if ($vote eq 'pass') {
    220         $self->next_turn();
    221         $self->pass_count($self->pass_count + 1);
    222         if ($self->pass_count >= 8) {
    223             # Throw em in
    224             $self->start_new_round();
    225         } 
    226     } elsif ($vote) {
    227         # Validate its an OK vote
    228         if ($self->pass_count < 4 && $self->trump_nominee !~ /$vote/) {
    229             return VOTE_ON_KITTY;
    230         } elsif ($self->pass_count >=4 && $self->trump_nominee =~ /$vote/) {
    231             return VOTE_OFF_KITTY;
    232         }
    233 
    234         # Accept the vote...
    235         $self->trump($vote);
    236         $self->caller($self->turn);
    237         if ($loner) {
    238             my $partner_seat = ($self->turn + 2) % 4;
    239             $self->out_player($partner_seat);
    240             $self->tricks->[$partner_seat] = 'X';
    241         }
    242         if ($self->pass_count < 4) {
    243             # Setting phase will block all other play actions until the
    244             # dealer is done swapping. Do still broadcast so dealer knows!
    245             # Piggy back on the handle_msg turn validation by temporarily
    246             # setting "turn" to dealer.
    247             $self->phase('dealer_swap');
    248             $self->turn($self->dealer);
    249         } else {
    250             # Get right to it!
    251             $self->phase('play');
    252             $self->reset_turn();
    253         }
    254         $self->sort_hands();
    255     } else {
    256         return BAD_VOTE;
    257     }
    258     return SUCCESS;
    259 }
    260 
    261 sub hand_lengths {
    262     my ($self) = @_;
    263     return [map { scalar @{$_} } @{$self->hands}];
    264 }
    265 
    266 sub curr_hand {
    267     my ($self) = @_;
    268     return $self->hands->[$self->turn];
    269 }
    270 
    271 sub add_to_table {
    272     my ($self, $card) = @_;
    273     $self->table->[$self->turn] = $card;
    274 }
    275 
    276 sub start_game {
    277     my ($self, $start_seat) = @_;
    278 
    279     # One less since start_new_round will rotate
    280     $self->dealer($start_seat - 1);
    281     $self->start_new_round();
    282 
    283     return SUCCESS;
    284 }
    285 
    286 1;