#!/usr/bin/perl -w
#
# Magestats - BatMUD Mage guild statistics generator
# Developed by Matti Hämäläinen (Ggr Pupunen) <ccr@tnsp.org>
# (C) Copyright 2010-2016 Tecnic Software productions (TNSP)
#
# Requires Perl 5.8 and following modules:
# In Debian / Ubuntu, apt-get install libgd-graph-perl
#
use strict;
use warnings;
use File::Basename;
use Data::Dumper;
use GD::Graph;
use GD::Graph::linespoints;

# List of spells per damage type. Only major blasts/areas are counted
# for things like essence gain, etc.
my %spell_data = (
  "acid" => [ "acid blast",          "acid storm",      "acid ray",              "acid rain",       "acid arrow",      "acid wind", "disruption" ],
  "fire" => [ "lava blast",          "lava storm",      "meteor blast",          "meteor swarm",    "fire blast",      "fire bolt", "flame arrow" ],
  "elec" => [ "electrocution",       "lightning storm", "forked lightning",      "chain lightning", "blast lightning", "lightning bolt", "shocking grasp" ],
  "pois" => [ "summon carnal spores","killing cloud",   "power blast",           "venom strike",    "poison blast",    "poison spray", "thorn spray" ],
  "cold" => [ "cold ray",            "hailstorm",       "ice bolt",              "cone of cold",    "darkfire",        "flaming ice", "chill touch" ],
  "mana" => [ "golden arrow",        "magic eruption",  "summon greater spores", "magic wave",      "levin bolt",      "summon lesser spores", "magic missile" ],
  "asph" => [ "blast vacuum",        "vacuum globe",    "strangulation",         "chaos bolt",      "vacuum ball",     "suffocation", "vacuumbolt" ],
);

# Settings and defaults
my $prog_name = "Magestats";
my $prog_version = "0.8.0";
my $prog_file = $0;

my $opt_cachefile;
my $opt_verbosity = 1;
my $opt_prefix = "magestats";
my $opt_imgfmt = "png";
my $opt_noinput = 0;
my $opt_width = 500;
my $opt_height = 250;
my $opt_ggrtf = 0;
my $opt_ignore = 0;

my @crit_types = ("Unseen", "ENERGY", "POWER", "power");

# Log level support
sub mlog($$)
{
  my $level = shift;
  my $msg = shift;
  print STDERR "* $msg\n" if ($opt_verbosity >= $level);
}

###
### Print out help if no arguments given
###
my $opt_mode = shift or die(
"$prog_name v$prog_version - BatMUD Mage guild statistics generator
Developed by Matti Hamalainen (Ggr \@ bat), <ccr\@tnsp.org>
(C) Copyright 2010-2016 Tecnic Software productions (TNSP)

Usage: $prog_file dump [options] < logfile
       $prog_file stats [options] < logfile

 'dump' mode parses input log (unless -n is specified) and dumps
        the whole state into standard output. This dump acts as
        a cache, which can be later restored and added to.
        
 'stats' mode parses input (unless -n is specified) and outputs
        statistics in HTML format file with graphs in specified
        image format ($opt_imgfmt by default).

 -v                Verbose mode
 -c <cachefile>    Specify a cache file to restore from
 -p <prefix>       Output filename prefix ('$opt_prefix')
 -t <png|gif>      Image format to be used ('$opt_imgfmt')
 -s <W>x<H>        Graph dimensions in pixels ($opt_width x $opt_height)
 -n                No input (only handle cache, if specified)
 -g                Assume GgrTF mangled logfiles

 -i                Try to ignore blasts for staff counters that occured
                   when staff was not being worn. WARNING! This is a very
                   fragile and EXPERIMENTAL feature!

NOTICE! The input log data is assumed to be in CHRONOLOGICAL ORDER!
Things will go bonkers if that is not the case. Thus, make sure you
are feeding the data in correct order (older logs first, etc.)
");

die("Invalid operation mode '$opt_mode'!\n") unless ($opt_mode =~ /^(dump|stats)$/);

while (my $opt = shift) {
  if ($opt eq "-c") {
    # Restore cache from file
    $opt_cachefile = shift or die("-c option requires an argument.\n");
  } elsif ($opt eq "-v") {
    $opt_verbosity++;
  } elsif ($opt eq "-t") {
    $opt_imgfmt = shift or die("-t option requires an argument.\n");
    die("Invalid format '$opt_imgfmt' specified!\n") unless ($opt_imgfmt =~ /^(png|gif)$/);
  } elsif ($opt eq "-p") {
    $opt_prefix = shift or die("-p option requires an argument.\n");
  } elsif ($opt eq "-n") {
    $opt_noinput = 1;
  } elsif ($opt eq "-g") {
    $opt_ggrtf = 1;
  } elsif ($opt eq "-i") {
    $opt_ignore = 1;
  } elsif ($opt eq "-s") {
    my $tmp = shift or die("-s option requires an argument.\n");
    if ($tmp =~ /^(\d+)\s*[x:]\s*(\d+)$/) {
      $opt_width = $1;
      $opt_height = $2;
    } else {
      die("-s option expects WxH, for example 320x200.\n");
    }
  }
}


###
### Construct full data structure
###
mlog(1, "Initializing structures.");
my $spells = {};
foreach my $type (keys %spell_data) {
  my $src = $spell_data{$type};

  foreach my $spell (@{$src}) {
    $$spells{$spell}{"type"} = $type;
    $$spells{$spell}{"blasts"} = 0;
    $$spells{"staff"}{$spell}{"blasts"} = 0;
  }

  $$spells{$type}{"essence"}{"increase"} = 0;
  $$spells{$type}{"essence"}{"blasts"}{"single"} = [];
  $$spells{$type}{"essence"}{"blasts"}{"area"} = [];
  $$spells{$type}{"reinc"} = 0;

  $$spells{"staff"}{$type}{"blasts"} = 0;
 
  $$spells{$type}{"blasts"} = 0;
  $$spells{$type}{"reagents"} = 0;
  
  $$spells{$type}{"single"} = $$src[0];
  $$spells{$type}{"area"} = $$src[1];

  foreach my $crit (@crit_types) {
    $$spells{$type}{"crits"}{$crit} = 0;
  }
  
  push(@{$$spells{"single"}}, $$src[0]);
  push(@{$$spells{"area"}}, $$src[1]);
}
$$spells{"total"}{"blasts"} = 0;
$$spells{"total"}{"essence"} = 0;
$$spells{"total"}{"reagents"} = 0;

$$spells{"staff"}{"desc"} = "";
$$spells{"staff"}{"data"}{"normal"} = [];
$$spells{"staff"}{"data"}{"ignore"} = [];
$$spells{"staff"}{"total"}{"blasts"} = 0;


### Convert special characters to HTML/XML entities
my %entities = (
  "&" => "amp",
  "<" => "lt",
  ">" => "gt",
);

sub htmlentities($)
{
  my $value = $_[0];
  $value =~ s/$_/\&$entities{$_}\;/g foreach (keys %entities);
  return $value;
}


### Get damage type of given mage spell, die if not known spell.
sub get_spell_type($)
{
  my $spell = $_[0];
  die("get_spell_type($spell): No such spell.\n") unless exists($$spells{$spell}{"type"});
  return $$spells{$spell}{"type"};
}


### Trap warnings to inform the user that the cache might be stale
my $has_warned = 0;
$SIG{__WARN__} = sub {
  warn("* ", @_);
  if (!$has_warned) {
    if (defined($opt_cachefile)) {
      mlog(-1, "!! The given cache file '$opt_cachefile' is probably stale / incompatible !!");
    } else {
      mlog(-1, "!! There seems to be a bug. Report to Ggr !!");
    }
  }
  $has_warned = 1;
};


###
### Read cache
###
if (defined($opt_cachefile)) {
  mlog(1, "Restoring cache from '$opt_cachefile'.");
  open(CACHE, "<", $opt_cachefile) or die("Could not open cache file '$opt_cachefile'!\n");
  my $s = <CACHE>;
  close(CACHE);
  eval $s;
}


###
### Scan input for blasts etc.
###
my @all_spells = ();
foreach my $type (keys %spell_data) {
  push(@all_spells, @{$spell_data{$type}});
}
my $match = join("|", @all_spells);
my $essence_flag = 0;
my $crit_flag = 0;
my $crit_type;
my $crit_dist;
my $last_spell = "";
my $staff_worn = 0;
my $spell_active = 0;
my $nline = 0;


sub staff_update($$)
{
  my ($desc, $line) = @_;
  
  if ($$spells{"staff"}{"desc"} ne $desc) {
    mlog(2, "Staff change '".$$spells{"staff"}{"desc"}."' -> '$desc'\n# $line\n");
    my %blasts = ();
    my $area = 0;

    foreach my $type (keys %spell_data) {
      foreach my $class ("single", "area") {
        my $name = $$spells{$type}{$class};
        $blasts{"ignore"}{$class} += $$spells{"staff"}{$name}{"blasts"};
        $blasts{"normal"}{$class} += $$spells{$name}{"blasts"};
      }
    }

    push(@{$$spells{"staff"}{"data"}{"normal"}},
      {
        "desc" => $desc,
        "blasts" => $$spells{"total"}{"blasts"},
        "major" => $blasts{"normal"}{"single"} + $blasts{"normal"}{"area"},
        "single" => $blasts{"normal"}{"single"},
        "area" => $blasts{"normal"}{"area"},
      });

    push(@{$$spells{"staff"}{"data"}{"ignore"}},
      {
        "desc" => $desc,
        "blasts" => $$spells{"staff"}{"total"}{"blasts"},
        "major" => $blasts{"ignore"}{"single"} + $blasts{"ignore"}{"area"},
        "single" => $blasts{"ignore"}{"single"},
        "area" => $blasts{"ignore"}{"area"},
      });

    $$spells{"staff"}{"desc"} = $desc;
  }
}


sub crit_update()
{
  if ($crit_flag) {
    my $type = get_spell_type($last_spell);
#    print STDERR "crit: $type : $last_spell : $crit_type [$crit_dist]\n";
    $$spells{$type}{"crits"}{$crit_type}++;
    $crit_flag = 0;
  }
}


sub spell_update($)
{
  crit_update();

  $last_spell = $_[0];

  $spell_active = $nline;
  my $type = get_spell_type($last_spell);

  $$spells{$last_spell}{"blasts"}++;
  $$spells{"total"}{"blasts"}++;
  $$spells{$type}{"blasts"}++;

  if ($staff_worn) {
    $$spells{"staff"}{$last_spell}{"blasts"}++;
    $$spells{"staff"}{"total"}{"blasts"}++;
    $$spells{"staff"}{$type}{"blasts"}++;
  }

  # If essence was gained, get the type etc ..
  if ($essence_flag) {
    $essence_flag = 0;
        
    # Handle the post-reinc essence increase
    if ($$spells{$type}{"reinc"}) {
      mlog(2, "Ignoring post-reinc essence gain for type $type.\n");
      $$spells{$type}{"reinc"} = 0;
    } else {
      $$spells{"total"}{"essence"}++;
      $$spells{$type}{"essence"}{"increase"}++;

      # Save amount of major blasts for each "essence gain" step
      foreach my $class ("single", "area") {
        my $name = $$spells{$type}{$class};
        push(@{$$spells{$type}{"essence"}{"blasts"}{$class}}, $$spells{$name}{"blasts"});
      }
    }
  }
}


sub staff_match($$$)
{
  my ($str, $wear, $line) = @_;
  my ($result, $postfix) = ("", "");
  
  if ($str =~ /(\S+ the (Shimmering|Radiating|Glowing) (white|grey|dark|black) mage staff)(.*)$/i) {
    $result = $1;
    $postfix = $4;
  } elsif ($str =~ /(\S+ the (white|grey|dark|black) mage staff)(.*)$/i) {
    $result = $1;
    $postfix = $3;
  } elsif ($str =~ /((Shimmering|Radiating|Glowing) (white|grey|dark|black) mage staff)(.*)$/i) {
    $result = $1;
    $postfix = $4;
  } elsif ($str =~ /((white|grey|dark|black) mage staff)(.*)$/i) {
    $result = $1;
    $postfix = $3;
  }

  if ($postfix ne "") {
    if ($postfix =~ /^ \(glowing\) <.+? glow>/) {
      $postfix = " <red glow>";
    } elsif ($postfix =~ /^ <.+? glow>/) {
      $postfix = " <red glow>";
    } elsif ($postfix =~ /^( of Power)/i) {
      $postfix = $1;
    } else {
      $postfix = "";
    }
  }
  
  if ($result ne "") {
    $staff_worn = $wear;
    if ($wear) {
#      print STDERR "'$result' :: '$postfix'\n";
      staff_update($result.$postfix, $line);
    }
  }
}


if ($opt_noinput) {
  mlog(1, "Skipping input parsing.");
} else {
  my $ggrtf_flag = 0;
  mlog(1, "Using GgrTF format only!") if ($opt_ggrtf);
  mlog(2, "Matching regexp '".$match."'\n");
  mlog(1, "Parsing log from stdin ...");

  while (defined(my $s = <STDIN>)) {
    $nline++;
    if ($s =~ /^You wear (.+?)\.$/) {
      staff_match($1, 1, $s);
    } elsif ($s =~ /^You remove (.+?)\.$/) {
      staff_match($1, 0, $s);
    } elsif ($s =~ /^Time to choose your reincarnation method./) {
      # Set reinc flags for each type that has essence
      foreach my $type (keys %spell_data) {
        $$spells{$type}{"reinc"} = 1 if ($$spells{$type}{"essence"}{"increase"} > 0);
      }
    } elsif ($s =~ /^You watch with selfpride as your ($match) hits / || $s =~ /^You hit .+? with your ($match)\.$/) {
      spell_update($1) if ($ggrtf_flag == 0);
      $ggrtf_flag = 0;
    } elsif ($s =~ /^Your .($match). hits / || $s =~ /^Your ($match) hits /) {
      if ($opt_ggrtf) {
        spell_update($1);
        $ggrtf_flag = 1;
      }
    } elsif ($s =~ /^Your knowledge in elemental powers helps you to save the reagent for further use\./) {
      if ($last_spell ne "") {
        my $type = get_spell_type($last_spell);
        $$spells{$type}{"reagents"}++;
        $$spells{"total"}{"reagents"}++;
      }
    } elsif ($s =~ /^You feel your skills in handling elemental forces improve\./) {
      $essence_flag = 1;
    } elsif ($s =~ /^Your fingertips are surrounded with swirling (ENERGY) as you cast the spell\./ ||
      $s =~ /^You feel like you managed to channel additional (POWER) to your spell\./ ||
      $s =~ /^You feel like your spell gained additional (power)\./ ||
      $s =~ /^(Unseen) BURSTS of magic are absorbed into the spell/) {
      $crit_dist = $nline - $spell_active;
      if ($spell_active > 0 && $crit_dist <= 7) {
        $crit_type = $1;
        $crit_flag = 1;
      }
    }
  }

  crit_update();
}


###
### Dump cache to stdout
###
if ($opt_mode eq "dump") {
  $Data::Dumper::Indent = 0;
  $Data::Dumper::Useqq  = 1;
  $Data::Dumper::Purity = 1;
  
  my $dumper = Data::Dumper->new([$spells], ["spells"]);
  print $dumper->Dump();
  exit;
}


###
### Output statistics
###
if ($opt_mode eq "stats") {
my $filename = $opt_prefix.".html";
open(OUT, ">", $filename) or die("Could not create output file '$filename'.\n");

mlog(1, "Outputting stats HTML to '$filename'");

print OUT qq|<?xml version="1.0" encoding="UTF-8"?>
<!DOCTYPE html PUBLIC "-//W3C//DTD XHTML 1.0 Strict//EN" "http://www.w3.org/TR/xhtml1/DTD/xhtml1-strict.dtd">
<html xmlns="http://www.w3.org/1999/xhtml" lang="en" xml:lang="en">
<head>
 <meta http-equiv="Content-Type" content="text/html; charset=UTF-8" />
 <meta name="Generator" content="$prog_name version $prog_version" />
 <title>Mage statistics</title>
 <style type="text/css">
body {
	margin: 1em;
	background-color: #353;
	color: #cdc;
}

body, p, ul, td, th {
	font-family: Verdana, Arial, helvetica, sans-serif;
	font-size: 10pt;
}

a, a:visited, a:active {
	text-decoration: underline;
	color: #fc0;
}

a:hover {
	text-decoration: none;
	background-color: black;
	color: white;
}	

.icenter {
	text-align: center;
}

.noborder {
	border: none;
	padding: 0pt;
}

h1, h2, h3 {
	font-family: Arial, sans-serif;
	font-weight: normal;
	color: #efe;
	background: #575;
	padding: 4px;
	padding-bottom: 8px;
	text-shadow: 2px 2px 2px #000;
	border-bottom: 2px solid #242;
}

th {
	padding: 2px;
	margin: 2px;
	background: #575;
	color: #fc0;
	text-align: center;
}

td {
	padding: 4px;
	margin: 2px;
	background: #242;
}

td.blasts {
        margin: 0px;
        padding: 0px;
}

table.blasts {
        width: 100%;
        background: #464;
}

 </style>
</head>
<body>

<h1>Mage statistics</h1>
<p>
Generated with $prog_name v$prog_version by Matti H&auml;m&auml;l&auml;inen aka Ggr Pupunen.
</p>

<h2>Mage staff development</h2>
|;

if ($opt_ignore) {
  print OUT "<p><b>NOTICE!</b> Experimental 'ignore non-worn staff blasts' mode enabled.</p>\n";
}

print OUT "
<table class=\"info\">
 <tr>
  <th>Blasts</th>
  <th>Major blasts</th>
  <th>Singles</th>
  <th>Areas</th>
  <th>Staff short description</th>
 </tr>
";

my $tab = $opt_ignore ? "ignore" : "normal";

foreach my $foo (@{$$spells{"staff"}{"data"}{$tab}}) {
  print OUT "<tr><td>".$$foo{"blasts"}."</td><td>".
  $$foo{"major"}."</td><td>".$$foo{"single"}."</td><td>".
  $$foo{"area"}."</td><td>".htmlentities($$foo{"desc"})."</td></tr>\n";
}

print OUT "
</table>

<ul>
 <li><b>Blasts</b>: All blasts, including minor.</li>
 <li><b>Major blasts</b>: Only major blasts (sum of major singles + areas).</li>
 <li><b>Singles</b>: Major single blasts.</li>
 <li><b>Areas</b>: Major area blasts.</li>
</ul>

<h2>Blasts, essence, etc</h2>
<table class=\"info\">
<tr>
 <th>Type</th>
 <th>Blasts</th>
 <th>Reagents saved</th>
 <th>Essence gained</th>
 <th>Major blasts per essence gain</th>
</tr>
";

my %dographs = ();

$dographs{"ALL"} = 1;
foreach my $type (keys %spell_data) {
  next unless ($$spells{$type}{"blasts"} > 0);

  foreach my $crit (@crit_types) {
    $$spells{"ALL"}{"crits"}{$crit} += $$spells{$type}{"crits"}{$crit};
  }
  $$spells{"ALL"}{"reagents"} += $$spells{$type}{"reagents"};
  $$spells{"ALL"}{"blasts"} += $$spells{$type}{"blasts"};
  $$spells{"ALL"}{"essence"}{"increase"} += $$spells{$type}{"essence"}{"increase"};

  my $s_s = $$spells{$type}{"single"};
  my $s_a = $$spells{$type}{"area"};
  $$spells{"ALL"}{"single"} = "ALL_SINGLE";
  $$spells{"ALL"}{"area"} = "ALL_AREA";
  $$spells{"ALL_SINGLE"}{"blasts"} += $$spells{$s_s}{"blasts"};
  $$spells{"ALL_AREA"}{"blasts"} += $$spells{$s_a}{"blasts"};
  $dographs{$type} = 1;
}


foreach my $type (sort { $a cmp $b } keys %dographs) {

  my $s_s = $$spells{$type}{"single"};
  my $s_a = $$spells{$type}{"area"};

  my $b_s = $$spells{$s_s}{"blasts"};
  my $b_a = $$spells{$s_a}{"blasts"};
  my $total_blasts = $b_s + $b_a;

  next unless ($total_blasts > 0);
  
  print OUT "<tr><td>$type</td><td class=\"blasts\">
  <table class=\"blasts\"><th></th><th>Single</th><th>Area</th></tr>
  <tr><th>Name</th><td>$s_s</td><td>$s_a</td></tr>
  <tr><th>Blasts</th><td>".$b_s."</td><td>".$b_a."</td></tr>
  <tr><th>Total</th><td colspan=\"2\">".$total_blasts."</td></tr>";

  foreach my $crit (@crit_types) {
    print OUT "<tr><th>$crit</th><td colspan=\"2\">".$$spells{$type}{"crits"}{$crit}."</td></tr>\n";
  }
  
  printf OUT "</table></td><td><b>%d</b> (%1.2f %%)</td><td>%d</td><td>",
    $$spells{$type}{"reagents"},
    ($total_blasts > 0) ? ($$spells{$type}{"reagents"} * 100.0) / $total_blasts : 0.0,
    $$spells{$type}{"essence"}{"increase"};
    
  if ($type ne "ALL" && exists($$spells{$type}{"essence"}{"blasts"})) {
    my ($gfilename, $gpath, $gsuffix) = fileparse($opt_prefix);
    print OUT "<img src=\"".$gfilename.$gsuffix."_".$type.".".$opt_imgfmt."\" alt=\"?\" />";
  } else {
    $dographs{$type} = 0;
  }
  
  print OUT "
  </td>
  </tr>\n";
}

print OUT "</table>
</body>
</html>
";


###
### Output graphs
###
mlog(1, "Outputting graphs '".$opt_prefix."_*.".$opt_imgfmt."'...");

foreach my $type (keys %dographs) {
  next unless $dographs{$type};
  
  my $s = $$spells{$type}{"single"};
  my $a = $$spells{$type}{"area"};
  
  my $graph = GD::Graph::linespoints->new($opt_width, $opt_height);
  $graph->set(
    y_label => 'Blasts',
    x_label => 'Essence gained', 
    show_values => 1,
    transparent => 0,
    bgclr => 'white',
  );

  my @titles = ();
  for (my $i = 1; $i <= $$spells{$type}{"essence"}{"increase"}; $i++) {
    push(@titles, "+".$i);
  }

  my @total = ();
  for (my $i = 0; $i < $$spells{$type}{"essence"}{"increase"}; $i++) {
    push(@total, $$spells{$type}{"essence"}{"blasts"}{"single"}[$i] + $$spells{$type}{"essence"}{"blasts"}{"area"}[$i]);
  }
  
  my @data = (
    \@titles,
    \@total,
  );
  
  my $gd = $graph->plot(\@data) or mlog(0, "Error creating graph ($type): ".$graph->error);

  if ($gd) {
    open(IMG, ">", $opt_prefix."_".$type.".".$opt_imgfmt) or die("Error opening file ".$!."\n");
    binmode IMG;
    print IMG $gd->gif if ($opt_imgfmt eq "gif");
    print IMG $gd->png if ($opt_imgfmt eq "png");
    close IMG;
  }
}

}