Mercurial > hg > batmud > misc
view materials/parsealloys.pl @ 315:72bf6267e34f misc
Use underlines for multiword material names in plaintext format alloy list.
author | Matti Hamalainen <ccr@tnsp.org> |
---|---|
date | Wed, 30 Dec 2015 06:58:07 +0200 |
parents | 809e2a1c64eb |
children | a4dff42fc40e |
line wrap: on
line source
#!/usr/bin/perl -w # # BatMUD alloy data parser and converter # Developed by Matti Hämäläinen (Ggr Pupunen) <ccr@tnsp.org> # (C) Copyright 2009-2015 Tecnic Software productions (TNSP) # # Old format of alloying skill output was somewhat different, but # it has been tuned somewhere after 2005. New output format is: # #You mix obsidian and crystal and create a quantity of glass #You mix nullium and illumium and create a quantity of dukonium #You mix nullium and illumium and create a quantity of dukonium use strict; use warnings; use materials; my $domark = 0; my $mode = shift or die("Usage: $0 <-php|-text>\n"); if ($mode eq "-php") { $domark = 1; } elsif ($mode eq "-text") { } else { die("$0: Invalid operation mode '$mode'.\n"); } sub ul($) { my $tmp = $_[0]; $tmp =~ s/ /_/g; return $tmp; } ### ### Parse data from input, ignoring fumbled alloys ### my %data = (); my $fumble = 0; my $nline = 0; sub addCombo($$$) { if (!$fumble) { push(@{$data{$_[1]}{$_[2]}}, $_[0]); } else { print STDERR "Ignoring fumbled combo $_[1] + $_[2] = $_[0]\n"; } $fumble = 0; } while (<STDIN>) { chomp; if (/^You mix ([a-z ]+?) and ([a-z ]+?) and create a quantity of (.+?)\.?$/) { addCombo($3, $1, $2); } elsif (/^([a-zA-Z0-9]+)#([a-z ]+)\+([a-z ]+)=([a-z ]+)$/) { addCombo($4, $2, $3); } elsif (/^(You slip up and fumble your attempt)/) { $fumble = 1; } } ### ### Re-format the data into single "ordered" hash, using as ### close to alphabetical order as possible. ### my %final = (); foreach my $min1 (keys %data) { foreach my $min2 (keys %{$data{$min1}}) { if (!defined($final{$min1}{$min2}) && !defined($final{$min2}{$min1})) { # Get both (a, b) and (b, a) combinations results into same array my @tmp = (); if (defined($data{$min1}{$min2})) { push(@tmp, @{$data{$min1}{$min2}}); } if (defined($data{$min2}{$min1})) { push(@tmp, @{$data{$min2}{$min1}}); } # Determine if there are multiple results and which is the most likely. # Some alloy combinations are inherently "unstable". my %seen = (); $seen{$_}++ foreach (@tmp); if ($domark) { $final{$min1}{$min2} = $final{$min2}{$min1} = \%seen; } elsif ($min1 lt $min2) { $final{$min1}{$min2} = \%seen; } else { $final{$min2}{$min1} = \%seen; } } } } ## Output the results if ($mode eq "-php") { print "<?\n". "\$alloyTable = array(\n"; foreach my $min1 (sort { $a cmp $b } keys %$Materials::matTable) { print " \"$min1\" => "; if (scalar(keys %{$final{$min1}}) > 0) { print "array("; foreach my $min2 (sort { $a cmp $b } keys %{$final{$min1}}) { print "\"$min2\" => array("; foreach my $res (sort { $final{$min1}{$min2}{$a} <=> $final{$min1}{$min2}{$b} } keys %{$final{$min1}{$min2}}) { print "\"$res\" => ".$final{$min1}{$min2}{$res}.", "; } print "), "; } print "),\n"; } else { print "null,\n"; } } print ");\n\n"; # Create 'reverse' alloy table my %restab = (); foreach my $res (keys %$Materials::matTable) { foreach my $min1 (keys %final) { foreach my $min2 (keys %{$final{$min1}}) { my $tmp = $final{$min1}{$min2}; if (scalar(keys %$tmp) > 1) { # print STDERR "Ignoring multi $min1 + $min2 = ".join(", ", keys %$tmp)."\n"; } else { foreach my $key (keys %$tmp) { if ($key eq $res && !defined($restab{$res}{$min1}{$min2}) && !defined($restab{$res}{$min2}{$min1})) { $restab{$res}{$min1}{$min2} = $$tmp{$key}; } } } } } } print "\$alloyRevTable = array(\n"; foreach my $res (sort { $a cmp $b } keys %restab) { print " \"$res\" => array(\n"; foreach my $min1 (sort { $a cmp $b } keys %{$restab{$res}}) { if (scalar(keys %{$restab{$res}{$min1}}) > 0) { print " \"$min1\" => array("; foreach my $min2 (sort { $a cmp $b } keys %{$restab{$res}{$min1}}) { print "\"$min2\" => ".$restab{$res}{$min1}{$min2}.","; } print "),\n"; } } print " ),\n"; } print ");\n\n". "?>"; } elsif ($mode eq "-text") { my $total = 0; my %tdata = (); foreach my $type (sort { $a cmp $b } keys %{$Materials::matByType}) { my $subtotal = 0; print "\n".$$Materials::revTransTable{99}{$type}." alloys\n". "=========================================================\n"; foreach my $min1 (@{$$Materials::matByType{$type}}) { foreach my $min2 (sort { $a cmp $b } keys %{$final{$min1}}) { printf "%-35s = ", ul($min1)." + ".ul($min2); my $n = 0; foreach my $res (sort { $final{$min1}{$min2}{$a} <=> $final{$min1}{$min2}{$b} || $a cmp $b } keys %{$final{$min1}{$min2}}) { print ul($res)."[".$final{$min1}{$min2}{$res}."] "; $n++; } if ($n > 1) { print " (unstable)"; } print "\n"; $total++; $subtotal++; } } print "\n".$subtotal." ".lc($$Materials::revTransTable{16}{$type})." type alloys.\n\n"; } print "\n".$total." alloys total.\n"; }