#! /usr/bin/env perl

use strict;
use warnings;
use English;
use Time::HiRes qw( time );

sub usage()
{
    print "Usage:\n    pmon_comp INPUT_FILE\n\npmon_comp reads a single .permon file INPUT_FILE and generates a permon.cc\nand pmon_id.hh based on its contents.";
    exit(1);
}

our @monsters;

our $max_flag_index = 1;

our %flag_indices =
(
    'RESIST_FIRE' => 0,
    'RESIST_COLD' => 0,
    'RESIST_ELEC' => 0,
    'RESIST_POIS' => 0,
    'RESIST_NECR' => 0,
    'RESIST_SLAM' => 0,
    'RESIST_DRWN' => 0,
    'UNDEAD' => 0,
    'DEMONIC' => 0,
    'MAGICIAN' => 0,
    'ARCHER' => 0,
    'SMART' => 0,
    'STUPID' => 0,
    'ETHEREAL' => 0,
    'FLYING' => 0,
    'HUMANOID' => 0,
    'CENTAUROID' => 0,
    'SERPENTINE' => 0,
    'AMORPHOUS' => 0,
    'QUADRUPED' => 0,
    'SKITTERISH' => 0,
    'HUGE' => 0,
    'SMALL' => 0,
    'MADE_OF_MEAT' => 1,
    'MADE_OF_GOO' => 1,
    'MADE_OF_BONE' => 1,
    'MADE_OF_METAL' => 1,
    'MADE_OF_ICE' => 1,
    'MADE_OF_FIRE' => 1,
    'CONTAINS_BLOOD' => 1,
    'CONTAINS_PUS' => 1,
    'BURSTS_ON_DEATH' => 1,
    'LEAVES_CORPSE' => 1,
);


sub macroify_name($)
{
    my $name = "".shift @_;
    $name =~ tr/'//d;
    return uc(($name =~ tr/a-zA-Z/_/csr));
}

sub flag_string($)
{
    my $aref = shift @_;
    my @flag_fields = ();
    if (!defined($aref) || scalar(@$aref == 0))
    {
        return "0";
    }
    else
    {
        my $name;
	my $i;
	for ($i = 0; $i <= $max_flag_index; ++$i)
	{
            $#flag_fields = $i if ($i > $#flag_fields);
            if (!defined($flag_fields[$i]))
            {
                $flag_fields[$i] = "0 ";
            }
	}
        for $name (@$aref)
        {
            die("Attempt to generate a flag string containing an undefined flag $name!") if !exists($flag_indices{$name});
            my $idx = $flag_indices{$name};
            $flag_fields[$idx] .= "| PMF_$name ";
        }
    }
    return join(", ", @flag_fields);
}

sub commit_monster($)
{
    my $href = shift(@_);
    die("Attempt to commit an unnamed monster!") if !exists($href->{name});
    die("Attempt to commit a ASCIIless monster ".$href->{name}."!") if !exists($href->{ascii});
    die("Attempt to commit a UTF8less monster ".$href->{name}."!") if !exists($href->{uni});
    if (!exists($href->{plural}))
    {
        # naive fallback, guaranteed to look shit sooner or later
        $href->{plural} = $href->{name}."s";
    }
    my $new_hash = {
        'name' => $href->{name},
        'plural' => $href->{plural},
        'desc' => $href->{desc},
        'ascii' => $href->{ascii},
        'uni' => $href->{uni},
        'colour' => $href->{colour},
        'rarity' =>  $href->{rarity},
        'power' =>  $href->{power},
        'hp' =>  $href->{hp},
        'mtohit' =>  $href->{mtohit},
        'rtohit' =>  $href->{rtohit},
        'mdam' =>  $href->{mdam},
        'rdam' =>  $href->{rdam},
        'rdtyp' =>  $href->{rdtyp},
        'shootverb' => $href->{shootverb},
        'defence' =>  $href->{defence},
        'exp' =>  $href->{exp},
        'speed' =>  $href->{speed},
        'power' =>  $href->{power},
        'flags' => $href->{flags}
    };
    push @monsters, $new_hash;
}

our $argc = scalar(@ARGV);
usage() if ($argc != 1);
our $output_fname;
our $input_fname = "$ARGV[0]";
open(INFILE, "<", $input_fname) or die "pmon_comp: could not open $input_fname for read: $!";
our @input_file = <INFILE>;
close INFILE;
our %blank_monster = (
    'desc' => "An monster some useless slacker hasn't bothered to describe.",
    'colour' => "l_grey",
    'rarity' => 100,
    'power' => 1,
    'hp' => 1,
    'mtohit' => 0,
    'rtohit' => -1,
    'mdam' => 0,
    'rdam' => -1,
    'rdtyp' => "PHYS",
    'shootverb' => "shoots",
    'defence' => 0,
    'exp' => 0,
    'speed' => 0
);

our %working_monster;

sub reinit_working_monster($)
{
    %working_monster = %blank_monster;
    $working_monster{name} = shift;
    $working_monster{plural} = "$working_monster{name}s";
    $working_monster{flags} = [];
}

my $input_line;

our $start_time = time();
print "Processing permons database $input_fname";
for $input_line (@input_file)
{
    chomp $input_line;
    next if ($input_line =~ /^\s*$/);
    next if ($input_line =~ /^\s*#/);
    if ($input_line =~ /^\s*monster\s+([^[:space:]].*)$/i)
    {
        my $name = $1;
        if (exists($working_monster{name}))
        {
            commit_monster(\%working_monster);
            %working_monster = ();
        }
        reinit_working_monster($name);
        print ".";
    }
    elsif (!exists($working_monster{name}))
    {
        die("Attempt to specify monster properties without starting an monster");
    }
    elsif ($input_line =~ /^\s*(power|depth)\s+/i)
    {
        my $pm = "$POSTMATCH";
        if ($pm =~ /^(-?[0-9]+)/)
        {
            $working_monster{power} = $1;
        }
        else
        {
            die("Non-numeric power value $pm in monster $working_monster{name}");
        }
    }
    elsif ($input_line =~ /^\s*hp\s+/i)
    {
        my $pm = "$POSTMATCH";
        if ($pm =~ /^(-?[0-9]+)/)
        {
            $working_monster{hp} = $1;
        }
        else
        {
            die("Non-numeric hp value $pm in monster $working_monster{name}");
        }
    }
    elsif ($input_line =~ /^\s*m(elee)?(to)?hit\s+/i)
    {
        my $pm = "$POSTMATCH";
        if ($pm =~ /^([0-9]+)/)
        {
            $working_monster{mtohit} = $1;
        }
        else
        {
            die("Negative or non-numeric mtohit value $pm in monster $working_monster{name}");
        }
    }
    elsif ($input_line =~ /^\s*m(elee)?dam\s+/i)
    {
        my $pm = "$POSTMATCH";
        if ($pm =~ /^([0-9]+)/)
        {
            $working_monster{mdam} = $1;
        }
        else
        {
            die("Negative or non-numeric mdam value $pm in monster $working_monster{name}");
        }
    }
    elsif ($input_line =~ /^\s*r(anged)?(to)?hit\s+/i)
    {
        my $pm = "$POSTMATCH";
        if ($pm =~ /^([0-9]+)/)
        {
            $working_monster{rtohit} = $1;
        }
        else
        {
            die("Negative or non-numeric rtohit value $pm in monster $working_monster{name}");
        }
    }
    elsif ($input_line =~ /^\s*sp(ee)?d\s+/i)
    {
        my $pm = "$POSTMATCH";
        if ($pm =~ /^([0-9]+)/)
        {
            $working_monster{speed} = $1;
        }
        else
        {
            die("Negative or non-numeric speed value $pm in monster $working_monster{name}");
        }
    }
    elsif ($input_line =~ /^\s*exp(erience)?\s+/i)
    {
        my $pm = "$POSTMATCH";
        if ($pm =~ /^([0-9]+)/)
        {
            $working_monster{exp} = $1;
        }
        else
        {
            die("Negative or non-numeric exp value $pm in monster $working_monster{name}");
        }
    }
    elsif ($input_line =~ /^\s*def(en[cs]e)?\s+/i)
    {
        my $pm = "$POSTMATCH";
        if ($pm =~ /^([0-9]+)/)
        {
            $working_monster{defence} = $1;
        }
        else
        {
            die("Negative or non-numeric defence value $pm in monster $working_monster{name}");
        }
    }
    elsif ($input_line =~ /^\s*r(anged)?dam\s+/i)
    {
        my $pm = "$POSTMATCH";
        if ($pm =~ /^([0-9]+)/)
        {
            $working_monster{rdam} = $1;
        }
        else
        {
            die("Negative or non-numeric rdam value $pm in monster $working_monster{name}");
        }
    }
    elsif ($input_line =~ /^\s*rarity\s+/i)
    {
        my $pm = "$POSTMATCH";
        if ($pm =~ /^([0-9]+)/)
        {
            $working_monster{rarity} = $1;
        }
        else
        {
            die("Negative or non-numeric rarity value $pm in monster $working_monster{name}");
        }
    }
    elsif ($input_line =~ /^\s*shootverb\s+/i)
    {
        $working_monster{shootverb} = "$POSTMATCH";
    }
    elsif ($input_line =~ /^\s*colour\s+/i)
    {
        $working_monster{colour} = "$POSTMATCH";
    }
    elsif ($input_line =~ /^\s*desc\s+/i)
    {
        $working_monster{desc} = "$POSTMATCH";
    }
    elsif ($input_line =~ /^\s*plural\s+/i)
    {
        $working_monster{plural} = "$POSTMATCH";
    }
    elsif ($input_line =~ /^\s*r(anged)?dtyp\s+/i)
    {
        $working_monster{rdtyp} = "$POSTMATCH";
    }
    elsif ($input_line =~ /^\s*ascii\s+/i)
    {
        my $pm = "$POSTMATCH";
        if ($pm =~ /^'[[:ascii:]]'/)
        {
            $working_monster{ascii} = "$MATCH";
        }
        else
        {
            die("Malformed 'ASCII' argument $pm in monster $working_monster{name}");
        }
    }
    elsif ($input_line =~ /^\s*utf-?8\s+/i)
    {
        my $pm = "$POSTMATCH";
        if ($pm =~ /^"[^"]+"/)
        {
            $working_monster{uni} = "$MATCH";
        }
        else
        {
            die("Malformed 'UTF8' argument $pm in monster $working_monster{name}");
        }
    }
    else
    {
        my $test_line = "$input_line";
        $test_line =~ s/\s+//;
        if (exists($flag_indices{$test_line}))
        {
            my $aref = $working_monster{flags};
            push @$aref, $test_line;
        }
        else
        {
            die("Malformed/unrecognized line $input_line in monster $working_monster{name}");
        }
    }
}
commit_monster(\%working_monster);
print "\n";

open(HEADERFILE, ">", "pmon_id.hh") or die "pmon_comp: could not open pmon_id.hh for write: $!";
open(SOURCEFILE, ">", "permons.cc") or die "pmon_comp: could not open permons.cc for write: $!";
print HEADERFILE "// pmon_id.hh\n// This file is autogenerated from $input_fname\n// and is subject to the same copyright licensing terms as that file.\n// Do not edit this file directly; edit $input_fname\n// then use pmon_comp to regenerate this file and permons.cc\n#pragma once\nenum Pmon_id {\n";
print SOURCEFILE "// permons.cc\n// This file is autogenerated from $input_fname\n// and is subject to the same copyright licensing terms as that file.\n// Do not edit this file directly; edit $input_fname then use pmon_comp to\n// regenreate this file and pmon_id.hh\n#include \"core.hh\"\n#include \"permon.hh\"\nPermon permons[] = {\n";
my $phref;
my $i;
my $total_mons = 0;
my $tagname;

for ($i = 0; $i <= $#monsters; ++$i, ++$total_mons)
{
    $phref = $monsters[$i];
    $tagname = "PM_".macroify_name($phref->{name});
    if ($total_mons != 0)
    {
        print HEADERFILE ",\n";
    }
    print HEADERFILE "    ${tagname}";
    printf SOURCEFILE "    { \"%s\", \"%s\", \"%s\", %s, %s, Gcol_%s, %d, %d, %d, %d, %d, %d, %d, DT_%s, \"%s\", %d, %d, %d, { %s } },\n", $phref->{name}, $phref->{plural}, $phref->{desc}, $phref->{ascii}, $phref->{uni}, $phref->{colour}, $phref->{rarity}, $phref->{power}, $phref->{hp}, $phref->{mtohit}, $phref->{rtohit}, $phref->{mdam}, $phref->{rdam}, $phref->{rdtyp}, $phref->{shootverb}, $phref->{defence}, $phref->{exp}, $phref->{speed},  flag_string($phref->{flags});
}

printf SOURCEFILE "};\nconst int NUM_OF_PERMONS = %d;\n// permons.cc\n", $total_mons;
printf HEADERFILE "};\n\n// pmon_id.hh\n";

close(SOURCEFILE);
close(HEADERFILE);
our $end_time = time();
printf "Processed $total_mons monsters in %1.4f seconds.\n", ($end_time - $start_time);

# vim:autoindent:smartindent
