Mercurial > hg > batmud > misc
view parse_rubi.pl @ 374:10d030b85117 misc tip
Switch Convent map to SVG version, add link to PNG render to the caption.
author | Matti Hamalainen <ccr@tnsp.org> |
---|---|
date | Fri, 01 Mar 2024 10:02:38 +0200 |
parents | e23ea99e7aa8 |
children |
line wrap: on
line source
#!/usr/bin/perl -w use strict; my %rawdata = (); my $mismatches = ""; sub addto($$) { my ($target, $str) = @_; foreach my $result (@{$rawdata{$target}{"results"}}) { return if ($result eq $str); } if ($str ne "") { push(@{$rawdata{$target}{"results"}}, $str); if ($target =~ /^an? ([a-z]+) of (.+)$/) { $rawdata{$target}{"organ"} = $1; $rawdata{$target}{"name"} = $2; } else { $rawdata{$target}{"organ"} = ""; $rawdata{$target}{"name"} = $target; } } } sub err($) { print STDERR "!! ".$_[0]; $mismatches .= $_[0]; } my %says = (); my %races = (); my $result = ""; my $target = ""; my $dis_flag = 0; my $dis_corpse = ""; my $dr_name = ""; my $dr_race = ""; while (<STDIN>) { chomp; if (/^Rubi tosses (.+?) into a cauldron, and it dissolves away\.$/) { addto($1, $result); $result = ""; } elsif (/^Rubi says 'No, no, that won't do at all/) { $result = "NO" if ($result eq ""); } elsif (/^Rubi says 'Hmm, seems a bit shoddy./) { $result = "SHODDY" if ($result eq ""); } elsif (/^Rubi takes (.+?) and starts a new potion\.$/) { $target = $1; } elsif (/^Rubi puts (\d+ potions?) on her shelves\.$/) { addto($target, $1); $target = ""; } elsif (/^Rubi says '(.+?)'$/) { $says{$1} = 1; } elsif (/^You say \'-dis-\.\'$/) { $dis_flag = 1; $dis_corpse = ""; } elsif (/^This is the dead body of (.+)\.$/) { $dis_corpse = $1; } elsif (/^You start slicing into the corpse of '(.+?)'\.\.\.$/) { my $race = $1; if ($dis_flag && $dis_corpse ne "") { if (defined($races{$dis_corpse}) && $races{$dis_corpse} ne $race) { err("'$dis_corpse' race mismatch '".$races{$dis_corpse}."' <=> '$race'.\n"); } else { $races{$dis_corpse} = $race; } } $dis_flag = 0; } elsif (/^([A-Za-z ]+) is an? ([a-z]+)\.$/) { $dr_name = $1; $dr_race = $2; } elsif (/^That race has the following organs:(.+)$/) { my $organs = $1; if ($dr_name ne "" && $dr_race ne "" && !($dr_name =~ /^Corpse of /)) { if (defined($races{$dr_name}) && $races{$dr_name} ne $dr_race) { err("'$dr_name' race mismatch '".$races{$dr_name}."' <=> '$dr_race'.\n"); } else { $races{$dr_name} = $dr_race; } } $dr_name = $dr_race = ""; } else { $dr_name = $dr_race = ""; } } ## Process data with matching races my %data = (); foreach my $i (keys %rawdata) { my $name = $rawdata{$i}{"name"}; $data{$i}{"name"} = $rawdata{$i}{"name"}; $data{$i}{"organ"} = $rawdata{$i}{"organ"}; $data{$i}{"results"} = $rawdata{$i}{"results"}; $data{$i}{"race"} = defined($races{$name}) ? $races{$name} : ""; } ## List what Rubi says .. e.g. the "hints" if ($mismatches ne "") { print "Following possible problems were detected:\n\n".$mismatches."\n"; print "\n=====================================================================\n\n"; } foreach my $i (sort { $a cmp $b } keys %says) { print "$i\n"; } print "\n\n=====================================================================\n\n"; print "-------- Sorted by results --------\n". "Only matches or near-matches shown!\n". "\n"; foreach my $i (keys %data) { $data{$i}{"sort"} = join(", ", sort @{$data{$i}{"results"}}); } sub printentry($$) { my ($i, $res) = @_; if ($data{$i}{"organ"} ne "") { if ($data{$i}{"race"} ne "") { printf "%-30s (%-10s) [%-10s] : %s\n", $data{$i}{"name"}, $data{$i}{"race"}, $data{$i}{"organ"}, $res; } else { printf "%-43s [%-10s] : %s\n", $data{$i}{"name"}, $data{$i}{"organ"}, $res; } } else { printf "%-56s : %s\n", $i, $res; } } foreach my $i (sort { $data{$a}{"sort"} cmp $data{$b}{"sort"} } keys %data) { my $res = join(", ", sort @{$data{$i}{"results"}}); if ($res ne "NO") { printentry($i, $res); } } print "\n\n=====================================================================\n\n"; print "-------- Sorted by name --------\n". "Total of ".(scalar(keys %data))." unique items (organs of given race, items, etc).\n". "\n"; foreach my $i (sort { $data{$a}{"name"} cmp $data{$b}{"name"} } keys %data) { my $res = join(", ", sort @{$data{$i}{"results"}}); printentry($i, $res); } print "\n\n=====================================================================\n\n"; my %byrace = (); foreach my $i (keys %data) { if ($data{$i}{"race"} ne "") { $byrace{$data{$i}{"race"}}{$data{$i}{"organ"}} = $data{$i}{"results"}; } } print "-------- Sorted by race --------\n". "Only data with known race shown!\n". "Total of ".(scalar(keys %byrace))." races.\n". "\n"; foreach my $i (sort { $a cmp $b } keys %byrace) { foreach my $o (sort { $a cmp $b } keys %{$byrace{$i}}) { my $res = join(", ", sort @{$byrace{$i}{$o}}); printf "%-43s (%-10s) : %s\n", $i, $o, $res; } print "\n"; }