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";
}