#!/usr/bin/perl -w
#
# BatMUD material data parser and converter
# Developed by Matti Hämäläinen (Ggr Pupunen) <ccr@tnsp.org>
# (C) Copyright 2006-2015 Tecnic Software productions (TNSP)
#
# Converts "raw" material data (output of 'cast identify at material')
# from log(s) into various formats and intermediate data for additional
# processing by other tools.
#
use strict;
use warnings;
use Data::Dumper;


#
# Data translation table generated with csv2transtab.pl
#
my $transTable =
{
  2 => {
    "very light" => 0,
    "light" => 1,
    "normal" => 2,
    "heavy" => 3,
    "very heavy" => 4,
    "incredibly heavy" => 5,
  },
  3 => {
    "very fragile" => 0,
    "fragile" => 1,
    "normal" => 2,
    "sturdy" => 3,
    "very sturdy" => 4,
    "incredibly sturdy" => 5,
  },
  4 => {
    "not magical" => 0,
    "weakly magical" => 1,
    "a bit magical" => 2,
    "magical" => 3,
    "notable magical" => 4,
    "very magical" => 5,
    "highly magical" => 6,
  },
  5 => {
    "unburnable" => 0,
    "almost unburnable" => 1,
    "quite unburnable" => 2,
    "normal" => 3,
    "quite flammable" => 4,
    "very flammable" => 5,
    "highly flammable" => 6,
  },
  6 => {
    "icy" => 0,
    "chilly" => 1,
    "drafty" => 2,
    "comfortable" => 3,
    "very warm" => 4,
    "excellent" => 5,
  },
  7 => {
    "non toxic" => 0,
    "very low toxicity" => 1,
    "low toxicity" => 2,
    "mediocre toxicity" => 3,
    "toxic" => 4,
    "very toxic" => 5,
    "highly toxic" => 6,
  },
  8 => {
    "lousy" => 0,
    "poor" => 1,
    "weak" => 2,
    "insulator" => 3,
    "good" => 4,
    "great" => 5,
  },
  9 => {
    "loose" => 0,
    "a bit loose" => 1,
    "quite solid" => 2,
    "solid" => 3,
    "very solid" => 4,
    "incredibly solid" => 5,
  },
  10 => {
    "poor mentality" => 0,
    "low mentality" => 1,
    "some mentality" => 2,
    "mental" => 3,
    "high mentality" => 4,
    "great mentality" => 5,
  },
  11 => {
    "great reactivity" => 0,
    "high reactivity" => 1,
    "notable reactivity" => 2,
    "reactive" => 3,
    "low reactivity" => 4,
    "poor reactivity" => 5,
    "not reactive" => 6,
  },
  12 => {
    "not used" => 0,
    "rarely used" => 1,
    "sometimes used" => 2,
    "quite much used" => 3,
    "frequently used" => 4,
    "most common" => 5,
  },
  13 => {
    "not used" => 0,
    "rarely used" => 1,
    "sometimes used" => 2,
    "quite much used" => 3,
    "frequently used" => 4,
    "most common" => 5,
  },
  14 => {
    "cheap" => 0,
    "low-priced" => 1,
    "average" => 2,
    "valuable" => 3,
    "very valuable" => 4,
    "highly valuable" => 5,
  },
  15 => {
    "very common" => 0,
    "quite common" => 1,
    "common" => 2,
    "average" => 3,
    "rare" => 4,
    "very rare" => 5,
    "impossible" => 6,
  },
  16 => {
    "Organ" => 0,
    "Cloth" => 1,
    "Paper" => 2,
    "Bone" => 3,
    "Metal" => 4,
    "Wood" => 5,
    "Stone" => 6,
    "Alloy" => 7,
    "Inorg" => 8,
    "Glass" => 9,
    "Gem" => 10,
  },
  17 => {
    "No" => 0,
    "Yes" => 1,
  },
  18 => {
    "Hit" => 0,
    "Protrusion" => 1,
    "Crag" => 2,
    "Lode" => 3,
    "Pocket" => 4,
    "Gloss" => 5,
    "Shard" => 6,
    "Deposit" => 7,
    "Mountain" => 8,
    "Nest" => 9,
    "Stack" => 10,
    "Mound" => 11,
    "Chunky" => 12,
    "Puddle" => 13,
    "Slab" => 14,
    "Network" => 15,
    "Pool" => 16,
    "Hill" => 17,
    "Mass" => 18,
    "Tangle" => 19,
    "Graveyard" => 20,
    "Lump" => 21,
    "Coil" => 22,
    "Abyss" => 23,
    "Pile" => 24,
    "Torrent" => 25,
    "Conflagration" => 26,
  },
  19 => {
    "heap" => 0,
    "stick" => 1,
    "pocket" => 2,
    "hunk" => 3,
    "shard" => 4,
    "string" => 5,
    "stone" => 6,
    "slice" => 7,
    "wisp" => 8,
    "wad" => 9,
    "clump" => 10,
    "carcass" => 11,
    "gob" => 12,
    "strip" => 13,
    "dough" => 14,
    "ball" => 15,
    "chunk" => 16,
    "load" => 17,
    "leaf" => 18,
    "salt" => 19,
    "pile" => 20,
    "isotope" => 21,
    "tusk" => 22,
    "clod" => 23,
    "lump" => 24,
    "lode" => 25,
    "piece" => 26,
    "flame" => 27,
    "stem" => 28,
    "sphere" => 29,
    "fragment" => 30,
    "mineral" => 31,
    "twig" => 32,
    "stalk" => 33,
    "crystal" => 34,
    "log" => 35,
    "reed" => 36,
    "nugget" => 37,
    "mix" => 38,
    "mic" => 39,
    "pulp" => 40,
    "block" => 41,
    "puddle" => 42,
    "sliver" => 43,
    "bulge" => 44,
  },
  20 => {
    "formed" => 0,
    "stick" => 1,
    "bundle" => 2,
    "ellipsoid" => 3,
    "pocket" => 4,
    "brick" => 5,
    "mold" => 6,
    "gene" => 7,
    "shard" => 8,
    "form" => 9,
    "wisp" => 10,
    "isometric" => 11,
    "cord" => 12,
    "billot" => 13,
    "bar" => 14,
    "bolt" => 15,
    "strip" => 16,
    "ball" => 17,
    "billit" => 18,
    "chunk" => 19,
    "octagon" => 20,
    "cube" => 21,
    "ingot" => 22,
    "chip" => 23,
    "casting" => 24,
    "dean" => 25,
    "piece" => 26,
    "flame" => 27,
    "billet" => 28,
    "crafted" => 29,
    "cut" => 30,
    "pelt" => 31,
    "strand" => 32,
    "crystal" => 33,
    "log" => 34,
    "reed" => 35,
    "tetragonal" => 36,
    "sheet" => 37,
    "strap" => 38,
    "reem" => 39,
    "length" => 40,
    "sculpted" => 41,
    "block" => 42,
    "hexagonal" => 43,
    "product" => 44,
    "shaped" => 45,
    "puddle" => 46,
    "fibres" => 47,
    "slab" => 48,
    "flare" => 49,
  },
};

my $transFixes =
{
  16 => {
    "Organic" => 0,
    "Cloth" => 1,
    "Paper" => 2,
    "Bone" => 3,
    "Metal" => 4,
    "Wood" => 5,
    "Stone" => 6,
    "Alloy" => 7,
    "Inorganic" => 8,
    "Glass" => 9,
    "Gem" => 10,
  },
};


my $revTransTable = {};

my @fieldInfo = (
  { "i" =>  1, "f" => "name",		"w" => 15, "l" => "Name",		"s" => "Name"		},
  { "i" =>  2, "f" => "weight",		"w" => 10, "l" => "Weight",		"s" => "Weight"		},

  { "i" =>  3, "f" => "sturdyness",	"w" => 18, "l" => "Sturdyness",		"s" => "Sturdyness"	},
  { "i" =>  4, "f" => "magic",		"w" => 15, "l" => "Magic",		"s" => "Magic"		},
  { "i" =>  5, "f" => "flammability",	"w" => 18, "l" => "Flammability",	"s" => "Flammability"	},
  { "i" =>  6, "f" => "warmth",		"w" => 11, "l" => "Warmth",		"s" => "Warmth"		},
  { "i" =>  7, "f" => "toxicity",	"w" => 18, "l" => "Toxicity",		"s" => "Toxicity"	},
  { "i" =>  8, "f" => "resistivity",	"w" =>  9, "l" => "Resistivity",	"s" => "Resist"		},
  { "i" =>  9, "f" => "malleability",	"w" => 18, "l" => "Malleability",	"s" => "Malleability"	},
  { "i" => 10, "f" => "mentality",	"w" => 18, "l" => "Mentality",		"s" => "Mentality"	},
  { "i" => 11, "f" => "reactivity",	"w" => 18, "l" => "Reactivity",		"s" => "Reactivity"	},

  { "i" => 12, "f" => "weapon_rarity",	"w" => 15, "l" => "Weapon rarity",	"s" => "Weapon rarity"	},
  { "i" => 13, "f" => "armour_rarity",	"w" => 15, "l" => "Armour rarity",	"s" => "Armour rarity"	},
  { "i" => 14, "f" => "value",		"w" => 15, "l" => "Value",		"s" => "Value"		},
  { "i" => 15, "f" => "rarity",		"w" => 12, "l" => "Rarity",		"s" => "Rarity"		},
  { "i" => 16, "f" => "type",		"w" =>  6, "l" => "Type",		"s" => "Type"		},
  { "i" => 17, "f" => "found_nature",	"w" =>  3, "l" => "Found in Nature",	"s" => "FN?"		},
  { "i" => 18, "f" => "lode_name",	"w" => 13, "l" => "Lode name",		"s" => "Lode name"	},
  { "i" => 19, "f" => "raw_names",	"w" => 35, "l" => "Raw names",		"s" => "Raw names"	},
  { "i" => 20, "f" => "refined_names",	"w" => 35, "l" => "Refined names",	"s" => "Refined names"	},
);


sub ptranslate($$)
{
  if (defined($$revTransTable{$_[0]}{$_[1]}))
  {
    return $$revTransTable{$_[0]}{$_[1]};
  }
  else
  {
    die("$0: Unknown REVERSE translation table type ".$_[0]." : ".$_[1]."\n");
  }
}


sub pt($$)
{
  return ptranslate($_[1], $_[0]{$_[1]})
}


sub pta($$)
{
  return map { ptranslate($_[1], $_) } @{$_[0]{$_[1]}};
}


sub mtranslate($$)
{
  if (defined($$transTable{$_[0]}{$_[1]}))
  {
    return $$transTable{$_[0]}{$_[1]};
  }
  else
  {
    die("$0: Unknown translation table type ".$_[0]." : ".$_[1]."\n");
  }
}


###
### Check options
###
my $opt_mode = "";
my $opt_strip = 1;

while (defined(my $arg = shift))
{
  if ($arg eq "-csv") { $opt_mode = $arg; }
  elsif ($arg eq "-tf") { $opt_mode = $arg; }
  elsif ($arg eq "-names") { $opt_mode = $arg; }
  elsif ($arg eq "-perl") { $opt_mode = $arg; }
  elsif ($arg eq "-php") { $opt_mode = $arg; }
  elsif ($arg eq "-table") { $opt_mode = $arg; }
  elsif ($arg eq "-dumpfiles") { $opt_mode = $arg; $opt_strip = 0; }
  elsif ($arg eq "-dump") { $opt_mode = $arg; $opt_strip = 0; }
  else
  {
    die("Invalid option '$arg'\n");
  }
}


###
### Parse input materials
###
my $data = {};
my $name = "";
my $nline = 0;
while (defined(my $line = <STDIN>))
{
  $nline++;
  chomp($line);
  if ($line =~ /MATERIAL STATS \(([a-z ]+)\)\:/)
  {
    $name = $1;
  }
  elsif ($line =~ /^Weight \(g\/l\)\: *\(([a-z. ]+)\) *Sturdyness\: *\(([a-z. ]+)\)/)
  {
    $$data{$name}{2} = mtranslate(2, $1);
    $$data{$name}{3} = mtranslate(3, $2);
  }
  elsif ($line =~ /^Magic\: *\(([a-z. ]+)\) *Flammability\: *\(([a-z. ]+)\)/)
  {
    $$data{$name}{4} = mtranslate(4, $1);
    $$data{$name}{5} = mtranslate(5, $2);
  }
  elsif ($line =~ /^Warmth\: *\(([a-z. ]+ outfit)\) *Toxicity\: *\(([a-z. ]+)\)/)
  {
    my ($tmp1, $tmp2) = ($1, $2);
    $tmp1 =~ s/ +outfit$//;
    $$data{$name}{6} = mtranslate(6, $tmp1);
    $$data{$name}{7} = mtranslate(7, $tmp2);
  }
  elsif ($line =~ /^Warmth\: *\(([a-z. ]+)\) *Toxicity\: *\(([a-z. ]+)\)/)
  {
    my ($tmp1, $tmp2) = ($1, $2);
    $$data{$name}{6} = mtranslate(6, $1);
    $$data{$name}{7} = mtranslate(7, $2);
  }
  elsif ($line =~ /^Resistivity\: *\(([a-z. ]+ insulator)\) *Malleability\: *\(([a-z. ]+)\)?/)
  {
    my ($tmp1, $tmp2) = ($1, $2);
    $tmp1 =~ s/ +insulator$//;
    $$data{$name}{8} = mtranslate(8, $tmp1);
    $$data{$name}{9} = mtranslate(9, $tmp2);
  }
  elsif ($line =~ /^Resistivity\: *\(([a-z. ]+)\) *Malleability\: *\(([a-z. ]+)\)?/)
  {
    $$data{$name}{8} = mtranslate(8, $1);
    $$data{$name}{9} = mtranslate(9, $2);
  }
  elsif ($line =~ /^Mentality\: *\(([a-z. ]+)\) *Reactivity\: *\(([a-z. ]+)\)?/)
  {
    $$data{$name}{10} = mtranslate(10, $1);
    $$data{$name}{11} = mtranslate(11, $2);
  }
  elsif ($line =~ /^Weapon rarity\: *\(([a-z. ]+)\) *Armour rarity\: *\(([a-z. ]+)\)/)
  {
    $$data{$name}{12} = mtranslate(12, $1);
    $$data{$name}{13} = mtranslate(13, $2);
  }
  elsif ($line =~ /^Value \(gp\/kg\)\: *\(([a-z -]+)\) *Rarity\: *\(([a-z. ]+)\)/)
  {
    $$data{$name}{14} = mtranslate(14, $1);
    $$data{$name}{15} = mtranslate(15, $2);
  }
  elsif ($line =~ /^Article\: *([a-z. ]+) *Type: *([A-Za-z]+)/)
  {
    my ($tmp1, $tmp2) = ($1, $2);
    $tmp1 =~ s/ *$//;

    $$data{$name}{"article"} = $tmp1;
    $$data{$name}{16} = mtranslate(16, $tmp2);
  }
  elsif ($line =~ /^Found nature\: *(Yes|No) *Lode name\: *([A-Za-z]+)/)
  {
    $$data{$name}{17} = mtranslate(17, $1);
    $$data{$name}{18} = mtranslate(18, $2);
  }
  elsif ($line =~ /^Raw names\: *([a-z, ]+[a-z])/)
  {
    my $tmp = $1;
    @{$$data{$name}{19}} = map { mtranslate(19, $_) } split(/, */, $tmp);
  }
  elsif ($line =~ /^Refined names\: *([a-z, ]+[a-z])/)
  {
    my $tmp = $1;
    @{$$data{$name}{20}} = map { mtranslate(20, $_) } split(/, */, $tmp);
  }
  elsif ($line =~ /^-+$|^\s*$/)
  {
    # Ignore empty lines, and -*
  }
  else
  {
    print STDERR "Unparsed line #".$nline.": ".$line."\n";
  }
}

# Fix material types
foreach my $mid (keys %$transFixes)
{
  $$transTable{$mid} = $$transFixes{$mid};
}

# Sort the entries by name
my @entries = sort { $a cmp $b } keys %$data;

# Sort materials by type
my %matByType = ();
foreach my $name (@entries)
{
  push(@{$matByType{$$data{$name}{16}}}, lc($name));
}

# List of known types
my $matTypes = $$transTable{16};

# Create reverse translation table
foreach my $mid (keys %$transTable)
{
  foreach my $mkey (keys %{$$transTable{$mid}})
  {
    $$revTransTable{$mid}{$$transTable{$mid}{$mkey}} = $mkey;
  }
}


sub get_datastr($$)
{
  my ($name, $i) = @_;
  return $name if ($i == 1);
  return join(", ", pta($$data{$name}, $i)) if (ref($$data{$name}{$i}) eq "ARRAY");
  return pt($$data{$name}, $i);
}


sub print_material_long($$$)
{
  my ($file, $mat, $name) = @_;

  printf $file
  "MATERIAL STATS (".$name."):\n".
  "-------------------------------------------------------------------------------\n".
  "Weight (g/l):  %-17s  Sturdyness:    (%s)\n".
  "Magic:         %-17s  Flammability:  (%s)\n",
  "(".pt($mat, 2).")", pt($mat, 3),
  "(".pt($mat, 4).")", pt($mat, 5);
  
  printf $file
  "Warmth:        %-17s  Toxicity:      (%s)\n".
  "Resistivity:   %-17s  Malleability:  (%s)\n",
  "(".pt($mat, 6).")", pt($mat, 7),
  "(".pt($mat, 8).")", pt($mat, 9);
  
  printf $file
  "Mentality:     %-17s  Reactivity:    (%s)\n".
  "Weapon rarity: %-17s  Armour rarity: (%s)\n".
  "Value (gp/kg): %-17s  Rarity:        (%s)\n",
  "(".pt($mat, 10).")", pt($mat, 11),
  "(".pt($mat, 12).")", pt($mat, 13),
  "(".pt($mat, 14).")", pt($mat, 15);

  printf $file
  "Article:       %-17s       Type:          %s\n".
  "Found nature:  %-17s       Lode name:     %s\n".
  "Raw names:     %s\n".
  "Refined names: %s\n",
  $$mat{"article"}, pt($mat, 16),
  pt($mat, 17), pt($mat, 18),
  join(", ", pta($mat, 19)),
  join(", ", pta($mat, 20));
}


###
### Output functionality begins here
###

###
### Print material names only, one per line
###
if ($opt_mode eq "-names")
{
  foreach my $name (@entries)
  {
    print $name."\n";
  }
}
###
### Print CSV format list
###
elsif ($opt_mode eq "-csv")
{
  foreach my $name (@entries)
  {
    print join(";", map { get_datastr($name, $$_{"i"}) } @fieldInfo)."\n";
  }
}
###
### Dump long-format material data to individual files
###
elsif ($opt_mode eq "-dumpfiles")
{
  foreach my $name (@entries)
  {
    my $filename = $name.".mat";
    $filename =~ s/[^a-z0-9]/_/g;
    open(OUTFILE, ">", $filename) or die("Error opening file '".$filename."' ".$!."\n");
    print_material_long(\*OUTFILE, $$data{$name}, $name);
    close(OUTFILE);
  }
}
###
### Dump long-format material data to stdout
###
elsif ($opt_mode eq "-dump")
{
  foreach my $name (@entries)
  {
    print "\n".
    "-------------------------------------------------------------------------------\n";
    print_material_long(\*STDOUT, $$data{$name}, $name);
  }
}
###
### Print TinyFugue script variables
###
elsif ($opt_mode eq "-tf")
{
  print "/set gmat_names=".join(' ', map { my $tmp = $_; $tmp =~ s/ /_/g; $tmp } @entries)."\n";
  print "/set gmat_ntypes=".join(' ', map(lc(ptranslate(16, $$data{$_}{16})), @entries))."\n";
  print "/set gmat_types=".join(' ', sort map(lc(ptranslate(16, $_)), values %$matTypes))."\n";

  foreach my $mkey (sort keys %$matTypes)
  {
    my $type = $$matTypes{$mkey};
    print "/set gmat_type_".
      lc(ptranslate(16, $type))."=".
      join('|', @{$matByType{$type}})."\n";
  }
}
###
### Print a nice ASCII table
###
elsif ($opt_mode eq "-table")
{
  my $str = join("",
    map { 
      sprintf("%-".$$_{"w"}."s | ", $$_{"s"})
    } @fieldInfo);

  print $str."\n";
  $str =~ s/[^|]/-/g;
  $str =~ s/\|/+/g;
  print $str."\n";

  foreach my $name (@entries)
  {
    print join("", map {
      sprintf("%-".$$_{"w"}."s | ", get_datastr($name, $$_{"i"}));
      } @fieldInfo)."\n";
  }
}
###
### Dump a Perl module with material data
###
elsif ($opt_mode eq "-perl")
{
  $Data::Dumper::Indent = 0;
  $Data::Dumper::Useqq  = 1; 
  $Data::Dumper::Purity = 1;

  print
    "package Materials;\n".
    "require Exporter;\n".
    "\@ISA = qw(Exporter);\n".
    "\n".
    "\@EXPORT = qw(matTable transTable revTransTable matByType matTypes);\n".
    "\n";

  my $dumper = Data::Dumper->new([$data], ["matTable"]);
  print "our ".$dumper->Dump()."\n\n";

  $dumper = Data::Dumper->new([\%$transTable], ["transTable"]);
  print "our ".$dumper->Dump()."\n\n";

  $dumper = Data::Dumper->new([\%$revTransTable], ["revTransTable"]);
  print "our ".$dumper->Dump()."\n\n";

  $dumper = Data::Dumper->new([\%matByType], ["matByType"]);
  print "our ".$dumper->Dump()."\n\n";

  $dumper = Data::Dumper->new([\%$matTypes], ["matTypes"]);
  print "our ".$dumper->Dump()."\n\n";
  
  print "1;\n";
}
###
### Dump PHP array format data
###
elsif ($opt_mode eq "-php")
{
  print "<?\n".
  "\$matTransNames = array(".
  join(",", map { "\"".$$_{"l"}."\"" } @fieldInfo).
  ");\n\n".
  "\$matTransTable = array(\n";
  foreach my $i (sort { $a <=> $b } keys %$transTable)
  {
    print "  array(";
    foreach my $j (sort { $$transTable{$i}{$a} <=> $$transTable{$i}{$b} } keys %{$$transTable{$i}})
    {
      print $$transTable{$i}{$j};
      $j =~ s/very /v./;
      $j =~ s/incredibly /incr./;
      print " => \"".$j."\","
    }
    print "),\n";
  }
  print ");\n\n".
  "\$matDataTable = array(\n";
  foreach my $name (sort { $a cmp $b } keys %$data)
  {
    print "  \"$name\" => array(";
    for (my $qn = 1; $qn < scalar(@fieldInfo); $qn++)
    {
      my $i = $fieldInfo[$qn]{"i"};
      if (ref($$data{$name}{$i}) eq "ARRAY")
      {
        print "array(".join(",", @{$$data{$name}{$i}})."),";
      }
      else
      {
        print $$data{$name}{$i}.", ";
      }
    }
    print "),\n";
  }
  print ");\n?>\n";
}