#!/usr/bin/perl

require 5.004;
use FileHandle;
use strict 'vars';


# Directory containing the *_info.txt files.  Modify this if you don't
# have the $ANGBAND_PATH env variable set.
my $ANGBAND_PATH = $ENV{ANGBAND_PATH} || '/var/lib/games/angband';


sub usage () {
  print <<EOF;
Usage: angspoil options

Options:
    -E[y] pattern [pattern ...]		Info on ego item
    -A[y] pattern [pattern ...]		Info on artifact
    -O[y] pattern [pattern ...]		Info on normal object
    -M[y] pattern [pattern ...]		Info on monster
        The 'y' option prints all matching entries without prompting
    -S [race] [class]			Stat modifiers for race/class combo
    -W [str]				Carring capacity for STR
    -N [class] [Snn] [Dnn] [Wnn]	Num attacks for STR/DEX/wpn weight
        Specify exactly zero or two of:
          Snn = strength; Dnn = dex; Wnn = weapon weight

Recognized race keywords (case insensitive):
    human, half-elf, elf, hobbit, gnome, dwarf, half-orc, half-troll,
    dunadan, high-elf

Recognized class keywords (case insensitive):
    warrior, mage, priest, rogue, ranger, paladin


Examples:
    angspoil -M tiamat
        Get info on a certain bad-ass monster

    angspoil -O 'power dragon'
        Get info on a certain bad-ass suit of armor

    angspoil -Ay cloak
        Get info on all artifact cloaks

    angspoil -S priest
        Get stat modifications for a priest character; you will be
        prompted for race

    angspoil -W 18/20
	Get the carrying capacity of a character with 18/20 strength.

    angspoil -N warrior S18/100 W1.2
        Find out what DEX levels are needed for a warrior with 18/100
        strength to get various numbers of hits with a dagger (1.2 lbs)

EOF
}


sub do_item ($$@);
sub do_monster ($@);
sub do_stats (@);
sub do_wpn (@);
sub do_wgt (@);

package Util;
sub read_blob ($);
sub prompt_val ($;$);
sub ynq ($);
sub s ($);
sub add_plus (@);
sub add_plus2 (@);
sub fix_weight ($);
sub comma_list ($$);
sub wrap_line ($);
sub split_hash ($);

package Item;
sub init ();
sub new ($$$$);
sub print_self ($);

package Monster;
sub init ();
sub new ($$);
sub treasure_desc ($);
sub print_self ($);

package RaceClass;
sub init ();
sub get_race (\@);
sub get_class (\@);

package Stats;
sub init ();
sub index ($);
sub rev_index ($);

package Attr;
sub init ();

package Weapon;
sub Weapon::init ();
sub blows ($$$$);

package main;

if ($ARGV[0] =~ /-([AEO])(y?)/) {
  shift; do_item lc $1, $2 eq 'y', @ARGV;
} elsif ($ARGV[0] =~ /-M(y?)/) {
  shift; do_monster $1 eq 'y', @ARGV;
} elsif ($ARGV[0] eq '-S') {
  shift; do_stats @ARGV;
} elsif ($ARGV[0] eq '-N') {
  shift; do_wpn @ARGV;
} elsif ($ARGV[0] eq '-W') {
  shift; do_wgt @ARGV;
} else {
  usage;
  exit 1;
}

sub do_item ($$@) {
  my ($which, $auto, @keys) = @_;
  $which = 'k' if $which eq 'o';
  my $filename = "${ANGBAND_PATH}/edit/${which}_info.txt";
  my $fh = new FileHandle $filename;

  die "cannot open $filename: $!\n" if !defined($fh);

  Item::init;
  BLOB:
  while (my $blob = Util::read_blob $fh) {
    my $name = &{$Item::getname{$which}}($blob);
    KEY:
    for my $key (@keys) {
      next KEY if $name !~ /$key/i;
      if (!$auto) {
	my $ynq = Util::ynq $name;
	last BLOB if !defined($ynq);
	next BLOB if !$ynq;
      }

      my $obj = new Item $name, $blob, $which;
      $obj->print_self();
      next BLOB;
    }
  }

  close($fh);
}

sub do_monster ($@) {
  my ($auto, @keys) = @_;
  my $filename = "${ANGBAND_PATH}/edit/r_info.txt";
  my $fh = new FileHandle $filename;

  die "cannot open $filename: $!\n" if !defined($fh);

  Monster::init;
  BLOB:
  while (my $blob = Util::read_blob $fh) {
    my ($name) = ($blob =~ /^N:\d+:(.*)$/m);
    KEY:
    for my $key (@keys) {
      next KEY if $name !~ /$key/i;
      if (!$auto) {
	my $ynq = Util::ynq $name;
	last BLOB if !defined($ynq);
	next BLOB if !$ynq;
      }

      my $mon = new Monster($blob);
      $mon->print_self();
      next BLOB;
    }
  }
}

sub do_stats (@) {
  Stats::init;

  my $race = RaceClass::get_race @_;
  my $class = RaceClass::get_class @_;
  my @stats = map { $Stats::race_mods[$race][$_] +
		    $Stats::class_mods[$class][$_] } 0..5;
  my @names = qw(STR INT WIS DEX CON CHR);

  @stats = Util::add_plus @stats;
  print "Total stat mods: " .
	join(', ', map { "$names[$_] $stats[$_]" } 0..5) . "\n";
}

sub do_wpn (@) {
  my ($class, $method, $str, $dex, $wgt) = (-1) x 5;
  my ($i, $n) = (0, 0);

  Weapon::init;
  $class = RaceClass::get_class @_;

  foreach (@_) {
    if (m|^S(\d+(/\d+)?)$|) {
      $str = Stats::index $1;
      $n++ if $str >= 0;
    }
    if (m|^D(\d+(/\d+)?)$|) {
      $dex = Stats::index $1;
      $n++ if $dex >= 0;
    }
    if (m|^W(\d+(\.\d*)?)$|) {
      $wgt = $1 * 10;
      $n++;
    }
  }

  print "\n";

  if ($n == 2) {
    $method = 1 if $str >= 0 && $dex >= 0;
    $method = 2 if $str >= 0 && $wgt >= 0;
    $method = 3 if $dex >= 0 && $wgt >= 0;
  } elsif ($n != 0) {
    print <<pick_two;
  Must specify exactly two of:
    Snn -- Strength
    Dnn -- Dexterity
    Wnn -- Weapon weight
pick_two
    return;
  } else {
    $method = Util::prompt_val $Weapon::which_method . "Choose method:",
			       '[1-3]';
    print "\n";
  }

  if ($method != 3) {
    while ($str < 0) { $str = Stats::index Util::prompt_val "Your STR:"; }
  }
  if ($method != 2) {
    while ($dex < 0) { $dex = Stats::index Util::prompt_val "Your DEX:"; }
  }
  if ($method != 1) {
    if ($wgt < 0) {
      $wgt = Util::prompt_val "Weight of your weapon (in pounds):",
			      '\d+(\.\d*)?';
      $wgt *= 10;
      $wgt = $Weapon::min_weight[$class] if $wgt < $Weapon::min_weight[$class];
    }
  }

  print "\n";
  $i = 0;
  if ($method == 1) {
    my $D = $Weapon::dex_tbl[$dex];
    my $S = $Weapon::str_tbl[$str];
    my $W = $Weapon::min_weight[$class];
    my $M = $Weapon::mult[$class];
    my $P0 = int($S * $M / $W);
    my $P;
    my @lines = ();

    $D = 11 if $D > 11;
    $P0 = 11 if $P0 > 11;
    $n = Weapon::blows $str, $dex, $S*$M+1, $class;
    unshift @lines, sprintf 'Otherwise, %d blow%s', $n, Util::s $n;

    for $P (1..$P0) {
      next if ($Weapon::blows_tbl[$P][$D] == $Weapon::blows_tbl[$P-1][$D]);
      $wgt = int($S * $M / $P);
      $wgt = $W if $wgt < $W;
      $n = Weapon::blows $str, $dex, $wgt, $class;
      unshift @lines, sprintf 'For %d blow%s:  <= %s lb',
			      $n, Util::s $n, Util::fix_weight $wgt;
      last if $n == $Weapon::max_blows[$class] || $wgt <= $W;
    }
    $lines[0] =~ s/Otherwise, // if scalar @lines == 1;
    map { print "$_\n" } @lines;
  }
  if ($method == 2) {
    for $dex (0..37) {
      $n = Weapon::blows $str, $dex, $wgt, $class;
      if ($n > $i) {
	printf 'For %d blow%s:  DEX %s'."\n",
	       $n, Util::s $n, Stats::rev_index $dex;
	$i = $n;
	last if $n == $Weapon::max_blows[$class];
      }
    }
  }
  if ($method == 3) {
    for $str (0..37) {
      $n = Weapon::blows $str, $dex, $wgt, $class;
      if ($n > $i) {
	printf 'For %d blow%s:  STR %s'."\n",
	       $n, Util::s $n, Stats::rev_index $str;
	$i = $n;
	last if $n == $Weapon::max_blows[$class];
      }
    }
  }
}

sub do_wgt (@) {
  my $str = -1;
  my ($wgt, $step);

  $str = Stats::index $_[0] if scalar @_;
  while ($str < 0) { $str = Stats::index Util::prompt_val "Your STR:"; }
  $wgt = $str + 5;
  $wgt += $str - 15 if $str > 15;
  $wgt = 30 if $wgt > 30;
  $step = $wgt;
  $wgt = $wgt*6 - 0.1;
  print "Max unencumbered weight $wgt lb;" .
	" -1 speed per additional $step lb.\n";
}



package Attr;
use vars qw(%color);

sub init () {
  %color = Util::split_hash <<EOF;
    d, black
    w, white
    s, grey
    o, orange
    r, red
    g, green
    b, blue
    u, brown
    D, dark grey
    W, light grey
    v, purple
    y, yellow
    R, light red
    G, light green
    B, light blue
    U, light brown
EOF
}



package Item;
use vars qw(%getname %tsvals %activate %slots %ego_random %pval_boost
	    %slays %brands %sustains %immune %resists %ignores %general
	    %admin %tvals @ego_defns);

sub init () {
  Attr::init;

  %tsvals = Util::split_hash <<EOF;
    19:13, Long Bow
    19:23, Light Crossbow
    21:10, Lucerne Hammer
    21:12, Morning Star
    21:13, Flail
    21:18, Two-Handed Flail
    21:20, Mace~ of Disruption
    21:3, Quarterstaff
    21:5, Mace
    21:50, Mighty Hammer
    21:8, War Hammer
    22:10, Beaked Axe
    22:11, Broad Axe
    22:13, Glaive
    22:15, Halberd
    22:17, Scythe
    22:2, Spear
    22:20, Lance
    22:22, Battle Axe
    22:25, Great Axe
    22:28, Lochaber Axe
    22:5, Trident
    22:8, Pike
    23:10, Short Sword
    23:11, Sabre
    23:12, Cutlass
    23:16, Broad Sword
    23:17, Long Sword
    23:18, Scimitar
    23:20, Katana
    23:21, Bastard Sword
    23:25, Two-Handed Sword
    23:28, Executioners Sword
    23:30, Blade of Chaos
    23:4, Dagger
    23:5, Main Gauche
    23:7, Rapier
    23:8, Small Sword
    30:2, Pair of Soft Leather Boots
    30:3, Pair of Hard Leather Boots
    30:6, Pair of Metal Shod Boots
    31:1, Set of Leather Gloves
    31:2, Set of Gauntlets
    31:5, Set of Cesti
    32:2, Hard Leather Cap
    32:3, Metal Cap
    32:5, Iron Helm
    32:6, Steel Helm
    33:10, Iron Crown
    33:11, Golden Crown
    33:50, Massive Iron Crown
    34:3, Small Metal Shield
    34:4, Large Leather Shield
    34:5, Large Metal Shield
    35:1, Cloak
    35:6, Shadow Cloak
    36:11, Leather Scale Mail
    36:4, Soft Leather Armour
    37:15, Full Plate Armour
    37:20, Mithril Chain Mail
    37:25, Mithril Plate Mail
    37:30, Adamantite Plate Mail
    37:4, Chain Mail
    37:6, Augmented Chain Mail
    37:9, Metal Brigandine Armour
    38:30, Power Dragon Scale Mail
    38:6, Multi-Hued Dragon Scale Mail
    39:4, Phial
    39:5, Star
    39:6, Arkenstone
    40:10, Amulet
    40:11, Amulet
    40:12, Necklace
    45:32, Ring
    45:33, Ring
    45:34, Ring
    45:35, Ring
    45:36, Ring
    45:37, Ring
EOF
  %activate = Util::split_hash <<EOF;
    1, light area (2d15:3) [10+d10]
    2, magic mapping [50+d50]
    3, wizard lite + detect doors/traps [100+d100]
    4, protection from evil (d{3*lev}) [225+d225]
    5, dispel evil (lev*5) [300+d300]
    9, haste self (75+d75) [150+d150]
    10, fire ball (120:3) [225+d225]
    11, frost ball (200:3) [325+d325]
    12, lightning ball (250:3) [425+d425]
    13, ruination | dispel monsters (1000) | fire bolt (250) | fire ball (300:3) [450+d450]
    16, 8 lightning balls (150:3) in cardinal dirs [1000]
    17, resist A/L/F/C/P & bless & berzerker (50+d50) [400]
    19, heal (1000) [888]
    22, teleport (10) [2]
    23, genocide [500]
    25, destroy doors [10]
    40, detection [55+d55]
    42, heal (500) [500]
    44, resist A/L/F/C/P (20+d20) [111]
    45, sleep adjacent monsters[55]
    46, recharge item [70]
    48, teleport (100) [45]
    49, restore life levels [450]
    53, magic missile (2d6) [2]
    54, fire bolt (9d8) [8+d8]
    55, frost bolt (6d8) [7+d7]
    56, lightning bolt (4d8) [6+d6]
    57, acid bolt (5d8) [5+d5]
    59, magical arrow (150) [90+d90]
    60, haste self (20+d20) [200]
    61, remove fear & cure poison [5]
    66, fire bolt (9d8) [8+d8]
    67, frost bolt (6d8) [7+d7]
    68, lightning bolt (4d8) [6+d6]
    69, poison ball (12:3) [4+d4]
    70, frost ball (48:2) [5+d5]
    72, frost bolt (12d8) [500]
    82, frost ball (100:2) [300]
    83, fire ball (72:2) [400]
    93, drain life (120) [400]
    97, frost ball (100:2) [500]
    98, stone to mud [5]
    102, mass genocide [1000]
    104, heal (4d8) [3+d3]
    108, teleport away [150]
    109, word of recall [200]
    112, confuse monster (20) [15]
    115, fire ball (72:3) [100]
    116, haste self (20+d20) [100+d100]
    119, identify [10]
    120, probing [20]
    122, drain life (90) [70]
    126, firebrand bolts [999]
EOF
  %slots = Util::split_hash <<EOF;
    23, Ammo
    24, Weapon
    25, Bow
    30, Armor
    31, Cloak
    32, Shield
    33, Headgear
    34, Gloves
    35, Footwear
EOF
  %ego_random = Util::split_hash <<EOF;
    9, 1
    11, 1
    27, 2
    42, 1
    64, 3
    65, 3
    66, 2
EOF
  %pval_boost = Util::split_hash <<EOF;
    STR, STR
    INT, INT
    WIS, WIS
    DEX, DEX
    CON, CON
    CHR, CHR
    STEALTH, stealth
    SEARCH, search
    INFRA, infravision
    TUNNEL, tunneling
    SPEED, speed
    BLOWS, attacks
    MIGHT, multiplier
    SHOTS, shots
EOF
  %slays = Util::split_hash <<EOF;
    SLAY_ANIMAL, animal
    SLAY_EVIL, evil
    SLAY_UNDEAD, undead
    SLAY_DEMON, demon
    SLAY_ORC, orc
    SLAY_TROLL, troll
    SLAY_GIANT, giant
    SLAY_DRAGON, dragon
    KILL_DRAGON, Xdragon
EOF
  %brands = Util::split_hash <<EOF;
    BRAND_ACID, acid brand
    BRAND_ELEC, lightning brand
    BRAND_FIRE, fire brand
    BRAND_COLD, frost brand
EOF
  %sustains = Util::split_hash <<EOF;
    SUST_STR, STR
    SUST_INT, INT
    SUST_WIS, WIS
    SUST_DEX, DEX
    SUST_CON, CON
    SUST_CHR, CHR
EOF
  %immune = Util::split_hash <<EOF;
    IM_ACID, acid
    IM_ELEC, lightning
    IM_FIRE, fire
    IM_COLD, cold
    IM_POIS, poison
EOF
  %resists = Util::split_hash <<EOF;
    RES_ACID, acid
    RES_ELEC, lightning
    RES_FIRE, fire
    RES_COLD, cold
    RES_POIS, poison
    RES_LITE, light
    RES_DARK, darkness
    RES_BLIND, blindness
    RES_CONFU, confusion
    RES_SOUND, sound
    RES_SHARDS, shards
    RES_NETHER, nether
    RES_NEXUS, nexus
    RES_CHAOS, chaos
    RES_DISEN, disenchantment
EOF
  %ignores = Util::split_hash <<EOF;
    IGNORE_ACID, acid
    IGNORE_ELEC, lightning
    IGNORE_FIRE, fire
    IGNORE_COLD, cold
EOF
  %general = Util::split_hash <<EOF;
    IMPACT, causes earthquakes
    FREE_ACT, free action
    HOLD_LIFE, hold life
    FEATHER, feather fall
    LITE, perm light (1)
    SEE_INVIS, see invisible
    TELEPATHY, ESP
    SLOW_DIGEST, slow digestion
    REGEN, regeneration
    DRAIN_EXP, drains exp
    TELEPORT, teleports
    AGGRAVATE, aggravates
    BLESSED, blessed
    CURSED, cursed
    HEAVY_CURSE, *cursed*
    PERMA_CURSE, *CURSED*
EOF
  %admin = Util::split_hash <<EOF;
    EASY_KNOW, obvious
    HIDE_TYPE, hides pval
    SHOW_MODS, shows +to-hit/dam
    INSTA_ART, always artifact
EOF

  @ego_defns = (
    '',
    'Random high resist [blindness, confusion, sound, shards, nether, ' .
      "nexus, chaos,\n     disenchantment, poison]",
    'Random ability [feather fall, light, see invisible, telepathy, slow ' .
      "digestion,\n     regeneration, free action, hold life]",
    'Sustain random stat'
  );

  %tvals = Util::split_hash <<EOF;
    40, An Amulet of
    45, A Ring of
    55, A Staff of
    65, A Wand of
    66, A Rod of
    70, A Scroll of
    75, A Potion of
    80, A Mushroom of
    90, A Book of Magic Spells
    91, A Holy Book of Prayers
EOF

  %getname = ('a' => \&art_name, 'e' => \&ego_name, 'k' => \&obj_name);
}

sub art_name {
  my $blob = shift;
  $blob =~ /^N:\d+:(.*)\nI:(\d+:\d+)/ or return '';
  return "The $tsvals{$2} $1";
}

sub ego_name {
  my $blob = shift;
  $blob =~ /^N:\d+:(.*)\nX:(\d+)/ or return '';
  return "$slots{$2} $1";
}

sub obj_name {
  my $blob = shift;
  my $name;
  $blob =~ /^N:\d+:(.*)\nG:.:.\nI:(\d+):(\d+)/ or return '';
  $name = $1;
  $name =~ s/\&/A/;
  $name =~ s/\~//;
  return $name if !$tvals{$2} || ($2 == 80 && $3 >= 32);
  return "$tvals{$2} $name";
}

sub new ($$$$) {
  my ($class, $name, $blob, $which) = @_;
  my $self = {
    NAME	=> $name,
    IDX		=> 0,
    ATTRCHAR	=> '',
    PVAL	=> '',
    LEVEL	=> 0,
    RARITY	=> 0,
    WEIGHT	=> 0,
    COST	=> 0,
    APPEAR	=> '', 
    BONUS	=> [],
    EGO_BONUS	=> [],
    PVAL_BOOST	=> [],
    SLAYS	=> [],
    BRANDS	=> [],
    SUSTAINS	=> [],
    IMMUNES	=> [],
    RESISTS	=> [],
    IGNORES	=> [],
    GENERAL	=> [],
    ADMIN	=> []
  };

  study $blob;
  my ($idx) = ($blob =~ /^N:(\d+)/);
  ($$self{PVAL}) = ($blob =~ /^I:\d+:\d+:(-?\d+)/m);
  $$self{ATTRCHAR} = "$Attr::color{$2} '$1'" if ($blob =~ /^G:(.):(.)/m);
  @$self{qw(LEVEL RARITY WEIGHT COST)} =
	($blob =~ /^W:(\d+):(\d+):(\d+):(\d+)/m);
  $$self{APPEAR} = $1 if ($blob =~ /^A:(.*)$/m);
  $$self{BONUS} = [ $blob =~ /^P:(\d+):(\d+d\d+):(-?\d+):(-?\d+):(-?\d+)/m ];
  $$self{EGO_BONUS} = [ $blob =~ /^C:(-?\d+):(-?\d+):(-?\d+):(-?\d+)/m ];
  for my $i (split /\s*\|\s*/, join '', ($blob =~ /^F:(.*)$/mg)) {
    push @{$$self{PVAL_BOOST}}, $pval_boost{$i} if $pval_boost{$i};
    push @{$$self{SLAYS}}, $slays{$i} if $slays{$i};
    push @{$$self{BRANDS}}, $brands{$i} if $brands{$i};
    push @{$$self{SUSTAINS}}, $sustains{$i} if $sustains{$i};
    push @{$$self{IMMUNES}}, $immune{$i} if $immune{$i};
    push @{$$self{RESISTS}}, $resists{$i} if $resists{$i};
    push @{$$self{IGNORES}}, $ignores{$i} if $ignores{$i};
    push @{$$self{GENERAL}}, $general{$i} if $general{$i};
    push @{$$self{ADMIN}}, $admin{$i} if $admin{$i};
  }

  $$self{PVAL} = Util::add_plus $$self{PVAL};
  $$self{WEIGHT} = Util::fix_weight $$self{WEIGHT};
  $$self{SPECIAL} = $ego_defns[$ego_random{$idx}]
    if $which eq 'e' && $ego_random{$idx};
  $$self{SPECIAL} = "Activates for $activate{$idx}"
    if $which eq 'a' && $activate{$idx};
  for my $i (@{$$self{APPEAR}}) {
    $i =~ s/(\d+):(\d:+)/level $1 (1 in $2)/;
  }
  if (@{$$self{BONUS}}) {
    @{$$self{BONUS}}[2..4] = Util::add_plus @{$$self{BONUS}}[2..4];
    $$self{BONUS} = [ @{$$self{BONUS}}[0,4,1,2,3] ];
  }
  if (@{$$self{EGO_BONUS}}) {
    $$self{PVAL} = Util::add_plus2 $$self{EGO_BONUS}[3];
    $$self{EGO_BONUS} = [ Util::add_plus2 @{$$self{EGO_BONUS}}[0..2] ];
  }

  return bless $self, $class;
}

sub print_self ($) {
  my $self = shift;

  print "\n$$self{NAME}";
  printf ' [%s,%s] (%s) (%s,%s)', @{$$self{BONUS}} if @{$$self{BONUS}};
  printf ' (%s,%s) [%s]', @{$$self{EGO_BONUS}} if @{$$self{EGO_BONUS}};
  printf "\n".'Level %s, rarity %s, weight %s lb, cost %s'."\n",
	 @$self{qw(LEVEL RARITY WEIGHT COST)};
  print Util::comma_list 'Appearing on', $$self{APPEARING};
  print Util::comma_list "$$self{PVAL}", $$self{PVAL_BOOST};
  print Util::comma_list 'Slay', $$self{SLAYS};
  print Util::comma_list '', $$self{BRANDS};
  print Util::comma_list 'Sustain', $$self{SUSTAINS};
  print Util::comma_list 'Immune', $$self{IMMUNES};
  print Util::comma_list 'Resist', $$self{RESISTS};
  print Util::comma_list 'Unharmed by', $$self{IGNORES};
  print Util::comma_list '', $$self{GENERAL};
  print "$$self{SPECIAL}\n" if $$self{SPECIAL};
  print Util::comma_list '###', $$self{ADMIN};
  print "\n";
}



package Monster;
use vars qw(%attack_forms %damage_forms %is %doesnt %treasure %can %hurt_by
	    %resists %shoots %breathes %spells %rand_move @drop_type
	    @drop_worth);

sub init () {
  Attr::init;

  %attack_forms = Util::split_hash <<EOF;
    HIT, hit
    TOUCH, touch
    PUNCH, punch
    KICK, kick
    CLAW, claw
    BITE, bite
    STING, sting
    BUTT, butt
    CRUSH, crush
    ENGULF, engulf
    CRAWL, crawl
    DROOL, drool
    SPIT, spit
    GAZE, gaze
    WAIL, wail
    SPORE, spore
    BEG, beg
    INSULT, insult
    MOAN, moan
EOF
  %damage_forms = Util::split_hash <<EOF;
    HURT, damage
    POISON, poison
    UN_BONUS, disenchant
    UN_POWER, drain charges
    EAT_GOLD, steal money
    EAT_ITEM, steal item
    EAT_FOOD, steal food
    EAT_LITE, drain light
    ACID, acid
    ELEC, lightning
    FIRE, fire
    COLD, cold
    BLIND, blindness
    CONFUSE, confusion
    TERRIFY, fear
    PARALYZE, paralyze
    LOSE_STR, drain str
    LOSE_INT, drain int
    LOSE_WIS, drain wis
    LOSE_DEX, drain dex
    LOSE_CON, drain con
    LOSE_CHR, drain chr
    LOSE_ALL, drain all stats
    SHATTER, shatter
    EXP_10, drain exp [10d6+2%]
    EXP_20, drain exp [20d6+2%]
    EXP_40, drain exp [40d6+2%]
    EXP_80, drain exp [80d6+2%]
EOF
  %is = Util::split_hash <<EOF;
    UNIQUE, unique
    QUESTOR, quest monster
    MALE, male
    FEMALE, female
    CHAR_CLEAR, floor-hidden
    CHAR_MULTI, item-hidden
    ATTR_CLEAR, floor-colored
    ATTR_MULTI, multicolored
    FORCE_DEPTH, at depth
    FORCE_SLEEP, sluggish
    FRIEND, pack animal
    FRIENDS, pack animal
    ESCORT, escorted (single)
    ESCORTS, escorted (multi)
    STUPID, stupid
    SMART, smart
    INVISIBLE, invisible
    COLD_BLOOD, cold-blooded
    EMPTY_MIND, psi-blank
    WEIRD_MIND, psi-weird
    ORC, orc
    TROLL, troll
    GIANT, giant
    DRAGON, dragon
    DEMON, demon
    UNDEAD, undead
    EVIL, evil
    ANIMAL, animal
EOF
  %doesnt = Util::split_hash <<EOF;
    NEVER_BLOW, attack
    NEVER_MOVE, move
EOF
  %treasure = Util::split_hash <<EOF;
    ONLY_GOLD, 100
    ONLY_ITEM, 200
    DROP_60, 1
    DROP_90, 1
    DROP_1D2, 2
    DROP_2D2, 4
    DROP_3D2, 6
    DROP_4D2, 8
    DROP_GOOD, 1000
    DROP_GREAT, 2000
    DROP_USEFUL, 3000
    DROP_CHOSEN, 4000
EOF
  %can = Util::split_hash <<EOF;
    MULTIPLY, breed
    REGENERATE, regenerate
    OPEN_DOOR, open doors
    BASH_DOOR, bash doors
    PASS_WALL, pass through walls
    KILL_WALL, eat walls
    MOVE_BODY, push creatures
    KILL_BODY, eat creatures
    TAKE_ITEM, pick up items
    KILL_ITEM, eat items
EOF
  %hurt_by = Util::split_hash <<EOF;
    HURT_LITE, light
    HURT_ROCK, stone-to-mud
    HURT_FIRE, fire
    HURT_COLD, cold
EOF
  %resists = Util::split_hash <<EOF;
    IM_ACID, acid
    IM_ELEC, lightning
    IM_FIRE, fire
    IM_COLD, cold
    IM_POIS, poison
    RES_NETH, nether
    RES_WATE, water
    RES_PLAS, plasma
    RES_NEXU, nexus
    RES_DISE, disenchant
    NO_FEAR, fear
    NO_STUN, stun
    NO_CONF, confusion
    NO_SLEEP, sleep
EOF
  %shoots = Util::split_hash <<EOF;
    ARROW_1, arrow
    ARROW_2, arrows
    ARROW_3, missile
    ARROW_4, missiles
EOF
  %breathes = Util::split_hash <<EOF;
    BR_ACID, acid
    BR_ELEC, lightning
    BR_FIRE, fire
    BR_COLD, cold
    BR_POIS, poison
    BR_NETH, nether
    BR_LITE, light
    BR_DARK, darkness
    BR_CONF, confusion
    BR_SOUN, sound
    BR_CHAO, chaos
    BR_DISE, disenchantment
    BR_NEXU, nexus
    BR_TIME, time
    BR_INER, inertia
    BR_GRAV, gravity
    BR_SHAR, shards
    BR_PLAS, plasma
    BR_WALL, force
    BR_MANA, mana
EOF
  %spells = Util::split_hash <<EOF;
    SHRIEK, shriek
    BA_ACID, acid ball
    BA_ELEC, lightning ball
    BA_FIRE, fire ball
    BA_COLD, cold ball
    BA_POIS, poison ball
    BA_NETH, nether ball
    BA_WATE, water ball
    BA_MANA, mana ball
    BA_DARK, darkness ball
    DRAIN_MANA, drain mana
    MIND_BLAST, mind blast
    BRAIN_SMASH, brain smash
    CAUSE_1, cause wounds (3d8)
    CAUSE_2, cause wounds (8d8)
    CAUSE_3, cause wounds (10d15)
    CAUSE_4, cause wounds (15d15) & cut (10d10)
    BO_ACID, acid bolt
    BO_ELEC, lightning bolt
    BO_FIRE, fire bolt
    BO_COLD, frost bolt
    BO_POIS, poison bolt
    BO_NETH, nether bolt
    BO_WATE, water bolt
    BO_MANA, mana bolt
    BO_PLAS, plasma bolt
    BO_ICEE, ice bolt
    MISSILE, magic missile
    SCARE, fear
    BLIND, blindness
    CONF, confusion
    SLOW, slow
    HOLD, paralyze
    HASTE, haste
    HEAL, heal
    BLINK, blink
    TPORT, tport
    TELE_TO, teleport to
    TELE_AWAY, teleport away
    TELE_LEVEL, teleport level
    DARKNESS, darkness
    TRAPS, create traps
    FORGET, amnesia
    S_MONSTER, summon monster
    S_MONSTERS, summon monsters
    S_ANT, summon ant
    S_SPIDER, summon spider
    S_HOUND, summon hound
    S_HYDRA, summon hydra
    S_ANGEL, summon angel
    S_DEMON, summon demon
    S_UNDEAD, summon undead
    S_DRAGON, summon dragon
    S_HI_UNDEAD, summon greater undead
    S_HI_DRAGON, summon ancient dragon
    S_WRAITH, summon wraith
    S_UNIQUE, summon unique
EOF

  %rand_move = (0  => '',
		25 => ' (slightly random)',
		50 => ' (random)',
		75 => ' (very random)');
  @drop_type = ('drops', 'treasures', 'items');
  @drop_worth = ('', 'good ', 'great ', 'useful ', 'chosen ');
}

sub treasure_desc ($) {
  my $listref =  $_[0];
  my ($min, $max, $treas, $item) = (0, 0, 0, 0);
  my $n;

  return '' if scalar @$listref == 0;
  foreach $n (@$listref) {
    ($item = $n/1000) && next if $n >= 1000;
    ($treas = $n/100) && next if $n >= 100;
    ($min += $n/2) && ($max += $n) && next if $n > 1;
    $max++ && next if $n == 1;
  }
  return "$min-$max $drop_worth[$item]$drop_type[$treas]\n";
}

sub new ($$) {
  my ($class, $blob) = @_;
  my $self = {
    NAME	=> '',
    ATTRCHAR	=> '',
    HP		=> '',
    SPEED	=> 0,
    AC		=> 0,
    SLEEPY	=> 0,
    NOTICE	=> 0,
    LEVEL	=> 0,
    RARITY	=> 0,
    EXP		=> 0,
    MOVE	=> 0,
    SPELLRATE	=> 0,
    ATTACKS	=> [],
    FLAGS	=> {
		     FORCE_MAXHP => 0,
		     POWERFUL    => 0
		   },
    IS		=> [],
    DOESNT	=> [],
    TREASURE	=> [],
    CAN		=> [],
    HURT	=> [],
    RESISTS	=> [],
    SHOOTS	=> [],
    BREATHES	=> [],
    SPELLS	=> []
  };

  study $blob;
  ($$self{NAME}) = ($blob =~ /^N:\d+:(.*)$/m);
  $$self{ATTRCHAR} = "$Attr::color{$2} '$1'" if ($blob =~ /^G:(.):(.)/m);
  @$self{qw(SPEED HP NOTICE AC SLEEPY)} =
	($blob =~ /^I:(\d+):(\d+d\d+):(\d+):(\d+):(\d+)/m);
  @$self{qw(LEVEL RARITY EXP)} = ($blob =~ /^W:(\d+):(\d+):\d+:(\d+)/m);
  $$self{ATTACKS} = [ $blob =~ /^B:(.*)$/mg ];
  my @flags = grep { $_ } map { split /\s*\|\s*/ } ($blob =~ /^F:(.*)$/mg);
  for my $i (@flags) {
    $$self{FLAGS}{$i} = 1 if defined $$self{FLAGS}{$i};
    $$self{MOVE} += $1 if $i =~ /RAND_(\d+)/;
    push @{$$self{IS}}, $is{$i} if $is{$i};
    push @{$$self{DOESNT}}, $doesnt{$i} if $doesnt{$i};
    push @{$$self{TREASURE}}, $treasure{$i} if $treasure{$i};
    push @{$$self{CAN}}, $can{$i} if $can{$i};
    push @{$$self{HURT}}, $hurt_by{$i} if $hurt_by{$i};
    push @{$$self{RESISTS}}, $resists{$i} if $resists{$i};
  }
  my @spflags = grep { $_ } map { split /\s*\|\s*/ } ($blob =~ /^S:(.*)$/mg);
  for my $i (@spflags) {
    $$self{SPELLRATE} = $1 if $i =~ /1_IN_(\d+)/;
    push @{$$self{SHOOTS}}, $shoots{$i} if $shoots{$i};
    push @{$$self{BREATHES}}, $breathes{$i} if $breathes{$i};
    push @{$$self{SPELLS}}, $spells{$i} if $spells{$i};
  }

  $$self{SPEED} = Util::add_plus ($$self{SPEED} - 110);
  $$self{MOVE} = $rand_move{$$self{MOVE}};
  for my $i (@{$$self{ATTACKS}}) {
    $i = "$attack_forms{$1} for $damage_forms{$2} ($3)"
      if $i =~ /^(\w+):(\w+):(\d+d\d+)$/;
    $i = "$attack_forms{$1} for $damage_forms{$2}" if $i =~ /^(\w+):(\w+)$/;
    $i = "$attack_forms{$1}" if $i =~ /^(\w+)$/;
  }

  return bless $self, $class;
}

sub print_self ($) {
  my $self = shift;
  my $scratch = '';

  if ($$self{FLAGS}{FORCE_MAXHP} || $$self{HP} =~ /d1$/) {
    $$self{HP} = $1 * $2 if $$self{HP} =~ /(\d+)d(\d+)/;
  }
  print "\n$$self{NAME} ($$self{ATTRCHAR})\n";
  printf '%s HP, speed %s%s, AC %s, "sleepiness" %s, notice range %s'."\n",
	 @$self{qw(HP SPEED MOVE AC SLEEPY NOTICE)};
  printf 'Level %s, rarity %s, exp %s'."\n", @$self{qw(LEVEL RARITY EXP)};
  print Util::comma_list 'Monster is', $$self{IS};
  print "Doesn't ", join(' or ', @{$$self{DOESNT}}), "\n"
	if @{$$self{DOESNT}};
  print Util::comma_list 'Attacks: ', $$self{ATTACKS};
  print Util::comma_list 'Can', $$self{CAN};
  print Util::comma_list 'Hurt by', $$self{HURT};
  print Util::comma_list 'Resists', $$self{RESISTS};
  print Util::comma_list 'Shoots', $$self{SHOOTS};
  $scratch = ($$self{FLAGS}{POWERFUL} ? '*Breathes*' : 'Breathes');
  $scratch = "$scratch (1/$$self{SPELLRATE})";
  print Util::comma_list $scratch, $$self{BREATHES};
  print Util::comma_list "Spells (1/$$self{SPELLRATE}): ", $$self{SPELLS};
  print treasure_desc $$self{TREASURE};
  print "\n";
}



package RaceClass;
use vars qw($racelist $classlist %race_names %class_names);

sub init () {
  $racelist = <<EOF;
0) Human       1) Half-Elf    2) Elf         3) Hobbit      4) Gnome
5) Dwarf       6) Half-Orc    7) Half-Troll  8) Dunadan     9) High-Elf
EOF

  $classlist = <<EOF;
0) Warrior  1) Mage  2) Priest  3) Rogue  4) Ranger  5) Paladin
EOF

  %race_names = Util::split_hash <<EOF;
    human, 1
    half-elf, 2
    elf, 3
    hobbit, 4
    gnome, 5
    dwarf, 6
    half-orc, 7
    half-troll, 8
    dunadan, 9
    high-elf, 10
EOF
  %class_names = Util::split_hash <<EOF;
    warrior, 1
    mage, 2
    priest, 3
    rogue, 4,
    ranger, 5
    paladin, 6
EOF
}

sub get_race (\@) {
  my $listref = $_[0];

  for my $i (@$listref) {
    my $j = $race_names{lc $i};
    return $j-1 if $j;
  }
  return Util::prompt_val $racelist . 'Your race:', '[0-9]';
}

sub get_class (\@) {
  my $listref = shift;
  my ($i, $j);
  for $i (@$listref) {
    $j = $class_names{lc $i};
    return $j-1 if $j;
  }
  return Util::prompt_val $classlist . 'Your class:', '[0-5]';
}



package Stats;
use vars qw(@race_mods @class_mods);

sub init () {
  @race_mods = (
      [ 0,  0,  0,  0,  0,  0],	# Human
      [-1,  1,  0,  1, -1,  1],	# Half-Elf
      [-1,  2,  1,  1, -2,  1],	# Elf
      [-2,  2,  1,  3,  2,  1],	# Hobbit
      [-1,  2,  0,  2,  1, -2],	# Gnome
      [ 2, -3,  2, -2,  2, -3],	# Dwarf
      [ 2, -1,  0,  0,  1, -4],	# Half-Orc
      [ 4, -4, -2, -4,  3, -6],	# Half-Troll
      [ 1,  2,  2,  2,  3,  2],	# Dunadan
      [ 1,  3, -1,  3,  1,  5]	# High-Elf
  );

  @class_mods = (
      [ 5, -2, -2,  2,  2, -1],	# Warrior
      [-5,  3,  0,  1, -2,  1],	# Mage
      [-1, -3,  3, -1,  0,  2],	# Priest
      [ 2,  1, -2,  3,  1, -1],	# Rogue
      [ 2,  2,  0,  1,  1,  1],	# Ranger
      [ 3, -3,  1,  0,  2,  2]	# Paladin
  );

  RaceClass::init;
}

sub index ($) {
  my $val = shift;

  return -1 unless $val =~ /^[3-9]$/ || $val =~ /^1[0-8]$/ ||
		   $val =~ m:18/(\d{2,3}):;
  $val = 18 + $1 if $val =~ m:18/(\d+):;
  return -1 if $val > 18+220;

# This formula is correct for 2.7.9v6

  return $val - 3			  if $val <= 18;
  return (15 + int(($val-18) / 10))	  if $val <= 18+220;
  return 37;
}

sub rev_index ($) {
  my $idx = shift;

# This formula is correct for 2.7.9v6
  return $idx + 3 if $idx <= 15;
  return sprintf('18/%d0', ($idx-15)) if $idx <= 37;
  return 'N/A';
}



package Weapon;
use vars qw(@max_blows @mult @min_weight @str_tbl @dex_tbl @blows_tbl
	    $which_method);

sub init () {
  #		  War  Mag  Pri  Rog  Ran  Pal
  @max_blows =  (   6,   4,   5,   5,   5,   5 );
  @mult =       (   5,   2,   3,   3,   4,   4 );
  @min_weight = (  30,  40,  35,  30,  35,  30 );

  @str_tbl = (
    3, 4, 5, 6, 7, 8, 9, 10, 11, 12, 13, 14, 15, 16, 17,  # 3-17
    20, 30, 40, 50, 60, 70, 80, 90, 100, 110,		  # 18-18/99
    120, 130, 140, 150, 160, 170, 180, 190, 200, 210,	  # 18/100-18/199
    220, 230, 240					  # 18/200-18/220
  );

  @dex_tbl = (
    0, 0, 0, 0, 0, 0, 0, 1, 1, 1, 1, 1, 1, 1, 1,	# 3-17
    1, 2, 2, 2, 2, 3, 3, 4, 4, 5,			# 18-18/99
    6, 7, 8, 9, 10, 11, 12, 14, 16, 18, 20, 20, 20	# 18/100-18/220
  );

  @blows_tbl = (
# Dex  0, 1, 2, 3, 4, 5, 6, 7, 8, 9, 10, 11+  / Str
      [1, 1, 1, 1, 1, 1, 2, 2, 2, 2,  2,  3], # 0
      [1, 1, 1, 1, 2, 2, 3, 3, 3, 4,  4,  4], # 1
      [1, 1, 2, 2, 3, 3, 4, 4, 4, 5,  5,  5], # 2
      [1, 2, 2, 3, 3, 4, 4, 4, 5, 5,  5,  5], # 3
      [1, 2, 2, 3, 3, 4, 4, 5, 5, 5,  5,  5], # 4
      [2, 2, 3, 3, 4, 4, 5, 5, 5, 5,  5,  6], # 5
      [2, 2, 3, 3, 4, 4, 5, 5, 5, 5,  5,  6], # 6
      [2, 3, 3, 4, 4, 4, 5, 5, 5, 5,  5,  6], # 7
      [3, 3, 3, 4, 4, 4, 5, 5, 5, 5,  6,  6], # 8
      [3, 3, 4, 4, 4, 4, 5, 5, 5, 5,  6,  6], # 9
      [3, 3, 4, 4, 4, 4, 5, 5, 5, 6,  6,  6], # 10
      [3, 3, 4, 4, 4, 4, 5, 5, 6, 6,  6,  6], # 11+
  );

  $which_method = <<EOF;
1) STR, DEX        ==> Wpn weight
2) STR, Wpn weight ==> DEX
3) DEX, Wpn weight ==> STR
EOF

  RaceClass::init;
}

sub blows ($$$$) {
  my ($str, $dex, $wgt, $class) = @_;
  my $n;

  $wgt = $min_weight[$class] if $wgt < $min_weight[$class];
  $str = int($str_tbl[$str] * $mult[$class] / $wgt);
  $dex = $dex_tbl[$dex];
  $str = 11 if $str > 11;
  $dex = 11 if $dex > 11;

  $n = $blows_tbl[$str][$dex];
  $n = $max_blows[$class] if $n > $max_blows[$class];
  return $n;
}



package Util;

sub read_blob ($) {
  my $fh = $_[0];
  my $lines = '';
  local($_);

  while (<$fh>) {
    return $lines if /^$/ && $lines;
    $lines .= $_ if !(/^$/ || /^[#VD]/);
  }
  return $lines;
}

sub add_plus (@) {
  return ($_[0] < 0 ? $_[0] : "+$_[0]") if !wantarray;
  return map { $_ < 0 ? $_ : "+$_" } @_;
}

sub add_plus2 (@) {
  return ($_[0] < 0 ? $_[0] : $_[0] == 0 ? "+0" : "+1-$_[0]") if !wantarray;
  return map { $_ < 0 ? $_ : $_ == 0 ? "+0" : "+1-$_" } @_;
}

sub s ($) { return ($_[0] == 1 ? ' ' : 's') }

sub fix_weight ($) {
  my $wgt = $_[0];

  return "0.$wgt" if $wgt >0 && $wgt < 10;
  return $wgt/10 if $wgt%10 == 0;
  return "${\( int($wgt/10) )}.${\( $wgt%10 )}";
}
  
sub ynq ($) {
  my $prompt = $_[0];
  my $ans;

  print "$prompt? [y/N/q]  ";
  $ans = <STDIN>;
  return ($ans =~ /^[Qq]/ ? undef : $ans =~ /^[Yy]/ ? 1 : 0);
}

sub prompt_val ($;$) {
  my ($prompt, $pattern) = @_;
  my $line;

  if (defined $pattern) {
    do { print "$prompt  "; $line = <STDIN>; } until $line =~ /^$pattern$/;
  } else {
    print "$prompt  "; $line = <STDIN>;
  }
  return $line;
}

sub wrap_line ($) {
  my $line = $_[0];
  my ($full_lines, $part_line) = ('', '');

  for my $w (split(/\s+/, $line)) {
    if (length($part_line) + length($w) > 72) {
      $full_lines = "$full_lines$part_line\n";
      $part_line = "    $w";
    } else {
      $part_line = ($part_line ? "$part_line $w" : $w);
    }
  }
  return "$full_lines$part_line\n";
}

sub comma_list ($$) {
  my ($first, $listref) = @_;
  return if ref $listref ne 'ARRAY' || scalar @$listref == 0;
  my $line = join ', ', @$listref;
  $line = "$first $line" if $first;
  return Util::wrap_line ucfirst $line;
}

sub split_hash ($) {
  return ($_[0] =~ /^\s*([^,]*), (.*)$/mg);
}