Mercurial > hg > batmud > misc
view materials/parsematerial.pl @ 281:2e8fefca6594 misc
Clean up parsing.
author | Matti Hamalainen <ccr@tnsp.org> |
---|---|
date | Mon, 09 Mar 2015 04:45:33 +0200 |
parents | 5e9f8b76d494 |
children | b72e0788d63e |
line wrap: on
line source
#!/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 %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 "-dump") { $opt_mode = $arg; $opt_strip = 0; } else { die("Invalid option '$arg'\n"); } } ### ### Parse input materials ### my %data = (); my $name = ""; my $linenum = 0; while (defined($line = <STDIN>)) { $linenum++; chomp; 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]+)/) { $data{$name}{16} = mtranslate(16, $2); $data{$name}{"article"} = $1; $data{$name}{"article"} =~ s/ *$//; } 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 #".$linenum.": ".$line."\n"; } } # 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); } ### ### 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) { print join(";", map { get_datastr($name, $$_{"i"}) } @fieldInfo)."\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", "(".pt($mat, 2).")", pt($mat, 3), "(".pt($mat, 4).")", pt($mat, 5); printf OUTFILE "Warmth: %-17s Toxicity: (%s)\n". "Resistivity: %-17s Malleability: (%s)\n", "(".pt($mat, 6).")", pt($mat, 7), "(".pt($mat, 8).")", pt($mat, 9); printf OUTFILE "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 OUTFILE "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)); 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(pt($data{$_},16)), @entries))."\n"; print "/set gmat_types=".join(' ', map(lc(ptranslate(16,$_)), values %matTypes))."\n"; foreach my $type (values %matTypes) { print "/set gmat_type_". lc(ptranslate(16, $type))."=". join('|', @{$matByType{$type}})."\n"; } } # Print normal 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 data elsif ($opt_mode eq "-php") { print "<?\n". "\$transNameTable = array(". join(",", map { "\"".$$_{"l"}."\"" } @fieldInfo). ");\n\n". "\$transTable = 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". "\$matTable = 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"; }