Mercurial > hg > batmud > misc
changeset 100:90033967a42d misc
Added perl-script that processes logfiles with specially marked information of NPCs and produces ready to cut & paste NPC templates for BatWiki. This is completely undocumented for the moment.
author | Matti Hamalainen <ccr@tnsp.org> |
---|---|
date | Sat, 22 May 2010 00:50:58 +0000 |
parents | a943c659e6fd |
children | 10dd1019609e |
files | log2npctemplate.pl |
diffstat | 1 files changed, 251 insertions(+), 0 deletions(-) [+] |
line wrap: on
line diff
--- /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 = +}} +--------------------- +"; +}