--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/log2npctemplate.pl	Sat May 22 00:50:58 2010 +0000
@@ -0,0 +1,251 @@
+#!/usr/bin/perl -w
+use strict;
+
+my @spellchants = (
+"claps its hands and says",
+"claps his hands and whispers",
+"fills up his cheeks with air and exhales",
+"booms in sinister voice",
+"throws a pinch of magic dust in air and chants",
+"rolls her eyes wildly and exclaims",
+"rolls its eyes frantically and states",
+"utters the magic words",
+"spreads her fingers and whispers",
+"waves its index finger while uttering",
+"points an accusing finger and cries",
+"gets an evil gleam in its eyes and chants",
+"flaps arms and utters the magic words",
+"flaps his arms and utters the magic words",
+"taps its foot three times and utters the words",
+"is surrounded by blue waves as you hear the words:",
+"closes his eyes and with a dry, dark voice entones",
+"shakes with firey rage and yells",
+"traces fiery demonic night runes in the air",
+#"",
+);
+
+my %monsters = ();
+my %aligns = ();
+my %spells = ();
+
+my $line = 0;
+my $mode = 0;
+my ($mob_sname, $mob_sdesc, $mob_ldesc, $mob_area, $mob_cont, $mob_line);
+my $mob_eqs = { };
+my $state = 0;
+
+# Convert spellchants array
+my $spellregexps = join("|", map { s/ (his|its|her) / ... /g; $_ } @spellchants);
+
+#print STDERR "$spellregexps\n";
+
+# Change parsing state
+sub setstate($$)
+{
+  return unless ($_[0] != $state);
+#  print STDERR "STATE = $_[0], old = $state\n";
+  $state = $_[0];
+  if ($state < 0) {
+    print STDERR "ERROR: $_[1]\n";
+    $state = 0;
+  }
+}
+
+# Main parsing loop
+while (<STDIN>) {
+  $line++;
+  chomp;
+  if (/^([A-Za-z][A-Za-z\ -]+?)\ ($spellregexps)\ \(([a-z][a-z\ ]+)\)$/) {
+    # Grab spells cast
+#    print STDERR "CAST: '$1' '$3' \@ #$line\n";
+    $spells{$1}{$line} = $3;
+  } elsif (/\| +(\d+): (.+?) +\|$/) {
+    # Grab exp worth
+    my $exp = $1;
+    my $tmp = $2;
+    my $sdesc = substr($tmp, 0, 66);
+    if (defined($monsters{$sdesc}) && $line > $monsters{$sdesc}{"line"}) {
+      $monsters{$sdesc}{"exp"} = $exp;
+    } else {
+      $tmp .= " (undead)";
+      $sdesc = substr($tmp, 0, 66);
+      if (defined($monsters{$sdesc}) && $line > $monsters{$sdesc}{"line"}) {
+        $monsters{$sdesc}{"exp"} = $exp;
+      }
+    }
+  } elsif (/^You see nothing special.$/) {
+    setstate(0, $_);
+  } elsif ($state == 0 && /^You quack '-+ .+? -+\.'$/) {
+    setstate(1, $_);
+    $mob_sname = "";
+    $mob_sdesc = "";
+    $mob_ldesc = "";
+    $mob_area = "";
+    $mob_cont = "";
+    $mob_line = $line;
+    undef($mob_eqs);
+  } elsif ($state == 1) {
+    if (/^You prod (.+?) like a stray cow\.$/) {
+      # Get 'short name'
+      $mob_sname = $1;
+    } elsif (/^You are in '.*?' in (.+?) on the continent of ([A-Z][a-z]+). \(Coordinates: \d+x, \d+y\)$/) {
+      # Area, continent
+      $mob_area = $1;
+      $mob_cont = $2;
+    } elsif (/^You are in '.*?', which is on the continent of ([A-Z][a-z]+). \(Coordinates: \d+x, \d+y\)$/) {
+      # Area, continent
+      $mob_area = $1;
+      $mob_cont = $1;
+    } elsif (/^You quack '--\?\?--\?\?--\?\?--\?\?--\.'$/) {
+      setstate(2, $_);
+    }
+  } elsif ($state == 2) {
+    if (/^You quack '-=-=-=-=-=-=-=-=-\.'$/) {
+      setstate(3, $_);
+    } elsif (/^(He|She|It) +\[[a-z]+\] \([0-9-]+\%\)/) {
+      setstate(-1, $_);
+    } elsif (/^You quack /) {
+      setstate(-1, $_);
+    } else {
+      $mob_sdesc = $_;
+    }
+  } elsif ($state == 3) {
+    if (/^ +([a-zA-Z ,-]+?)'s equipment:$/) {
+      # End of long desc
+      setstate(4, $_);
+    } elsif (/^(He|She|It) +\[[a-z]+\] \([0-9-]+\%\)$/) {
+      # End of long desc
+      setstate(4, $_);
+    } elsif (/^You quack /) {
+      setstate(-1, $_);
+    } else {
+      # Collect long desc
+      $mob_ldesc .= $_." ";
+    }
+  } elsif ($state == 4) {
+    if (/^You quack '====+'?\.'$/) {
+      # Finished, submit information to hash
+      $monsters{$mob_sdesc}{"line"} = $mob_line;
+      $monsters{$mob_sdesc}{"eqs"} = $mob_eqs;
+      $monsters{$mob_sdesc}{"sname"} = $mob_sname;
+      $monsters{$mob_sdesc}{"ldesc"} = $mob_ldesc;
+      $monsters{$mob_sdesc}{"area"} = $mob_area;
+      $monsters{$mob_sdesc}{"cont"} = $mob_cont;
+      setstate(0, $_);
+    } elsif (/^([A-Z][a-z, ]+): (.*)$/) {
+      # Collect EQ and slot information
+      $mob_eqs->{$1} = $2;
+    } elsif (/^ +([a-zA-Z -]+?)'s equipment:$/) {
+    } elsif (/^((It|She|He) has a blueish black kiss on ... cheek\.|(It|She|He) suffers from scourge\.|Some glittering red mist is surrounding this creature.|Nothing\.|(It|He|She) has a faint ring of .+ magic mist around ... neck\.)$/) {
+    } else {
+      setstate(-1, $_);
+    }
+  } elsif (/^(.+?) is (a bit good|a bit evil|evil|good|neutral)\.$/) {
+    print "## '$1' is '$2'\n";
+    $aligns{$1}{"align"} = $2;
+    $aligns{$1}{"line"} = $line;
+  } elsif (/^You quack /) {
+    setstate(0, $_);
+  }
+}
+
+
+# Print out information
+foreach my $sdesc (sort { $a cmp $b } keys %monsters) {
+  my $mob = $monsters{$sdesc};
+
+  print "---------------------
+$sdesc
+
+{{ NPC
+| name = ".$mob->{"sname"}."
+| description = ".$mob->{"ldesc"}."
+| eqs = ";
+
+  foreach my $slot (sort { $a cmp $b } keys %{$mob->{"eqs"}}) {
+    my ($k, $s);
+    $k = $s = $mob->{"eqs"}{$slot};
+    $k =~ s/ <[a-z]+ glow>$//;
+    if ($k eq $s) {
+      print "$slot: [[$s]]\n\n";
+    } else {
+      print "$slot: [[$k|$s]]\n\n";
+    }
+  }
+  
+  print "none" unless (scalar keys %{$mob->{"eqs"}} > 0);
+  print "\n";
+        
+  if ($sdesc =~ / \(undead\)$/) {
+    print "| undead = x\n";
+  }
+
+  # Check if we find a matching alignment: find a cast of 'detect alignment'
+  # with matching short name and withing appropriate distance from the mob look.
+  print "| alignment = ";
+  my $mname = $mob->{"sname"};
+  my $mline = $mob->{"line"};
+
+  if (defined($aligns{$mname})) {
+    my $aline = $aligns{$mname}{"line"};
+    my $offs = $aline - $mline;
+#    print STDERR "align '".$aligns{$mname}{"align"}."' found for '$mname' '$sdesc' at offset $offs.\n";
+    if ($offs < 200 && $offs > -100) {
+#      print STDERR "align '".$aligns{$mname}{"align"}."' found for '$mname' '$sdesc' at offset $offs.\n";
+      print $aligns{$mname}{"align"};
+    }
+  }
+  print "\n";
+
+  my $hasspells = 0;
+  if (defined($spells{$mname}) && length($mname) > 4) {
+    my $maxdist = length($mname) * 150 * length($mname);
+    my $mindist = length($mname) * -5 * length($mname);
+    my %mspells = ();
+    foreach my $sline (sort { $a <=> $b } keys %{$spells{$mname}}) {
+      my $offs = $sline - $mline;
+#      print STDERR "TEST $mname @ $offs vs $mindist...$maxdist : '".$spells{$mname}{$sline}."'\n";
+      if ($offs < $maxdist && $offs > $mindist) {
+#        print STDERR "match $mname @ $offs / $mindist...$maxdist : '".$spells{$mname}{$sline}."'\n";
+        $mspells{$spells{$mname}{$sline}} = 1;
+        $hasspells++;
+      }
+    }
+    my $n = 1;
+    foreach my $spell (sort { $a cmp $b } keys %mspells) {
+      print "| spell".($n < 2 ? "" : $n)." = $spell\n";
+      $n++;
+    }
+  }
+
+unless ($hasspells > 0) {
+print "| spell = 
+| spell# = 
+";
+}
+
+  print "
+| area = ".$mob->{"area"}."
+| skill = 
+| skill# = 
+| race = 
+";
+
+  if (defined($mob->{"exp"})) {
+    if ($mob->{"exp"} > 1000) {
+      printf "| exp = %dk\n", $mob->{"exp"} / 1000;
+    } else {
+      printf "| exp = %d\n", $mob->{"exp"};
+    }
+  } else {
+    print "| exp = \n";
+  }
+
+print "| GAP = 
+| PAP = 
+| kerbholz = 
+| other = 
+}}
+---------------------
+";
+}