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

package EgoName;
use Exporter qw(import);
our @ISA = qw(Exporter);
our @EXPORT = ();
use FancyName;

our %decollide_sfx = (
  '14:58:59'			=> '_INSTRUMENT',
  '15:1:4,19:2:24'		=> '_RANGED',
  '15:1:4,21:1:19,21:21:50,22:2:30,23:1:34,24:1:30,115:55:55'	=> '_WPN',
  '15:1:4,21:1:50,22:2:30,23:1:34,24:1:30,115:55:55'		=> '_WPN',
  '16:0:2,17:1:3,18:1:3'	=> '_AMMO',
  '19:2:24'			=> '_BOW',
  '21:1:50,22:2:30,23:1:34,24:1:30'			=> '_WPN',
  '30:2:6'			=> '_BOOTS',
  '31:1:5'			=> '_GLOVES',
  '32:2:6'			=> '_HELM',
  '32:2:6,115:57:57'		=> '_HELM',
  '33:10:50'			=> '_CROWN',
  '34:2:10,115:56:56'		=> '_SHIELD',
  '34:2:5,34:7:10,115:56:56'	=> '_SHIELD',
  '34:3:3,34:5:5,34:10:10'	=> '_SHIELD',
  '35:1:100'			=> '_CLOAK',
  '35:1:99'			=> '_CLOAK',
  '36:1:15,37:1:30'		=> '_ARMOR',
  '36:1:16,37:1:30'		=> '_ARMOR',
  '37:2:30'			=> '_ARMOR',
  '39:0:99'			=> '_LITE',
  '39:1:99'			=> '_LITE',
  '46:1:3'			=> '_TRAP',
  '46:1:6'			=> '_TRAP',
  '6:1:1'			=> '_MSTAFF',
);
our %spec_desc = (
  '14:58:59'			=> 'Drum/Harp',
  '14:60:60'			=> 'Horn',
  '15:1:4,19:2:24'		=> 'Launcher/Boomerang',
  '19:2:2'			=> 'Sling',
  '19:12:13'			=> 'Bow',
  '19:23:24'			=> 'Crossbow',
  '19:24:24'			=> 'Heavy Crossbow',
  '19:2:24'			=> 'Launcher',
  '20:1:7'			=> 'Digger',
  '21:1:50,115:55:55'		=> 'Hafted/Demonblade',
  '23:1:34,115:55:55'		=> 'Sword/Demonblade',
  '23:1:34,24:1:30,115:55:55'	=> 'Sword/Axe/Demonblade',
  '15:1:4,21:1:50,22:2:30,23:1:34,24:1:30'
  				=> 'Weapon/Boomerang',
  '21:1:50,22:2:30,23:1:34,24:1:30,115:55:55'
  				=> 'Weapon/Demonblade',
  '21:1:50,22:2:30,23:1:29,23:31:34,24:1:30,115:55:55'
  				=> 'Weapon/Demonblade (except Blade of Chaos)',
  '15:1:4,21:1:19,21:21:50,22:2:30,23:1:34,24:1:30,115:55:55'
  				=> 'Weapon/Boomerang/Demonblade (except Mace of Disruption)',
  '15:1:4,21:1:50,22:2:30,23:1:34,24:1:30,115:55:55'
  				=> 'Weapon/Boomerang/Demonblade',
  '16:0:2,17:1:2,18:1:2'	=> 'Ammo (except Silver Arrow/Bolt)',
  '16:0:2,17:1:3,18:1:3'	=> 'Ammo',
  '21:1:50,22:2:30,23:1:34,24:1:30'
				  => 'Weapon',
  '21:12:50,22:10:30,23:16:34,24:8:30'
				  => 'Weapon (some)',
  '30:2:6'			=> 'Footwear',
  '30:2:3'			=> 'Leather Boots',
  '30:6:6'			=> 'Metal Shod Boots',
  '31:1:5'			=> 'Handwear',
  '31:1:1'			=> 'Gloves',
  '31:2:2'			=> 'Gauntlets',
  '31:2:5'			=> 'Gauntlets/Cesti',
  '32:2:6'			=> 'Cap/Helm',
  '32:5:7'			=> 'Helm/Dragon Helm',
  '32:2:6,115:57:57'		=> 'Cap/Helm/Demonhorn',
  '33:10:50'			=> 'Crown',
  '32:2:6,33:10:50'		=> 'Cap/Helm/Crown',
  '32:2:6,33:10:50,115:57:57'	=> 'Cap/Helm/Crown/Demonhorn',
  '34:2:10,115:56:56'		=> 'Shield/Demonshield',
  '34:2:5,34:7:10,115:56:56'	=> 'Shield/Demonshield (except Dragon Shield)',
  '34:3:3,34:5:5,34:10:10'	=> 'Metal Shield/Shield of Deflection',
  '35:1:100'			=> 'Cloak',
  '35:1:99'			=> 'Cloak (except Mimicry Cloak)',
  '36:1:15,37:1:30'		=> 'Soft/Hard Armor (except Thunderlord Coat)',
  '36:1:16,37:1:30'		=> 'Soft/Hard Armor',
  '36:1:1'			=> 'Filthy Rag',
  '36:2:2'			=> 'Robe',
  '37:2:30'			=> 'Hard Armor (except Rusty Chain Mail)',
  '37:25:25,37:30:30,38:30:30'	=> 'Mithril Plate/Adamantite Plate/Power Dragon Scale Mail',
  '38:1:30'			=> 'Dragon Scale Mail',
  '39:0:99'			=> 'Light',
  '39:1:99'			=> 'Light (except Wooden Torch)',
  '39:2:99'			=> 'Light (except fueled)',
  '40:0:30,45:0:59'		=> 'Amulet/Ring',
  '46:1:3'			=> 'Ammo-based Trap Kit',
  '46:1:6'			=> 'Trap Kit',
  '55:1:30,70:0:53,111:0:255'	=> 'Staff/Scroll/Spellbook',
  '55:1:29,65:1:26'		=> 'Staff/Wand (except of Nothing)',
  '6:1:1'			=> 'Mage Staff',
  '67:10:200'			=> 'Rod',
);
my %tsv_range = ();

open IN, "<t2-src/lib/edit/k_info.txt" or die "Cannot load k_info.txt: $!\n";
while (<IN>) {
  next unless /^I:(\d+):(\d+)/;
  my ($tval, $sval) = ($1, $2);
  $tsv_range{$tval} ||= [ 256, -1 ];
  my $tsv = $tsv_range{$tval};
  $$tsv[0] = $sval if $$tsv[0] > $sval;
  $$tsv[1] = $sval if $$tsv[1] < $sval;
}
close IN;

sub by_tsval {
  return $$a[0] <=> $$b[0] || $$a[1] <=> $$b[1] || $$a[2] <=> $$b[2];
}

sub tsval_simplify ($) {
  my $g = $_[0];
  my ($tval, $sv1, $sv2) = @$g;
  return undef unless exists $tsv_range{$tval};
  my $tsv = $tsv_range{$tval};
  $sv1 = $$tsv[0] if $sv1 < $$tsv[0];
  $sv2 = $$tsv[1] if $sv2 > $$tsv[1];
  return undef if $sv1 > $sv2;
  return [ $tval, $sv1, $sv2 ];
}

sub tsval_spec ($) {
  my $e = $_[0];
  return '' unless exists $$e{bases};
  my @s = grep { $_ } map { tsval_simplify $_ } @{$$e{bases}};
  return join ',', map { join ':', @$_ } sort by_tsval @s;
}

sub decollide ($$;$) {
  my ($e, $coll, $move) = @_;
  return unless ref $e;
  if (exists $decollide_sfx{$$e{tsv}}) {
    my $olddef = $$e{define_as};
    my $newdef = $olddef . $decollide_sfx{$$e{tsv}};
    if (exists $$coll{$newdef}) {
      my $ee = $$coll{$newdef};
      die "Decollide failed ($olddef -> $newdef, $$ee{tsv} vs. $$e{tsv})\n";
    }
    warn "Decolliding $olddef -> $newdef\n";
    $$e{define_as} = $newdef;
    if ($move) {
      $$coll{$newdef} = $e;
      $$coll{$olddef} = 1;
    }
  }
  else {
    warn "Unable to decollide $$e{name}/$$e{tsv}\n";
  }
}

sub ego_names () {
  my %ret = ();
  if (open IN, '<t2-src/lib/edit/e_info.txt') {
    my $e = ();
    while (<IN>) {
      chomp;
      if (/N:(\d+):(.*)$/) {
	my ($idx, $disp_name) = ($1, $2);
	$disp_name =~ s/^(.*) of $/of $1/;
	my $name = uc $disp_name;
	$name =~ s/^OF (?:THE )?//;
	$name =~ s/\*(.*)\*/STAR $1/;
	$name =~ s/[^A-Za-z0-9_]+/_/g;
	$name =~ s/^_*(.*?)_*$/$1/;
	$ret{$idx} = { name => $disp_name, define_as => $name };
	$e = $ret{$idx};
	next;
      }
      if (/^T:(\d+):(\d+):(\d+)$/) {
	my ($tval, $sv1, $sv2) = ($1, $2, $3);
	$$e{bases} ||= [];
	push @{$$e{bases}}, [ $tval, $sv1, $sv2 ];
	next;
      }
      if (/^X:([AB]):\d+:\d+/) {
	$$e{pos} = $1;
	next;
      }
    }
    close IN;
  }
  else {
    die "ego_names():  cannot open e_info.txt:  $!\n";
  }

  my %coll = ();
  for my $idx (sort { $a <=> $b } keys %ret) {
    my $e = $ret{$idx};
    $$e{tsv} = tsval_spec $e;
    if ($$e{tsv} eq '') {
      warn "Skipping ego $$e{name} that matches nothing\n";
      delete $ret{$idx};
      next;
    }
    if (exists $coll{$$e{define_as}}) {
      my $ee = $coll{$$e{define_as}};
      decollide $ee, \%coll, 1;
      decollide $e, \%coll;
    }
    $coll{$$e{define_as}} = $e;
    my $base = $spec_desc{$$e{tsv}} || "??? $$e{tsv}";
    $$e{full_name} = $$e{pos} eq 'A' ? "$base $$e{name}" : "$$e{name} $base";
    FancyName::substitute $$e{name};
  }

  return %ret;
}