# Nethack Logparser V 1.02
#
# By Robert Lund (robertl@pacificnet.net)
#
# This version runs under Win32.  To run under Unix, change the clear_screen
# function to call clear instead of cls
#
# Change the line that begins with $LOGFILE to point to the nethack Logfile
# on your system, NOT the record file

require 5;

$LOGFILE = "d:/games/Nethack 3.2 NT/logfile"; # CHANGE THIS LINE!!!!!

%chartypes = qw (P Priest A Archaelogist C Caveman W Wizard S Samurai
         H Healer T Tourist B Barbarian V Valkerie E Elf 
                 K Knight R Rogue);

$SCORE = 0; $END_LEV = 1; $MAX_LEV = 2; $END_HP = 3; $DEATH = 5;
$START = 6; $END = 7; $CHAR = 8; $SEX = 9; $NAME = 10;
$DEATH = 11;    $MAX_HP = 4;

sub read_data() {

    undef @data;
    open (LOG, $LOGFILE)  || die "Couldn't open $LOGFILE\n";

    for (<LOG>) {
next if /quit/;
        my @stuff = /\S+ (\d+) \d+ (-*\d+) (\d+) (-*\d+) (\d+) (\d+) (\d+) (\d+) \d+ (.)(.) (.*?),(.*)/;
        push @data, \@stuff;
    }
}

sub info_string(@)
{
    sprintf ("%-8s %-3s %-5s %-7s %s\n",
@_[$NAME], @_[$CHAR], @_[$END_LEV], @_[$SCORE], @_[$DEATH]);
}

sub dummy() { print "\nPress <ENTER> when done..."; my $dummy = <STDIN> }

sub clear_screen() { system 'cls' }  # CHANGE cls to clear if using UNIX!!

sub print_top($$)
{
    (my $how_many, my $what) = @_;
    my @idx;
    undef my @temp;
    
  
    if ($what =~ /all/i) {
@temp = @data;
    } else {
for $i (0 .. $#data) {
    next unless $data[$i][$CHAR] =~ /$what/;
    push @temp, $data[$i];
}
    }

    for $i (0 .. $#temp) {
push @idx, $temp[$i][$SCORE];
    }

    my @new = @temp[ reverse sort { $idx[$a] <=> $idx[$b] } 0 .. $#temp ];

    clear_screen;
    for $i (0 .. --$how_many) {
last unless $new[$i];
printf ("%2d) %s", $i + 1, info_string ( @{ $new[$i] }));
    }
    dummy
}

sub lethal()
{
    undef my %deadly;
    undef my $answer;

    while ($answer < 1 || $answer > 100) {
print "Show top how many lethal thingies? ";
chomp ($answer = <STDIN>);
    }
    
    for my $i (0 .. $#data) {
$_ = $data[$i][$DEATH];
next unless /killed by/;
s/ a //; s/ an //; s/killed by//;
  s/hallucinogen-distorted //; s/invisible //;
$deadly{$_}++;
    }

    my @t = reverse sort { $deadly{$a} <=> $deadly{$b} } keys %deadly;

    clear_screen;

    for (0 .. --$answer) {
        printf ("%3s) %-20s %-5s\n", 1 + $_, $t[$_], $deadly{$t[$_]});
    }
    dummy;
}


sub averages()
{
    undef %schitt;
    undef %size;
    my $totgames = 0;
    my $tothp = my $totlev = 0;


    clear_screen;
    for $i (0 .. $#data)
    {
($score, $max_hp, $max_lev, $char) = 
@{$data[$i]}[$SCORE, $MAX_HP, $MAX_LEV, $CHAR];
$schitt{$char}{score} += $score;
$schitt{$char}{maxhp} += $max_hp;
$schitt{$char}{maxlv} += $max_lev;
$totscore += $score;
$tothp += $max_hp;
$totlev += $max_lev;
$totgames++; 
$size{$char}++;
    }

    printf("%-15s %-15s %-10s %-10s %-10s\n\n",
     "Character", "Av. Score", "Av. Maxhp", "Av. Maxlv", "Total Games");

    for (reverse sort { 
        $schitt{$a}{score} / $size{$a} <=> $schitt{$b}{score} / $size{$b} 
    } qw (A B C E H K R S T V W)) {

printf ("%-15s %-15s %-10s %-10s %-10d\n",
$chartypes{$_}, 
         int ($schitt{$_}{score} / $size{$_}),
         int ($schitt{$_}{maxhp} / $size{$_}),
         int ($schitt{$_}{maxlv} / $size{$_}),
$size{$_});
    }
    
    printf ("\n%-15s %-15s %-10s %-10s %-10d\n", "Total", 
     int ($totscore / $totgames), int ($tothp / $totgames),
     int ($totlev / $totgames), $totgames);

    dummy
}

sub top_menu()
{
    my $how_many = my $what = 0;
    my %good = qw (A 1 B 1 C 1 E 1 H 1 K 1 P 1 R 1 S 1 T 1 V 1 W 1 ALL 1);

    until ($how_many > 0 && $how_many < 100) {
print "Show how many scores? ";
chomp ($how_many = <STDIN>);
    }

    until ($good{$what}) {
        print "For Which Class [ABCEHKPRSTVW|ALL]? ";
chomp ($what = <STDIN>);
$what = uc $what;
    }
    print_top($how_many, $what);
}

    
sub main_menu()
{
    while(1) {
   clear_screen;
print "Welcome to the Nethack LogParser V1.02 by Robert Lund!\n\n";
        print "\t1) Show top scores\n";
        print "\t2) Show class averages\n";
print "\t3) Show Lethal Monsters\n";
        print "\tq) Exit\n\n";
        print "Your Choice ==> ";
        chomp ($answer = <STDIN>);

  top_menu if $answer eq '1';
averages if $answer eq '2';
lethal if $answer eq '3';
exit if $answer =~ /q/i;
    }
}

read_data;
main_menu