#!/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, "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
  --alive                  Only list faces for objects with alive 1
  --player                 Only list faces for objects that are players
  --monster                Only list faces for objects with are monsters
  --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;
				$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 ($_ =~ /^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);
				$criteria = ($nopasscheck or $monstercheck or $alivecheck or $playercheck or $searchcheck or $bsearchcheck or $racecheck or $slaycheck);
			} 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);
				$criteria = ($nopasscheck and $monstercheck and $alivecheck and $playercheck and $searchcheck and $bsearchcheck and $racecheck and $slaycheck);
			}
			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);
}
}