#!/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-2010 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 @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" => 10, "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"	}
);


###
### 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 "-dump") { $opt_mode = $arg; $opt_strip = 0; }
  else {
    die("Invalid option '$arg'\n");
  }
}

###
### Parse input materials
###
my %data = ();

my $name = "";
while (<STDIN>) {
    chomp;
    if (/MATERIAL STATS \(([a-z ]+)\)\:/) {
      $name = $1;
      $data{$name}{"name"} = $1;
    }
    elsif (/^Weight \(g\/l\)\: *\(([a-z. ]+)\) *Sturdyness\: *\(([a-z. ]+)\)/) {
      $data{$name}{"weight"} = $1;
      $data{$name}{"sturdyness"} = $2;
    }
    elsif (/^Magic\: *\(([a-z. ]+)\) *Flammability\: *\(([a-z. ]+)\)/) {
      $data{$name}{"magic"} = $1;
      $data{$name}{"flammability"} = $2;
    }
    elsif (/^Warmth\: *\(([a-z. ]+ outfit)\) *Toxicity\: *\(([a-z. ]+)\)/) {
      $data{$name}{"warmth"} = $1;
      $data{$name}{"toxicity"} = $2;
      
      $data{$name}{"warmth"} =~ s/ +outfit$// if ($opt_strip);
    }
    elsif (/^Warmth\: *\(([a-z. ]+)\) *Toxicity\: *\(([a-z. ]+)\)/) {
      $data{$name}{"warmth"} = $1;
      $data{$name}{"toxicity"} = $2;
    }
    elsif (/^Resistivity\: *\(([a-z. ]+ insulator)\) *Malleability\: *\(([a-z. ]+)\)?/) {
      $data{$name}{"resistivity"} = $1;
      $data{$name}{"malleability"} = $2;

      $data{$name}{"resistivity"} =~ s/ +insulator$// if ($opt_strip);
    }
    elsif (/^Resistivity\: *\(([a-z. ]+)\) *Malleability\: *\(([a-z. ]+)\)?/) {
      $data{$name}{"resistivity"} = $1;
      $data{$name}{"malleability"} = $2;
    }
    elsif (/^Mentality\: *\(([a-z. ]+)\) *Reactivity\: *\(([a-z. ]+)\)?/) {
      $data{$name}{"mentality"} = $1;
      $data{$name}{"reactivity"} = $2;
    }
    elsif (/^Weapon rarity\: *\(([a-z. ]+)\) *Armour rarity\: *\(([a-z. ]+)\)/) {
      $data{$name}{"weapon_rarity"} = $1;
      $data{$name}{"armour_rarity"} = $2;
    }
    elsif (/^Value \(gp\/kg\)\: *\(([a-z -]+)\) *Rarity\: *\(([a-z. ]+)\)/) {
      $data{$name}{"value"} = $1;
      $data{$name}{"rarity"} = $2;
    }
    elsif (/^Article\: *([a-z. ]+) *Type: *([A-Za-z]+)/) {
      $data{$name}{"article"} = $1;
      $data{$name}{"type"} = $2;
      
      $data{$name}{"article"} =~ s/ *$//;
    }
    elsif (/^Found nature\: *(Yes|No) *Lode name\: *([A-Za-z]+)/) {
      $data{$name}{"found_nature"} = $1;
      $data{$name}{"lode_name"} = $2;
    }
    elsif (/^Raw names\: *([a-z, ]+[a-z])/) {
      my $tmp = $1;
      $data{$name}{"raw_names"} = $tmp;
      @{$data{$name}{"raw_names_arr"}} = split(/, */, $tmp);
    }
    elsif (/^Refined names\: *([a-z, ]+[a-z])/) {
      my $tmp = $1;
      $data{$name}{"refined_names"} = $tmp;
      @{$data{$name}{"refined_names_arr"}} = split(/, */, $tmp);
    }
}

# 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}{"type"}}}, lc($name));
}

# Create list of known types
my @matTypes = sort { $a cmp $b } keys %matByType;


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

# Print names only
if ($opt_mode eq "-names") {
  foreach my $name (@entries) {
    print "$name\n";
  }
}

# Print CSV list
elsif ($opt_mode eq "-csv") {
  foreach my $name (@entries) {
    my $str = "";
    foreach my $info (@fieldInfo) {
      my $field = $$info{"f"};
      if (defined($data{$name}{$field})) {
        $str .= $data{$name}{$field}.";";
      } else {
        print STDERR "Field $field not defined for $name.\n";
      }
    }
    print "$str\n";
  }
}

# Dump normal data to files
elsif ($opt_mode eq "-dump") {
  foreach my $name (@entries) {
    my $mat = $data{$name};
    my $filename = $name.".mat";
    $filename =~ s/ /_/g;
    open(OUTFILE, ">", $filename) or die("Error opening file '$filename' ".$!."\n");
    
    printf OUTFILE
    "MATERIAL STATS ($name):\n".
    "-------------------------------------------------------------------------------\n".
    "Weight (g/l):  %-17s  Sturdyness:    (%s)\n".
    "Magic:         %-17s  Flammability:  (%s)\n",
    "(".$$mat{"weight"}.")", $$mat{"sturdyness"},
    "(".$$mat{"magic"}.")", $$mat{"flammability"};
    
    printf OUTFILE
    "Warmth:        %-17s  Toxicity:      (%s)\n".
    "Resistivity:   %-17s  Malleability:  (%s)\n",
    "(".$$mat{"warmth"}.")", $$mat{"toxicity"},
    "(".$$mat{"resistivity"}.")", $$mat{"malleability"};
    
    printf OUTFILE
    "Mentality:     %-17s  Reactivity:    (%s)\n".
    "Weapon rarity: %-17s  Armour rarity: (%s)\n".
    "Value (gp/kg): %-17s  Rarity:        (%s)\n",
    "(".$$mat{"mentality"}.")", $$mat{"reactivity"},
    "(".$$mat{"weapon_rarity"}.")", $$mat{"armour_rarity"},
    "(".$$mat{"value"}.")", $$mat{"rarity"};

    printf OUTFILE
    "Article:       %-17s       Type:          %s\n".
    "Found nature:  %-17s       Lode name:     %s\n".
    "Raw names:     %s\n".
    "Refined names: %s\n",
    $$mat{"article"}, $$mat{"type"},
    $$mat{"found_nature"}, $$mat{"lode_name"},
    $$mat{"raw_names"}, $$mat{"refined_names"};

    close(OUTFILE);
  }
}

# Print TinyFugue formatted data
elsif ($opt_mode eq "-tf") {
  print "/set gmat_names=".join(' ', @entries)."\n";
  print "/set gmat_ntypes=".join(' ', map(lc($data{$_}{"type"}), @entries))."\n";

  print "/set gmat_types=".join(' ', map(lc($_), @matTypes))."\n";
  
  foreach my $type (@matTypes) {
    print "/set gmat_type_".lc($type)."=".join('|', @{$matByType{$type}})."\n";
  }
}

# Print normal table
elsif ($opt_mode eq "-table") {

  my $str = "";
  foreach my $info (@fieldInfo) {
    $str .= sprintf("%-".$$info{"w"}."s | ", $$info{"s"});
  }
  print "$str\n";
  $str =~ s/[^|]/-/g;
  $str =~ s/\|/+/g;
  print "$str\n";

  foreach my $name (@entries) {
    my $str = "";
    foreach my $info (@fieldInfo) {
      my $field = $$info{"f"};
      if (defined($data{$name}{$field})) {
        $str .= sprintf("%-".$$info{"w"}."s | ", $data{$name}{$field});
      } else {
        print STDERR "# Field $field does not exist for $name\n";
      }
    }
    print "$str\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;\nrequire Exporter;\n".
  "\@ISA = qw(Exporter);\n\n".
  "\@EXPORT = qw(matTable transTable 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([\%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 data
elsif ($opt_mode eq "-php") {
  print "<?\n".
  "\$transNameTable = array(";
  foreach my $info (@fieldInfo) {
    print "\"".$$info{"l"}."\",";
  }
  print ");\n\n".
  "\$transTable = array(\n";
  foreach my $i (sort { $a <=> $b } keys %transTable) {
    print "  array(";
    foreach my $j (keys %{$transTable{$i}}) {
      if (defined($transTable{$i}{$j})) {
        print $transTable{$i}{$j};
        $j =~ s/very /v./;
        $j =~ s/incredibly /incr./;
        print " => \"$j\","
      } else {
        print STDERR "$0: Unknown transTable type $i : $j\n";
      }
    }
    print "),\n";
  }

  print ");\n\n".
  "\$matTable = array(\n";
  foreach my $name (sort { $a cmp $b } keys %data) {
    print "  \"$name\" => array(";
    foreach my $info (@fieldInfo) {
      my $s = $$info{"i"};
      my $f = $$info{"f"};
      my $idx = $data{$name}{$f};
      my $arr = $f."_arr";
      if (defined($data{$name}{$arr})) {
        print "array(";
        foreach my $q (sort { $a cmp $b } @{$data{$name}{$arr}}) {
          if (defined($transTable{$s}{$q})) {
            print $transTable{$s}{$q}.",";
          } else {
            print STDERR "$0: Unknown transTable type for '$name' : $s :: $q ($idx)\n";
          }
        }
        print "),";
      } elsif (defined($transTable{$s}{$idx})) {
        print $transTable{$s}{$idx}.", ";
      } else {
        if ($s != 1) {
          print STDERR "$0: Unknown transTable type for '$name' : $s == $f ($idx)\n";
          print "-1,";
        }
      }
    }
    print "),\n";
  }
  print ");\n?>\n";
}