#!/usr/bin/env perl

require "util.pl";

if ($#ARGV >= 0) {
    if ($ARGV[0] =~ m/^--?[hH](elp)?$/) {
	die ("\nUSAGE: perl collect.pl  ARCHDIR\n".
	     "\nWhere ARCHDIR is the directory where you stored the ".
	     "raw archetypes.\n".
	     "This script will then create these files:\n".
	     "archetypes,bmaps.paths,faces,treasures,animations.\n"
	)
    }
}

# mkdir is nice because it is an atomic operation - if 2 programs
# try to do it at the same time, one will fail.  Do a -e/create
# file check has a chance of race condition.
if (!mkdir("collect.lock",0)) {
    print "Collect is already running.  If you think this is an error,\n";
    print "rmdir collect.lock\n";
    # exit with a non zero code - in that way make errors out and
    # won't try to build the next target - the images.  If another
    # process is running on the archetypes, that will make a new bmaps.paths
    # requiring new images at that time.
    exit(1);
}


# archonly is used to only build the archetypes.  I find this
# very handy if I know I've only changed .arc files - I don't want
# to rebuild the other files, because now cvs tries to do diffs
# on them as well as commit them, even if there are no changes.
$archonly = 0;
if ($#ARGV >= 1) {
    if ($ARGV[1] eq "ARCHONLY") { $archonly = 1; }
    else {print "Ignoring unknown option: $ARGV[1]\n"; }
}


$root = $ARGV[0];
$archetypes = "archetypes";
$faces = "faces";
$treasures = "treasures";
$animations = "animations";
$paths = "bmaps.paths";
$faceExt = "\\.[a-zA-Z0-9][A-Z0-9][A-Z0-9]";
$smooths = "smooth";

### main
&info("looking ...");
&traverse($root);

$attacktype{ 'physical' } = ( 1 << 0 );
$attacktype{ 'magic' } = ( 1 << 1 );
$attacktype{ 'fire' } = ( 1 << 2 );
$attacktype{ 'electricity' } = ( 1 << 3 );
$attacktype{ 'cold' } = ( 1 << 4 );
$attacktype{ 'confusion' } = ( 1 << 5 );
$attacktype{ 'acid' } = ( 1 << 6 );
$attacktype{ 'drain' } = ( 1 << 7 );
$attacktype{ 'weaponmagic' } = ( 1 << 8 );
$attacktype{ 'ghosthit' } = ( 1 << 9 );
$attacktype{ 'poison' } = ( 1 << 10 );
$attacktype{ 'slow' } = ( 1 << 11 );
$attacktype{ 'paralyze' } = ( 1 << 12 );
$attacktype{ 'turnundead' } = ( 1 << 13 );
$attacktype{ 'fear' } = ( 1 << 14 );
$attacktype{ 'cancellation' } = ( 1 << 15 );
$attacktype{ 'deplete' } = ( 1 << 16 );
$attacktype{ 'death' } = ( 1 << 17 );
$attacktype{ 'chaos' } = ( 1 << 18 );
$attacktype{ 'counterspell' } = ( 1 << 19 );
$attacktype{ 'godpower' } = ( 1 << 20 );
$attacktype{ 'holyword' } = ( 1 << 21 );
$attacktype{ 'blind' } = ( 1 << 22 );
$attacktype{ 'internal' } = ( 1 << 23 );
$attacktype{ 'lifestealing' } = ( 1 << 24 );
$attacktype{ 'disease' } = ( 1 << 25 );

&info("writing ...$archetypes");
open(ARCH,">".$archetypes) || &my_die("cannot open ".$archetypes);

binmode(ARCH);
&archsOut($root);
close(ARCH);


if (!$archonly) {
    &info("$paths");
    open(BMAPS,">".$paths) || &my_die("cannot open ".$paths);
	binmode(BMAPS);
    &pathsOut;
    close(BMAPS);

    &info("$faces");
    open(FACES,">".$faces) || &my_die("cannot open ".$faces);
	binmode(FACES);
    &facesOut;
    close(FACES);

    &info("$smooths");
    open(SMOOTHS,">".$smooths) || &my_die("cannot open ".$smooths);
	binmode(SMOOTHS);
    &smoothOut;
    close(SMOOTHS);

    &info("$treasures");
    # We still support the old consolidated treasure information
    # so copy it over.
    open(TREASURES,">".$treasures) || &my_die("cannot open ".$treasures);
	binmode(TREASURES);
    print TREASURES "#
# Do not modify this file - any changes will get overwritten.
# instead, modify the .trs file in the arch directory.
#
";
    &treasuresOut;
    close(TREASURES);

    &info("$animations");
    open(ANIM,">".$animations) || &my_die("cannot open ".$animations);
	binmode(ANIM);
    &animOut;
    close(ANIM);
}


&stats;
rmdir("collect.lock");
exit 0;

sub traverse {
    local($dir) = shift;
    local($file,$name);
    local( $tfile);

    opendir(THISDIR, $dir) || my_die("couldn't open $dir");
    local(@allfiles) = readdir(THISDIR);
    closedir(THISDIR);

    foreach $tfile (sort @allfiles) {
	next if $tfile =~ /^\./;
	next if $tfile =~ /~$/;
	$file = $dir."/".$tfile;
	$name = &basename($file,""); # DIR

	if( -d $file && $name ne "dev" && $name ne "trashbin" && $name ne ".svn" ) {
	    &traverse($file);
	} elsif ( -d $file && ( $name eq "dev" || $name eq "trashbin" ) ) {
# Empty directive to prevent warnings below
	} elsif( $file =~ /.*\.arc$/) {	# ARCHETYPE
	    $archsNum++;
	    push(@archs,$file);n
	} elsif( $name =~ /(\S+)\.base($faceExt)\.png$/) { # FACE
	    $facesNum++;
	    $im_name = "$1$2";
	    &warn("duplicate face $im_name in ".$dir." and $faces{$im_name}")
		if $faces{$im_name};
	    $faces{$im_name} = $dir."/".$im_name;

	} elsif ( $file =~ /.*\.face$/) {	# Face information file
	    $facesFileNum++;
	    push(@face_files, $file);
	} elsif ( $file =~ /.*\.trs$/) {	# Treasure information file
	    push(@treasure_files, $file);
	}
	elsif ( $file =~ /\.png$/ || $file =~ /\.xpm$/ || $file =~ /\.xcf/ || $file =~ /\.doc$/ || $file =~ /\.txt$/ || $file =~ /$faceExt$/ || $file =~ /\.blend$/ ) {
	# we cover many files we probably shouldn't, but oh well.
	# we just don't want complaints about all of these.
	}
	# ignore a couple of the more common 'junk' files that are not
	# really junk.
	elsif (($name ne "README") && ($name ne "ChangeLog") && ($name ne "TODO") && ($name ne ".svn") && ($name ne "artifacts") && ($name ne "attackmess") && ($name ne "formulae") && ($name ne "image_info") && ($name ne "materials") && ($name ne "messages") && ($name ne "races")) {
	    $trashNum++;
	    print "Warning: $file might be a junk file\n";
	}
    }
}

sub storeFaceInfo {
    local($lface,@values) = @_;

    if ($values[0] ne "") {
#	blank.111 is a special case -
#	since no foreground pixels will actually be drawn, foreground colors is
#	not relevant.  Several monsters use blank.111 as part of their
#	animation to make them appear invisible, but have some other
#	foreground color set.
#	Same applies to empty also.
	if ($fg{$lface} && $fg{$lface} ne $values[0] && $lface ne "blank.111"
		&& $lface ne "empty.111") {
	    &warn($arch." duplicate fg color ".$fg{$lface}."/".$values[0]." face ".$lface);
	} else {
	    $fg{$lface} = $values[0];
	}
    }
    if ($values[1] ne "" && $lface ne "blank.111" && $lface ne "empty.111") {
#      blank.111 is a special case - see above explanation
#      Its visibility is always 0.
	if ($visibility{$lface} && $visibility{$lface} ne $values[1]) {
	    &warn($arch." duplicate visibilty ".$visibility{$lface}."/".$values[1]." face ".$lface);
	} else {
	    $visibility{$lface} = $values[1];
	}
    }
    if ($values[2] ne "" && lface ne "blank.111" && $lface ne "empty.111") {
	if ($magicmap{$lface} && $magicmap{$lface} ne $values[2]) {
	    &warn($arch." duplicate magicmap color ".$magicmap{$lface}."/".$values[2]." face ".$lface);
	} else {
	    $magicmap{$lface} = $values[2];
	}
    }
    if ($values[3] ne "") {
	if ($floor{$lface} && $floor{$lface} ne $values[3]) {
	    &warn($arch." duplicate floor information ".$floor{$lface}."/".$values[3]." face ".$lface);
	} else {
	    $floor{$lface} = $values[3];
	}
    }
}


sub archsOut {
    local($dir) = shift;

    foreach $arch (@archs) {
	# Assume the filename $arch begins with $dir. Assign all path name
	# components after $dir to $pathto.
	if($arch =~ /^\Q$dir\E\/(.*)\/[^\/]*[.]arc$/) {
	    $pathto = $1;
	} else {
	    &warn("cannot determine editor_folder from arch '$arch'");
	    $pathto = "";
	}
	open(ARC,$arch) || &my_die("cannot open ".$arch);
line:	while(<ARC>) {
	    chop;
	    ($var,@values) = split;
	    if ($var eq "#") {
		#developper comment, switch to next line
		$commentNum++;
		next line;
	    }
	    if ($var eq "Object") {
		$lface[0] = "";
		$#lface = 0;
		$lfg = "";
		$lvis = "";
		$mm = "";
		$floor = "";
		$moveon = 0;
		$nopick = 0;
		$arch = join "_", @values;
		$print_editor_folder = 1;
	    } else {
		$print_editor_folder = 0;
	    }
	    if ($var eq "end") {
		if ($#lface !=0) {
		    $#lface--;
		    foreach $face (@lface) {
			&storeFaceInfo($face, $lfg, $lvis,$mm,$floor);
		    }
	 	}
		if ($moveon && !$nopick) {
		    &warn("File $arch has an object with move_on set which can be picked up\n");
		}
	    }
	    # Process the color/face info now
	    if ($var eq "color_fg") {
		$lfg = $values[0];
		next line;
	    }
	    if ($var eq "visibility") {
		$lvis = $values[0];
		next line;
	    }
	    if ($var eq "magicmap") {
		$mm = $values[0];
		next line;
	    }
	    if ($var eq "attacktype") {
		$at = 0;
		foreach $t ( @values ) {
		    if ( $t =~ /^\d+$/ ) {
			$at |= $t;
		    } else {
			if ( defined( $attacktype{ $t } ) ) {
			    $at |= $attacktype{ $t };
			} else {
			    &warn($arch . " has invalid attacktype " . $t);
			}
		    }
		}
		$_ = $var . ' ' . $at;
	    }
	    if ($var eq "is_floor") {
		$floor = $values[0];
		# is_floor is also needed for archs, so let it pass
		# through
	    }
	    elsif ($var eq "no_pick") {
		$nopick = $values[0];
	    } elsif ($var eq "move_on") {
		$moveon = 1;
	    }
	    elsif ($var eq "face") {
		$lface[$#lface++] = $values[0]
	    }
	    if ($var eq "face" && ! $faces{$values[0]}) {
		&warn($arch." is missing face ".$values[0])
	    }
	    if ($var eq "smoothface") {
		if ($smoothing{$values[0]} && ($smoothing{$values[0]} ne $values[1])) {
		    &warn($arch." duplicate smoothface for ".$values[0].": ".$smoothing{$values[0]}." and ".$values[1]);
		} elsif ( ($values[0] eq "") || ($values[1] eq "")) {
		    &warn ($arch." incomplete smoothface entry found: ".$values[0]." ".$values[1]);
		} else {
		    $smoothing{$values[0]}=$values[1]
		}
		next line;  #smoothface must be excluded from archetype file
	    }
	    print ARCH $_,"\n";
	    if ($print_editor_folder) {
		print ARCH "editor_folder $pathto\n" if $pathto ne "";
	    }
	}
	close(ARC);
    }
}

sub pline {
    local($face) = shift;
    print BMAPS sprintf("%05d",$idx++)," ",$face,"\n";
}

sub opline {
    local($face) = shift;
    print BMAPS sprintf("\\%05d",$idx++),"\t",$face,"\n";
}

sub pheader {
    print BMAPS "# This file is generated by $0, do not edit\n";
}

sub pathsOut {
    &pheader;
    $idx = 0;
    &opline($root."/system/bug.111");
    foreach $face (sort(keys %faces)) {
	&opline($faces{$face}) if $faces{$face} !~ /bug\.111/;
    }
}

sub treasuresOut {
    foreach $treasure (@treasure_files) {
	open(TREAS, $treasure) || &my_die("cannot open ".$treasure);
	while(<TREAS>) {
	    if (! /^\s*$/) {
		print TREASURES $_;
	    }
	}
	close(FACE);
    }
}

sub facesOut {
    foreach $face (@face_files) {
	open(FACE, $face) || &my_die("cannot open ".$face);
	while(<FACE>) {
	    chop;
	    local ($var, @values) = split;
	    if ($var eq "face") {
		$lface = $values[0];
		$lfg = "";
		$lvis = "";
		$mm = "";
		$floor = "";
	    }
	    elsif ($var eq "color_fg") {
		$lfg = $values[0];
	    }
	    elsif ($var eq "visibility") {
		$lvis = $values[0];
	    }
	    elsif ($var eq "magicmap") {
		$mm = $values[0];
	    }
	    elsif ($var eq "is_floor") {
		$floor = $values[0];
	    }
	    elsif ($var eq "end") {
		&storeFaceInfo($lface, $lfg, $lvis, $mm, $floor);
	    }
	    elsif ($var eq "animation") {
		$animation=$values[0];
		if ($anim{$1}) {
		    &warn("$animation is a duplicate animation name");
		    $anim{$animation}="";
		}
		while (<FACE>) {
		    chomp;
		    $var = $_;
		    last if ($var =~ /^mina\s*$/);
		    if ($var !~ /^facings/ ) {
		    	if (! $faces{$var}) {
			    &warn($arch." is missing face ".$var);
			}
			else {
			    $lface[$#lface++] = $var;
			}
		    }
		    $anim{$animation} .= "$var\n";
		}
		next;	# don't want the mina
	    }
	}
	close(FACE);
    }
    print FACES "# This file is generated by $0, do not edit\n";
    foreach $face (sort(keys %faces)) {
	if ($fg{$face} ne "" || $bg{$face} ne "" || $visibility{$face} ne "" ||
	    $magicmap{$face} ne "" || $floor{$face} ne "") {
	    print FACES "face ".$face."\n";
	    print FACES "color_fg ".$fg{$face}."\n"
	    if $fg{$face} ne "";
		print FACES "visibility ".$visibility{$face}."\n"
	    if $visibility{$face} ne "";
		print FACES "magicmap ".$magicmap{$face}."\n"
	    if $magicmap{$face} ne "";
		print FACES "is_floor ".$floor{$face}."\n"
	    if $floor{$face} ne "";
		print FACES "end\n";
	}
    }
}

sub animOut {
    foreach $anim (sort keys %anim) {
	print ANIM "anim $anim\n$anim{$anim}mina\n";
	$animationsNum++;
    }
}
sub smoothOut {
    local ($sm);
    print SMOOTHS "##########################################################\n";
    print SMOOTHS "# Do not touch this file.                                #\n";
    print SMOOTHS "# It has been generated from the informations present    #\n";
    print SMOOTHS "# in the archetype files.                                #\n";
    print SMOOTHS "# To add new entries, simply add                         #\n";
    print SMOOTHS "#     smoothface xxx yyy                                 #\n";
    print SMOOTHS "# to an archetype and collect.pl will put below an entry #\n";
    print SMOOTHS "#      xxx yyy                                           #\n";
    print SMOOTHS "##########################################################\n\n";
    print SMOOTHS "\n# Data extracted from arch files\n";
    foreach $sm (sort (keys %smoothing)) {
	print SMOOTHS "$sm $smoothing{$sm}\n";
	$smoothNum++;
    }
}

### print out statical information
sub stats {
    &info(Archs.":\t".$archsNum);
    &info(Images.":\t".$facesNum);
    &info(Faces.":\t".$facesFileNum);
    &info(Animations.":\t".$animationsNum);
    &info(Treasures.":\t".($#treasure_files+1));
    &info(Trash.":\t".$trashNum);
    &info(Smooths.":\t".$smoothNum);
    &info("Comment lines:\t".$commentNum);
}

# This is a simple function to clean up the collect lock
# and then call die.
sub my_die {
    rmdir("collect.lock");
    die(@_);
}