bluesaxman/deckard-and-company
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

Added more internal logic functions, not tested for syntax

Browse Source
This commit is contained in:
bluesaxman 2020-09-03 11:50:24 -06:00
parent 847a333d60
commit 2671799407
1 changed files with 101 additions and 13 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

114
Server/server.pl
View File

@ -5,7 +5,7 @@ use POSIX;
use Net::WebSocket::Server;
use JSON;
use Data::Dumper;
use Data::Dumper; # For debuging only, REMOVE WHEN INITIAL CODE IS FINISH
#########################Game Logic starts here##########################
@ -33,7 +33,7 @@ sub generateDeck {
# Add proper handling for reading of DDFs
}
sub shuffleDeck {
sub shuffle {
my @deck = @_;
my $index = 0;
for (@deck) {
@ -48,22 +48,20 @@ sub shuffleDeck {
sub addUser {
my ($sessionID,$userID) = @_;
}
sub delUser {
my ($sessionID,$userID) = @_;
$sessions{$sessionID}{"users"}{$userID} = (
name => "$userID",
hands => ()
);
}
sub addCards {
my ($sessionID,$deckID, $DDF) = @_;
my ($sessionID,$deckID, $cards) = @_;
push(@{$sessions{$sessionID}{"decks"}{$deckID}->{cards}}, @$cards);
}
sub addDeck {
my ($sessionID,$deckID) = @_;
my %newDeck = {
cards => []
}
$sessions{$sessionID}{"decks"}{$deckID} = %newDeck;
$sessions{$sessionID}{"decks"}{$deckID} = ( name => "$deckID", cards => [] );
}
sub delDeck {
@ -71,11 +69,101 @@ sub delDeck {
$sessions{$sessionID}{"decks"}{$deckID} = undef;
}
sub addPool {}
sub uploadDDF {
my ($sessionID, $deckID, $DDF) = @_;
addCards($sessionID,$deckID,\@{generateDeck($DDF)});
}
sub delPool {}
sub addPool {
my ($sessionID,$poolID) = @_;
$sessions{$sessionID}{"pools"}{$poolID} = ( name => "$poolID", cards => [] );
}
sub reapCards {
my $arrayRef = @_[0];
my @reapedCards = [];
print "Reaping cards";
while(@{$arrayRef}) {
push(@reapedCards,shift(@{$arrayRef})):
print ".";
}
print "Done\n";
return @reapedCards;
}
sub delPool {
my ($sessionID,$poolID) = @_;
my @reapedCards = reapCards(\@{$sessions{$sessionID}{"pools"}{$poolID}->{cards}});
$sessions{$sessionID}{"pools"}{$poolID} = undef;
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 addHand {
my ($sessionID, $userID, $handID) = @_;
$sessions{$sessionID}{"users"}{$userID}->{hands}{$handID} = ( cards => [] );
}
sub delHand {
my ($sessionID, $userID, $handID) = @_;
my @leftoverCards = reapCards(\@{$sessions{$sessionID}{"users"}{$userID}->{hands}{$handID}->{cards}});
$sessions{$sessionID}{"users"}{$userID}->{hands}{$handID} = undef;
return @leftoverCards;
}
sub getHands {
my ($sessionID, $userID) = @_;
return keys $sessions{$sessionID}{"users"}{$userID}->{hands};
}
sub moveCard {
my ($originStackRef, $originIndex, $destStackRef, $destIndex) = @_;
# splice card out of one deck, and into the other.
}
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($sessions{$sessionID}{"users"}{$userID}->{hands});
for (@hands) {
delHand($sessionID,$userID,$_);
}
$sessions{$sessionID}{"users"}{$userID} = undef;
}
sub getDeckSize {
my ($sessionID, $deckID) = @_;
return length $sessions{$sessionID}{"decks"}{$deckID}->{cards};
}
########################Game Logic ends here#############################