#!/usr/bin/perl
#----------------------------------------------------------------------
#
# Copyright (c) Craig Ferguson, 2000. All rights reserved.
#
# Note that this code implements Richard Bartle's "Waving Hands" game,
# which is itself copyright.
#
#----------------------------------------------------------------------
#
# The contents of this file are subject to the FM Public License
# Version 1.0 (the "License"); you may not use this file except in
# compliance with the License. You may obtain a copy of the License at
# ftp://ftp.gamerz.net/pub/fm/LICENSE
#
# Software distributed under the License is distributed on an "AS IS"
# basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See the
# License for the specific language governing rights and limitations
# under the License.
#
# The Original Code is games.pl.
#
# The Initial Developer of the Original Code is Craig Ferguson.
#
# Portions of the Original Code are based on lib.pl, by Martin
# Gregory
#
#----------------------------------------------------------------------
#
# This code presents the output of a GAMES command as an HTML
# page.
#
#----------------------------------------------------------------------
$Revision .= ' L1.00';
# The description of an opponent's state in a Game Status report...
# (any states not in this hash will appear unchanged in the report)
sub Num
{
my $str = shift;
return $1 if ($str =~ /(-?\d+)/);
return 0;
}
sub ReportErrorAndExit
{
my $Error = shift;
print "Content-type: text/html\n\n";
print "Error in Games.pl\n";
print "\n";
print "$Error\n";
print "\n";
exit;
}
sub BadGame
{
my $game = shift;
$game =~ s/\.gm$//;
print "| Error $! opening game $game |
\n";
}
sub BadDsc
{
my $dsc = shift;
$dsc =~ s/\.dsc$//;
print "Error $! opening decsription $dsc
\n";
}
%StateDescription = ('orders' => 'thinking',
'choose-target' => 'thinking',
'choose-spell' => 'thinking'
);
$version = "";
$version = "Test" if ($ENV{SCRIPT_FILENAME} =~ m#/Test/#);
$version = "Main" if ($ENV{SCRIPT_FILENAME} =~ m#/Main/#);
$gamedir = "/home/FM/fm/\L$version\E/saves";
my($Wiz,$state,$Games,$NextGame,$GameTurn,$desc,$line,@ActiveGameFiles,@DscFiles) = ("","","",0,0);
opendir(GAMEDIR, "$gamedir") || ReportErrorAndExit("Error opening games directory ($gamedir): " . $!);
@ActiveGameFiles = sort {&Num($a) <=> &Num($b)} grep(/\.gm$/, readdir(GAMEDIR));
open (WIZARDS, "<$gamedir/wizards.dat") || ReportErrorAndExit("Error wizards file ($gamedir/wizards.dat): " . $!);
@WizardInfo = ;
close WIZARDS;
eval "@WizardInfo";
print "Content-type: text/html\n\n";
print "Firetop Mountain Games ($version Server)\n";
print "\n";
if (@ActiveGameFiles)
{
print "Battles in Progress on Firetop Mountain
\n";
print "\n";
print "| Game | \n";
print "Turn | \n";
print "Wizard State | \n";
print "Wizard State | \n";
print "
|---|
\n";
while($NextGame = pop(@ActiveGameFiles))
{
if (!open (GAME, "$gamedir/$NextGame"))
{
BadGame($NextGame);
next;
}
my(@Game) = ;
close GAME;
eval "@Game";
$NextGame =~ s/\.gm$//;
my $RowsOfWizards = int($#Players / 2) + 1;
print " 1);
print ">$NextGame 1);
print ">$Turn\n";
my($WizCount) = 0;
while($Wizard = shift(@Players))
{
# Go to a new row when required
if (++$WizCount == 3)
{
$WizCount = 1;
print "
\n";
}
my $State = "";
if (defined($Wizard{$Wizard}{'User'})
&& defined($Users{$Wizard{$Wizard}{'User'}}{'Vacation'})
&& ($Users{$Wizard{$Wizard}{'User'}}{'Vacation'}))
{
$State = "(on vacation)";
}
else
{
$State = $Info{$Wizard}{'State'};
if ($StateDescription{$State} and
$StateDescription{$State} eq 'thinking')
{
$State = "";
}
else
{
$State = "($State)";
}
$State =~ s/_/ /;
}
print "| $Wizard $State | \n";
}
print "
\n";
}
print "
\n";
}
rewinddir GAMEDIR;
@DscFiles = sort {&Num($a) <=> &Num($b)} grep(/.dsc$/, readdir(GAMEDIR));
if (@DscFiles)
{
print "Past History
\n";
while($NextGame = pop(@DscFiles))
{
$NextGame =~ m/(.*)\./;
$Name = $1;
if (!-f "$gamedir/$Name.gm")
{
if (!open(DESC, "$gamedir/$Name.dsc"))
{
BadDsc($NextGame);
}
else
{
chomp($desc = );
$line = ; #skip ---- line
chomp ($line = );
if ($line =~ m/Last turn/)
{
$desc .= " ($line";
chomp ($line = );
$desc .= " $line)";
}
print "$desc
\n";
close DESC;
}
}
}
}
print "\n";