commit a0f29931afdcfe3c83f28646645565bfde15142f (patch)
parent 03a500e7a37b77d62adc71964a9adb2fb6ee663b
Author: Alex Karle <alex@karle.co>
Date: Sat, 2 May 2020 18:02:05 -0400
refactor: Make Game and Player hashes objects
(spoiler alert!) I'm planning on adding a third major type: Tables, but
before I added another hash in the fray, I figured I should PROBABLY
move them all to bonefide objects.
The perks here are:
1. Can't accidentally create new properties
2. Can move a bunch of the actions that act on hashes to methods
Already I've ironed out a few small bugs from the leniency of hashes.
I don't particularly enjoy object oriented programming, but it just
feels right for this problem.
I chose Class::Tiny as my object framework because (1) it's only a
hundred or so lines of pure perl with no dependencies and (2) I really
don't need the crazy inheritence, encapsulation, and other things that
come with Moose or even Moo.
This commit mostly is the syntax changes to move the hash keys to proper
object attributes (getters and setters). Not many of the subroutines
have become methods yet (only send_error as an example). More on the
latter to come.
Diffstat:
5 files changed, 213 insertions(+), 234 deletions(-)
diff --git a/cpanfile b/cpanfile
@@ -1,2 +1,3 @@
requires 'Mojolicious';
requires 'Mojolicious::Plugin::Webpack';
+requires 'Class::Tiny';
diff --git a/lib/Euchre/Dealer.pm b/lib/Euchre/Dealer.pm
@@ -8,6 +8,8 @@ use Mojo::IOLoop;
use List::Util qw(sum);
use Euchre::Errors;
+use Euchre::Game;
+use Euchre::Player;
use Euchre::Rules;
require Exporter;
@@ -19,56 +21,7 @@ our @EXPORT = qw(
stats
);
-
-
-# XXX: The first draft of this was written quickly and chose
-# to use global hashes over objects. I think globals are eventually
-# necessary, becuase the server needs it all in memory. It's just
-# unfortunate... (or common wisdom tells me so)
-#
-# Nevertheless here's the rough idea:
-#
-# %GAMES -- each game is a hash with
-# {
-# players => [ p1, p2, p3, p4 ], # player objs
-# spectators => [ pa, pb, ... ], # for "lobby" period of picking seat
-# tricks => [ p1, p2, p3, p4 ], # ints per player
-# dealer => 0-3,
-# turn => 0-3,
-# 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 => card,
-# pass_count => 0-7,
-# out_player => -1-3, -1 if none, else idx of "out player"
-# password => string
-# }
-#
-# We decided the players would keep track of their own hands
-# (after the initial deal), which simplifies state
-#
-#
-# %PLAYERS -- all active players (across all games), keyed on client
-# websocket id
-#
-# {
-# id => client id (key in %PLAYERS)
-# game => reference to current game object,
-# name => username,
-# seat => 0-3,
-# ws => websocket obj,
-# hand => cards in hand,
-# active => is connection active,
-# }
-#
-# The players keyed on ws id is key (pun) because the closure in
-# the webserver will always pass the proper client ws id to the
-# handler, allowing us to identify who is playing cards and what
-# game to attribute the action to.
-
+# Global State
our %GAMES;
our %PLAYERS;
@@ -83,7 +36,7 @@ our $START_TIME = localtime(time);
sub register_player {
my ($tx) = @_;
my $id = ''.$tx;
- $PLAYERS{$id} = { id => $id, ws => $tx, active => 1, joined => time };
+ $PLAYERS{$id} = Euchre::Player->new(id => $id, ws => $tx);
print "Player $id has joined the server\n";
$TOTAL_PLAYERS++;
@@ -97,22 +50,22 @@ sub gloaters_never_win {
return;
}
my $p = $PLAYERS{$id};
- my $game = $p->{game};
+ my $game = $p->game;
- $p->{active} = 0;
+ $p->active(0);
if (defined $game) {
# Player was in a game... if no one else is still there,
# we should clean up the game after some inactivity
my $timeout = $ENV{DEBUG} ? 1 : (60 * 30); # 30 mins
Mojo::IOLoop->timer($timeout => sub {
- if (!grep { defined($_) && $_->{active} } @{$game->{players}}) {
- print "Deleting inactive Game $game->{id}\n";
- delete $GAMES{$game->{id}};
+ if (!grep { defined($_) && $_->active } @{$game->players}) {
+ print "Deleting inactive Game $game->id\n";
+ delete $GAMES{$game->id};
}
});
}
- my $name = $p->{name} ? $p->{name} : 'UnnamedPlayer';
+ my $name = $p->name ? $p->name : 'UnnamedPlayer';
print "Player $name went inactive\n";
# Remove reference in %PLAYERS, but NOTE: still referenced in $game
@@ -157,10 +110,10 @@ sub handle_msg {
my $p = $PLAYERS{$cid};
my ($handler, $req_phase, $phase_err, $turn_based) = @{$dispatch{$msg->{action}}};
- if ($req_phase && ($p->{game}->{phase} ne $req_phase)) {
- send_error($p, $phase_err);
- } elsif ($turn_based && ($p->{seat} != $p->{game}->{turn})) {
- send_error($p, PLAY_CARD);
+ if ($req_phase && ($p->game->phase ne $req_phase)) {
+ $p->error($phase_err);
+ } elsif ($turn_based && ($p->seat != $p->game->turn)) {
+ $p->error(TURN);
} else {
$handler->($p, $msg);
}
@@ -168,7 +121,7 @@ sub handle_msg {
sub pong {
my ($p) = @_;
- $p->{ws}->send({ json => { msg_type => 'pong' } });
+ $p->ws->send({ json => { msg_type => 'pong' } });
}
# player_name
@@ -185,53 +138,39 @@ sub join_game {
# init game if needed
if (!exists $GAMES{$id}) {
- $GAMES{$id} = {
- id => $id,
- players => [undef, undef, undef, undef],
- spectators => [],
- turn => -1,
- dealer => -1,
- trump => undef,
- tricks => [0, 0, 0, 0],
- table => [undef, undef, undef, undef],
- caller => -1,
- score => $ENV{END_DEBUG} ? [9,9] :[0, 0],
- phase => 'lobby',
- start_time => time,
- (exists $msg->{password} ? (password => $msg->{password}) : ()),
- };
+ $GAMES{$id} = Euchre::Game->new(id => $id);
$TOTAL_GAMES++;
}
my $game = $GAMES{$id};
# Before adding, verify the password is correct
- if (exists $game->{password} && $game->{password} ne $msg->{password}) {
- send_error($p, BAD_PASS);
+ if ($game->password && $game->password ne $msg->{password}) {
+ $p->error(BAD_PASS);
return;
}
# Make sure name is unique to game
- my @all_names = map { $_->{name} }
+ my @all_names = map { $_->name }
grep { defined }
- (@{$game->{players}}, @{$game->{spectators}});
+ (@{$game->players}, @{$game->spectators});
my $player_exists = grep { $_ eq $msg->{player_name} } @all_names;
if ($player_exists) {
if (!$msg->{force}) {
- send_error($p, UNIQUE_USER);
+ $p->error(UNIQUE_USER);
return;
}
- $p->{name} = $msg->{player_name};
+ $p->name($msg->{player_name});
swap_player($game, $p, 'players') || swap_player($game, $p, 'spectators');
} else {
# Add player object to Game
# All players start as spectators and have to take a seat explicitly
- $p->{name} = $msg->{player_name};
- $p->{hand} = [];
- $p->{game} = $game;
- push @{$game->{spectators}}, $p;
+ $p->name($msg->{player_name});
+ $p->hand([]);
+ $p->game($game);
+ push @{$game->spectators}, $p;
}
broadcast_gamestate($game);
@@ -240,22 +179,22 @@ sub join_game {
sub leave_game {
my ($p) = @_;
- my $game = $p->{game};
+ my $game = $p->game;
if (!defined $game) {
- send_error($p, NOT_IN_GAME);
+ $p->error(NOT_IN_GAME);
return;
}
- delete $p->{game};
- if (exists $p->{seat}) {
- $game->{players}->[$p->{seat}] = undef;
- delete $p->{seat};
- delete $p->{hand};
+ $p->game(undef);
+ if (defined $p->seat) {
+ $game->players->[$p->seat] = undef;
+ $p->seat(undef);
+ $p->hand([]);
} else {
# Check for specatator
- for (my $i = 0; $i < @{$game->{spectators}}; $i++) {
- if ($game->{spectators}->[$i]->{id} eq $p->{id}) {
- splice(@{$game->{spectators}}, $i, 1);
+ for (my $i = 0; $i < @{$game->spectators}; $i++) {
+ if ($game->spectators->[$i]->id eq $p->id) {
+ splice(@{$game->spectators}, $i, 1);
last;
}
}
@@ -268,25 +207,25 @@ sub leave_game {
sub take_seat {
my ($p, $msg) = @_;
- my $game = $p->{game};
+ my $game = $p->game;
my $seat = $msg->{seat};
if ($seat > 3 || $seat < 0) {
- send_error($p, INVALID_SEAT);
+ $p->error(INVALID_SEAT);
return;
}
- if (defined $game->{players}->[$seat]) {
- send_error($p, TAKEN_SEAT);
+ if (defined $game->players->[$seat]) {
+ $p->error(TAKEN_SEAT);
return;
} else {
# Move from standing (or sitting) to sitting
- stand_up($p) if defined $p->{seat};
- $game->{players}->[$seat] = $p;
- $p->{seat} = $seat;
- for (my $i = 0; $i < @{$game->{spectators}}; $i++) {
- if ($game->{spectators}->[$i]->{id} eq $p->{id}) {
- splice(@{$game->{spectators}}, $i, 1);
+ stand_up($p) if defined $p->seat;
+ $game->players->[$seat] = $p;
+ $p->seat($seat);
+ for (my $i = 0; $i < @{$game->spectators}; $i++) {
+ if ($game->spectators->[$i]->id eq $p->id) {
+ splice(@{$game->spectators}, $i, 1);
}
}
}
@@ -296,16 +235,16 @@ sub take_seat {
sub stand_up {
my ($p) = @_;
- my $game = $p->{game};
- my $seat = $p->{seat};
+ my $game = $p->game;
+ my $seat = $p->seat;
if (!defined $seat) {
- send_error($p, ALREADY_STANDING);
+ $p->error(ALREADY_STANDING);
} else {
# Move from sitting to standing
- push @{$game->{spectators}}, $p;
- delete $p->{seat};
- $game->{players}->[$seat] = undef;
+ push @{$game->spectators}, $p;
+ $p->seat(undef);
+ $game->players->[$seat] = undef;
broadcast_gamestate($game);
}
@@ -314,20 +253,20 @@ sub stand_up {
# start_seat: -1 - 3
sub start_game {
my ($p, $msg) = @_;
- my $game = $p->{game};
+ my $game = $p->game;
- if (num_players($game->{id}) < 4) {
- send_error($p, PARTIAL_GAME);
+ if (num_players($game->id) < 4) {
+ $p->error(PARTIAL_GAME);
return;
}
if (!defined $msg->{start_seat} || $msg->{start_seat} < 0) {
- $game->{dealer} = int(rand(4));
+ $game->dealer(int(rand(4)));
} elsif ($msg->{start_seat} < 4) {
# One less since start_new_round will rotate
- $game->{dealer} = ($msg->{start_seat} - 1);
+ $game->dealer(($msg->{start_seat} - 1));
} else {
- send_error($p, INVALID_SEAT);
+ $p->error(INVALID_SEAT);
return;
}
@@ -336,32 +275,32 @@ sub start_game {
sub restart_game {
my ($p) = @_;
- my $game = $p->{game};
+ my $game = $p->game;
- $game->{score} = $ENV{END_DEBUG} ? [9,9] : [0,0];
- $game->{phase} = 'lobby';
+ $game->score($ENV{END_DEBUG} ? [9,9] : [0,0]);
+ $game->phase('lobby');
broadcast_gamestate($game);
}
sub num_players {
my ($gid) = @_;
- return scalar grep { defined } @{$GAMES{$gid}->{players}}
+ return scalar grep { defined } @{$GAMES{$gid}->players}
}
sub start_new_round {
my ($game) = @_;
# Shift dealer and deal
- $game->{dealer} = ($game->{dealer} + 1) % 4;
- $game->{trump} = undef;
- $game->{tricks} = [0,0,0,0];
- $game->{out_player} = -1;
+ $game->dealer(($game->dealer + 1) % 4);
+ $game->trump(undef);
+ $game->tricks([0,0,0,0]);
+ $game->out_player(-1);
deal_players_hands($game);
# Signal vote of player next to dealer...
reset_turn($game);
- $game->{phase} = 'vote';
- $game->{pass_count} = 0;
+ $game->phase('vote');
+ $game->pass_count(0);
broadcast_gamestate($game); # includes trump_nominee
}
@@ -370,9 +309,9 @@ sub deal_players_hands {
my ($game) = @_;
my ($handsA, $kiddeyA) = deal();
- $game->{trump_nominee} = shift @$kiddeyA;
- for my $p (@{$game->{players}}) {
- $p->{hand} = shift @$handsA;
+ $game->trump_nominee(shift @$kiddeyA);
+ for my $p (@{$game->players}) {
+ $p->hand(shift @$handsA);
}
sort_hands($game);
@@ -384,11 +323,11 @@ sub deal_players_hands {
sub order {
my ($p, $msg) = @_;
- my $game = $p->{game};
+ my $game = $p->game;
if ($msg->{vote} eq 'pass') {
next_turn($game);
- $game->{pass_count}++;
- if ($game->{pass_count} >= 8) {
+ $game->pass_count($game->pass_count + 1);
+ if ($game->pass_count >= 8) {
# Throw em in
start_new_round($game);
} else {
@@ -396,43 +335,43 @@ sub order {
}
} elsif ($msg->{vote}) {
# Validate its an OK vote
- if ($game->{pass_count} < 4) {
- if ($game->{trump_nominee} !~ /$msg->{vote}/) {
- send_error($p, VOTE_ON_KITTY);
+ if ($game->pass_count < 4) {
+ if ($game->trump_nominee !~ /$msg->{vote}/) {
+ $p->error(VOTE_ON_KITTY);
return;
}
} else {
- if ($game->{trump_nominee} =~ /$msg->{vote}/) {
- send_error($p, VOTE_OFF_KITTY);
+ if ($game->trump_nominee =~ /$msg->{vote}/) {
+ $p->error(VOTE_OFF_KITTY);
return;
}
}
# Accept the vote...
- $game->{trump} = $msg->{vote};
- $game->{caller} = $p->{seat};
+ $game->trump($msg->{vote});
+ $game->caller($p->seat);
if ($msg->{loner}) {
- my $partner_seat = ($p->{seat} + 2) % 4;
- $game->{out_player} = $partner_seat;
- $game->{tricks}->[$partner_seat] = 'X';
+ my $partner_seat = ($p->seat + 2) % 4;
+ $game->out_player($partner_seat);
+ $game->tricks->[$partner_seat] = 'X';
}
- if ($game->{pass_count} < 4) {
+ if ($game->pass_count < 4) {
# Setting phase will block all other play actions until the
# dealer is done swapping. Do still broadcast so dealer knows!
# Piggy back on the handle_msg turn validation by temporarily
# setting "turn" to dealer.
- $game->{phase} = 'dealer_swap';
- $game->{turn} = $game->{dealer};
+ $game->phase('dealer_swap');
+ $game->turn($game->dealer);
} else {
# Get right to it!
- $game->{phase} = 'play';
+ $game->phase('play');
reset_turn($game);
}
sort_hands($game);
broadcast_gamestate($game);
} else {
- send_error($p, BAD_VOTE);
+ $p->error(BAD_VOTE);
}
}
@@ -441,23 +380,23 @@ sub play_card {
my ($p, $msg) = @_;
# Identify player
- my $game = $p->{game};
- my $seat = $p->{seat};
+ my $game = $p->game;
+ my $seat = $p->seat;
my %colors = (H => 'D', D => 'H', S => 'C', C => 'S');
# Validate they follow suit if they CAN
- if (defined $game->{led}) {
+ if (defined $game->led) {
# Build up a list of valid cards
- my @followers = map { "$_$game->{led}" } qw(N T Q K A); # no jack
- if ($game->{led} eq $game->{trump}) {
+ my @followers = map { "$_$game->led" } qw(N T Q K A); # no jack
+ if ($game->led eq $game->trump) {
# Trump led, both jacks valid
- push @followers, "J$game->{led}";
- push @followers, "J$colors{$game->{led}}";
- } elsif ($colors{$game->{led}} ne $game->{trump}) {
+ push @followers, "J$game->led";
+ push @followers, "J$colors{$game->led}";
+ } elsif ($colors{$game->led} ne $game->trump) {
# Off-color, jack is OK
- push @followers, "J$game->{led}";
+ push @followers, "J$game->led";
} else {
# Played same color as trump, don't add jack
}
@@ -468,9 +407,9 @@ sub play_card {
# 2) Can't follow suit
# By checking negative of both
if ($msg->{card} !~ /$follower_re/ &&
- grep { $_ =~ /$follower_re/ } @{$p->{hand}}) {
+ grep { $_ =~ /$follower_re/ } @{$p->hand}) {
- send_error($p, FOLLOW_SUIT);
+ $p->error(FOLLOW_SUIT);
return;
}
}
@@ -478,45 +417,45 @@ sub play_card {
take_card($p, $msg->{card}) or return;
# Update the table and current player
- $game->{table}->[$seat] = $msg->{card};
+ $game->table->[$seat] = $msg->{card};
next_turn($game);
- my $played_cards = scalar grep { defined } @{$game->{table}};
+ my $played_cards = scalar grep { defined } @{$game->table};
if ($played_cards == 1) {
# First card!
my ($val, $suit) = split('', $msg->{card});
# Special case Jack of Color == trump
- if ($val eq 'J' && $suit eq $colors{$game->{trump}}) {
- $game->{led} = $game->{trump};
+ if ($val eq 'J' && $suit eq $colors{$game->trump}) {
+ $game->led($game->trump);
} else {
- $game->{led} = $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);
+ 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($_) ? $_ : 'X' } @{$game->{table}};
- my $winner_id = trick_winner($game->{trump}, $game->{led}, @table);
+ my @table = map { defined($_) ? $_ : 'X' } @{$game->table};
+ my $winner_id = trick_winner($game->trump, $game->led, @table);
# Update the gamestate and pause so all can see
- $game->{tricks}->[$winner_id]++;
- $game->{turn} = $winner_id;
- $game->{phase} = 'pause';
+ $game->tricks->[$winner_id]++;
+ $game->turn($winner_id);
+ $game->phase('pause');
# Sub to call after pause
my $post_pause = sub {};
- my @num_tricks = grep { /^\d+$/ } @{$game->{tricks}};
+ my @num_tricks = grep { /^\d+$/ } @{$game->tricks};
if (sum(@num_tricks) >= 5) {
# End round -- update scores, clear tricks, push dealer
- my ($team_id, $score) = score_round($game->{caller}, @{$game->{tricks}});
- $game->{score}->[$team_id] += $score;
+ my ($team_id, $score) = score_round($game->caller, @{$game->tricks});
+ $game->score->[$team_id] += $score;
- if ($game->{score}->[$team_id] >= 10) {
+ if ($game->score->[$team_id] >= 10) {
$post_pause = sub { signal_game_end($game) };
} else {
$post_pause = sub { start_new_round($game) };
@@ -525,9 +464,9 @@ sub play_card {
Mojo::IOLoop->timer(2 => sub {
- $game->{table} = [undef, undef, undef, undef];
- $game->{led} = undef;
- $game->{phase} = 'play';
+ $game->table([undef, undef, undef, undef]);
+ $game->led(undef);
+ $game->phase('play');
$post_pause->();
broadcast_gamestate($game);
@@ -541,15 +480,15 @@ sub play_card {
sub signal_game_end {
my ($game) = @_;
- $game->{phase} = 'end';
+ $game->phase('end');
# Put all players into spectator roles. This is crucial so that one player
# doesn't walk away and hold up a seat (assuming others want to play again)
- for my $p (grep { defined } @{$game->{players}}) {
- delete $p->{seat};
- push @{$game->{spectators}}, $p;
+ for my $p (grep { defined } @{$game->players}) {
+ $p->seat(undef);
+ push @{$game->spectators}, $p;
}
- $game->{players} = [undef, undef, undef, undef];
+ $game->players([undef, undef, undef, undef]);
}
@@ -558,15 +497,15 @@ sub signal_game_end {
sub dealer_swap {
my ($p, $msg) = @_;
- my $game = $p->{game};
+ my $game = $p->game;
# Exchange the cards
take_card($p, $msg->{card}) or return;
- push @{$p->{hand}}, $game->{trump_nominee};
+ push @{$p->hand}, $game->trump_nominee;
sort_hands($game);
# Start the game
- $game->{phase} = 'play';
+ $game->phase('play');
reset_turn($game);
broadcast_gamestate($game);
}
@@ -578,12 +517,12 @@ sub broadcast_gamestate {
my ($game) = @_;
# Translate to human readable names for clients
- my @pnames = map { defined($_) ? $_->{name} : 'Empty' } @{$game->{players}};
- my @snames = map { $_->{name} } @{$game->{spectators}};
+ my @pnames = map { defined($_) ? $_->name : 'Empty' } @{$game->players};
+ my @snames = map { $_->name } @{$game->spectators};
# Hand lengths are nice for rendering in the clients
my @hand_lengths =
- map { defined($_) ? scalar @{$_->{hand}} : 0 } @{$game->{players}};
+ map { defined($_) ? scalar @{$_->hand} : 0 } @{$game->players};
my $msg = {
%$game,
@@ -592,46 +531,34 @@ sub broadcast_gamestate {
hand_lengths => \@hand_lengths,
};
- for my $p (@{$game->{players}}, @{$game->{spectators}}) {
+ for my $p (@{$game->players}, @{$game->spectators}) {
next unless defined $p;
my $json = {
msg_type => 'game_state',
game => $msg,
- hand => $p->{hand},
- is_spectator => (exists $p->{seat}) ? 0 : 1,
- sit_out => $p->{sit_out},
+ hand => $p->hand,
+ is_spectator => ($p->seat) ? 0 : 1,
};
- $p->{ws}->send({ json => $json });
+ $p->ws->send({ json => $json });
}
}
-sub send_error {
- my ($p, $errno) = @_;
- my $ws = $p->{ws};
- my $json = {
- msg_type => 'error',
- errno => $errno,
- msg => err_msg($errno),
- };
- $ws->send({ json => $json});
-}
-
sub next_turn {
my ($game) = @_;
- my $turn = ($game->{turn} + 1) % 4;
- if ($turn == $game->{out_player}) {
+ my $turn = ($game->turn + 1) % 4;
+ if ($turn == $game->out_player) {
# It's a loner! Only gonna be one of these...
$turn = ($turn + 1) % 4;
}
- $game->{turn} = $turn;
+ $game->turn($turn);
}
sub reset_turn {
my ($game) = @_;
- $game->{turn} = $game->{dealer};
+ $game->turn($game->dealer);
next_turn($game);
}
@@ -639,10 +566,10 @@ sub reset_turn {
sub sort_hands {
my ($game) = @_;
- my $t = $game->{trump};
- for my $p (@{$game->{players}}) {
- my @sorted = sort { card_value($a, $t) <=> card_value($b, $t) } @{$p->{hand}};
- $p->{hand} = \@sorted;
+ my $t = $game->trump;
+ for my $p (@{$game->players}) {
+ my @sorted = sort { card_value($a, $t) <=> card_value($b, $t) } @{$p->hand};
+ $p->hand(\@sorted);
}
}
@@ -651,14 +578,14 @@ sub take_card {
my ($p, $card) = @_;
# Make sure they have the card, and update their hand
- for (my $i = 0; $i < scalar @{$p->{hand}}; $i++) {
- if ($p->{hand}->[$i] eq $card) {
- splice(@{$p->{hand}}, $i, 1);
+ for (my $i = 0; $i < scalar @{$p->hand}; $i++) {
+ if ($p->hand->[$i] eq $card) {
+ splice(@{$p->hand}, $i, 1);
return 1;
}
}
- send_error($p, DONT_HAVE_CARD);
+ $p->error(DONT_HAVE_CARD);
return 0;
}
@@ -666,17 +593,17 @@ sub take_card {
sub swap_player {
my ($game, $new_p, $list) = @_;
- for (my $i = 0; $i < @{$game->{$list}}; $i++) {
- next unless defined $game->{$list}->[$i]; # undef potentially in lobby
- if ($game->{$list}->[$i]->{name} eq $new_p->{name}) {
+ for (my $i = 0; $i < @{$game->$list}; $i++) {
+ next unless defined $game->$list->[$i]; # undef potentially in lobby
+ if ($game->$list->[$i]->name eq $new_p->name) {
# Ye ole switcheroo
# Don't delete the old player cuz we need to preserve the hand, etc.
# Just swap out the WS and ID, and update PLAYERS
- my $old_id = $game->{$list}->[$i]->{id};
- $game->{$list}->[$i]->{id} = $new_p->{id};
- $game->{$list}->[$i]->{ws} = $new_p->{ws};
- $game->{$list}->[$i]->{active} = 1; # May have disconnected previously
- $PLAYERS{$new_p->{id}} = $game->{$list}->[$i];
+ my $old_id = $game->$list->[$i]->id;
+ $game->$list->[$i]->id($new_p->id);
+ $game->$list->[$i]->ws($new_p->ws);
+ $game->$list->[$i]->active(1); # May have disconnected previously
+ $PLAYERS{$new_p->id} = $game->$list->[$i];
# NOTE: For now, don't delete from %PLAYERS here...
# the old WS may still be playing ping/pong, so we just
@@ -698,9 +625,9 @@ sub stats {
$msg .= "PLAYERS: Join Time\t\tName\tGame\n";
$msg .= "===========================================================\n";
for my $p (values %PLAYERS) {
- my $name = $p->{name} ? $p->{name} : 'UnnamedPlayer';
- my $game = $p->{game} ? $p->{game}->{id} : 'Lobby';
- $msg .= localtime($p->{joined}) . "\t$name\t$game\n";
+ my $name = $p->name ? $p->name : 'UnnamedPlayer';
+ my $game = $p->game ? $p->game->id : 'Lobby';
+ $msg .= localtime($p->joined) . "\t$name\t$game\n";
}
$msg .= "-----------------------------------------------------------\n";
$msg .= "$num_players\tPlayers\n";
@@ -728,15 +655,15 @@ sub stats {
sub chat {
my ($p, $msg) = @_;
- my $game = $p->{game};
- for my $player (@{$game->{players}}, @{$game->{spectators}}) {
+ my $game = $p->game;
+ for my $player (@{$game->players}, @{$game->spectators}) {
next unless defined $player;
my $json = {
msg_type => 'chat',
- msg => "$p->{name}: $msg->{msg}"
+ msg => "$p->name: $msg->{msg}"
};
- $player->{ws}->send({ json => $json });
+ $player->ws->send({ json => $json });
}
}
diff --git a/lib/Euchre/Game.pm b/lib/Euchre/Game.pm
@@ -0,0 +1,17 @@
+# Euchre::Game -- the Game object
+use strict;
+use warnings;
+
+package Euchre::Game;
+
+use Class::Tiny qw(id trump out_player turn dealer caller password pass_count led trump_nominee), {
+ phase => 'lobby',
+ players => sub { [undef, undef, undef, undef] },
+ spectators => sub { [] },
+ tricks => sub { [0, 0, 0, 0] },
+ table => sub { [undef, undef, undef, undef] },
+ score => sub { $ENV{END_DEBUG} ? [9, 9] : [0, 0] },
+ start_time => sub { time },
+};
+
+1;
diff --git a/lib/Euchre/Player.pm b/lib/Euchre/Player.pm
@@ -0,0 +1,34 @@
+# Player.pm -- a Player class for each websocket client
+use strict;
+use warnings;
+
+package Euchre::Player;
+
+use Euchre::Errors;
+
+# {
+# id => client id (key in %PLAYERS)
+# name => username,
+# seat => undef OR 0-3,
+# ws => websocket obj,
+# active => ...
+# }
+#
+use Class::Tiny qw(id ws seat game), {
+ joined => sub { time },
+ name => 'Anon',
+ hand => sub { [] },
+ active => 1,
+};
+
+sub error {
+ my ($self, $errno) = @_;
+ my $json = {
+ msg_type => 'error',
+ errno => $errno,
+ msg => err_msg($errno),
+ };
+ $self->ws->send({ json => $json});
+}
+
+1;
diff --git a/public/debug.html b/public/debug.html
@@ -43,7 +43,7 @@
document.getElementById('hand').innerHTML += '<img onclick="play(' + "'" + c + "'" + ')" class="card" src="cards/' + c + '.svg">'
}
- if (msg.game.table.length) {
+ if (msg.game.table) {
document.getElementById('table').innerHTML = ''
for (var i = 0; i < msg.game.table.length; i++) {
var c = msg.game.table[i]
