#!/usr/bin/perl
# nhk - nethack monster high scores (version 1.0)
#
# Copyright (C) 1993 by John J. Chew, III <jjchew@math.utoronto.ca>
# Heavily edited by Boudewijn Wayers <kroisos@win.tue.nl>
#
# Eva Myers <erm1001@cam.ac.uk> updated it for 3.3.0 and made a few
# changes - 23 Feb 2000
#
# 11 Mar 2000 - First fully functional version for 3.3.0. It was
# modified to take account of all the ways to die in my list - Eva.
#
# 17 Jul 2000 - Added Scorpius to the list of monsters which can kill
# with disease.
#
# 1 Dec 2000 - Updated it to work with Slash'Em (if $CV_DEFAULT_DIRECTORY
# is changed)
#
# 11 Dec 2000 - Fixed "killed by an X called Y, while helpless" bug.
#
# DESCRIPTION
#
# This program lists high scores for monsters, either by the number of
# players that they have managed to kill, or by the total score of
# their victims.
#
# BUGS
#
# - nhk has been tested only on our local files and may not correctly
# format unusual killers. Please report bugs to erm1001@cam.ac.uk
# - nhk stands, for historical reasons, for NetHack Killers. It does
# not stand for Nihon Housou Kyoku.
# - Some causes of death (e.g., riding a cockatrice) need more elegant
# and precise descriptions
# - It is not always obvious which deaths are "really" the same. YMMV.
#
# The output looks like:
#
# 13 47668338 3666795 ascended
# 1 2122863 2122863 Pestilence
# 1 408571 408571 electric eel
# 1 239816 239816 Croesus
# 1 211387 211387 Ashikaga Takauji
# 2 138039 69019 death ray
# 2 130732 65366 air elemental
# 1 101805 101805 troll
# 1 89870 89870 dingo
# 1 62131 62131 priest(ess)
# 1 35567 35567 cockatrice egg
# 1 27756 27756 quit
# 4 26614 6653 helplessness
# 1 21839 21839 fire vortex
# 1 13699 13699 blue jelly
# 1 13047 13047 leocrotta
# 1 11236 11236 gnome lord
# 1 3033 3033 rothe
# 1 1825 1825 giant ant
# configuration variables
$CV_DEFAULT_DIRECTORY = '/usr/lib/games/nethackdir';
$CV_LOGFILE_NAME = 'logfile';
$CV_RECORD_NAME = 'record';
%gods = ("Quetzalcoatl", 1, "Camaxtli", 1, "Huhetotl", 1,
"Mitra", 1, "Crom", 1, "Set", 1,
"Anu", 1, "Ishtar", 1, "Anshar", 1,
"Earth", 1, "Fire", 1, "Ash", 1,
"Athena", 1, "Hermes", 1, "Poseidon", 1,
"Air", 1, "Frost", 1, "Smoke", 1,
"Lugh", 1, "Brigit", 1, "Manannan Mac Lir", 1,
"Shan Lai Ching", 1, "Chih Sung-tzu", 1, "Huan Ti", 1,
"Nharlotep", 1, "Zugguthobal", 1, "Gothuulbe", 1,
"Issek", 1, "Mog", 1, "Kos", 1,
"Mercury", 1, "Venus", 1, "Mars", 1,
"Amaterasu Omikami", 1, "Raijin", 1, "Susanowo", 1,
"Blind Io", 1, "The Lady", 1, "Offler", 1,
"Seeker", 1, "Osiris", 1, "Seth", 1,
"Tyr", 1, "Odin", 1, "Loki", 1,
"Ptah", 1, "Thoth", 1, "Anhur", 1,
"His Majesty", 1, "His Holiness", 1, "The Commons", 1);
@petrifiers = ("cockatrice", "chickatrice", "Medusa", "basilisk", "asphynx");
sub usage {
warn "Usage: $0 [ -f file | -l | -r ] [ -n | -s ]\n\n";
warn " -f use indicated file\n";
warn " -l use logfile\n";
warn " -r use record (high score file) [default]\n";
warn " -n sort by number of kills\n";
warn " -s sort by aggregate victim score [default]\n";
exit 1;
}
require 'getopts.pl';
&Getopts('f:lnrs') || &usage;
(defined $opt_f) && $opt_l && $opt_r && &usage;
$opt_n && $opt_s && &usage;
$opt_n || $opt_s || ($opt_s = 1);
$FILE = (defined $opt_f) ? $opt_f :
$CV_DEFAULT_DIRECTORY . '/' . ($opt_l ? $CV_LOGFILE_NAME : $CV_RECORD_NAME);
(defined $opt_f) || $opt_l || ($opt_r = 1);
open(FILE, "<$FILE") || die "$0: cannot open $FILE";
@file = <FILE>;
close(FILE);
$killlen = 1;
$scorelen = 1;
for $_ (@file) {
chop;
# version points deathwhere deathlev maxlvl hp maxhp deathdnum enddate
# startdate usernum class race gender alignment name,death
@info = split(/ /, $_, 16); $_ = $info[15];
s/ \(with the Amulet\)//;
s/ \(with a fake Amulet\)//;
s/[^\,]*,//;
# This must be checked here because of "killed by a little dog called
# Idefix, while helpless".
# Some forms of helplessness, like being paralysed by a floating eye, are
# typically the root cause of death, while others, like praying
# unsuccessfully, are not, but this is the best we can do until the logfile
# distinguishes between the different kinds of helplessness.
s/.*, while helpless$/helplessness/;
# "called XYZ" always comes at the end, except for this
if (/trying to help/ && /out of a pit/) {
s / called .*/ out of a pit/;
}
else {
s/ called .*//;
}
# "choked on a foo" - choking
# "poisoned by a rotted foo corpse" - food poisoning
# "poisoned by a killer bee/quasit/..." - deadly poison
# "poisoned by Demogorgon/Pestilence/Juiblex/Scorpius" -
# Demogorgon/Pestilence/Juiblex/Scorpius
# "drowned ... by a foo" - foo
# "drowned ..." - drowned [removed ring of levitation above water?]
s/choked on .*/choking/;
if (/poisoned by/) {
s/poisoned by( an?)? //;
if (/corpse/) { $_ = "food poisoning"; }
elsif ($_ ne "Demogorgon" && $_ ne "Pestilence" && $_ ne "Juiblex"
&& $_ ne "Scorpius")
{ $_ = "deadly poison"; }
}
s/drowned in .* by an? //;
s/drowned .*/drowned/;
if (/petrified by/) {
s/petrified by( an?)? //;
# Arbitrary assumption: all ways of being turned to stone by a
# cockatrice corpse are essentially the same YASD, but the ways of being
# petrified by a live cockatrice are distinct.
if (/corpse| tin |meat/) {
foreach $mon (@petrifiers) {
if (/$mon/) { $_ = "dead $mon"; }
}
}
# Riding cockatrices (can this really happen?)
# Assumes that the monster name is the last word in the line,
# and that Medusa is the only unique petrifying monster
if (/ride|riding|saddle|falling off/) {
@words = split;
$monart = $words[$#words-1] . " ";
$monster = $words[$#words];
if ($monster eq "Medusa") { $monart = ""; }
$_ = "riding" . $monart . $monster;
}
}
s/(killed by|crushed to death by|dissolved in)( an?)? //; # see topten.c
s/^the //;
s/hallucinogen-distorted |invisible //;
s/ his / his\/her /;
s/ her / his\/her /;
s/ himself / him\/herself /;
s/ herself / him\/herself /;
s/priest(ess)?.*/priest(ess)/;
s/.*, the shopkeeper/shopkeeper/;
s/ghost of .*/ghost/;
s/slipped while mounting .*/slipped while mounting a steed/;
s/fall onto //;
s/bolt of .*/magic bolt/;
s/blast of .*/magic blast/;
s/wrath of .*/divine wrath/;
# Miscellaneous deaths which are (IMHO) really the same thing
if (/iron ball/) { $_ = "iron ball"; }
if (/drawbridge/) { $_ = "drawbridge"; }
if (/^caught/) { $_ = "caught him/herself in his/her own magical blast"; }
if (/genocid/) { $_ = "self-genocide"; }
if (/kicking/) { $_ = "kicking something"; }
if (/reverting/) { $_ = "reverting to unhealthy normal form"; }
if (/touching/ && $_ !~ /edge of the universe/)
{ $_ = "touching an artifact"; }
# Divine minions. "X of Y" must become "X" if and only if "Y" is a
# deity, EXCEPT that "Minion of Huhetotl" needs to remain unchanged.
if (/of ([A-Z].*)/) {
if ($gods{$1} == 1 && $_ ne "Minion of Huhetotl") {
s/of [A-Z].*//;
}
}
$count{$_}++;
$killlen = length($count{$_}) if length($count{$_}) > $killlen;
$score{$_} += $info[1];
$scorelen = length($score{$_}) if length($score{$_}) > $scorelen;
}
sub mysort {
($A = $a) =~ tr/A-Z/a-z/; ($B = $b) =~ tr/A-Z/a-z/;
if ($opt_n) {
$count{$b} <=> $count{$a} || $score{$b} <=> $score{$a} || $A cmp $B;
}
else {
$score{$b} <=> $score{$a} || $count{$b} <=> $count{$a} || $A cmp $B;
}
}
for $key (sort mysort keys %count)
{
printf "%${killlen}d %${scorelen}d %${scorelen}d %s\n", $count{$key}, $score{$key}, $score{$key}/$count{$key}, $key;
}
exit 0;
__END__