#!/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 scores.pl. # # The Initial Developer of the Original Code is Craig Ferguson. # # Portions of the Original Code are based on users.pl, by Martin # Gregory # #---------------------------------------------------------------------- # # This code presents the output of a SCORES 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 scores.pl\n"; print "\n"; print "$Error\n"; print "\n"; exit; } sub BusyCode { local ($wiz) = @_; if ($Wizard{$wiz}{'Busy'}) { if ($Wizard{$wiz}{'Busy'} =~ m/^N/) { return 1; } return 2; } return 0; } sub wizard_by_score { if ($Wizard{$a}{$ScoreType.'Score'} != $Wizard{$b}{$ScoreType.'Score'}) { return $Wizard{$b}{$ScoreType.'Score'} <=> $Wizard{$a}{$ScoreType.'Score'}; } if(&BusyCode($a) != &BusyCode($b)) { return &BusyCode($a) <=> &BusyCode($b); } if($Wizard{$a}{'User'} ne $Wizard{$b}{'User'}) { return "\U$Wizard{$a}{'User'}" cmp "\U$Wizard{$b}{'User'}"; } return "\U$a" cmp "\U$b"; } sub dead_by_score { if ($DeadScores[$a] != $DeadScores[$b]) { return $DeadScores[$b] <=> $DeadScores[$a]; } if ($DeadUsers[$a] ne $DeadUsers[$b]) { return "\U$DeadUsers[$a]" cmp "\U$DeadUsers[$b]"; } return "\U$DeadNames[$a]" cmp "\U$DeadNames[$b]"; } $version = ""; $version = "Test" if ($ENV{SCRIPT_FILENAME} =~ m#/Test/#); $version = "Main" if ($ENV{SCRIPT_FILENAME} =~ m#/Main/#); # Get type of score output requested based on filename @types = ('Duel', 'Melee'); @types = ('Melee') if ($ENV{SCRIPT_FILENAME} =~ m/meleescores\.pl$/); @types = ('Duel') if ($ENV{SCRIPT_FILENAME} =~ m/duelscores\.pl$/); $gamedir = "/home/FM/fm/\L$version\E/saves"; open (WIZARDS, "<$gamedir/wizards.dat") || ReportErrorAndExit("Error opening wizards file ($gamedir/wizards.dat): " . $!); @WizardInfo = ; close WIZARDS; eval "@WizardInfo"; @WizardNames = keys %Wizard; print "Content-type: text/html\n\n"; print "Firetop Mountain Scores ($version Server)\n"; print "\n"; foreach $type (@types) { print "

Honour Roll of the Mages of Firetop Mountain

\n"; print "

Active List (Sorted by $type Scores):

\n"; print "\n"; print "\n"; my $othertype = "Melee" if ($type eq 'Duel'); $othertype = "Duel" if ($type eq 'Melee'); print "\n"; print "\n"; print "\n"; print "\n"; print "\n"; $ScoreType = $type; foreach $wiz (sort wizard_by_score grep {!$Wizard{$_}{'Dead'} && !$Wizard{$_}{'Retired'}} @WizardNames) { print "\n"; print "\n"; print "\n"; print "\n"; print "\n"; print "\n"; print "\n"; } print "

Game	$type Score	$othertype Score	Battles	Mage	User
"; if ($Wizard{$wiz}{'Busy'}) { print "$Wizard{$wiz}{'Busy'}"; print "V" if ($Users{$Wizard{$wiz}{'User'}}{'Vacation'}); } print "	$Wizard{$wiz}{$type.'Score'}	$Wizard{$wiz}{$othertype.'Score'}	$Wizard{$wiz}{'Battles'}	$wiz	$Wizard{$wiz}{'User'}

\n"; print "

Successfully Retired ($type Scores):

\n"; print "\n"; print "\n"; my $othertype = "Melee" if ($type eq "Duel"); my $othertype = "Duel" if ($type eq "Melee"); print "\n"; print "\n"; print "\n"; print "\n"; print "\n"; $ScoreType = $type; foreach $wiz (sort wizard_by_score grep {!$Wizard{$_}{'Dead'} && $Wizard{$_}{'Retired'}} @WizardNames) { print "\n"; print "\n"; print "\n"; print "\n"; print "\n"; print "\n"; print "\n"; } print "

Game	$type Score	$othertype Score	Battles	Mage	User
"; if ($Wizard{$wiz}{'Busy'}) { print "$Wizard{$wiz}{'Busy'}"; print "V" if ($Users{$Wizard{$wiz}{'User'}}{'Vacation'}); } print "	$Wizard{$wiz}{$type.'Score'}	$Wizard{$wiz}{$othertype.'Score'}	$Wizard{$wiz}{'Battles'}	$wiz	$Wizard{$wiz}{'User'}

\n"; if (!open(HISTORY, "<$gamedir/$type.history.dat")) { print "\n"; exit; } @DeadNames = (); @DeadScores = (); @DeadUsers = (); %BestScore = (); while() { chomp; ($Name, $Score, $DeadUser) = split(/[ ]+/, $_, 3); if ($Name && (!$BestScore{$Name} || ($BestScore{$Name} < $Score))) { push(@DeadNames, $Name); push(@DeadScores, $Score); push(@DeadUsers, $DeadUser); $BestScore{$Name} = $Score; } } close HISTORY; #if (!open(HISTORY, ">$gamedir/$type.history.dat")) #{ # print "\n"; # exit; #} print "

In Remembrance of those who died Valiantly in ${type}s

\n"; print "\n"; print "\n"; foreach $wiz_index (sort dead_by_score (0 .. $#DeadNames)) { print "\n"; print "\n"; print "\n"; print "\n"; # print HISTORY "$DeadNames[$wiz_index] $DeadScores[$wiz_index] $DeadUsers[$wiz_index]\n"; } print "

Score	Mage	User
$DeadScores[$wiz_index]	$DeadNames[$wiz_index]	$DeadUsers[$wiz_index]

\n"; #close HISTORY; } print "\n";