Skip to content

HTTPS clone URL

Subversion checkout URL

You can clone with HTTPS or Subversion.

Download ZIP
branch: master
Fetching contributors…

Cannot retrieve contributors at this time

executable file 718 lines (528 sloc) 19.766 kb
#!/usr/bin/perl
use strict;
use warnings;
use Mojolicious::Lite;
use EV;
use AnyEvent::Util;
use DBM::Deep;
use Image::Magick;
use Mojo::JSON;
use List::Util qw(shuffle);
use POSIX qw(tmpnam);
my %game;
my %ws_clients;
my %lobby;
my $json = Mojo::JSON->new;
my $config = plugin 'Config';
foreach my $field (qw(host ws_host passphrase db)) {
die "no $field in config" unless exists $config->{$field};
}
if ($config->{passphrase} eq 'DEFAULT') {
warn " **********************************************************\n";
warn " *** You need to set up guess-whom; see guess-whom.conf ***\n";
warn " **********************************************************\n";
}
my $host = $config->{host};
my $db = DBM::Deep->new($config->{db});
$db->{stats} ||= {};
$db->{facetype} ||= {};
$db->{stats}{rehashes}++;
my $TURN_TIMER = 60;
my @AWWSNAP = (
"Aww, snap!",
"Darn it!",
"Oops!",
);
helper awwsnap => sub {
return $AWWSNAP[rand @AWWSNAP];
};
helper ws_hostname => sub {
return $config->{ws_host};
};
helper gamename => sub {
my ($self, $facetype) = @_;
return $facetype ? $db->{facetype}{$facetype}{name} : '';
};
helper nfaces => sub {
my ($self, $facetype) = @_;
return () if !defined $facetype || !$db->{facetype}{$facetype};
return $db->{facetype}{$facetype}{nfaces};
};
helper faceids => sub {
my ($self, $facetype) = @_;
return () if !defined $facetype || !$db->{facetype}{$facetype};
my @faceids = shuffle (1 .. $db->{facetype}{$facetype}{nfaces});
return @faceids[0..5];
};
helper facename => sub {
my ($self, $facetype, $faceid) = @_;
return '' if !defined $facetype or !defined $faceid or !$db->{facetype}{$facetype} || $db->{facetype}{$facetype}{nfaces} < $faceid;
return $db->{facetype}{$facetype}{facenames}[$faceid];
};
helper filename => sub {
my ($self, $facetype, $faceid) = @_;
return '' if !defined $facetype or !defined $faceid or !$db->{facetype}{$facetype} || $db->{facetype}{$facetype}{nfaces} < $faceid;
return $db->{facetype}{$facetype}{filenames}[$faceid];
};
get '/' => sub {
my $self = shift;
my @games = keys %{ $db->{game_suggestions} };
my $facetype = $games[rand @games];
my $gamename;
$gamename = $db->{facetype}{$facetype}{name} if $facetype;
$self->render('index', facetype => $facetype, gamename => $gamename);
};
get '/about' => sub { shift->render('about') };
get '/admin/stats' => sub {
my %stats;
$stats{$_} = $db->{stats}{$_} for keys %{ $db->{stats} };
shift->render(text => $json->encode(\%stats));
};
get '/admin/livestats' => sub {
my $self = shift;
my @clients = keys %ws_clients;
my $nclients = @clients;
my @games = keys %game;
my $ngames = @games;
$self->render(text => $json->encode({
ws_clients => $nclients,
livegames => $ngames,
}));
};
get '/games' => sub {
my $self = shift;
my @games = (shuffle keys %{ $db->{game_suggestions} })[0 .. 4];
$self->render('games', games => \@games);
};
get '/lobby' => sub {
my $self = shift;
$self->render('error', error => 'Not implemented!');
};
get '/lobby/:facetype' => sub {
my $self = shift;
my $facetype = $self->param('facetype');
if (!defined $facetype || !$db->{facetype}{$facetype}) {
# TODO: explain the error
# TODO: redirect to referer if it is on our hostname
$self->render('error');
return;
}
$self->render('lobby', facetype => $facetype);
};
websocket '/ws/lobby/:facetype' => sub {
my $self = shift;
my $facetype = $self->param('facetype');
$db->{stats}{ws_connects}++;
my $jsonstr = $json->encode({type=>'join', joiner=>'JOINER'});
for my $client (values %{ $lobby{$facetype} }) {
$client->send($jsonstr);
}
$ws_clients{$self} = $self;
$lobby{$facetype}{$self} = $self;
$self->on(message => sub {
my ($self, $msg_str) = @_;
print STDERR "Received message: $msg_str\n";
my $msg = $json->decode($msg_str);
if ($msg->{type} eq 'chat') {
my $output = $json->encode({type=>'chat', sender=>'SENDER', message=>$msg->{message}});
for my $client (values %{ $lobby{$facetype} }) {
next if $client == $self;
$client->send($output);
}
}
});
$self->on(finish => sub {
delete $ws_clients{$self};
delete $lobby{$facetype}{$self};
my $jsonstr = $json->encode({type=>'quit', quitter=>'QUITTER'});
for my $client (values %{ $lobby{$facetype} }) {
$client->send($jsonstr);
}
});
};
get '/create-game' => sub {
my $self = shift;
$self->render('create-game');
};
post '/create-game' => sub {
my $self = shift;
my $facetype = fresh_facetype();
my $gamename = $self->param('gamename');
my $error = '';
if (!$gamename) {
$error = 'Please specify a name for the game.';
}
if ($error) {
$self->flash(error => $error);
$self->redirect_to('/create-game');
return;
}
$db->{facetype}{$facetype} = {};
$db->{facetype}{$facetype}{plural} = 'people';
$db->{facetype}{$facetype}{singular} = 'person';
$db->{facetype}{$facetype}{name} = $gamename;
$db->{facetype}{$facetype}{nfaces} = 0;
$db->{facetype}{$facetype}{facenames} = [ 'None' ];
$db->{facetype}{$facetype}{filenames} = [ '0000000000000000' ];
$self->flash(info => 'Choose an image, then click at the top left of a face and drag to select the face.');
$self->session("managing.$facetype" => 1);
$self->redirect_to("/add-faces/$facetype");
};
get '/manage-game/:facetype' => sub {
my $self = shift;
my $facetype = $self->param('facetype');
if (!$self->session("managing.$facetype")) {
$self->render('error', error => "You're not managing that game.");
return;
}
$self->stash(facetype => $facetype);
$self->stash(facenames => $db->{facetype}{$facetype}{facenames});
$self->stash(filenames => $db->{facetype}{$facetype}{filenames});
$self->stash(gamename => $db->{facetype}{$facetype}{name});
$self->stash(nfaces => $db->{facetype}{$facetype}{nfaces});
$self->render('manage-game');
};
post '/name-faces/:facetype' => sub {
my $self = shift;
my $facetype = $self->param('facetype');
if (!$self->session("managing.$facetype")) {
$self->render('error', error => "You're not managing that game.");
return;
}
for my $i (1 .. $db->{facetype}{$facetype}{nfaces}) {
$db->{facetype}{$facetype}{facenames}[$i] = $self->param("facename$i");
}
$self->redirect_to("/manage-game/$facetype");
};
get '/add-faces/:facetype' => sub {
my $self = shift;
my $facetype = $self->param('facetype');
my $gamename = $db->{facetype}{$facetype}{name};
if (!$self->session("managing.$facetype")) {
$self->render('error', error => "You're not managing that game.");
return;
}
$self->render('add-faces', facetype => $facetype, gamename => $gamename);
};
post '/add-faces/:facetype' => sub {
my $self = shift;
my $facetype = $self->param('facetype');
if (!$self->session("managing.$facetype")) {
$self->render('error', error => "You're not managing that game.");
return;
}
my $json_faces = $self->param('json-faces');
my $rotations = $self->param('rotations');
my $image_file = $self->req->upload('file-input');
my $faces = $json->decode($json_faces);
# use fork_call because the image processing is slow
fork_call {
handle_uploaded_faces($facetype, $faces, $rotations, $image_file);
update_suggestable($facetype);
} sub {
if ($@) {
print STDERR "$@";
$self->render('error', error => "Something went wrong trying to process that image. Sorry!");
} else {
# TODO: inflect
$self->flash(info => 'Now set the names for those faces.');
$self->redirect_to("/manage-game/$facetype");
}
};
};
post '/delete-face/:facetype' => sub {
my $self = shift;
my $facetype = $self->param('facetype');
if (!$self->session("managing.$facetype")) {
$self->render('error', error => "You're not managing that game.");
return;
}
my $faceid = $self->param('faceid');
if ($faceid < 1 || $faceid > $db->{facetype}{$facetype}{nfaces}) {
$self->flash(error => 'Face ID out of range!');
$self->redirect_to("/manage-game/$facetype");
return;
}
# shuffle subsequent filenames and names along
for my $i ($faceid .. $db->{facetype}{$facetype}{nfaces}-1) {
my $i1 = $i+1;
$db->{facetype}{$facetype}{facenames}[$i] = $db->{facetype}{$facetype}{facenames}[$i1];
$db->{facetype}{$facetype}{filenames}[$i] = $db->{facetype}{$facetype}{filenames}[$i1];
}
pop @{ $db->{facetype}{$facetype}{facenames} };
pop @{ $db->{facetype}{$facetype}{filenames} };
$db->{facetype}{$facetype}{nfaces}--;
$self->redirect_to("/manage-game/$facetype");
};
get '/new-game' => sub {
my $self = shift;
$self->redirect_to('/games');
};
get '/new-game/:facetype' => sub {
my $self = shift;
my $facetype = $self->param('facetype');
if (!defined $facetype || !$db->{facetype}{$facetype} || $db->{facetype}{$facetype}{nfaces} < 2) {
# TODO: explain the error
# TODO: redirect to referer if it is on our hostname
$self->render('error');
$db->{stats}{failed_newgame_facetypes}++;
return;
}
$db->{stats}{newgames}++;
my $gameid = new_game();
$game{$gameid}{facetype} = $facetype;
$game{$gameid}{faces} = [];
$self->stash(gameid => $gameid);
$self->redirect_to("/game/$gameid");
};
get '/game/:gameid' => sub {
my $self = shift;
my $gameid = $self->param('gameid');
if (!$game{$gameid} || $game{$gameid}{state} ne 'join') {
# TODO: explain the error
$self->render('error');
$db->{stats}{failed_joins}++;
return;
}
$db->{stats}{http_gamestarts}++;
$self->stash(gameid => $gameid);
render_game($self);
};
websocket '/ws/game/:gameid' => sub {
my $self = shift;
my $gameid = $self->param('gameid');
$db->{stats}{ws_connects}++;
if (!($game{$gameid} && $game{$gameid}{state} eq 'join')) {
$self->send($json->encode({error => 'game-in-progress'}));
return;
}
$ws_clients{$self} = $self;
push @{ $game{$gameid}{websockets} }, $self;
$game{$gameid}{n_connected}++;
my $takenface = @{ $game{$gameid}{faces} } ? $game{$gameid}{faces}[0] : -1;
my $facetype = $game{$gameid}{facetype};
my $faceid;
do {
$faceid = 1 + int(rand($db->{facetype}{$facetype}{nfaces}));
} while ($faceid == $takenface);
push @{ $game{$gameid}{faces} }, $faceid;
$self->send($json->encode({faceid => $faceid}));
$self->on(message => sub {
my ($self, $msg_str) = @_;
print STDERR "Received message: $msg_str\n";
my $msg = $json->decode($msg_str);
my $playeridx = $game{$gameid}{websockets}[1] && $self == $game{$gameid}{websockets}[1];
my $otherself = $game{$gameid}{opposite}{$self};
if ($game{$gameid}{state} ne 'play') {
$self->send($json->encode({error => 'not-ready'}));
return;
}
# TODO: refactor into hash of message type to handler function
if ($msg->{type} eq 'question') {
if ($game{$gameid}{expect_from}[$playeridx] eq 'question') {
$self->send($json->encode({state => 'wait-answer'}));
$otherself->send($json->encode({state => 'answer', question => $msg->{text}}));
Mojo::IOLoop->remove($game{$gameid}{timer});
$_->send($json->encode({timer => $TURN_TIMER})) for @{ $game{$gameid}{websockets} };
$game{$gameid}{timer} = Mojo::IOLoop->timer($TURN_TIMER => sub {
end_game($gameid, winner => $playeridx, timeout => 1);
});
$game{$gameid}{expect_from}[$playeridx] = 'silence';
$game{$gameid}{expect_from}[!$playeridx] = 'answer';
} else {
$self->send($json->encode({error => 'shutup'}));
}
} elsif ($msg->{type} eq 'victory') {
if ($game{$gameid}{expect_from}[$playeridx] eq 'question') {
if ($game{$gameid}{faces}[!$playeridx] == $msg->{face}) {
end_game($gameid, winner => $playeridx);
} else {
end_game($gameid,
winner => !$playeridx,
guessed => $msg->{face},
);
}
} else {
$self->send($json->encode({error => 'shutup'}));
}
} elsif ($msg->{type} eq 'answer') {
if ($game{$gameid}{expect_from}[$playeridx] eq 'answer') {
# don't allow arbitrary answers
my $answer = $msg->{answer} eq 'yes' ? 'yes' : 'no';
$self->send($json->encode({state => 'ask'}));
$otherself->send($json->encode({state => 'wait-question', answer => $answer}));
Mojo::IOLoop->remove($game{$gameid}{timer});
$_->send($json->encode({timer => $TURN_TIMER})) for @{ $game{$gameid}{websockets} };
$game{$gameid}{timer} = Mojo::IOLoop->timer($TURN_TIMER => sub {
end_game($gameid, winner => $playeridx, timeout => 1);
});
$game{$gameid}{expect_from}[$playeridx] = 'question';
$game{$gameid}{expect_from}[!$playeridx] = 'silence';
} else {
$self->send($json->encode({error => 'shutup'}));
}
}
});
$self->on(finish => sub {
if (!$game{$gameid}{finished}) {
$db->{stats}{game_aborts}++;
}
if ($game{$gameid}{opposite}{$self}) {
$game{$gameid}{opposite}{$self}->send($json->encode({state => 'ditched'}));
$game{$gameid}{opposite}{$self}->finish();
$game{$gameid}{opposite} = {};
}
destroy_game($gameid) unless --$game{$gameid}{n_connected};
delete $ws_clients{$self};
});
if (@{ $game{$gameid}{websockets} } == 2) {
$db->{stats}{ws_gamestarts}++;
$game{$gameid}{opposite}{$game{$gameid}{websockets}[0]} = $game{$gameid}{websockets}[1];
$game{$gameid}{opposite}{$game{$gameid}{websockets}[1]} = $game{$gameid}{websockets}[0];
$game{$gameid}{state} = 'play';
$game{$gameid}{expect_from}[0] = 'question';
$game{$gameid}{expect_from}[1] = 'silence';
$_->send($json->encode({timer => $TURN_TIMER})) for @{ $game{$gameid}{websockets} };
$game{$gameid}{timer} = Mojo::IOLoop->timer($TURN_TIMER => sub {
end_game($gameid,
winner => 1,
timeout => 1);
});
$game{$gameid}{websockets}[0]->send($json->encode({state => 'ask'}));
$game{$gameid}{websockets}[1]->send($json->encode({state => 'wait-question'}));
} else {
$self->send($json->encode({state => 'wait-partner'}));
}
};
Mojo::IOLoop->recurring(10 => sub {
for my $client (values %ws_clients) {
$client->send($json->encode({ping => 'foo'}));
}
});
app->secret($config->{passphrase});
app->start;
sub new_game {
my $id;
do {
$id = random_id();
} while ($game{id});
$game{$id} = {
state => 'join',
};
return $id;
}
sub render_game {
my $self = shift;
my $gameid = $self->stash('gameid');
my $facetype = $game{$gameid}{facetype};
$self->stash(gameurl => "http://$host/game/" . $gameid);
$self->stash(facetype => $facetype);
my @facenames = @{ $db->{facetype}{$facetype}{facenames} };
my @filenames = @{ $db->{facetype}{$facetype}{filenames} };
$self->render('game',
gamename => $db->{facetype}{$facetype}{name},
nfaces => $db->{facetype}{$facetype}{nfaces},
facenames => $json->encode(\@facenames),
filenames => $json->encode(\@filenames),
singular => $db->{facetype}{$facetype}{singular},
plural => $db->{facetype}{$facetype}{plural},
);
}
sub destroy_game {
my $gameid = shift;
delete $game{$gameid};
}
sub scale_factor {
my ($imgw, $imgh, $w, $h) = @_;
my $wfactor = $imgw / $w;
my $hfactor = $imgh / $h;
if ($wfactor > $hfactor) {
return $wfactor;
} else {
return $hfactor;
}
}
sub random_id {
return sprintf("%08x%08x", int(rand(2**32)), int(rand(2**32)));
}
sub fresh_facetype {
my $facetype;
do {
$facetype = random_id();
} while ($db->{facetype}{$facetype});
return $facetype;
}
sub handle_uploaded_faces {
my ($facetype, $faces, $rotations, $file) = @_;
my $i = $db->{facetype}{$facetype}{nfaces} + 1;
mkdir "public/face/$facetype";
my $tmp_path = tmpnam();
$file->move_to($tmp_path);
foreach my $face (@$faces) {
my ($tlx, $tly, $diam) = @$face;
my $image = Image::Magick->new;
my $err = $image->Read($tmp_path);
die $err if $err;
$err = $image->Rotate(degrees => $rotations*90, background => 'white');
die $err if $err;
my $factor = scale_factor($image->Get('width'), $image->Get('height'), 900, 900);
my $w = $image->Get('width');
my $h = $image->Get('height');
if ($w < $h) {
$tlx -= (900 - $w/$factor) / 2;
} else {
$tly -= (900 - $h/$factor) / 2;
}
$tlx *= $factor;
$tly *= $factor;
$diam *= $factor;
$err = $image->Border(bordercolor => 'white', width => 128, height => 128);
die $err if $err;
$tlx += 128;
$tly += 128;
$err = $image->Crop("${diam}x${diam}+$tlx+$tly");
die $err if $err;
$err = $image->Scale("128x128");
die $err if $err;
my $filename = random_id();
$err = $image->Write("public/face/$facetype/$filename.jpg");
die $err if $err;
$i++;
$db->{facetype}{$facetype}{nfaces}++;
push @{ $db->{facetype}{$facetype}{facenames} }, 'Name';
push @{ $db->{facetype}{$facetype}{filenames} }, $filename;
}
}
sub update_suggestable {
my ($facetype) = @_;
if ($db->{facetype}{$facetype}{name} ne 'Untitled'
&& $db->{facetype}{$facetype}{nfaces} >= 6) {
$db->{game_suggestions}{$facetype} = 1;
} else {
delete $db->{game_suggestions}{$facetype};
}
}
sub end_game {
my ($gameid, %opts) = @_;
Mojo::IOLoop->remove($game{$gameid}{timer});
return if !$game{$gameid};
$game{$gameid}{finished} = 1;
$db->{stats}{finished_games}++;
my $win = $game{$gameid}{websockets}[$opts{winner}];
my $lose = $game{$gameid}{websockets}[!$opts{winner}];
my $winmsg = {state => 'victory'};
my $losemsg = {state => 'defeat', face => $game{$gameid}{faces}[$opts{winner}]};
if (defined $opts{guessed}) {
$winmsg->{face} = $opts{guessed};
$winmsg->{realface} = $game{$gameid}{faces}[!$opts{winner}];
}
if ($opts{timeout}) {
$winmsg->{timeout} = $opts{timeout};
$winmsg->{realface} = $game{$gameid}{faces}[!$opts{winner}];
$losemsg->{timeout} = $opts{timeout};
}
$win->send($json->encode($winmsg));
$lose->send($json->encode($losemsg));
$win->finish();
$lose->finish();
}
Jump to Line
Something went wrong with that request. Please try again.