433 lines
13 KiB
Perl
Executable File
433 lines
13 KiB
Perl
Executable File
#!/usr/bin/perl -w
|
|
use strict;
|
|
use warnings;
|
|
use POSIX;
|
|
use Net::WebSocket::Server;
|
|
use JSON;
|
|
|
|
use Data::Dumper; # For debuging only, REMOVE WHEN INITIAL CODE IS FINISH
|
|
|
|
#########################Game Logic starts here##########################
|
|
|
|
my %sessions = ();
|
|
|
|
sub generateSession {
|
|
my $newSession = shift;
|
|
unless (defined $newSession) { my $uniquifyer = sprintf("%.0f",rand()*1000); $newSession = time.$uniquifyer; }
|
|
if ( grep( /$newSession/, keys %sessions ) ) {
|
|
return 0 #failur to create session
|
|
} else {
|
|
print "Adding session ".$newSession." to database\n";
|
|
$sessions{$newSession} = {
|
|
"id" => $newSession,
|
|
"connections" => {},
|
|
"users" => {},
|
|
"decks" => {},
|
|
"pools" => {},
|
|
};
|
|
|
|
}
|
|
return $newSession;
|
|
}
|
|
|
|
sub generateSingle {
|
|
my $DDF = shift;
|
|
my @cards = ("");
|
|
for (@$DDF) {
|
|
my @tempcards = ();
|
|
my %datablock = %$_;
|
|
for (@cards) {
|
|
my $current = $_;
|
|
for (@{$datablock{data}}) {
|
|
push(@tempcards,$current.$_);
|
|
}
|
|
}
|
|
@cards = @tempcards;
|
|
}
|
|
return @cards;
|
|
}
|
|
|
|
sub generateDeck {
|
|
my $DDF = from_json(shift);
|
|
if ("ARRAY" eq ref($DDF->[0])) {
|
|
my @deck = ();
|
|
for (@$DDF) {
|
|
push(@deck,generateSingle($_));
|
|
}
|
|
return @deck;
|
|
} else {
|
|
return generateSingle($DDF);
|
|
}
|
|
}
|
|
|
|
sub shuffle {
|
|
my @deck = @_;
|
|
my $index = 0;
|
|
for (@deck) {
|
|
my $swapCardIndex = floor(rand() * @deck);
|
|
my $swapCard = $deck[$swapCardIndex];
|
|
$deck[$swapCardIndex] = $_;
|
|
$deck[$index] = $swapCard;
|
|
$index++;
|
|
}
|
|
return \@deck;
|
|
}
|
|
|
|
sub shuffleDeck {
|
|
my ($sessionID, $deckID) = @_;
|
|
my @cards = @{$sessions{$sessionID}{"decks"}{$deckID}->{cards}};
|
|
$sessions{$sessionID}{"decks"}{$deckID}->{cards} = shuffle(@cards);
|
|
}
|
|
|
|
sub shufflePool {
|
|
my ($sessionID, $poolID) = @_;
|
|
my @cards = @{$sessions{$sessionID}{"pools"}{$poolID}->{cards}};
|
|
@{$sessions{$sessionID}{"pools"}{$poolID}->{cards}} = shuffle(@cards);;
|
|
}
|
|
|
|
sub shuffleHand {
|
|
my ($sessionID, $userID, $handID) = @_;
|
|
my @cards = @{$sessions{$sessionID}{"users"}{$userID}->{hands}{$handID}->{cards}};
|
|
$sessions{$sessionID}{"users"}{$userID}->{hands}{$handID}->{cards} = shuffle(@cards);
|
|
}
|
|
|
|
sub addUser {
|
|
my ($sessionID,$userID) = @_;
|
|
if (grep( /$userID/, keys %{$sessions{$sessionID}{"users"}})) { print "ERROR: Duplicate user\n"; return 0; }
|
|
$sessions{$sessionID}{"users"}{$userID} = {
|
|
name => "$userID",
|
|
hands => {}
|
|
};
|
|
addHand($sessionID,$userID,"default");
|
|
return 1;
|
|
}
|
|
|
|
sub addCards {
|
|
my ($sessionID,$deckID, $cards) = @_;
|
|
push(@{$sessions{$sessionID}{"decks"}{$deckID}->{cards}}, @$cards);
|
|
}
|
|
|
|
sub addDeck {
|
|
my ($sessionID,$deckID) = @_;
|
|
$sessions{$sessionID}{"decks"}{$deckID} = { name => "$deckID", cards => [] };
|
|
}
|
|
|
|
sub delDeck {
|
|
my ($sessionID,$deckID) = @_;
|
|
delete($sessions{$sessionID}{"decks"}{$deckID});
|
|
}
|
|
|
|
sub uploadDDF {
|
|
my ($sessionID, $deckID, $DDF) = @_;
|
|
addCards($sessionID,$deckID,\@{generateDeck($DDF)});
|
|
}
|
|
|
|
sub addPool {
|
|
my ($sessionID,$poolID) = @_;
|
|
$sessions{$sessionID}{"pools"}{$poolID} = { name => "$poolID", cards => [] };
|
|
}
|
|
|
|
sub delPool {
|
|
my ($sessionID,$poolID) = @_;
|
|
my @reapedCards = splice(@{$sessions{$sessionID}{"pools"}{$poolID}{cards}});
|
|
delete($sessions{$sessionID}{"pools"}{$poolID});
|
|
return @reapedCards;
|
|
}
|
|
|
|
sub getUsers {
|
|
my $sessionID = $_[0];
|
|
return keys %{$sessions{$sessionID}{"users"}};
|
|
}
|
|
|
|
sub getDecks {
|
|
my $sessionID = $_[0];
|
|
return keys %{$sessions{$sessionID}{"decks"}};
|
|
}
|
|
|
|
sub getPools {
|
|
my $sessionID = $_[0];
|
|
return keys %{$sessions{$sessionID}{"pools"}};
|
|
}
|
|
|
|
sub getDeckName {
|
|
my ($sessionID, $deckID) = @_;
|
|
return $sessions{$sessionID}{"decks"}{$deckID}{name};
|
|
}
|
|
|
|
sub getUserName {
|
|
my ($sessionID, $userID) = @_;
|
|
return $sessions{$sessionID}{"users"}{$userID}{name};
|
|
}
|
|
|
|
sub getPoolName {
|
|
my ($sessionID, $poolID) = @_;
|
|
return $sessions{$sessionID}{"pools"}{$poolID}{name};
|
|
}
|
|
|
|
sub renameDeck {
|
|
my ($sessionID, $deckID, $newName) = @_;
|
|
unless (defined($newName)) { return print "ERROR: No name provided"; }
|
|
$sessions{$sessionID}{"decks"}{$deckID}{name} = $newName;
|
|
}
|
|
|
|
sub renameUser {
|
|
my ($sessionID, $userID, $newName) = @_;
|
|
unless (defined($newName)) { return print "ERROR: No name provided"; }
|
|
$sessions{$sessionID}{"users"}{$userID}{name} = $newName;
|
|
}
|
|
|
|
sub renamePool {
|
|
my ($sessionID, $poolID, $newName) = @_;
|
|
unless (defined($newName)) { return print "ERROR: No name provided"; }
|
|
$sessions{$sessionID}{"pools"}{$poolID}{name} = $newName;
|
|
}
|
|
|
|
sub addHand {
|
|
my ($sessionID, $userID, $handID) = @_;
|
|
$sessions{$sessionID}{"users"}{$userID}{hands}{$handID} = { cards => [] };
|
|
}
|
|
|
|
sub delHand {
|
|
my ($sessionID, $userID, $handID) = @_;
|
|
my @leftoverCards = splice(@{$sessions{$sessionID}{"users"}{$userID}->{hands}{$handID}->{cards}});
|
|
delete($sessions{$sessionID}{"users"}{$userID}{hands}{$handID});
|
|
return @leftoverCards;
|
|
}
|
|
|
|
sub getHands {
|
|
my ($sessionID, $userID) = @_;
|
|
return keys %{$sessions{$sessionID}{"users"}{$userID}{hands}};
|
|
}
|
|
|
|
sub moveCard {
|
|
my ($originStackRef, $originIndex, $destStackRef, $destIndex) = @_;
|
|
unless(defined($originStackRef)) { return print "ERROR: No Origin Stack\n"; }
|
|
unless(defined($originIndex)) { return print "ERROR: No Origin Index\n"; }
|
|
unless(defined($destStackRef)) { return print "ERROR: No Destination Stack\n"; }
|
|
unless(defined($destIndex)) { return print "ERROR: No Destination Index\n"; }
|
|
my $card = splice(@$originStackRef,$originIndex,1);
|
|
unless(defined($card)) { return print "ERROR: No Card available to be pulled\n"; }
|
|
splice(@$destStackRef,$destIndex,0,$card);
|
|
}
|
|
|
|
sub drawCard {
|
|
my ($sessionID, $deckID, $userID, $handID) = @_;
|
|
moveCard(
|
|
$sessions{$sessionID}{"decks"}{$deckID}->{cards}, 0,
|
|
$sessions{$sessionID}{"users"}{$userID}->{hands}{$handID}->{cards}, 0
|
|
);
|
|
}
|
|
|
|
sub playCard {
|
|
my ($sessionID, $userID, $handID, $cardIndex, $poolID) = @_;
|
|
moveCard(
|
|
\@{$sessions{$sessionID}{"users"}{$userID}->{hands}{$handID}->{cards}}, $cardIndex,
|
|
\@{$sessions{$sessionID}{"pools"}{$poolID}->{cards}},0
|
|
);
|
|
}
|
|
|
|
sub delUser {
|
|
my ($sessionID,$userID) = @_;
|
|
my @hands = getHands($sessionID,$userID);
|
|
my @reaped = ();
|
|
for (@hands) {
|
|
push(@reaped,delHand($sessionID,$userID,$_));
|
|
}
|
|
delete($sessions{$sessionID}{"users"}{$userID});
|
|
return @reaped;
|
|
}
|
|
|
|
sub getDeckSize {
|
|
my ($sessionID, $deckID) = @_;
|
|
return scalar @{$sessions{$sessionID}{"decks"}{$deckID}->{cards}};
|
|
}
|
|
|
|
sub getPoolTop {
|
|
my ($sessionID, $poolID) = @_;
|
|
return @{$sessions{$sessionID}{"pools"}{$poolID}->{cards}}[0];
|
|
}
|
|
|
|
########################Game Logic ends here#############################
|
|
|
|
#########################Server Logic below##############################
|
|
|
|
my $origin = 'ws://localhost';
|
|
|
|
sub joinSession {
|
|
my ($sessionID, $userID) = @_;
|
|
unless (defined($sessions{$sessionID})) {
|
|
print $sessionID." does not exsist, attempting to create...\n";
|
|
if (generateSession($sessionID)) {
|
|
print "Session ".$sessionID." has been created.\n";
|
|
|
|
} else {
|
|
print "ERROR: Could not create session ".$sessionID."\n";
|
|
return 0;
|
|
}
|
|
}
|
|
unless (addUser($sessionID,$userID)) {
|
|
#assume rejoining user
|
|
}
|
|
return 1;
|
|
}
|
|
|
|
my $server = Net::WebSocket::Server->new(
|
|
listen => 8080,
|
|
on_connect => sub {
|
|
my ($serv, $conn) = @_;
|
|
$conn->on(
|
|
handshake => sub {
|
|
my ($conn,$handshake) = @_;
|
|
$conn->{"initHand"} = $handshake;
|
|
},
|
|
ready => sub {
|
|
my ($conn) = @_;
|
|
$conn->send_utf8('{"request":"user"}');
|
|
$conn->send_utf8('{"request":"session"}');
|
|
},
|
|
utf8 => sub {
|
|
my ($conn, $msg) = @_;
|
|
my $sessionID = $conn->{"currentSession"}{"id"};
|
|
my $messageData = "";
|
|
eval { $messageData = from_json($msg) };
|
|
if ($@) { $conn->send_utf8('{"error":100, "message":"ERROR: Invalid json"}'); return 0;}
|
|
|
|
if (defined($messageData->{user})) {
|
|
$conn->{user} = $messageData->{user};
|
|
# Need to check if userID is unique
|
|
$conn->send_utf8('{"info":"user success"}');
|
|
}
|
|
if (defined($messageData->{session})) {
|
|
unless(defined($conn->{user})) { $conn->send_utf8('{"error":200, "message":"Could not join session, no user defined", "request":"user"}'); $conn->send_utf8('{"request":"session"}'); return 0; }
|
|
$conn->{session} = $messageData->{session};
|
|
$conn->send_utf8('{"info":"session success", "request":"join"}');
|
|
}
|
|
if (defined($messageData->{action})) {
|
|
if ($messageData->{action} =~ /join/ ) { if (joinSession($conn->{session},$conn->{user})) { $conn->send_utf8('{"info":"join success", "request":"update"}'); } }
|
|
if ($messageData->{action} =~ /update/ ) { my $sessionID = $conn->{session}; for ($conn->server->connections) { if ($_->{session} == $conn->{session}) {
|
|
#This might be a lot to do at once, might need to break it up in the future.
|
|
# Update all connections joined to this session.
|
|
# User List
|
|
my @users = getUsers($sessionID);
|
|
my @userNames;
|
|
my $current = $_;
|
|
for (@users) {
|
|
push(@userNames,getUserName($sessionID,$_));
|
|
}
|
|
$current->send_utf8('{"users":["'.join('","',@userNames).'"]}');
|
|
# Deck List
|
|
my @decks = getDecks($sessionID);
|
|
my %deckStats = ();
|
|
for (@decks) {
|
|
$deckStats{$_}{name} = $sessions{$sessionID}{"decks"}{$_}{name};
|
|
$deckStats{$_}{size} = getDeckSize($sessionID,$_);
|
|
}
|
|
$current->send_utf8('{"decks":'.to_json(\%deckStats).'}');
|
|
# Pool List
|
|
my @pools = getPools($sessionID);
|
|
my %poolStats = ();
|
|
for (@pools) {
|
|
$poolStats{$_}{name} = $sessions{$sessionID}{"pools"}{$_}{name};
|
|
$poolStats{$_}{top} = getPoolTop($sessionID,$_);
|
|
}
|
|
$current->send_utf8('{"pools":'.to_json(\%poolStats).'}');
|
|
# Users Hands
|
|
my @hands = getHands($sessionID,$_->{user});
|
|
my %handStats = ();
|
|
for (@hands) {
|
|
$handStats{$_}{name} = $_;
|
|
$handStats{$_}{cards} = [];
|
|
}
|
|
$current->send_utf8('{"hands":'.to_json(\%handStats).'}');
|
|
# for each hand
|
|
for (@hands) {
|
|
my $handID = $_;
|
|
my @hand = @{$sessions{$sessionID}{"users"}{$current->{user}}{hands}{$handID}{cards}};
|
|
# each card (so we scale better)
|
|
if (@hand) { for (@hand) {
|
|
my $card = $_;
|
|
$current->send_utf8('{"action":"addCard","hand":"'.$handID.'", "card":"'.$card.'"}');
|
|
}}
|
|
}
|
|
}}}
|
|
if ($messageData->{action} =~ /draw/) {
|
|
drawCard($conn->{session},$messageData->{deck},$conn->{user},$messageData->{hand});
|
|
$conn->send_utf8('{"info":"card drawn", "request":"update"}');
|
|
}
|
|
if ($messageData->{action} =~ /play/) {
|
|
playCard($conn->{session},$conn->{user},$messageData->{hand},$messageData->{cardID},$messageData->{pool});
|
|
$conn->send_utf8('{"info":"card played", "request":"update"}');
|
|
}
|
|
if ($messageData->{action} =~ /clear/) {
|
|
my @cards = delPool($conn->{session},$messageData->{pool});
|
|
addCards($conn->{session},$messageData->{deck},\@cards);
|
|
addPool($conn->{session},$messageData->{pool});
|
|
$conn->send_utf8('{"info":"pool cleared", "request":"update"}');
|
|
}
|
|
if ($messageData->{action} =~ /muligan/) {
|
|
my @cards = delHand($conn->{session},$messageData->{hand});
|
|
addCards($conn->{session},$messageData->{deck},\@cards);
|
|
addHand($conn->{session},$messageData->{hand});
|
|
$conn->send_utf8('{"info":"hand returned to deck","request":"update"}');
|
|
}
|
|
if ($messageData->{action} =~ /shuffle/) {
|
|
shuffleDeck($conn->{session},$messageData->{action});
|
|
$conn->send_utf8('{"info":"deck shuffeled","request":"update"}');
|
|
}
|
|
if ($messageData->{action} =~ /add/) {
|
|
if ($messageData->{type} =~ /deck/) {
|
|
addDeck($conn->{session},$messageData->{id});
|
|
}
|
|
if ($messageData->{type} =~ /pool/) {
|
|
addPool($conn->{session},$messageData->{id});
|
|
}
|
|
if ($messageData->{type} =~ /hand/) {
|
|
addHand($conn->{session},$conn->{user},$messageData->{id});
|
|
}
|
|
$conn->send_utf8('{"info":"Added","request":"update"}');
|
|
}
|
|
if ($messageData->{action} =~ /del/) {
|
|
if ($messageData->{type} =~ /deck/) {
|
|
delDeck($conn->{session},$messageData->{id});
|
|
$conn->send_utf8('{"info":"Deck deleted, cards contained are gone"}');
|
|
}
|
|
if ($messageData->{type} =~ /pool/) {
|
|
my @cards = delPool($conn->{session},$messageData->{id});
|
|
addCards($conn->{session},$messageData->{deck},\@cards);
|
|
$conn->send_utf8('{"info":"Pool deleted, added to deck"}');
|
|
}
|
|
if ($messageData->{type} =~ /hand/) {
|
|
my @cards = delHand($conn->{session},$conn->{user},$messageData->{id});
|
|
my $newPool = $conn->{user}."_".$messageData->{id};
|
|
addPool($conn->{session},$newPool);
|
|
splice(@{$sessions{$conn->{session}}{"pools"}{$newPool}{cards}},0,0,@cards);
|
|
$conn->send_utf8('{"info":"Hand deleted, added as pool"}');
|
|
}
|
|
$conn->send_utf8('{"request":"update"}');
|
|
}
|
|
if ($messageData->{action} =~ /ddf/) {
|
|
my @cards = generateDeck($messageData->{ddf});
|
|
addCards($conn->{session},$messageData->{deck},\@cards);
|
|
$conn->send_utf8('{"info":"Deck file added to deck","request":"update"}');
|
|
}
|
|
}
|
|
},
|
|
disconnect => sub {
|
|
my ($conn, $code, $reason) = @_;
|
|
}
|
|
);
|
|
}
|
|
);
|
|
|
|
my $ses = generateSession(50);
|
|
addDeck($ses,"default");
|
|
my @tCards = generateDeck('[{"data":["Male ","Female "]},{"data":["Ardvark ","Platipus ","Cat "]},{"data":["Jumping","Falling","Flying"]}]');
|
|
addCards($ses,"default",\@tCards);
|
|
addPool($ses,"default");
|
|
addUser($ses,"Sergiy");
|
|
drawCard($ses,"default","Sergiy","default");
|
|
drawCard($ses,"default","Sergiy","default");
|
|
playCard($ses,"Sergiy","default",0,"default");
|
|
|
|
$server->start;
|