#!/usr/bin/perl -w ## statnethack -- compute statistics from Nethacks logfile # ## Author : Sascha Lüdecke ## Maintainer: Sascha Lüdecke ## WWW : http://www.meta-x.de/software # ## Description: Shows some statistics on how you are performing in nethack. # # Works with logfiles from Nethack 3.2.*, 3.3.* and 3.1*. # Run with "--help" to get a list of aviable options. # ## Copyright (C) 2000 Sascha Lüdecke # # This program is free software; you can redistribute it and/or modify # it under the terms of the GNU General Public License as published by # the Free Software Foundation; either version 2 of the License, or # (at your option) any later version. # # This program is distributed in the hope that it will be useful, # but WITHOUT ANY WARRANTY; without even the implied warranty of # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the # GNU General Public License for more details. # # You should have received a copy of the GNU General Public License # along with this program; if not, write to the Free Software # Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA. # ## Credits: Special thanks the people on rec.games.roguelike.nethack, # who gave a lot of improving hints. # ## TODO: - some special levels are negative. # - make order of tables output dependent of parameter order # - include duration of games # - filter for games in a certain date range # - finish list of deadly levels (branches, ascended) # - optionally use median instead of avg # - gtk: add some accelerators # - gtk: add tooltips # - reengineer (maybe in another language?) -- this is becoming # all spaghetti code (*ugh*) # - gtk: select logfile fills gtklist twice! # - gtk: button to set/unset all roles/races/alignments # - offer configfile # - gtk: new last_color doesn't need to reread logfile # - gtk: highlight changes when reread logfile # - gtk: last_color should be refleted in set button and choose # dialogue $version = '2.6.0'; ########################################################################### ########################################################################### # $Id: statnethack,v 1.47 2000/06/30 13:08:12 saschal Exp $ # this needs at least perl 5 require 5; ########################################################################### # # variables for options and hashes for role, race and alignment names # ########################################################################### # Some global variables: # # %games, %roles_played, # %players, %playerlvmax, %playerhigh, %player_sclv, %player_lvsc # %score, %scmax, # %level, %lvmax, %lvdeadly, %scdeadly # %races_played, %genders_played, %aligns_played # $n, @unknown # make some command line parameter checking, which sets several variables # filters: ($look_gender, $look_name, $look_race, $look_role, $look_version, $look_align); # memorizers: ($lastrole, $lastrace, $lastalign, $lastgender, $lastdlev, $lastplayer); # preset filters: foreach $f ($look_role, $look_gender, $look_version, $look_name, $look_race, $look_align) { $f = ''; } $nhlog = '/var/games/nethack/logfile'; $opt_short = 0; $opt_listnames = 0; $opt_long_tables = 0; $opt_deadly_levels = 0; $opt_death_reasons = 0; $opt_death_expand = 0; $opt_list_sortby = 'N'; # one of GLNS (games, level, name, score) $opt_roles_sortby = 'N'; # one of GLlNSs (games, level max, level avg, name, scoremax, score avg) $opt_printunknown = 0; $opt_gtk_stats = 0; $opt_with_quits = 0; %rolenames = ('Arc' => 'Archeologist', 'A' => 'Archeologist', 'Bar' => 'Barbarian', 'B' => 'Barbarian', 'Cav' => 'Cave(wo)man', 'C' => 'Cave(wo)man', 'Elf' => 'Elf', 'E' => 'Elf', 'Hea' => 'Healer', 'H' => 'Healer', 'Kni' => 'Knight', 'K' => 'Knight', 'Mon' => 'Monk', 'Pri' => 'Priest(ess)', 'P' => 'Priest(ess)', 'Rog' => 'Rogue', 'R' => 'Rogue', 'Ran' => 'Ranger', 'Sam' => 'Samurai', 'S' => 'Samurai', 'Tou' => 'Tourist', 'T' => 'Tourist', 'Val' => 'Valkyrie', 'V' => 'Valkyrie', 'Wiz' => 'Wizard', 'W' => 'Wizard'); %racenames = ('Hum' => 'Humans', 'H' => 'Humans', 'Elf' => 'Elfs', 'E' => 'Elfs', 'Dwa' => 'Dwarfs', 'D' => 'Dwarfs', 'Gno' => 'Gnomes', 'G' => 'Gnomes', 'Orc' => 'Orcs', 'O' => 'Orcs'); %alignnames = ('Neu' => 'Neutral', 'N' => 'Neutral', 'Cha' => 'Chaotic', 'C' => 'Chaotic', 'Law' => 'Lawful', 'L' => 'Lawful', 'Unk' => 'Unknown', 'U' => 'Unknown'); %levelnames = ( -5 => 'The Astral plane', -4 => 'The Water plane', -3 => 'The Fire plane', -2 => 'The Air plane', -1 => 'The Earth plane'); $label_sum = 'Overall'; $label_best = 'Highscore'; $label_deepest = 'Deepest'; $label_last = 'Last game'; $label_male = 'Men'; $label_female = 'Women'; @label_sums = ($label_best, $label_deepest, $label_last, $label_sum); $n = 0; ########################################################################### # # gtk_showStats # # shows a window with a single list containing the playernames # ########################################################################### sub gtk_showStats () { my ($main_window, $box1, $notebook, $button, $statsbox, $deadlybox, $aboutbox, $clist, $scrolled_win, $lev, $text, $scavg, $tmpscores, $bbox, $label); my @titles; local @statlists; local $statslabel; local $deadlyclist; local $deadlylabel; local $playerclist; local $playerlastlabel; local $playersumlabel; local $nhloglabel; local $gtkstatus; init Gtk; ## Main window # $main_window = new Gtk::Window -toplevel; $main_window->set_title('statnethack' ); $main_window->set_usize(600, 770); $main_window->border_width(0); #my $last_color = $box->get_colormap->color_alloc( { red => 0xeaea, green => 0xeaea, blue => 0xEAEA } ); #green local $last_color = $main_window->get_colormap->color_alloc( { red => 41287, green => 49723, blue => 65535 } ); # local $last_color = $main_window->get_colormap->color_alloc( { red => 7208, # green => 55704, # blue => 65536 } ); # my $last_color = $box->get_colormap->color_alloc( { red => 3276, # green => 53083, # blue => 65535 } ); ## Box for notebook and buttons # $box1 = new Gtk::VBox(0,0); $main_window->add($box1); $box1->show; ## Notebook # $notebook = new Gtk::Notebook(); $box1->pack_start($notebook, 1, 1, 0); $notebook->show; ########## ## Statistics page # $statsbox = new Gtk::VBox(0, 0); $notebook->append_page($statsbox, new Gtk::Label('Statistics')); $statsbox->show; # generate lists, fill them later push @statlists, gtk_makeStatList ($statsbox, 1, 'Roles'); push @statlists, gtk_makeStatList ($statsbox, 0, 'Races'); push @statlists, gtk_makeStatList ($statsbox, 0, 'Alignments'); push @statlists, gtk_makeStatList ($statsbox, 0, 'Gender'); push @statlists, gtk_makeStatList ($statsbox, 0, 'Sums'); # Buttonbox to sort all tables at once $bbox = new Gtk::HBox(0,0); $label = new Gtk::Label('Sort all by:'); $bbox->pack_start($label, 1, 0, 0); $label->show; $pos = 0; foreach $text ('Name', 'Games', 'Games %', 'Score avg', 'Score max', 'Level avg', 'Level max', 'Ascended', 'Asc. %') { $button = new Gtk::Button($text); # this might be dirty, but is there another way than # unrolling the loop? eval "\$button->signal_connect('clicked' => " . "sub { gtk_sortStatLists($pos) } )"; $bbox->pack_start($button, 1, 0, 0); $button->show; $pos++; } $statsbox->pack_start($bbox, 0, 0, 0); $bbox->show; # label with number of Games $statslabel = new Gtk::Label(); $statsbox->pack_start($statslabel, 0, 1, 0); $statslabel->show; ########## ## Deadly levels # $deadlybox = new Gtk::VBox(0, 0); $notebook->append_page($deadlybox, new Gtk::Label('Deadly Levels')); $deadlybox->show; $scrolled_win = new Gtk::ScrolledWindow(undef, undef); $scrolled_win->set_policy('automatic', 'automatic'); # create clist @titles = ('Name', 'Level', 'Deaths', 'Sum score lost', 'Score lost avg'); $deadlyclist = new_with_titles Gtk::CList(@titles); $deadlyclist->set_column_width(0, 80); $deadlyclist->set_column_auto_resize(0, 1); $deadlyclist->signal_connect('click_column', \>k_sortCList); for $i ( 1 .. scalar(@titles) ) { $deadlyclist->set_column_justification($i, 'right'); } $deadlyclist->set_selection_mode('single'); # add list to window $deadlyclist->border_width(5); $scrolled_win->add($deadlyclist); $deadlybox->pack_start($scrolled_win, 1, 1, 0); $deadlyclist->show; $scrolled_win->show; $deadlyclist->set_compare_func(\>k_cmpCList); # label with sums about deadly levels $deadlylabel = new Gtk::Label(); $deadlybox->pack_start($deadlylabel, 0, 1, 0); $deadlylabel->show; ########## ## Death reason page # $reasonbox = new Gtk::VBox(0, 0); $notebook->append_page($reasonbox, new Gtk::Label('Death reasons')); $reasonbox->show; $scrolled_win = new Gtk::ScrolledWindow(undef, undef); $scrolled_win->set_policy('automatic', 'automatic'); @titles = ('Count', 'Reason', 'Sum Score', 'Avg Score', 'Avg Level', 'Max Level'); $reasonclist = new_with_titles Gtk::CList(@titles); #$reasonclist->set_column_width(0, 80); $reasonclist->signal_connect('click_column', \>k_sortCList); for $i ( 0 .. scalar(@titles) ) { $reasonclist->set_column_justification($i, 'right'); } # reasons look different $reasonclist->set_column_auto_resize(1, 1); $reasonclist->set_column_justification(1, 'left'); $reasonclist->set_selection_mode('single'); $reasonclist->set_compare_func(\>k_cmpReasonList); # add list to window $reasonclist->border_width(5); $scrolled_win->add($reasonclist); $reasonbox->pack_start($scrolled_win, 1, 1, 0); $reasonclist->show; $scrolled_win->show; ########## ## Playerlist page # $namebox = new Gtk::VBox(0, 0); $notebook->append_page($namebox, new Gtk::Label('Playerlist')); $namebox->show; $scrolled_win = new Gtk::ScrolledWindow(undef, undef); $scrolled_win->set_policy('automatic', 'automatic'); # create clist @titles = ('Player', 'Games', 'Highscore', 'At level', 'Max level', 'With score'); $playerclist = new_with_titles Gtk::CList(@titles); $playerclist->set_column_width(0, 80); $playerclist->signal_connect('click_column', \>k_sortCList); for $i ( 1 .. scalar(@titles) ) { $playerclist->set_column_justification($i, 'right'); } $playerclist->set_selection_mode('single'); # add list to window $playerclist->border_width(5); $scrolled_win->add($playerclist); $namebox->pack_start($scrolled_win, 1, 1, 0); $playerclist->show; $scrolled_win->show; # label with last player $playerlastlabel = new Gtk::Label(); $namebox->pack_start($playerlastlabel, 0, 1, 0); $playerlastlabel->show; # label with number of players $playersumlabel = new Gtk::Label(); $namebox->pack_start($playersumlabel, 0, 1, 0); $playersumlabel->show; $playerclist->set_compare_func(\>k_cmpCList); ########## ## config page # $configbox = new Gtk::VBox(0,0); $notebook->append_page($configbox, new Gtk::Label('Config')); $configbox->show; ## frame for configs $frame = new Gtk::Frame('Configuration'); $frame->show; $frame->set_shadow_type('in'); $frame->set_border_width(3); $configbox->pack_start($frame, 1, 1, 0); #config table $table = new Gtk::Table(5, 2, 1); $table->show; $frame->add($table); #, 0, 1, 0); # logfile label $label = new Gtk::Label('Logfile: '); $table->attach_defaults($label, 0, 1, 0, 1); $label->show; $nhloglabel = new Gtk::Label($nhlog); $table->attach_defaults($nhloglabel, 1, 2, 0, 1); $nhloglabel->show; # color selector for $last_color $label = new Gtk::Label('Choose color for last game:'); $label->show; $table->attach_defaults($label, 0, 1, 1, 2); $button = new Gtk::Button('Select'); # [fixme] how to fix size of the button? $button->can_default(1); $button->show; $table->attach_defaults($button, 1, 2, 1, 2); $button->signal_connect('clicked' => sub { my $f = new Gtk::ColorSelectionDialog('Choose color for last game'); $f->help_button->hide; $f->cancel_button->hide; #$f->colorsel->set_color($last_color); $f->ok_button->signal_connect('clicked', sub { destroy $f } ); $f->colorsel->signal_connect('color_changed', sub { my (@color) = $f->colorsel->get_color; $color[0] *= 65535; $color[1] *= 65535; $color[2] *= 65535; $last_color = $main_window->get_colormap->color_alloc( { red => $color[0], green => $color[1], blue => $color[2] }); $gtkstatus->push(1, 'Color for last game changed. Reread logfile to get the effect.'); }); $f->show; }); ## frame for death reasons $frame = new Gtk::Frame('Death reasons'); $frame->show; $frame->set_shadow_type('in'); $frame->set_border_width(3); $configbox->pack_start($frame, 1, 1, 0); # config button $button = new Gtk::CheckButton('Expand killed by monster'); $button->can_default(1); $button->show; $frame->add($button); $button->set_active($opt_death_expand); $button->signal_connect('clicked' => sub { $opt_death_expand = 1 - $opt_death_expand; gtk_filterChanged(); }); ## frame for filters $frame = new Gtk::Frame('Filters'); $frame->show; $frame->set_shadow_type('in'); $frame->set_border_width(3); $configbox->pack_start($frame, 1, 1, 0); $table = new Gtk::Table(15, 2, 0); $table->show; $frame->add($table); #, 0, 1, 0); # config filter for roles $label = new Gtk::Label('Roles to consider: '); $table->attach_defaults($label, 0, 1, 2, 3); $label->show; $t2 = new Gtk::Table(4, 5, 1); $t2->show; $table->attach_defaults($t2, 1, 2, 2, 3); $t2->attach_defaults(gtk_makeRoleButton('Arc'), 0, 1, 0, 1); $t2->attach_defaults(gtk_makeRoleButton('Bar'), 0, 1, 1, 2); $t2->attach_defaults(gtk_makeRoleButton('Cav'), 0, 1, 2, 3); $t2->attach_defaults(gtk_makeRoleButton('Elf'), 0, 1, 3, 4); $t2->attach_defaults(gtk_makeRoleButton('Hea'), 1, 2, 0, 1); $t2->attach_defaults(gtk_makeRoleButton('Kni'), 1, 2, 1, 2); $t2->attach_defaults(gtk_makeRoleButton('Mon'), 1, 2, 2, 3); $t2->attach_defaults(gtk_makeRoleButton('Pri'), 1, 2, 3, 4); $t2->attach_defaults(gtk_makeRoleButton('Rog'), 2, 3, 0, 1); $t2->attach_defaults(gtk_makeRoleButton('Ran'), 2, 3, 1, 2); $t2->attach_defaults(gtk_makeRoleButton('Sam'), 2, 3, 2, 3); $t2->attach_defaults(gtk_makeRoleButton('Tou'), 2, 3, 3, 4); $t2->attach_defaults(gtk_makeRoleButton('Val'), 3, 4, 0, 1); $t2->attach_defaults(gtk_makeRoleButton('Wiz'), 3, 4, 1, 2); $sep = new Gtk::HSeparator(); $sep->show; $table->attach_defaults($sep, 0, 2, 3, 4); # config filter for races $label = new Gtk::Label('Races to consider: '); $table->attach_defaults($label, 0, 1, 4, 5); $label->show; $t2 = new Gtk::Table(1, 6, 1); $t2->show; $table->attach_defaults($t2, 1, 2, 4, 5); $t2->attach_defaults(gtk_makeRaceButton('H'), 0, 1, 0, 1); $t2->attach_defaults(gtk_makeRaceButton('D'), 1, 2, 0, 1); $t2->attach_defaults(gtk_makeRaceButton('E'), 2, 3, 0, 1); $t2->attach_defaults(gtk_makeRaceButton('G'), 3, 4, 0, 1); $t2->attach_defaults(gtk_makeRaceButton('O'), 4, 5, 0, 1); $sep = new Gtk::HSeparator(); $sep->show; $table->attach_defaults($sep, 0, 2, 5, 6); # config filter for alignments $label = new Gtk::Label('Alignment to consider: '); $table->attach_defaults($label, 0, 1, 6, 7); $label->show; $t2 = new Gtk::Table(1, 6, 1); $t2->show; $table->attach_defaults($t2, 1, 2, 6, 7); $t2->attach_defaults(gtk_makeAlignButton('C'), 0, 1, 0, 1); $t2->attach_defaults(gtk_makeAlignButton('L'), 1, 2, 0, 1); $t2->attach_defaults(gtk_makeAlignButton('N'), 2, 3, 0, 1); $t2->attach_defaults(gtk_makeAlignButton('U'), 3, 4, 0, 1); $sep = new Gtk::HSeparator(); $sep->show; $table->attach_defaults($sep, 0, 2, 7, 8); # config filter for gender $label = new Gtk::Label('Gender: '); $label->show; $table->attach_defaults($label, 0, 1, 8, 9); $hbox = new Gtk::HBox(0, 0); $hbox->show; $table->attach_defaults($hbox, 1, 2, 8, 9); # this button is a workaround, since always the first # RadioButton of a group receives 'clicked'. Why? $button = new Gtk::RadioButton('[fixme]'); $hbox->pack_start($button, 0, 1, 0); $button = new Gtk::RadioButton('any', $button); $hbox->pack_start($button, 0, 1, 0); $button->set_active($look_gender eq ''); $button->show; $button->signal_connect('clicked' => sub { $look_gender = ''; gtk_filterChanged(); }); $button = new Gtk::RadioButton('female', $button); $hbox->pack_start($button, 0, 1, 0); $button->set_active($look_gender eq 'F'); $button->show; $button->signal_connect('clicked' => sub { $look_gender = 'F'; gtk_filterChanged(); }); $button = new Gtk::RadioButton('male', $button); $hbox->pack_start($button, 0, 1, 0); $button->set_active($look_gender eq 'M'); $button->show; $button->signal_connect('clicked' => sub { $look_gender = 'M'; gtk_filterChanged(); }); $sep = new Gtk::HSeparator(); $sep->show; $table->attach_defaults($sep, 0, 2, 9, 10); # config for filtering for a version $label = new Gtk::Label('Nethak versions to consider: '); $label->show; $table->attach_defaults($label, 0, 1, 10, 11); $hbox = new Gtk::HBox(0,0); $hbox->show; $table->attach_defaults($hbox, 1, 2, 10, 11); # this button is a workaround, since always the first # RadioButton of a group receives 'clicked'. Why? $button = new Gtk::RadioButton('[fixme]'); $hbox->pack_start($button, 0, 1, 0); $button = new Gtk::RadioButton('any', $button); $hbox->pack_start($button, 0, 1, 0); $button->set_active($look_version eq ''); $button->show; $button->signal_connect('clicked' => sub { $look_version = ''; gtk_filterChanged(); }); $button = new Gtk::RadioButton('pre 3.2.0', $button); $button->show; $hbox->pack_start($button, 0, 1, 0); $button->set_active($look_version eq '3.1'); $button->signal_connect('clicked' => sub { $look_version = '3.1'; gtk_filterChanged(); }); $button = new Gtk::RadioButton('3.2.x', $button); $hbox->pack_start($button, 0, 1, 0); $button->set_active($look_version eq '3.2'); $button->show; $button->signal_connect('clicked' => sub { $look_version = '3.2'; gtk_filterChanged(); }); $button = new Gtk::RadioButton('3.3.x', $button); $hbox->pack_start($button, 0, 1, 0); $button->set_active($look_version eq '3.3'); $button->show; $button->signal_connect('clicked' => sub { $look_version = '3.3'; gtk_filterChanged(); }); $sep = new Gtk::HSeparator(); $sep->show; $table->attach_defaults($sep, 0, 2, 11, 12); # config to include games quit $button = new Gtk::CheckButton('Include games quit'); $button->show; $button->set_active($opt_with_quits); $table->attach_defaults($button, 0, 2, 12, 13); $button->signal_connect('clicked' => sub { $opt_with_quits = 1 - $opt_with_quits; gtk_filterChanged(); }); ########## ## Button bar at the bottom # $buttonbox = new Gtk::HButtonBox; #(0, 10); $box1->pack_start($buttonbox, 0, 1, 0); $buttonbox->show; $button = new Gtk::Button('Reread logfile'); # $button->set_text('foo'); $button->signal_connect('clicked' => sub { readLogfile (); gtk_fillData (); }); $button->can_default(1); $button->grab_default; $buttonbox->pack_start($button, 0, 1, 0); $button->show; $button = new Gtk::Button('Select logfile'); $button->signal_connect('clicked' => sub { my $f = new Gtk::FileSelection('Choose nethack logfile'); $f->cancel_button->signal_connect('clicked', sub { destroy $f } ); $f->ok_button->signal_connect('clicked', sub { $file = $f->get_filename; if (-f $file && -s $file && -r $file) { $nhloglabel->set($file); $nhlog = $file; readLogfile(); gtk_fillData(); destroy $f; } else { print "GTK: No valid file selected!\n" } } ); $f->show; }); $button->can_default(1); $buttonbox->pack_start($button, 0, 1, 0); $button->show; $button = new Gtk::Button('Exit'); $button->signal_connect('clicked' => sub { Gtk->exit(0);} ); $button->can_default(1); $button->grab_default; $buttonbox->pack_start($button, 0, 1, 0); $button->show; ########## ## about page # $aboutbox = new Gtk::VBox(0, 0); $notebook->append_page($aboutbox, new Gtk::Label('About')); $aboutbox->show; $label = new Gtk::Label('statnethack version ' . $version); $aboutbox->pack_start($label, 0, 1, 0); $label->show; $label = new Gtk::Text(); $label->set_editable(0); # [fixme] colors are wrong. $label->insert('Courier', 'white', '#EAEAEA', ' ## statnethack -- compute statistics from Nethacks logfile # ## Author : Sascha Lüdecke ## Maintainer: Sascha Lüdecke ## WWW : http://www.meta-x.de/software # ## Description: Shows some statistics on how you are performing in nethack. # # Works with logfiles from Nethack 3.2.*, 3.3.* and 3.1*. # Run with "--help" to get a list of aviable options. # ## Copyright (C) 2000 Sascha Lüdecke # # This program is free software; you can redistribute it and/or modify # it under the terms of the GNU General Public License as published by # the Free Software Foundation; either version 2 of the License, or # (at your option) any later version. # # This program is distributed in the hope that it will be useful, # but WITHOUT ANY WARRANTY; without even the implied warranty of # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the # GNU General Public License for more details. # # You should have received a copy of the GNU General Public License # along with this program; if not, write to the Free Software # Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA. # ## Credits: Special thanks the people on rec.games.roguelike.nethack, # who gave a lot of improving hints. # ## TODO: see beginning or sourcefile for a list of open topics '); $aboutbox->pack_start($label, 1, 1, 0); $label->show; $gtkstatus = new Gtk::Statusbar(); $gtkstatus->show; $box1->pack_start($gtkstatus, 0, 1, 0); gtk_fillData (); $main_window->show; main Gtk; } # # signal the user, that the filters have changed and te logfile should be reread # sub gtk_filterChanged { $gtkstatus->push(1, 'Filters have changed. Reread logfile to get the new values.'); } # # show a window with a label and a button # sub gtk_infobox ($$) { $text = shift; $buttontext = shift; $win = new Gtk::Dialog(); $win->set_title('Information'); $win->border_width(0); $win->set_default_size(200, 100); $win->set_position('mouse'); $label = new Gtk::Label($text); $label->show; $win->vbox->pack_start($label, 1, 1, 0); $button = new Gtk::Button($buttontext); $button->show; $button->can_default(1); $button->signal_connect('clicked' => sub { destroy $win } ); $win->vbox->pack_start($button, 0, 1, 0); $win->show; } sub gtk_makeRaceButton ($) { $race = shift; $button = new Gtk::CheckButton($racenames{$race}); if ($look_race =~ /$race/) { $button->set_active(1); } $button->signal_connect('clicked' => eval "sub { if (\$look_race =~ /$race/) { \$look_race =~ s/$race//; } else { \$look_race .= $race; } gtk_filterChanged(); }"); $button->show; return $button; } sub gtk_makeAlignButton ($) { $align = shift; $button = new Gtk::CheckButton($alignnames{$align}); if ($look_align =~ /$align/) { $button->set_active(1); } $button->signal_connect('clicked' => eval "sub { if (\$look_align =~ /$align/) { \$look_align =~ s/$align//; } else { \$look_align .= $align; } gtk_filterChanged(); }"); $button->show; return $button; } sub gtk_makeRoleButton ($) { $role = shift; $button = new Gtk::CheckButton($rolenames{$role}); if ($look_role =~ /$role/) { $button->set_active(1); } $button->signal_connect('clicked' => eval "sub { if (\$look_role =~ /$role/) { \$look_role =~ s/$role\[\\|\]*//; \$look_role =~ s/\\|\$//; } else { \$look_role .= \"\\|$role\"; \$look_role =~ s/^\\|//; } gtk_filterChanged(); }"); $button->show; return $button; } # # compare routine for a clist. This *should* be improved! # sub gtk_cmpCList ($$$) { $list = shift; $a = shift; $b = shift; if ($list->sort_column > 0) { $a <=> $b; } else { $a cmp $b; } } # # compare routine for death reason list sub gtk_cmpReasonList ($$$) { $list = shift; $a = shift; $b = shift; if ($list->sort_column == 1) { $a cmp $b; } else { $a <=> $b; } } # # fills all elements on the window with data. introduced to support # reread of data # sub gtk_fillData () { if ($n == 0) { $gtkstatus->push(1, "Read of \`$nhlog\' resulted in no lines."); gtk_infobox("Sorry, but no lines of\n\`$nhlog\'\nwere recognized.\n" . "Adjust you filters or choose another file.", 'OK'); return } #################### # Statlists and label # gtk_fillAStatList ($statlists[0], $lastrole, keys %roles_played); gtk_fillAStatList ($statlists[1], $lastrace, keys %races_played); gtk_fillAStatList ($statlists[2], $lastalign, keys %aligns_played); gtk_fillAStatList ($statlists[3], $lastgender, keys %genders_played); gtk_fillAStatList ($statlists[4], $label_last, @label_sums); $statslabel->set("Number of Games: $n -- Logfile: $nhlog"); #################### # list of deadly levels # $deadlyclist->set_auto_sort(0); $deadlyclist->freeze; $deadlyclist->clear; $deadlyclist->set_sort_column(2); $deadlyclist->set_sort_type('descending'); foreach $lev (keys %lvdeadly) { $scavg = sprintf '%.2f', $scdeadly{$lev} / $lvdeadly{$lev}; $deadlyclist->append($levelnames{$lev}, $lev, $lvdeadly{$lev}, $scdeadly{$lev}, $scavg); $tmpscores += $scdeadly{$lev}; if ($lev == $lastdlev) { $deadlyclist->set_background($deadlyclist->rows - 1, $last_color); } } $deadlyclist->thaw; $deadlyclist->set_auto_sort(1); $text = 'Levels: ' . scalar keys %lvdeadly; $text .= " - Deaths: $n - Total score lost: $tmpscores"; $text .= ' - Total score lost avg: ' . sprintf '%.2f', $tmpscores / $n; $text .= "\n Logfile: $nhlog"; $deadlylabel->set($text); #################### # death reasons # $reasonclist->set_auto_sort(0); $reasonclist->freeze; $reasonclist->clear; $reasonclist->set_sort_column(0); $reasonclist->set_sort_type('descending'); foreach $reason (keys %deaths) { $scavg = sprintf '%.2f', $deaths_score{$reason} / $deaths{$reason}; $lvavg = sprintf '%.3f', $deaths_level{$reason} / $deaths{$reason}; $reasonclist->append( $deaths{$reason}, $reason, $deaths_score{$reason}, $scavg, $lvavg, $deaths_deepest{$reason} ); if ($reason eq $lastreason) { $reasonclist->set_background($reasonclist->rows - 1, $last_color); } } $reasonclist->thaw; $reasonclist->set_auto_sort(1); #################### # playerlist # $playerclist->set_auto_sort(0); $playerclist->freeze; $playerclist->clear; $playerclist->set_sort_column(2); $playerclist->set_sort_type('descending'); foreach $name (keys %players) { $playerclist->append( $name, $players{$name}, $playerhigh{$name}, $player_sclv{$name}, $playerlvmax{$name}, $player_lvsc{$name}); if ($name eq $lastplayer) { $playerclist->set_background($playerclist->rows - 1, $last_color); } } $playerclist->thaw; $playerclist->set_auto_sort(1); $playerlastlabel->set('Last: ' . $lastplayer . ' Games: ' . $players{$lastplayer} . ' Highscore: ' . $playerhigh{$lastplayer} . ' At level: ' . $player_sclv{$lastplayer} . ' Max level: ' . $playerlvmax{$lastplayer} . ' With score: ' . $player_lvsc{$lastplayer} ); $text = 'Number of Players: ' . scalar keys %players; $playersumlabel->set( $text . " -- Logfile: $nhlog"); } # # fill a clist on the stats page with data. # sub gtk_fillAStatList ($$@) { $clist = shift; $last = shift; @entries = @_; #@titles = ($title1, 'Games', 'Games %', 'Score avg', 'Score max', # 'Level avg', 'Level max', 'Ascended', 'Asc %'); #$clist = new_with_titles Gtk::CList(@titles); # build list $clist->set_auto_sort(0); $clist->freeze; $clist->clear; foreach $c (@entries) { $gpercent = sprintf '%.2f', $games{$c} / $n * 100; $scavg = sprintf '%.3f', $score{$c} / $games{$c}; $lvavg = sprintf '%.2f', $level{$c} / $games{$c}; $ascpercent = sprintf '%.3f', $ascended{$c} * 100 / $games{$c}; $clist->append( $c, $games{$c}, $gpercent, $scavg, $scmax{$c}, $lvavg, $lvmax{$c}, $ascended{$c}, $ascpercent ); if ($c eq $last) { $clist->set_background($clist->rows - 1, $last_color); } } $clist->thaw; $clist->set_auto_sort(1); } # # build table for page with stats about roles, races, etc. # this is analogical to printTable for STDOUT # sub gtk_makeStatList ($$@) { $box = shift; #$clist = shift; $expand = shift; $title1 = shift; if ($expand) { $scrolled_win = new Gtk::ScrolledWindow(undef, undef); $scrolled_win->set_policy('automatic', 'automatic'); } @titles = ($title1, 'Games', 'Games %', 'Score avg', 'Score max', 'Level avg', 'Level max', 'Ascended', 'Asc %'); $clist = new_with_titles Gtk::CList(@titles); $clist->set_column_width(0, 80); $clist->signal_connect('click_column', \>k_sortCList); $clist->set_compare_func(\>k_cmpCList); for $i ( 1 .. scalar(@titles) ) { $clist->set_column_justification($i, 'right'); } # set score avg to autoresize $clist->set_column_auto_resize(3, 1); $clist->set_selection_mode('single'); $clist->border_width(5); # add list to window if ($expand) { $scrolled_win->add($clist); $box->pack_start($scrolled_win, 1, 1, 0); $scrolled_win->show; } else { $box->pack_start($clist, 0, 0, 0); } $clist->show; return $clist; } # # callback to sort a clist after click on column header # sub gtk_sortCList { $list = shift; $col = shift; if ($col == $list->sort_column) { ($list->sort_type eq 'ascending') ? $list->set_sort_type('descending') : $list->set_sort_type('ascending'); } else { $list->set_sort_column($col); $list->set_sort_type('ascending'); } $list->sort; } # # callback to sort all stat lists on the stats page # sub gtk_sortStatLists ($) { $col = shift; $ascend = 1; if ($col == $statlists[0]->sort_column) { if ($statlists[0]->sort_type eq 'ascending') { $ascend = 0; } else { $ascend = 1; } } foreach $l (@statlists) { $l->set_sort_column($col); if ($ascend == 1) { $l->set_sort_type('ascending'); } else { $l->set_sort_type('descending'); } $l->sort; } } ########################################################################### # # printHelp # ########################################################################### sub printHelp () { print <<"HELP"; $0 -- Version $version Usage: $0 [command|option|filter]+ Defaults: - logfile read from \`$nhlog\' - generate long statistics - playerlist sorted by name - roles table sorted by name Commands: none Long ouput of statistics. -h|--help Prints this text. -l|--listnames [GNLS] Show a list of all players found in the logfile. Optional [GLNS] sorts by Games played, max Level, Name or high Score. No other tables be created. All filters can be used. -d|--deadly Show a ranking of deadly levels. -D|--deaths [crsalm] Show a list of death reasons, optionally sort by Count, Reason, Score sum, Avg score, avg Level, Max level. Default is sort by count. -s|--short Short output of statistics. -t|--tables [rRags] Long output of statistics (tables for role, race, alignment, gender and a summary) (default) Optionally you can specify any of [rRags] to choose one or more tables. --unknown Show all lines not recognized. --gtk Show alls stats in a GTK window (GTK must be installed). All filters aply as well. Options: -f|--file file Use \`file\' as input for statistics. -S|--sort [GLlNSs] Sort roles table by games played, max. level, avg. level, role name, max. score or avg. score --with-quits Include games which were quit. --expand-reasons Do not collapse deaths by a monster to a single line in list of death reasons. Default is to collapse. Filter: -a|--align [CLNU]+ Consider games played with alignment Chaoric, Neutral or Lawful. This works only for games played with Nethack 3.3. Prior games are listed as Unknown. You can specify more than one alignment. -r|--role Wiz[,Ran]+ Consider games played with role specified alike Wiz (first three letters of rolename) only. More than one role can be specified by a comma seperated list. -g|--gender [MF] Consider only games played as Male or Female. -n|--name n1[,n2]+ Consider games played by n1, ... only. -R|--race [HDEGO]+ Consider games played as race Human, Dwarf, Elf Gnome or Orc only. You can specify more than one race. -v|--nhversion 3.[123] Consider games played with Nethack Version 3.1 and prior, 3.2 or 3.3 only. --version Print version number and exit. Examples: statnethack -a L -g M statnethack --align L --gender M Compute stats for all games played as a lawful man. Tables for gender and alignment will be suppressed, since its content is a single line equal to the \`Overall\' line in the sums table. statnethack -S G -r Wiz,Pri,Hea -R HE statnethack --sort G --role Wiz,Pri,Hea --race HE Compute stats for games played either as wizard, priest or healer with race human or elf. Role table will be sorted by number of games played. HELP } ########################################################################### # # parseCommandline # # command line checking # ########################################################################### sub parseCommandline () { while ($_ = shift @ARGV) { /^-a|--align/ && do { $_ = shift @ARGV; (!defined $_ || $_ !~ /^[CLNU]*$/) && die "Specify some of CLNU for chaotic, lawful, neutral and unkown alignment.\n" . "The U is for games played befor Nethack 3.3.\n"; $look_align = $_; next }; /^-d|--deadly/ && do { $opt_deadly_levels = 1; next }; /^-D|--deaths$/ && do { $_ = shift @ARGV; $opt_death_reasons = 1; (!defined $_ || $_ =~ /^-/) && do { unshift @ARGV, $_; $opt_death_sort = 'c'; next }; if ($_ !~ /^[crsalm]$/) { die "Specify none or one of [crsalm] to sort death reasons\n"; } else { $opt_death_sort = $_; } next }; /^--expand-reasons/ && do { $opt_death_expand = 0; next }; /^-f|--file/ && do { $_ = shift @ARGV; (! defined $_) && die "No filename given!\n"; $nhlog = $_; next }; /^-g|--gender/ && do { $_ = shift @ARGV; (!defined $_) && die "No gender given!\n"; $_ !~ /^[MF]$/ && die "Specify M or F as gender. \`$_\' not recognized.\n"; $look_gender = $_; next }; /^--gtk/ && do { $opt_gtk_stats = 1; print 'NOTE: statnethack will fail with an error, if it doesn\'t find '; print "Gtk-Perl!\n"; next }; /^-h|--help/ && do { printHelp(); exit }; /^-l|--listnames/ && do { $opt_listnames = 1; $_ = shift @ARGV; (!defined $_ || $_ =~ /^-/) && do { unshift @ARGV, $_; next }; ($_ !~ /^[GLNS]*$/) && die "Specify some of GLNS as sort order (Games, Level, Name, Score) the playerlist.\n"; $opt_list_sortby = $_; next }; /^-n|--name/ && do { $_ = shift @ARGV; (!defined $_) && die "No playername(s) given!\n"; $look_name = $_; $look_name =~ s/,/|/g; next }; /^-r|--role/ && do { $_ = shift @ARGV; (!defined $_) && die 'No classname given!'; ($_ !~ /^[A-Z][a-z][a-z](,[A-Z][a-z][a-z])*$/) && die "Specify classnames alike \`Wiz,Ran,...\' for wizards and rangers and more.\n"; foreach $i (split ',',$_) { unless (exists $rolenames{$i}) { die "$i is not a valid rolename.\n"; } } $look_role = $_; $look_role =~ s/,/|/g; next }; /^-R|--race/ && do { $_ = shift @ARGV; (!defined $_) && die "No race given! Specify some of [HDEGO].\n"; $_ !~ /^[HDEGO]*$/ && die "Specify some of [HDEGO] as race, \`$_\' not recognized.\n"; $look_race = $_; next }; /^-s|--short/ && do { $opt_short = 1; next }; /^-S|--sort/ && do { $_ = shift @ARGV; (!defined $_ || $_ !~ /^[GLlNSs]$/) && die 'Specify one of GLlNSs as sort order ' . "(Games, Levelmax, level avg, Name, \n\tScore max, score avg) for roles table.\n"; $opt_roles_sortby = $_; next }; /^-t|--tables/ && do { $opt_long_tables = 1; $_ = shift @ARGV; (defined $_ && $_ =~ /^-/) && do { unshift @ARGV, $_; $_ = 'rRags'; # all tables! }; (!defined $_) && do { $_ = 'rRags' }; ($_ !~ /^[rRags]+$/) && die 'Specify any of rRags to choose tables.'; foreach $t (split '', $_) { ($t eq 'r') && do { $opt_tables_roles = 1}; ($t eq 'R') && do { $opt_tables_races = 1}; ($t eq 'a') && do { $opt_tables_aligns = 1}; ($t eq 'g') && do { $opt_tables_genders = 1}; ($t eq 's') && do { $opt_tables_sums = 1}; } next }; /^--unknown/ && do { $opt_printunknown = 1; next }; /^-v|--nhversion/ && do { $_ = shift @ARGV; (!defined $_ || $_ !~ /^3.[123]$/) && die 'Specify one of 3.1, 3.2 or 3.3 as version-filter.'; $look_version = $_; next }; /--version/ && do { print "statnethack Version $version\n"; exit 0 }; /^--with-quits/ && do { $opt_with_quits = 1; next }; print "Unknown parameter \'$_\' skipped.\n"; } if (!$opt_death_reasons && !$opt_deadly_levels && !$opt_listnames && !$opt_long_tables) { $opt_long_tables = 1; $opt_tables_roles = 1; $opt_tables_races = 1; $opt_tables_aligns = 1; $opt_tables_genders = 1; $opt_tables_sums = 1; } } ########################################################################### # # readLogfile # # read records from nethacks logfile # ########################################################################### sub readLogfile () { (-s $nhlog) || die "File \`$nhlog\' not found or empty."; (-r $nhlog) || die "File \`$nhlog\' not readable."; open NHLOG, "$nhlog" || die 'Cannot open NHLOG. Sorry.'; # start numbering, clear stats $n = 0; %players = (); %playerhigh = (); %player_sclv = (); %player_lvsc = (); %playerlvmax = (); %lvdeadly = (); %scdeadly = (); %ascended = (); %score = (); %scmax = (); %level = (); %lvmax = (); %games = (); %roles_played = (); %races_played = (); %aligns_played = (); %genders_played = (); %deaths = (); %deaths_score = (); %deaths_level = (); %deaths_deepest = (); %deaths = (); %deaths = (); while () { chop; reset; #/()/; # clear $[1-9] $tmpascend = 0; ## # search for all relevant numbers in the actual line: # score, max level, max hp (unused so far), character class, gender, # char name, ascended(y/n) ## # 3.1 format, taken from Jukka Lahtinen's reclist (walker@clinet.fi), verified # from nh3.1 and nh3.1c-- source # date uid dtype dlev maxlev hp maxhp score class/gender name death /^\d+ [\d\-]+ \d+ ([\d\-]+) ([\d\-]+) [\d\-]+ ([\d\-]+) ([\d\-]+) ([A-Z])([MF]) ([^,]+),(.*)$/ && # fix order as we expect it # from maxlev, maxhp, score, class -> score, level, maxhp "$4 $1 $2 $3 $5 $6 $7,$8" =~ /([\d\-]+) ([\d\-]+) ([\d\-]+) ([\d\-]+) ([A-Z]) ([MF]) ([^,]+),(.*)/ && do { $nh_version = '3.1' }; # 3.2 format # version points dtype dlev maxlev hp maxhp ... class/gender name death /^3.2.\d+ ([\d\-]+) [\d\-]+ ([\d\-])+ ([\d\-]+) [\d\-]+ (\d+) [\d ]+ ([A-Z])([MF]) ([^,]+),(.*)$/ && do { $nh_version = '3.2' }; # 3.3 format # version points dtype dlev maxlev hp maxhp ... class race gender align name death /^3.3.\d+ ([\d\-]+) [\d\-]+ ([\d\-]+) ([\d\-]+) [\d\-]+ (\d+) [\d ]+ ([A-Z][a-z]+) ([A-Z][a-z]+) ([MF])[a-z]+ ([A-Z][a-z]+) ([^,]+),(.*)$/ && "$1 $2 $3 $4 $5 $7 $9,$10 \# $6 $8" =~ /([\d\-]+) ([\d\-]+) ([\d\-]+) ([\d\-]+) ([A-Z][a-z]+) ([MF]) ([^,]+),([^\#]+) \# ([A-Z][a-z]+) ([A-Z][a-z]+)/ && do { $nh_version = '3.3' }; # line recognized? # if (!defined $8) { push @unknown, pack 'A5a2a*', $., '| ', $_; next; } ## # get gender, role, race, score and level of this character into # $tmp* variables ## $tmpgenderchar = $6; ($6 eq 'M') ? do {$tmpgender = $label_male} : do {$tmpgender = $label_female}; $tmprole = $rolenames{$5}; if (!defined $9) { if ($5 eq 'E') { $tmprace = 'Elfs'; } else { $tmprace = 'Humans'; } } else { $tmprace = $racenames{$9}; } $tmpscore = $1; $tmpdlev = $2; $tmplev = $3; # $tmphp = $4; # unused so far $tmpname = $7; $tmpdeath = $8; # get alignment if (defined $10) { $tmpalign = $alignnames{$10}; } else { $tmpalign = $alignnames{'Unk'}; } # check if ascended $tmpdeath =~ /ascended/ && do { $tmpascend = 1 }; # this is for the debug case # print "ver: $nh_version sc: $tmpscore dlev: $tmpdlev maxlv: $tmplev " # # . "maxhp: $tmphp" # . "role: $tmprole gender: $tmpgender " # . "name: $tmpname death: $tmpdeath race: $tmprace " # . "align: $tmpalign ascended: $tmpascend\n"; ## # filter for a certain gender, player, role, version, alignment or race? # and other ko criteria ## (!$opt_with_quits && $tmpdeath =~ /panic/) && do { next }; ($look_gender ne '' && $look_gender ne $tmpgenderchar) && do { next }; ($look_name ne '' && $tmpname !~ /($look_name)/) && do { next }; ($look_race ne '' && $tmprace !~ /[$look_race]/) && do { next }; ($look_role ne '' && $tmprole !~ /($look_role)/) && do { next }; ($look_version ne '' && $nh_version ne $look_version) && do { next }; ($look_align ne '' && $tmpalign !~ /[$look_align]/) && do { next }; ## FIXME # new code for list of death reasons if ($opt_death_reasons || $opt_gtk_stats) { # do some reasonable tweaking on reasons $tmpdeath =~ s/by a.*, while helpless.*/while helpless/; $tmpdeath =~ s/by .*, the shopkeeper.*/by a shopkeeper/; $tmpdeath =~ s/rotted .*corpse/rotted corpse/; $tmpdeath =~ s/invisible.*/invisible monster/; $tmpdeath =~ s/by a hallucinogen-distorted.*/while hallucinating/; $tmpdeath =~ s/choked on.*/chocking/; $tmpdeath =~ s/called.*/kitten/; $tmpdeath =~ s/the ghost of.*/a ghost/; $tmpdeath =~ s/the wrath of.*/a wrath/; $tmpdeath =~ s/zapped (her|him)self with a wand/zapping (her|him)self/; $tmpdeath =~ s/.*kicking.*/kicking something/; $tmpdeath =~ s/petrified by.*/petrification/; $tmpdeath =~ s/poisoned by.*/getting poisoned/; $tmpdeath =~ s/quit/cowardly quitting/; $tmpdeath =~ s/drowned.*/drowning/; $tmpdeath =~ s/slipped while.*/slipping from something/; if ($opt_death_expand) { $tmpdeath =~ s/killed by an? (.*)/$1/; } else { $tmpdeath =~ s/killed by (a|the).*/killed by a monster/; } $deaths{$tmpdeath} += 1; $deaths_score{$tmpdeath} += $tmpscore; $deaths_level{$tmpdeath} += $tmpdlev; if (!defined $deaths_deepest{$tmpdeath} || $tmpdlev > $deaths_deepest{$tmpdeath}) { $deaths_deepest{$tmpdeath} = $tmpdlev; } $lastreason = $tmpdeath; $recorded = 1; } ## FIXME if ($opt_listnames || $opt_gtk_stats) { ## # If asked for playerlist, store playername and highscore # with level and vice versa. ## $players{$tmpname} += 1; if (!defined $playerhigh{$tmpname} || $playerhigh{$tmpname} <= $tmpscore || ($playerhigh{$tmpname} <= $tmpscore && $player_sclv{$tmpname} < $tmplev)) { $playerhigh{$tmpname} = $tmpscore; $player_sclv{$tmpname} = $tmplev } if (!defined $playerlvmax{$tmpname} || $playerlvmax{$tmpname} < $tmplev || ($playerlvmax{$tmpname} <= $tmplev && $player_lvsc{$tmpname} < $tmpscore)) { $playerlvmax{$tmpname} = $tmplev; $player_lvsc{$tmpname} = $tmpscore } $lastplayer = $tmpname; $recorded = 1; } if ($opt_deadly_levels || $opt_gtk_stats) { $lvdeadly{$tmpdlev} += 1; if ($tmpdlev >= 0) { $levelnames{$tmpdlev} = sprintf '%02d', $tmpdlev; } $scdeadly{$tmpdlev} += $tmpscore; $lastdlev = $tmpdlev; $recorded = 1; #print $n / 3 ." lastdlev: $tmpdlev $lastdlev " . $lvdeadly{$tmpdlev} . "\n"; } if ($opt_long_tables || $opt_gtk_stats) { ## # Compute statistic tables ## foreach $c (($label_sum, $tmpgender, $tmprole, $tmprace, $tmpalign)) { $ascended{$c} += $tmpascend; $score{$c} += $tmpscore; $level{$c} += $tmplev; if (!defined $scmax{$c} || $scmax{$c} <= $tmpscore) { $scmax{$c} = $tmpscore } if (!defined $lvmax{$c} || $lvmax{$c} < $tmplev) { $lvmax{$c} = $tmplev } $games{$c}++; } $genders_played{$tmpgender} = 1; $roles_played{$tmprole} = 1; $races_played{$tmprace} = 1; $aligns_played{$tmpalign} = 1; # save info for last game $lastgender = $tmpgender; $lastrole = $tmprole; $lastrace = $tmprace; $lastalign = $tmpalign; # save info for best game in score if (!defined $scmax{$label_best} || $scmax{$label_best} < $tmpscore) { $scmax{$label_best} = $tmpscore; $ascended{$label_best} = $tmpascend; $score{$label_best} = $tmpscore; $level{$label_best} = $tmplev; $lvmax{$label_best} = $tmplev; $games{$label_best} = 1; } # save info for best game in depth if (!defined $lvmax{$label_deepest} || $lvmax{$label_deepest} < $tmplev) { $scmax{$label_deepest} = $tmpscore; $ascended{$label_deepest} = $tmpascend; $score{$label_deepest} = $tmpscore; $level{$label_deepest} = $tmplev; $lvmax{$label_deepest} = $tmplev; $games{$label_deepest} = 1; } $score{$label_last} = $tmpscore; $scmax{$label_last} = $tmpscore; $level{$label_last} = $tmplev; $lvmax{$label_last} = $tmplev; $games{$label_last} = 1; $ascended{$label_last} = $tmpascend; $recorded = 1; } if ($recorded) { $n++; } } close NHLOG; # fix $n for gtk # this way is dirty ! if ($opt_gtk_stats) { # $n = $n / 4; (defined $gtkstatus) && do { $gtkstatus->push(1, "Reading $nhlog ... $n lines."); }; } } ########################################################################### # # Comparism operators for sorting lists # ########################################################################### # playerlist sub sort_pl_games { $players{$b} <=> $players{$a} } sub sort_names { $a cmp $b } sub sort_pl_score { $playerhigh{$b} <=> $playerhigh{$a} } sub sort_pl_level { $playerlvmax{$b} <=> $playerlvmax{$a} } # roles table sub sort_role_games { $games{$b} <=> $games{$a} } sub sort_role_scmax { $scmax{$b} <=> $scmax{$a} } sub sort_role_scavg { $score{$b}/$games{$b} <=> $score{$a}/$games{$a} } sub sort_role_lvmax { $lvmax{$b} <=> $lvmax{$a} } sub sort_role_lvavg { $level{$b}/$games{$b} <=> $level{$a}/$games{$a} } # death reasons sub sort_deaths_count { $deaths{$b} <=> $deaths{$a} } sub sort_deaths_reason { $a <=> $b } sub sort_deaths_accscore { $deaths_score{$b} <=> $deaths_score{$a} } sub sort_deaths_avgscore { $deaths_score{$b}/$deaths{$b} <=> $deaths_score{$a}/$deaths{$a} } sub sort_deaths_avglevel { $deaths_level{$b}/$deaths{$b} <=> $deaths_level{$a}/$deaths{$a} } sub sort_deaths_maxlevel { $deaths_deepest{$b} <=> $deaths_deepest{$a} } ########################################################################### # # printTable # # gets: title, last game was, list of colunm names # ########################################################################### sub printTable ($$@) { $tablename = shift; $last = shift; $^ = 'LONGHEAD'; $~ = 'LONGTABLEHEAD'; write; $~ = 'LONGTABLEBODY'; foreach $c (@_) { ($c eq $last) ? print '*' : print ' '; write; } $~ = 'LONGTABLESEP'; write; print "\n"; } ########################################################################### # # printFilters # # Shows, how the lines were filtered. # ########################################################################### sub printFilters () { # Show what has been filtered for if ($look_race || $look_role || $look_gender || $look_align || $look_version || $look_name) { print 'You filtered for'; ($look_role) && do { print "\n\trole"; ($look_role =~ /\|/) && print 's'; $tmpsep = ' '; foreach $i (sort split '\|', $look_role) { print "$tmpsep$rolenames{$i}"; $tmpsep = ', '; } }; ($look_race) && do { print "\n\trace"; (length $look_race > 1) && print 's'; $tmpsep = ' '; foreach $i (sort split '', $look_race) { print "$tmpsep$racenames{$i}"; $tmpsep = ', '; } }; ($look_gender) && print "\n\tgender $look_gender"; ($look_align) && do { print "\n\talignment"; (length $look_align > 1) && print 's'; $tmpsep = ' '; foreach $i (sort split '', $look_align) { print "$tmpsep$alignnames{$i}"; $tmpsep = ', '; } }; ($look_name) && do { print "\n\tplayername"; ($look_name =~ /\|/) && print 's'; $look_name =~ s/\|/, /g; print " $look_name"; }; ($look_version) && print "\n\tNethack version $look_version"; print ".\n"; } if ($opt_with_quits) { print "You included games which were quit.\n"; } } ########################################################################### # # printResults # # prints tables with statistics # ########################################################################### sub printResults () { # local $mysort; if ($n == 0) { print "$0: No lines recognized!\n"; } elsif ($opt_gtk_stats) { # GTK output # This will simply fail, if there is no GTK installed. require Gtk; import Gtk; gtk_showStats(); } else { # STDOUT output if ($opt_listnames) { # print all names $- = 0; $^ = 'PLAYERLISTHEAD'; $~ = 'PLAYERLISTBODY'; # determine comparism routine for list sort $mysort = *sort_names; # default ($opt_list_sortby eq 'G') && do { $mysort = *sort_pl_games }; ($opt_list_sortby eq 'N') && do { $mysort = *sort_names }; ($opt_list_sortby eq 'S') && do { $mysort = *sort_pl_score }; ($opt_list_sortby eq 'L') && do { $mysort = *sort_pl_level }; foreach $name (sort $mysort keys %players) { write; } print "\n"; } if ($opt_death_reasons) { $- = 0; $^ = 'REASONS_HEAD'; $~ = 'REASONS_BODY'; $deathsort = *sort_deaths_count; ($opt_death_sort eq 'c') && do { $deathsort = *sort_deaths_count }; ($opt_death_sort eq 'r') && do { $deathsort = *sort_deaths_reason }; ($opt_death_sort eq 's') && do { $deathsort = *sort_deaths_accscore }; ($opt_death_sort eq 'a') && do { $deathsort = *sort_deaths_avgscore }; ($opt_death_sort eq 'l') && do { $deathsort = *sort_deaths_avglevel }; ($opt_death_sort eq 'm') && do { $deathsort = *sort_deaths_maxlevel }; foreach $reason (sort $deathsort keys %deaths) { write; } print "\n"; } if ($opt_deadly_levels) { $- = 0; $^ = 'DEADLYHEAD'; $~ = 'DEADLYSEP'; write; $~ = 'DEADLYBODY'; foreach $lev (sort { $a <=> $b } keys %lvdeadly) { write; $tmpscores += $scdeadly{$lev}; } $~ = 'DEADLYSEP'; write; $~ = 'DEADLYBODY'; # this is very dirty! $lev = scalar keys %lvdeadly; $lvdeadly{$lev} = $n; $scdeadly{$lev} = $tmpscores; $levelnames{$lev} = $label_sum; write; print "\n"; } if ($opt_printunknown) { if (scalar @unknown == 0) { print "$0: no unknown lines found in $nhlog\n"; } else { print "$0: unknown lines found in $nhlog:\n"; print "\n" . "num | content\n" . "-----+--------------------------------------------------------------------------\n"; foreach $line (@unknown) { print "$line\n"; } @unknown = (); print "\n"; } } if ($opt_short){ # short statistics $~ = 'SHORT'; write; } if ($opt_long_tables) { $- = 0; # determine comparism routine for list sort $mysort = *sort_names; # default ($opt_roles_sortby eq 'G') && do { $mysort = *sort_role_games }; ($opt_roles_sortby eq 'N') && do { $mysort = *sort_names }; ($opt_roles_sortby eq 'S') && do { $mysort = *sort_role_scmax }; ($opt_roles_sortby eq 's') && do { $mysort = *sort_role_scavg }; ($opt_roles_sortby eq 'L') && do { $mysort = *sort_role_lvmax }; ($opt_roles_sortby eq 'l') && do { $mysort = *sort_role_lvavg }; # long statistic ((!$look_role || length $look_role > 3) && $opt_tables_roles) && do { printTable('Roles', $lastrole, sort $mysort keys %roles_played) }; ((!$look_race || length $look_race > 1) && $opt_tables_races) && do { printTable('Races', $lastrace, sort keys %races_played) }; ((!$look_align || length $look_align > 1) && $opt_tables_aligns) && do { printTable('Alignment', $lastalign, sort keys %aligns_played) }; (!$look_gender && $opt_tables_genders) && do { printTable('Gender', $lastgender, sort keys %genders_played) }; ($opt_tables_sums) && do { printTable('Sums', $label_last, @label_sums) }; } } # fi STDOUT output printFilters(); if (scalar @unknown > 0) { print "Warning:\n"; print "\tThere were " . scalar @unknown . " line(s) of unknown format.\n"; print "\tuse option \`--unknown\' to see them.\n"; } } ########################################################################### ########################################################################### END { parseCommandline(); readLogfile(); printResults(); } ########################################################################### ########################################################################### ########################################################################### ########################################################################### # # format definitions # ########################################################################### format SHORT = games: @>>> sc avg: @#######.#### max: @####### lv avg: @#.### max: @# asc: @# $n, $score{$label_sum} / $n, $scmax{$label_sum}, $level{$label_sum} / $n, $lvmax{$label_sum}, $ascended{$label_sum} . format LONGHEAD = Statistics about Nethack games . format LONGTABLEHEAD = Level Ascended @<<<<<<<<<<< | Games Percent | Score: Avg Max | Avg Max | Count % $tablename -------------+---------------+----------------------+-----------+----------- . format LONGTABLESEP = -------------+---------------+----------------------+-----------+----------- . format LONGTABLEBODY = @<<<<<<<<<<<| @#### @##.## | @######.### @>>>>>> | @#.## @> | @> @.### $c, $games{$c}, $games{$c} / $n * 100, $score{$c} / $games{$c}, $scmax{$c}, $level{$c} / $games{$c}, $lvmax{$c}, $ascended{$c}, $ascended{$c} * 100 / $games{$c} . format PLAYERLISTHEAD = Nethack Playerlist Players found: @<<<<<< scalar keys %players Player | Games || Highscore | At level || Maxlevel | With score -------------+-------++-----------+----------++----------+----------- . format PLAYERLISTBODY = @<<<<<<<<<<< | @#### || @>>>>>>>> | @>> || @>> | @>>>>>>>>> $name, $players{$name}, $playerhigh{$name}, $player_sclv{$name}, $playerlvmax{$name}, $player_lvsc{$name} . format DEADLYHEAD = Nethack list of deadly levels Levels found: @<< scalar keys %lvdeadly Name | Level | Deaths | Score lost | Score avg . format DEADLYSEP = -----------------+-------+--------+------------+----------- . format DEADLYBODY = @<<<<<<<<<<<<<<< | @>>>> | @>>> | @>>>>>>>>> | @######.## $levelnames{$lev}, $lev, $lvdeadly{$lev}, $scdeadly{$lev}, $scdeadly{$lev} / $lvdeadly{$lev} . format REASONS_HEAD = Count | Reason | Sum Score | Avg Score | Avg Lv | Max Lv ------+--------------------------------+-----------+------------+--------+------- . format REASONS_BODY = @>>>> | @<<<<<<<<<<<<<<<<<<<<<<<<<<<<< | @######## | @######.## | @#.### | @### $deaths{$reason}, $reason, $deaths_score{$reason}, $deaths_score{$reason} / $deaths{$reason}, $deaths_level{$reason} / $deaths{$reason}, $deaths_deepest{$reason} .