#!/usr/bin/perl -w
# $Id$

use lib '.';
use utf8;
use Verbatim;
use Util;
use ObjFlags;
use ObjName;
use EgoName;
use FancyName;

load_verbatim 'data/general/objects/egos.lua', key => 'define_as';

my @E = ();
my %coll = ();
my %tsvals = ();
my %seen_power = ();
my %seen_hardcore = ();

sub accum (\%) {
  my $e = $_[0];
  return if scalar keys %$e == 0;

  $$e{tsv} = EgoName::tsval_spec $e;
  if ($$e{tsv} eq '') {
    warn "Skipping ego $$e{name} that matches nothing\n";
    return;
  }
  if (exists $coll{$$e{define_as}}) {
    my $ee = $coll{$$e{define_as}};
    EgoName::decollide $ee, \%coll, 1;
    EgoName::decollide $e, \%coll;
  }
  $tsvals{$$e{tsv}} ||= 0;
  $tsvals{$$e{tsv}}++;

  if (exists $$e{flags}) {
    # Filter out empty probability groups.
    my @grps = ();
    for my $grp (@{$$e{flags}}) {
      push @grps, $grp if scalar keys %{$$grp[1]} > 0;
    }
    $$e{flags} = \@grps;
  }

  my %e = ( %$e );
  $coll{$$e{define_as}} = \%e;
  push @E, \%e;
}

sub output ($) {
  my $e = $_[0];
  my $k = $$e{define_as};
  my $verbatim = exists $verbatim{$k} ? $verbatim{$k} : undef;
  my $verb_all = exists $verbk{ALL}{$k} ? $verbk{ALL}{$k} : undef;

  # Slight Hack(TM):  Strip out the ACTIVATE flag if we have a 'hardcore'
  # definition.
  if (exists $$e{hardcore} && exists $$e{flags}) {
    for my $grp (@{$$e{flags}}) {
      next unless exists $$grp[1]{flags};
      $$grp[1]{flags} = [ grep { $_ ne 'ACTIVATE' } @{$$grp[1]{flags}} ];
      delete $$grp[1]{flags} if scalar @{$$grp[1]{flags}} == 0;
    }
    $$e{flags} = [ grep { scalar keys %{$$_[1]} > 0 } @{$$e{flags}} ];
    delete $$e{flags} if scalar @{$$e{flags}} == 0;
  }

  my $comment = $EgoName::spec_desc{$$e{tsv}} || "??? $$e{tsv}";
  $comment = $$e{pos} eq 'A' ? "$comment $$e{name}" : "$$e{name} $comment";

  FancyName::substitute $$e{name};

  my $pos = $$e{pos} eq 'A' ? 'suffix' : 'prefix';
  print <<EOF;

-- $comment
newEntity {
  define_as = '$$e{define_as}',
  name = [[$$e{name}]],
  $pos = true,
  level = $$e{depth},
  rarity = { $$e{rarity1}, $$e{rarity2} },
  cost = $$e{cost},
EOF

  print "  ego_filter = {\n";
  for (@{$$e{bases}}) {
    next unless defined EgoName::tsval_simplify $_;
    if ($$_[1] == 0 && $$_[2] == 255) {
      print "    { tval = $$_[0] },\n";
    }
    elsif ($$_[1] == $$_[2]) {
      print "    { tval = $$_[0], sval=$$_[1] },\n";
    }
    else {
      print "    { tval = $$_[0], sval={$$_[1],$$_[2]} },\n";
    }
  }
  for my $k (qw(forbid require)) {
    if (exists $$e{$k}) {
      my $ff = flag_dump $$e{$k}, '    ';
      print "    $k = {$ff},\n";
    }
  }
  print "  },\n";

  my $all_block = $verb_all || exists $$e{power} || exists $$e{hardcore};
  my @adj = ();
  for (qw(to_a pval to_d to_h)) {
    push @adj, "$_=$$e{$_}" if exists $$e{$_} && $$e{$_} != 0;
  }
  if (exists $$e{flags} || scalar @adj > 0 || $all_block) {
    print "  resolve_data = {\n";
    if (exists $$e{flags}) {
      for my $grp (@{$$e{flags}}) {
	my $ff = flag_dump $$grp[1], '    ';
	# Slight Hack(TM):  Ego lights of Fading also need to set lite_fuel.
	$ff =~ s/fuel_lite = true/fuel_lite = true, lite_fuel = 0/;
	# Vaguely Annoying Hack(TM):  Wand/Staff of Plenty needs to juice
	# up .power instead of .pval.
	if ($$e{define_as} eq 'PLENTY') {
	  $ff =~ s/resolvers.ego_adjust_field\('pval',/resolvers.ego_adjust_field('power',/g;
	}
	print "    { $$grp[0], {$ff} },\n";
      }
    }
    if (scalar @adj > 0) {
      my $adj = join ', ', @adj;
      print "    bonus = { $adj },\n";
    }
    if ($all_block) {
      print "    all = {\n";
      if (exists $$e{hardcore}) {
	my $act = ObjFlags::activation $$e{hardcore}, '      ';
	if ($act) {
	  warn "Duplicate $$e{hardcore} in VERBATIM ALL of $$e{name}\n"
	    if $verb_all && $verb_all =~ /\buse_\w+\s*=/;
	  print $act;
	}
	elsif (!$verb_all || $verb_all !~ /\buse_\w+\s*=/) {
	  local $_ = ObjFlags::placeholder_activation $$e{hardcore}, '      ', 1;
	  print $_;
	}
      }
      if (exists $$e{power}) {
	my $tid = 'T_OBJ_' . uc $$e{power};
	$tid =~ s/[^A-Z0-9]+/_/g;
	$tid = $ObjName::xlate_power{$tid}
	  if exists $ObjName::xlate_power{$tid};
	print "      worn_talents = { ActorTalents.$tid },\n";
      }
      if ($verb_all) {
	print "      -- BEGIN VERBATIM ALL\n$verb_all      -- END VERBATIM\n";
      }
      print "    },\n";
    }
    print "  },\n";
  }
  if (exists $$e{obvious}) {
    my $ff = flag_dump $$e{obvious}, '  ', 1;
    print "  obvious_flags = {$ff},\n";
  }
  print "  rating = $$e{rating},\n" if exists $$e{rating} && $$e{rating} != 0;

  print "  -- BEGIN VERBATIM\n$verbatim  -- END VERBATIM\n" if $verbatim;
  print "}\n";
}


my %e = ();
open IN, "<t2-src/lib/edit/e_info.txt" or die "Cannot load e_info.txt: $!\n";
while (<IN>) {
  chomp;
  if (/^N:\d+:(.*)$/) {
    accum %e;
    %e = ( name => $1 );
    $e{name} =~ s/^(.*) of $/of $1/;
    $e{define_as} = uc $e{name};
    $e{define_as} =~ s/^OF (?:THE )?//;
    $e{define_as} =~ s/\*(.*)\*/STAR $1/;
    $e{define_as} =~ s/[^A-Za-z0-9_]+/_/g;
    $e{define_as} =~ s/^_*(.*?)_*$/$1/;
    next;
  }
  if (/^D:(.*)$/) {
    $e{desc} = $e{desc} ? "$e{desc} $1" : $1;
    next;
  }
  if (/^T:(\d+):(\d+):(\d+)$/) {
    my ($tval, $sv1, $sv2) = ($1, $2, $3);
    $e{bases} ||= [];
    push @{$e{bases}}, [ $tval, $sv1, $sv2 ];
    next;
  }
  if (/^R:(\d+)/) {
    $e{flags} ||= [];
    push @{$e{flags}}, [ $1, {} ];
    next;
  }
  if (/^X:([AB]):\d+:(\d+)/) {
    @e{qw(pos rating)} = ($1, $2);
    next;
  }
  if (/^W:(\d+):(\d+):(\d+):(\d+)/) {
    @e{qw(depth rarity1 rarity2 cost)} = ($1, $2, $3, $4);
    next;
  }
  if (/^C:(-?\d+):(-?\d+):(-?\d+):(-?\d+)/) {
    @e{qw(to_h to_d to_a pval)} = ($1, $2, $3, $4);
    next;
  }
  if (/^r:([NF]):(.*)$/) {
    my ($flag, $f) = ($1, $2);
    $flag = ($flag eq 'N' ? 'require' : 'forbid');
    $f =~ s/^\s*(.*?)\s*$/$1/;
    $e{$flag} ||= {};
    for (split /\s*\|\s*/, $f) { flag_put $e{$flag}, $_ }
    next;
  }
  if (/^Z:(.*)$/) {
    $e{power} = $1;
    $seen_power{$1} = 1;
    next;
  }
  if (/^a:HARDCORE=(.*)$/) {
    $e{hardcore} = $1;
    $seen_hardcore{$1} = 1;
    next;
  }
  if (/^F:(.*)$/) {
    my $f = $1;
    warn "Missing R: before F: in $e{name}\n" and next unless exists $e{flags};
    for (split /\s*\|\s*/, $f) { flag_put $e{flags}[-1][1], $_, undef, \%e }
    next;
  }
  if (/^f:(.*)$/) {
    my $f = $1;
    $e{obvious} ||= {};
    for (split /\s*\|\s*/, $f) { flag_put $e{obvious}, $_, undef, \%e }
    next;
  }
}
close IN;
accum %e;

binmode STDOUT, ':utf8';
print_file_hdr 'gen_ego', "Ego entities generated from T2's e_info.txt";
for (@E) { output $_ }
print "\n\n\n-- Seen flags:\n";
for (sort keys %ObjFlags::seen_flags) { print "--   $_\n" }
print "\n-- Seen powers:\n";
for (sort keys %seen_power) { print "--   $_\n" }
print "\n-- Seen 'HARDCORE' fields:\n";
for (sort keys %seen_hardcore) { print "--   $_\n" }