Mercurial > hg > batmud > materials
view parsealloys.pl @ 49:527d37859f28
Sort the alloy tables more robustly.
author | Matti Hamalainen <ccr@tnsp.org> |
---|---|
date | Mon, 23 Aug 2021 18:19:40 +0300 |
parents | 857333562777 |
children |
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 File::Basename; use lib dirname(__FILE__); 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; my $ignored = 0; sub addCombo($$$) { if (!$fumble) { push(@{$data{$_[1]}{$_[2]}}, $_[0]); } else { $ignored++; #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; } } print STDERR "Ignored ".$ignored." fumbled alloys.\n"; ### ### 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 "<?php\n". "\$alloyTable = [\n"; foreach my $min1 (sort { $a cmp $b } keys %$Materials::matTable) { print " \"$min1\" => "; if (scalar(keys %{$final{$min1}}) > 0) { print "["; foreach my $min2 (sort { $a cmp $b } keys %{$final{$min1}}) { print "\"$min2\" => ["; foreach my $res (sort { $a cmp $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 (sort { $a cmp $b } keys %final) { foreach my $min2 (sort { $a cmp $b } keys %{$final{$min1}}) { my $tmp = $final{$min1}{$min2}; # Do we ignore unstable combinations, e.g. ones with multiple results? #if (scalar(keys %$tmp) == 1) { foreach my $key (sort { $a cmp $b } keys %$tmp) { if ($key eq $res && !defined($restab{$res}{$min1}{$min2}) && !defined($restab{$res}{$min2}{$min1})) { $restab{$res}{$min1}{$min2} = $$tmp{$key}; } } } } } } print "\$alloyRevTable = [\n"; foreach my $res (sort { $a cmp $b } keys %restab) { print " \"$res\" => [\n"; foreach my $min1 (sort { $a cmp $b } keys %{$restab{$res}}) { if (scalar(keys %{$restab{$res}{$min1}}) > 0) { print " \"$min1\" => ["; 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{16}{$type}." alloys\n". "=========================================================\n"; foreach my $min1 (@{$$Materials::matByType{$type}}) { foreach my $min2 (sort { $a cmp $b } keys %{$final{$min1}}) { my @reslist = map { ul($_) } sort { $final{$min1}{$min2}{$a} <=> $final{$min1}{$min2}{$b} || $a cmp $b } keys %{$final{$min1}{$min2}}; printf("%-35s = %s%s\n", ul($min1)." + ".ul($min2), join(" | ", @reslist), scalar(@reslist) > 1 ? " (unstable)" : "" ); $total++; $subtotal++; } } print "\n".$subtotal." ".lc($$Materials::revTransTable{16}{$type})." type alloys.\n\n"; } print "\n".$total." alloys total.\n"; }