; # read the bag
close(BAG);
# --------------------- load and decode the bag
$bagdump = "0 64" unless $bagdump =~ /^[0-9 ]+$/; # handle errors
my ($bagkey,@bagparts) = split(/ /,$bagdump); # fetch the key
my $that;
my $bag = "";
$log .= "Key($bagkey)";
foreach $that (@bagparts) {
my $onechar = "" . (chr($that) ^ chr($bagkey)); # decode the bag
# Stupid... ^ only works right for chars, not for numbers!?!?
if ($onechar =~ /[a-zäöü.]/) {
$log .= " Decode($that = " . $onechar . ")";
$bag .= $onechar;
} else {
$log .= " Invalid($that ^ $bagkey = " . ord($onechar) . " ($onechar))";
}
}
$log .= "\nBagRead($bag)\n\n";
$bagkey = int(rand(256)); # new key for the next save
# --------------------- reset the bag if needed or requested
my $oldbagsize = length($bag);
if ( ($oldbagsize == 0) && ($command =~ /^[1-9]$/) ) {
$bag = $newbag; # fill up empty bag to start new game
$answer = "Starting with a new bag, old was empty...
\n";
$log .= "\nNewBag($bag)\n";
}
if ($command =~ /^[*]$/) {
$bag = $newbag; # fill up empty bag to start new game
$answer = "Cheatcode *: Refilling bag with German letter set!
\n";
}
if ($command =~ /^[!]$/) {
$bag = $dutchbag; # fill up empty bag to start new game
$answer = "Cheatcode !: Refilling bag with Dutch letter set!
\n";
}
if ($command =~ /^[?]$/) {
$bag = $ukbag; # fill up empty bag to start new game
$answer = "Cheatcode ?: Refilling bag with English letter set!
\n";
}
my $bagsize = length($bag);
# --------------------- fetch from bag
if ($command =~ /^[1-9]$/) { # fetch N random bag elements
# $command = ord($command) - ord('0');
if ($command > $bagsize) {
$answer .= "You got only the following $bagsize items: ";
$answer .= "\n
(not $command, the bag was too empty)
\n";
$command = $bagsize;
} else {
$answer .= "You got the following $command items: ";
}
my @bagarray = split(//,$bag);
$answer .= "
";
for (1 .. $command) {
my @gotten = splice( @bagarray, int(rand($bagsize)), 1 );
# splice 1 element out at random position and return it
$answer .= join(' ',@gotten) . " ";
$bagsize--;
$bag = join('',@bagarray);
}
$answer .= "
";
}
# $bagsize = length($bag);
# --------------------- fill the bag
if ($command =~ /^[a-zäöü.]+$/) { # put the listed chars into the bag
$bag .= $command;
$answer .= "Your choice $command has been added to the bag";
$bagsize = length($bag);
}
# --------------------- complain about all other commands
if ($command =~ /[^a-z1-9äöü.*!?]/) {
$answer .= "\nCommand ignored. Must be a number or letters\n";
$answer .= "Letters: a-z äöü and . (for joker).\n";
$answer .= "Number: 1-9\n";
$answer .= "(Or cheatcode * or ! or ? for German or Dutch or English refill!)\n";
}
if (length($command) < 1) {
$answer .= "\nNo command given. Just showing bag status.\n";
}
# --------------------- write the new version of the bag:
open(BAG,">$bagfile") || print "$errheader"
. "Bag not writeable!!! CONTENTS COULD NOT BE UPDATED!\n";
print BAG "$bagkey" || print "$errheader"
. "Could not write bag key:\n$bagkey\n";
my $codebag = "";
$log .= "Written($bagkey)\n";
if ($bagsize > 0) {
foreach $that (split(//,$bag)) {
$codebag .= " " . ( ord($that ^ chr($bagkey)) ) # encode the bag
# Strange: ^ works better for chars than for numbers!?
}
print BAG "$codebag" || print "$errheader"
. "Could not write bag letters:\n$codebag\n";
}
$log .= "Written($codebag)\n";
close(BAG);
# --------------------- output the results to the user:
print $htmlheader;
print "Erics virtual Scrabble bag:
\n$answer\n";
print "
old size: $oldbagsize new size: $bagsize
\n";
# for debugging:
# print "
Current bag contents:
$bag
\n";
print "
Current bag contents, encoding key $bagkey:
\n";
print "$codebag
\n";
print "
This transaction is done for:
$who
\n
\n";
print ""
. "Regeln bei Brostedts Web-Scrabble
\n";
print ""
. "Kurzübersicht Brett und Buchstabenvorrat
\n";
print "Buchstabenvorrat zu Spielbeginn:
5x A (1) 1x Ä (6) 2x B (3) 2x C (4) 4x D (1) 15x E (1)
2x F (4) 3x G (2) 4x H (2) 6x I (1) 1x J (6) 2x K (4)
3x L (2) 4x M (3) 9x N (1) 3x O (2) 1x Ö (8) 1x P (4)
1x Q (10) 6x R (1) 7x S (1) 6x T (1) 6x U (1) 1x Ü (6)
1x V (6) 1x W (3) 1x X (8) 1x Y (10) 1x Z (3) 2x Joker (0)
Dutch Scrabble letters, values, frequency (plus 2 jokers, value 0):
a b C D e f G H i J K L m n O P Q R S T U V W x Y Z
1 3 5 2 1 4 3 4 1 4 3 3 3 1 1 3 10 2 2 2 4 4 5 8 8 4 (value)
6 2 2 5 18 1 4 3 6 2 2 3 2 10 6 2 1 6 3 6 2 2 2 1 1 2 (frequency)
English Scrabble letters, values, frequency (plus 2 jokers, value 0):
a b C D e f G H i J K L m n O P Q R S T U V W x Y Z
1 3 3 2 1 4 2 4 1 8 5 1 3 1 1 3 10 1 1 1 1 4 4 8 4 10 (value)
9 2 2 4 12 2 3 2 9 1 1 4 2 6 8 2 1 6 4 6 4 2 2 1 2 1 (frequency)
| Fetch 4 letters:
| scrabblesack.cgi?4
|
| Put an a, two e and a Joker back:
| scrabblesack.cgi?a.ee
|
| Check the contents:
| scrabblesack.cgi
|
| Refill, start a new German game:
| scrabblesack.cgi?*
|
| Refill, start a new Dutch game:
| scrabblesack.cgi?!
|
| Refill, start a new English game:
| scrabblesack.cgi??
|
\n";
# *** print "
\nDEBUG LOG:\n$log\n
\n";
print "\n\n\n";