#!/usr/bin/perl
use Getopt::Long;
use File::Find;
$result = GetOptions ("inclusive!" => \$inclusiveflags, "showfile!" => \$showfileflag, "showobject!" => \$showobjectflag, "duplicate!" => \$duplicateflag, "nopass" => \$nopass, "alive" => \$alive, "player" => \$player, "monster" => \$monster, "floor" => \$floor, "spelleffect" => \$spelleffect, "searchname=s" => \$searchstring, "searchbody=s" => \$searchbstring, "race=s" => \$racestring, "slay=s" => \$slaystring, "help|h" => \$showhelp);
if (!$result) { usage(); }
if ($showhelp) { help(); }
$curpath = "./arch";
if ($searchstring) { $namere = qr/$searchstring/i; }
if ($searchbstring) { $bodyre = qr/$searchbstring/i; }
if ($racestring) { $racere = qr/$racestring/i; }
if ($slaystring) { $slayre = qr/$slaystring/i; }
if ($ARGV[0]) { $curpath=$ARGV[0]; }
%animfaces = ();
%unique = ();
%unique2 = ();
#create an internal database of animations defined in .face files to reference to
File::Find::find({wanted => \&facehandle, follow => 1, no_chdir => 1 }, $curpath);
#look through all .arc files for data
File::Find::find({wanted => \&archhandle, follow => 1, no_chdir => 1 }, $curpath);
exit;
sub usage {
$usagemessage = "Usage: getfaces.pl [OPTION]... [PATH]
Try `./getface.pl --help' for more information.
";
die $usagemessage;
}
sub help {
$usagemessage = "Usage: getfaces.pl [OPTION]... [PATH]
List faces used by archtypes that fit given criteria.
Settings:
--showfile before each face, list the .arc that is using it
--showobject before each face, list the name of the object
that is using it
--duplicate show duplicate entries of faces for each object
using the face
--inclusive normally the logic of the criteria is exclusive,
this option makes the criteria behave inclusively
Criteria:
--nopass Only list faces for objects with no_pass 1
--floor Only list faces for objects with is_floor 1
--alive Only list faces for objects with alive 1
--player Only list faces for objects that are players
--monster Only list faces for objects that are monsters
--spelleffect Only list faces for objects that are spelleffects
--race=PATTERN Only list faces for objects with a race that
matches PATTERN
--slay=PATTERN Only list faces for objects with a slaying that
matches PATTERN
--searchname=PATTERN Only list faces for objects with a name that
matches PATTERN
--searchbody=PATTERN Only list faces for objects with a object data that
matches PATTERN
PATH is the path of the archtypes directory, and if no PATH is given it
defaults to ./arch
PATTERN is always in the form of a perl regexp, though plaintext usually
works too.
";
die $usagemessage;
}
sub archhandle {
if (/^.*\.arc\z/s) {
open (ARCHDATA, $File::Find::name) || die "Couldn't open $File::Find::name \n";
while (<ARCHDATA>) {
@words =split(/ /);
if ($_ =~ /^mina/) { $countframes=0; }
if (($countframes==1) && ($_ =~ /^facings /)) {next;}
if ($countframes==1) {$_ =~ s/\s+$//; $_=$_."\n"; $faces = $faces.$_; next;}
if ($_ =~ /^More/) { $morestatus=1; }
if ($_ =~ /^Object /) { chomp($name=$words[1]); $obstatus=1; $doneobject=0;
#reset variables unless "More" just happened (as in some multi-tile monsters)
if (not $morestatus) {
$inopass=0;
$ialive=0;
$imonster=0;
$ifloor=0;
$iteardown=0;
$itype=0;
$istype=0;
$race="";
$slay="";
$face="";
$pname="";
$bodyinfo="";
}
$faces="";
}
if ($_ =~ /^name /) { chomp($pname=$words[1]); }
if ($_ =~ /^end$/) { $newob=1; $obstatus=0; $countframes=0; $doneobject=1; }
if ($_ =~ /^anim$/) { $countframes=1; $hasobject=1 }
if ($_ =~ /^no_pass 1/) {$inopass=1;}
if ($_ =~ /^alive 1/) {$ialive=1;}
if ($_ =~ /^is_floor 1/) {$ifloor=1;}
if ($_ =~ /^monster 1/) {$imonster=1;}
if ($_ =~ /^type /) { $words[1] =~ s/\s+$//; $itype=$words[1]; }
if ($_ =~ /^subtype /) { $words[1] =~ s/\s+$//; $istype=$words[1]; }
if ($_ =~ /^race /) { $words[1] =~ s/\s+$//; $race=$words[1]; }
if ($_ =~ /^slaying /) { $words[1] =~ s/\s+$//; $slay=$words[1]; }
if ($_ =~ /^tear_down 1/) {$iteardown=1;}
if (($_ =~ /animation /) && ($obstatus==1)) { $words[1] =~ s/\s+$//; $faces=$faces."".$animfaces{$words[1]}.""; }
if ($_ =~ /^face/) { $words[1] =~ s/\s+$//; chomp($face=$words[1]); }
if (($obstatus==1) and not ($_ =~ /^end$/)) { $bodyinfo=$bodyinfo.$_; }
next if ($newob==0);
if ($doneobject>=1) {
#we're done with an object.
$faces = $faces."$face\n";
#check if it fits critera
if ($inclusiveflags) {
$nopasscheck = ($inopass and $nopass);
$monstercheck = (($imonster and not ($iteardown or ($itype =~ /^62$/) or ($itype =~ /^101$/))) and $monster);
$alivecheck = ($ialive and $alive);
$playercheck = ((($itype =~ /^37$/) or ($itype =~ /^1$/)) or (($itype =~ /^74$/) and ($istype =~ /^31$/)) and $player);
$bsearchcheck = (($bodyinfo =~ /$bodyre/) and $searchbstring);
$searchcheck = ((($name =~ /$namere/) or ($pname =~ /$namere/)) and $searchstring);
$racecheck = (($race =~ /$racere/) and $racestring);
$slaycheck = (($slay =~ /$slayre/) and $slaystring);
$floorcheck = ($ifloor and $floor);
$spellcheck = (($itype =~ /^102$/) and $spelleffect);
$criteria = ($nopasscheck or $monstercheck or $alivecheck or $playercheck or $searchcheck or $bsearchcheck or $racecheck or $slaycheck or $floorcheck or $spelleffect);
} else {
$nopasscheck = ($inopass or not $nopass);
$monstercheck = (($imonster and not ($iteardown or ($itype =~ /^62$/) or ($itype =~ /^101$/))) or not $monster);
$alivecheck = ($ialive or not $alive);
$playercheck = ((($itype =~ /^37$/) or ($itype =~ /^1$/)) or (($itype =~ /^74$/) and ($istype =~ /^31$/)) or not $player);
$bsearchcheck = (($bodyinfo =~ /$bodyre/) or not $searchbstring);
$searchcheck = ((($name =~ /$namere/) or ($pname =~ /$namere/)) or not $searchstring);
$racecheck = (($race =~ /$racere/) or not $racestring);
$slaycheck = (($slay =~ /$slayre/) or not $slaystring);
$floorcheck = ($ifloor or not $floor);
$spellcheck = (($itype =~ /^102$/) or not $spelleffect);
$criteria = ($nopasscheck and $monstercheck and $alivecheck and $playercheck and $searchcheck and $bsearchcheck and $racecheck and $slaycheck and $floorcheck and $spellcheck);
}
if ($criteria) {
#split the face list into an array and go through the elements
@facearray = split(/\n/, $faces);
foreach $face2(@facearray) {
$unique{$face2}++;
#check that we haven't already outputted this face
if ((($unique{$face2}<=1) or $duplicateflag) and not (($face2 =~ /^blank.111$/) or ($face2 =~ /^empty.111$/))) {
if ($showobjectflag) { $face2=$name.": ".$face2; }
if ($showfileflag) { $face2=$File::Find::name.": ".$face2; }
#make sure that we never output the EXACT same line twice
$unique2{($File::Find::name.": ".$name.": ".$face2)}++;
if ($unique2{($File::Find::name.": ".$name.": ".$face2)}<=1) {print $face2."\n";}
}
}
}
$morestatus=0;
$doneobject=0;
}
}
close (ARCHDATA);
}
}
sub facehandle {
if (/^.*\.face\z/s) {
open (FACEDATA, $File::Find::name) || die "Couldn't open $File::Find::name";
while ($record = <FACEDATA>) {
@words = split(/ /,$record);
if ($record =~ /^mina/) {
$countframes=0;
$animfaces{$aname} = $afaces;
$afaces="";
$aname="";
}
if (($countframes==1) && ($record =~ /^facings /)) {next;}
if ($countframes==1) { $record =~ s/\s+$//; $afaces = $afaces.$record."\n"; next; }
if ($record =~ /^animation /) { $countframes=1; $words[1] =~ s/\s+$//; $aname=$words[1]; next; }
}
close(FACEDATA);
}
}