#!/usr/bin/perl -w

use strict;
use File::Spec;
use FileHandle;
use Tk;
use Tk::ROText;
use Tk::BrowseEntry;
use Tk::FileSelect;

# Base directory containing ToME's data files.  Adjust as necessary for
# your configuration.
my $TOME_LIB = '/usr/local/lib/tome';
# Subdirectory of the preceding containing edit files.  This will be
# adjusted at runtime if your dump is from a module.
my $TOME_EDIT = File::Spec->catdir($TOME_LIB, 'edit');

my $help_text = <<EOF;
Welcome to the ToME interactive equipment optimizer.  This program reads a
ToME character dump, as generated by the 'f' command from the 'C'haracter
screen, and allows you to interactively select different combinations of
wieldable equipment from the character dump, with an automatically updated
display indicating what resists and other flags would be provided by the
current equipment combination.  The character dump to be read can either be
specified on the command line or selected via a file selection dialog when
the program starts.

The main program window displays the list of equipment items the character
was wearing at the time the character dump was generated, and a "flags
grid" similar to the grid in the character dump indicating the combination
of flags conferred by the current equipment set.  The row titles of the
grid are color-coded to show the current equipment's flags relative to the
original equipment's flags:  blue for flags conferred by both, white for
flags conferred by neither, green for flags conferred only by the current
equipment, and yellow for flags conferred only by the original equipment.
For pval-based flags like stat or speed boosts, the combined value for the
current equipment is displayed to the right of the grid, in green for
positive values or red for negative values; if the current value is
different from the original value, the latter is also shown in yellow.

Clicking the arrow next to one of the equipment items pops up a menu of
items from the character dump that can be worn or wielded in that equipment
slot; selecting one of these items will "wear/wield" it, updating the flags
grid accordingly.  Clicking on an item name itself, or shift-clicking on an
item in an equipment slot menu, will display a descriptions of the item's
properties.  Clicking on a row of the flags grid will display a list of all
items in the character dump that confer the selected flag; clicking on an
item in that list will display its properties.  The flags grid can be
scrolled with the scrollbar beside it, or with the up/down-arrow keys and
PageUp/PageDown keys.

Note that the program determines an item's properties by parsing the
description provided by fully identifying the item (via a Scroll of
*Identify* or similar effect).  If this information is not available, the
program will use ToME's internal information files to attempt to guess at
the item's properties; these guesses, however, may be incomplete.  You are
encouraged to fully identify as much of your equipment, inventory and home
stock as possible before creating the character dump to use with this
program.

Known bugs:
  - There is currently no check for equipment conflicts like wielding a
    shield with a two-handed weapon or wearing the same ring on both ring
    fingers; we depend on the honor system for now. ;)
  - The flags grid should probably display more flags, and in a different
    order.
  - Symbiotes are not yet supported.
  - The actual original design goal of this program was to algorithmically
    compute the optimum equipment combination from the character dump;
    obviously, this is not yet implemented. :-}

Possible future directions:
  - Use race/subrace/class info from ToME's info files (and possibly god
    and skill info) to determine the player's innate properties.
  - Accumulate and display total armor class, total to-hit and to-dam
    bonuses, and possibly total weapon damage.
  - Algorithmically compute optimum equipment configurations.  That was,
    after all, the original point of this exercise... :-}

Please report bugs or other problems to dsb-oetome\@killerbunnies.org.
EOF

# Changes:
#
# 2007-05-09:
#   Use File::Spec for pathname manipulation, which will hopefully make the
#   script work better on Windows.
#
# 2005-08-04:
#   Allow for multiple identically named prefix/suffix ego types covering
#   different tval groups.
#   
# 2005-07-31:
#   Attempt to detect the ToME module associated with the dump, and use the
#   module's info files for parsing purposes.
#
# 2005-03-18:
#   - Tweak character dump parsing to allow "Character Sheet" instead of
#     "Character Dump" on the first line, to accommodate new ToME versions.
#   - Skip oook-style "//" comment lines while parsing dump.
#
# 2004-07-18:
#   - Add extra color-coding to the flags grid to simplify comparing
#     current kit to original kit.
#   - Shift-clicking a menu item in the pop-down equipment slot menus will
#     now pop up a description of said item.
#
# 2004-07-12:
#   - Catch and handle the SENS_FIRE description.
#   - Add row 'Add Luck' to the flags grid.
#   - Add back in the wounding-typo, as an alternate needed for 2.1.x
#   - dumps.
#
# 2004-06-25:
#   Fixed a typo in the wounding description.
#
# 2003-11-08:
#   - Fixed assorted issues with Tk on Windows.
#   - The item list from clicking on a row of the flags grid can now be
#     clicked itself to pop up a description of the item clicked on.

my %base_items = ();
my %base_by_tsval = ();
my %ego_types = ( A => {}, B => {} );
my %artifacts = ();
my @slots_avail = ();
my %player_flags = ();
my %candidates = ();
my %candidates_by_name = ( '(nothing)' => { name=>'(nothing)', flags=>{} } );
my %eq_current = ();
my %init_flags = ();
my %W = ( main => new MainWindow );

my %pval_flags = (
  'strength'				=> 'STR',
  'intelligence'			=> 'INT',
  'wisdom'				=> 'WIS',
  'dexterity'				=> 'DEX',
  'constitution'			=> 'CON',
  'charisma'				=> 'CHA',
  'stealth'				=> 'STEALTH',
  'searching'				=> 'SEARCH',
  'infravision'				=> 'INFRA',
  'ability to tunnel'			=> 'TUNNEL',
  'speed'				=> 'SPEED',
  'attack speed'			=> 'BLOWS',
  'ability to score critical hits'	=> 'CRIT',
  'luck'				=> 'LUCK',
  'spell power'				=> 'SPELL',
  'mana capacity'			=> 'MANA',
  'hit points'				=> 'LIFE',
);
my %pval_pct_flags = (
  'spell power'				=> 'SPELL',
  'mana capacity'			=> 'MANA',
  'hit points'				=> 'LIFE',
);
my %is_pval_flag = map { ($_ => 1) } values %pval_flags;
my %is_pval_pct_flag = map { ($_ => 1) } values %pval_pct_flags;
my %brand_flags = (
  acid		=> 'BRAND_ACID',
  electricity	=> 'BRAND_ELEC',
  fire		=> 'BRAND_FIRE',
  frost		=> 'BRAND_COLD',
);
my %sustain_flags = (
  strength	=> 'SUST_STR',
  intelligence	=> 'SUST_INT',
  wisdom	=> 'SUST_WIS',
  dexterity	=> 'SUST_DEX',
  constitution	=> 'SUST_CON',
  charisma	=> 'SUST_CHA',
);
my %imm_flags = (
  acid		=> 'IM_ACID',
  electricity	=> 'IM_ELEC',
  fire		=> 'IM_FIRE',
  cold		=> 'IM_COLD',
  nether	=> 'IM_NETHER',
);
my %resist_flags = (
  'life draining'	=> 'HOLD_LIFE',
  'acid'		=> 'RES_ACID',
  'electricity'		=> 'RES_ELEC',
  'fire'		=> 'RES_FIRE',
  'cold'		=> 'RES_COLD',
  'poison'		=> 'RES_POIS',
  'light'		=> 'RES_LITE',
  'dark'		=> 'RES_DARK',
  'blindness'		=> 'RES_BLIND',
  'confusion'		=> 'RES_CONF',
  'sound'		=> 'RES_SOUND',
  'shards'		=> 'RES_SHARDS',
  'nether'		=> 'RES_NETHER',
  'nexus'		=> 'RES_NEXUS',
  'chaos'		=> 'RES_CHAOS',
  'disenchantment'	=> 'RES_DISEN',
);
my %esp_flags = (
  'orcs'		=> 'ESP_ORC',
  'trolls'		=> 'ESP_TROLL',
  'dragons'		=> 'ESP_DRAGON',
  'spiders'		=> 'ESP_SPIDER',
  'giants'		=> 'ESP_GIANT',
  'demons'		=> 'ESP_DEMON',
  'undead'		=> 'ESP_UNDEAD',
  'evil beings'		=> 'ESP_EVIL',
  'animals'		=> 'ESP_ANIMAL',
  'thunderlords'	=> 'ESP_THUNDERLORD',
  'good beings'		=> 'ESP_GOOD',
  'non-living things'	=> 'ESP_NONLIVING',
  'unique beings'	=> 'ESP_UNIQUE',
);
my %drain_flags = (
  mana		=> 'DRAIN_MANA',
  life		=> 'DRAIN_HP',
  experience	=> 'DRAIN_EXP',
);
my %ignore_flags = (
  acid		=> 'IGNORE_ACID',
  electricity	=> 'IGNORE_ELEC',
  lightning	=> 'IGNORE_ELEC',
  fire		=> 'IGNORE_FIRE',
  cold		=> 'IGNORE_COLD',
);
my %singletons = (
  'It can be wielded two-handed.'			=> 'COULD2H',
  'It must be wielded two-handed.'			=> 'MUST2H',
  'It poisons your foes.'				=> 'BRAND_POIS',
  'It produces chaotic effects.'			=> 'CHAOTIC',
  'It drains life from your foes.'			=> 'VAMPIRIC',
  'It can cause earthquakes.'				=> 'IMPACT',
  'It is very sharp and can cut your foes.'		=> 'VORPAL',
  'It is very sharp and can make your foes bleed.'	=> 'WOUNDING',
  # A duplicate of the previous, to accommodate a 2.1.2 typo.
  'It is very sharp and make your foes bleed.'		=> 'WOUNDING',
  'It is a great bane of dragons.'			=> 'KILL_DRAGON',
  'It is especially deadly against dragons.'		=> 'SLAY_DRAGON',
  'It is especially deadly against orcs.'		=> 'SLAY_ORC',
  'It is especially deadly against trolls.'		=> 'SLAY_TROLL',
  'It is especially deadly against giants.'		=> 'SLAY_GIANTS',
  'It is a great bane of demons.'			=> 'KILL_DEMON',
  'It strikes at demons with holy wrath.'		=> 'SLAY_DEMON',
  'It is a great bane of undead.'			=> 'KILL_UNDEAD',
  'It strikes at undead with holy wrath.'		=> 'SLAY_UNDEAD',
  'It fights against evil with holy fury.'		=> 'SLAY_EVIL',
  'It is especially deadly against natural creatures.'	=> 'SLAY_ANIMAL',
  'It makes you invisible.'				=> 'INVIS',
  'It provides immunity to paralysis.'			=> 'FREE_ACT',
  'It makes you completely fearless.'			=> 'RES_FEAR',
  'It renders you incorporeal.'				=> 'WRAITH',
  'It allows you to breathe underwater.'		=> 'WATER_BREATH',
  'It allows you to breathe without air.'		=> 'MAGIC_BREATH',
  # The following two entries accommodate typos in v2.1.2.
  'It allows you to breath underwater.'			=> 'WATER_BREATH',
  'It allows you to breath without air.'		=> 'MAGIC_BREATH',
  'It allows you to levitate.'				=> 'FEATHER',
  'It allows you to fly.'				=> 'FLY',
  'It allows you to climb mountains.'			=> 'CLIMB',
  'It allows you to see invisible monsters.'		=> 'SEE_INVIS',
  'It gives telepathic powers.'				=> 'ESP_ALL',
  'It slows your metabolism.'				=> 'SLOW_DIGEST',
  'It speeds your regenerative powers.'			=> 'REGEN',
  'It reflects bolts and arrows.'			=> 'REFLECT',
  'It produces a fiery sheath.'				=> 'SH_FIRE',
  'It produces an electric sheath.'			=> 'SH_ELEC',
  'It produces an anti-magic shell.'			=> 'NO_MAGIC',
  'It generates an antimagic field.'			=> 'ANTIMAGIC_50',
  'It prevents teleportation.'				=> 'NO_TELE',
  'It fires missiles with extra might.'			=> 'XTRA_MIGHT',
  'It fires missiles excessively fast.'			=> 'XTRA_SHOTS',
  'It has been blessed by the gods.'			=> 'BLESSED',
  'It identifies all items for you.'			=> 'AUTO_ID',
  'It induces random teleportation.'			=> 'TELEPORT',
  'It aggravates nearby creatures.'			=> 'AGGRAVATE',
  'It can\'t attack.'					=> 'NEVER_BLOW',
  'It fills you with the Black Breath.'			=> 'BLACK_BREATH',
  'It is permanently cursed.'				=> 'PERMA_CURSE',
  'It is heavily cursed.'				=> 'HEAVY_CURSE',
  'It is cursed.'					=> 'CURSE',
  'It carries an ancient foul curse.'			=> 'TY_CURSE',
  'It carries an ancient morgothian curse.'		=> 'DG_CURSE',
  'It can clone monsters.'				=> 'CLONE',
  'It cannot be dropped while cursed.'			=> 'CURSE_NO_DROP',
  'It can re-curse itself.'				=> 'AUTO_CURSE',
  'It can resist being shattered by morgul beings.'	=> 'RES_MORGUL',
  'It is part of the trinity of the ultimate weapons.'	=> 'ULTIMATE',
  'It is the ultimate armor.'				=> 'ULTIMATE',
);
my @ignore = (
  'It can hold more mana.',
  'It can cast spells for a lesser mana cost.',
  'It can cast spells faster.',
  'It regenerates its mana faster.',
  'It is well-hidden.',
  'It can rearm itself.',
  'It rearms itself.',
  'It is effective against Ghosts.',
  'It can teleport monsters to you.',
  'It can ony be set off by dragons.',
  'It can ony be set off by demons.',
  'It can ony be set off by undead.',
  'It can ony be set off by animals.',
  'It can ony be set off by evil creatures.',
);
my @slots = qw(INVEN_WIELD INVEN_BOW INVEN_RING INVEN_NECK INVEN_LITE
	       INVEN_BODY INVEN_OUTER INVEN_ARM INVEN_HEAD INVEN_HANDS
	       INVEN_FEET INVEN_CARRY INVEN_AMMO INVEN_TOOL);
my %slot_names = (
  INVEN_WIELD	=> 'Weapons',
  INVEN_BOW	=> 'Launchers',
  INVEN_RING	=> 'Rings',
  INVEN_NECK	=> 'Amulets',
  INVEN_LITE	=> 'Light sources',
  INVEN_BODY	=> 'Body armor',
  INVEN_OUTER	=> 'Cloaks',
  INVEN_ARM	=> 'Shields',
  INVEN_HEAD	=> 'Headwear',
  INVEN_HANDS	=> 'Handwear',
  INVEN_FEET	=> 'Footwear',
  INVEN_CARRY	=> 'Symbiotes',
  INVEN_AMMO	=> 'Ammo',
  INVEN_TOOL	=> 'Tools',
);
my %wield_slots = (
   6	=> 'INVEN_WIELD',
  12	=> 'INVEN_TOOL',
  14	=> 'INVEN_BOW',
  15	=> 'INVEN_BOW',
  16	=> 'INVEN_AMMO',
  17	=> 'INVEN_AMMO',
  18	=> 'INVEN_AMMO',
  19	=> 'INVEN_BOW',
  20	=> 'INVEN_TOOL',
  21	=> 'INVEN_WIELD',
  22	=> 'INVEN_WIELD',
  23	=> 'INVEN_WIELD',
  24	=> 'INVEN_WIELD',
  30	=> 'INVEN_FEET',
  31	=> 'INVEN_HANDS',
  32	=> 'INVEN_HEAD',
  33	=> 'INVEN_HEAD',
  34	=> 'INVEN_ARM',
  35	=> 'INVEN_OUTER',
  36	=> 'INVEN_BODY',
  37	=> 'INVEN_BODY',
  38	=> 'INVEN_BODY',
  39	=> 'INVEN_LITE',
  40	=> 'INVEN_NECK',
  45	=> 'INVEN_RING',
  115	=> \&demonwear_slot,
);
my %eq_slots = (
  'a'	=> 'INVEN_WIELD',
  'b'	=> 'INVEN_WIELD',
  'c'	=> 'INVEN_WIELD',
  'd'	=> 'INVEN_BOW',
  'e'	=> 'INVEN_RING',
  'f'	=> 'INVEN_RING',
  'g'	=> 'INVEN_RING',
  'h'	=> 'INVEN_RING',
  'i'	=> 'INVEN_RING',
  'j'	=> 'INVEN_RING',
  'k'	=> 'INVEN_NECK',
  'l'	=> 'INVEN_NECK',
  'm'	=> 'INVEN_LITE',
  'n'	=> 'INVEN_BODY',
  'o'	=> 'INVEN_OUTER',
  'p'	=> 'INVEN_ARM',
  'q'	=> 'INVEN_ARM',
  'r'	=> 'INVEN_ARM',
  's'	=> 'INVEN_HEAD',
  't'	=> 'INVEN_HEAD',
  'u'	=> 'INVEN_HANDS',
  'v'	=> 'INVEN_HANDS',
  'w'	=> 'INVEN_HANDS',
  'x'	=> 'INVEN_FEET',
  'y'	=> 'INVEN_FEET',
  'z'	=> 'INVEN_CARRY',
  '{'	=> 'INVEN_AMMO',
  '|'	=> 'INVEN_TOOL',
);
my $equip_slots = 'a-z{|';
my %grid_flags = (
  'Add Str'	=> 'STR',
  'Add Int'	=> 'INT',
  'Add Wis'	=> 'WIS',
  'Add Dex'	=> 'DEX',
  'Add Con'	=> 'CON',
  'Add Chr'	=> 'CHA',
  'Mul Mana'	=> 'MANA',
  'Mul SPower'	=> 'SPELL',
  'Add Stea.'	=> 'STEALTH',
  'Add Sear.'	=> 'SEARCH',
  'Add Infra'	=> 'INFRA',
  'Add Tun..'	=> 'TUNNEL',
  'Add Luck'	=> 'LUCK',
  'Add Speed'	=> 'SPEED',
  'Add Blows'	=> 'BLOWS',
  'Chaotic'	=> 'CHAOTIC',
  'Vampiric'	=> 'VAMPIRIC',
  'Slay Anim.'	=> 'SLAY_ANIMAL',
  'Slay Evil'	=> 'SLAY_EVIL',
  'Slay Und.'	=> 'SLAY_UNDEAD',
  'Slay Demon'	=> 'SLAY_DEMON',
  'Slay Orc'	=> 'SLAY_ORC',
  'Slay Troll'	=> 'SLAY_TROLL',
  'Slay Giant'	=> 'SLAY_GIANT',
  'Slay Drag.'	=> 'SLAY_DRAGON',
  'Kill Drag.'	=> 'KILL_DRAGON',
  'Kill Demon'	=> 'KILL_DEMON',
  'Kill Und.'	=> 'KILL_UNDEAD',
  'Sharpness'	=> 'VORPAL',
  'Impact'	=> 'IMPACT',
  'Poison Brd'	=> 'BRAND_POIS',
  'Acid Brand'	=> 'BRAND_ACID',
  'Elec Brand'	=> 'BRAND_ELEC',
  'Fire Brand'	=> 'BRAND_FIRE',
  'Cold Brand'	=> 'BRAND_COLD',
  'Sust Str'	=> 'SUST_STR',
  'Sust Int'	=> 'SUST_INT',
  'Sust Wis'	=> 'SUST_WIS',
  'Sust Dex'	=> 'SUST_DEX',
  'Sust Con'	=> 'SUST_CON',
  'Sust Chr'	=> 'SUST_CHR',
  'Invisible'	=> 'INVIS',
  'Mul life'	=> 'LIFE',
  'Imm Acid'	=> 'IM_ACID',
  'Imm Elec'	=> 'IM_ELEC',
  'Imm Fire'	=> 'IM_FIRE',
  'Imm Cold'	=> 'IM_COLD',
  'Sens Fire'	=> 'SENS_FIRE',
  'Reflect'	=> 'REFLECT',
  'Free Act'	=> 'FREE_ACT',
  'Hold Life'	=> 'HOLD_LIFE',
  'Res Acid'	=> 'RES_ACID',
  'Res Elec'	=> 'RES_ELEC',
  'Res Fire'	=> 'RES_FIRE',
  'Res Cold'	=> 'RES_COLD',
  'Res Pois'	=> 'RES_POIS',
  'Res Fear'	=> 'RES_FEAR',
  'Res Lite'	=> 'RES_LITE',
  'Res Light'	=> 'RES_LITE',
  'Res Dark'	=> 'RES_DARK',
  'Res Blind'	=> 'RES_BLIND',
  'Res Conf'	=> 'RES_CONF',
  'Res Sound'	=> 'RES_SOUND',
  'Res Shard'	=> 'RES_SHARDS',
  'Res Neth'	=> 'RES_NETHER',
  'Res Nexus'	=> 'RES_NEXUS',
  'Res Chaos'	=> 'RES_CHAOS',
  'Res Disen'	=> 'RES_DISEN',
  'Aura Fire'	=> 'SH_FIRE',
  'Aura Elec'	=> 'SH_ELEC',
  'NoTeleport'	=> 'NO_TELE',
  'AntiMagic'	=> 'NO_MAGIC',
  'WraithForm'	=> 'WRAITH',
  'EvilCurse'	=> 'TY_CURSE',
  'Easy Know'	=> 'EASY_KNOW',
  'Hide Type'	=> 'HIDE_TYPE',
  'Show Mods'	=> 'SHOW_MODS',
  'Insta Art'	=> 'INSTA_ART',
  'Levitate'	=> 'FEATHER',
  'Lite'	=> 'LITE1',
  'See Invis'	=> 'SEE_INVIS',
  'Digestion'	=> 'SLOW_DIGEST',
  'Regen'	=> 'REGEN',
  'Xtra Might'	=> 'XTRA_MIGHT',
  'Xtra Shots'	=> 'XTRA_SHOTS',
  'Ign Acid'	=> 'IGNORE_ACID',
  'Ign Elec'	=> 'IGNORE_ELEC',
  'Ign Fire'	=> 'IGNORE_FIRE',
  'Ign Cold'	=> 'IGNORE_COLD',
  'Activate'	=> 'ACTIVATE',
  'Drain Exp'	=> 'DRAIN_EXP',
  'Teleport'	=> 'TELEPORT',
  'Aggravate'	=> 'AGGRAVATE',
  'Blessed'	=> 'BLESSED',
  'Cursed'	=> 'CURSED',
  'Hvy Curse'	=> 'HEAVY_CURSE',
  'Prm Curse'	=> 'PERMA_CURSE',
  'No blows'	=> 'NEVER_BLOW',
  'Precogn.'	=> 'PRECOGNITION',
  'B.Breath'	=> 'BLACK_BREATH',
  'Recharge'	=> 'RECHARGE',
  'Fly'		=> 'FLY',
  'Mrg.Curse'	=> 'DG_CURSE',
  'Climb'	=> 'CLIMB',
  'Imm Neth'	=> 'IM_NETHER',
  'Sentient'	=> 'LEVELS',
  'Orc.ESP'	=> 'ESP_ORC',
  'Troll.ESP'	=> 'ESP_TROLL',
  'Dragon.ESP'	=> 'ESP_DRAGON',
  'Giant.ESP'	=> 'ESP_GIANT',
  'Demon.ESP'	=> 'ESP_DEMON',
  'Undead.ESP'	=> 'ESP_UNDEAD',
  'Evil.ESP'	=> 'ESP_EVIL',
  'Animal.ESP'	=> 'ESP_ANIMAL',
  'TLord.ESP'	=> 'ESP_THUNDERLORD',
  'Good.ESP'	=> 'ESP_GOOD',
  'Nlive.ESP'	=> 'ESP_NONLIVING',
  'Unique.ESP'	=> 'ESP_UNIQUE',
  'Full ESP'	=> 'ESP_ALL',
);
my %flags_pretty = (
  COULD2H		=> 'one- or two-handed',
  MUST2H		=> 'two-handed',
  LITE1			=> 'radius-1 light',
  LITE2			=> 'radius-2 light',
  LITE3			=> 'radius-3 light',
  STR			=> 'strength',
  INT			=> 'intelligence',
  WIS			=> 'wisdom',
  DEX			=> 'dexterity',
  CON			=> 'constitution',
  CHA			=> 'charisma',
  STEALTH		=> 'stealth',
  SEARCH		=> 'searching',
  INFRA			=> 'infravision',
  TUNNEL		=> 'tunneling',
  LUCK			=> 'luck',
  SPEED			=> 'speed',
  BLOWS			=> 'attacks',
  CRIT			=> 'critical hits',
  MANA			=> 'mana',
  SPELL			=> 'spell power',
  LIFE			=> 'hit points',
  BRAND_ACID		=> 'acid brand',
  BRAND_ELEC		=> 'lightning brand',
  BRAND_FIRE		=> 'fire brand',
  BRAND_COLD		=> 'cold brand',
  BRAND_POIS		=> 'poison brand',
  SLAY_EVIL		=> 'slay evil',
  SLAY_UNDEAD		=> 'slay undead',
  SLAY_DEMON		=> 'slay demon',
  SLAY_ORC		=> 'slay orc',
  SLAY_TROLL		=> 'slay troll',
  SLAY_GIANT		=> 'slay giant',
  SLAY_DRAGON		=> 'slay dragon',
  KILL_DRAGON		=> '*slay* dragon',
  KILL_DEMON		=> '*slay* demon',
  KILL_UNDEAD		=> '*slay* undead',
  VORPAL		=> 'sharpness',
  WOUNDING		=> 'wounding',
  VAMPIRIC		=> 'vampiric effects',
  CHAOTIC		=> 'chaotic effects',
  IMPACT		=> 'causes earthquakes',
  SLAY_ANIMAL		=> 'slay animal',
  SUST_STR		=> 'sustain strength',
  SUST_INT		=> 'sustain intelligence',
  SUST_WIS		=> 'sustain wisdom',
  SUST_DEX		=> 'sustain dexterity',
  SUST_CON		=> 'sustain constitution',
  SUST_CHR		=> 'sustain charisma',
  INVIS			=> 'invisibility',
  IM_ACID		=> 'immunity to acid',
  IM_ELEC		=> 'immunity to lightning',
  IM_FIRE		=> 'immunity to fire',
  IM_COLD		=> 'immunity to cold',
  IM_NETHER		=> 'immunity to nether',
  SENS_FIRE		=> 'vulnerability to fire',
  REFLECT		=> 'reflection',
  FREE_ACT		=> 'free action',
  HOLD_LIFE		=> 'hold life',
  RES_ACID		=> 'resist acid',
  RES_ELEC		=> 'resist lightning',
  RES_FIRE		=> 'resist fire',
  RES_COLD		=> 'resist cold',
  RES_POIS		=> 'resist poison',
  RES_FEAR		=> 'resist fear',
  RES_LITE		=> 'resist light',
  RES_DARK		=> 'resist dark',
  RES_BLIND		=> 'resist blindness',
  RES_CONF		=> 'resist confusion',
  RES_SOUND		=> 'resist sound',
  RES_SHARDS		=> 'resist shards',
  RES_NETHER		=> 'resist nether',
  RES_NEXUS		=> 'resist nexus',
  RES_CHAOS		=> 'resist chaos',
  RES_DISEN		=> 'resist disenchantment',
  SH_FIRE		=> 'fiery sheath',
  SH_ELEC		=> 'electric sheath',
  AUTO_CURSE		=> 'automatic re-curse',
  NO_TELE		=> 'anti-teleportation',
  NO_MAGIC		=> 'anti-magic',
  WRAITH		=> 'wraith form',
  RES_MORGUL		=> 'resist Morgul shatter',
  FEATHER		=> 'levitation',
  FLY			=> 'flight',
  CLIMB			=> 'climbing',
  SEE_INVIS		=> 'see invisible',
  SLOW_DIGEST		=> 'slow digestion',
  REGEN			=> 'regeneration',
  ANTIMAGIC_50		=> 'anti-magic field',
  XTRA_MIGHT		=> 'extra might',
  XTRA_SHOTS		=> 'extra shots',
  ESP_ORC		=> 'sense orc',
  ESP_TROLL		=> 'sense troll',
  ESP_DRAGON		=> 'sense dragon',
  ESP_GIANT		=> 'sense giant',
  ESP_DEMON		=> 'sense demon',
  ESP_UNDEAD		=> 'sense undead',
  ESP_EVIL		=> 'sense evil',
  ESP_ANIMAL		=> 'sense animal',
  ESP_THUNDERLORD	=> 'sense thunderlord',
  ESP_GOOD		=> 'sense good',
  ESP_NONLIVING		=> 'sense nonliving',
  ESP_UNIQUE		=> 'sense uniques',
  ESP_ALL		=> 'ESP',
  ACTIVATE		=> 'activation',
  AUTO_ID		=> 'auto-identify',
  BLESSED		=> 'blessed',
  PRECOGNITION		=> 'precognition',
  WATER_BREATH		=> 'underwater breathing',
  MAGIC_BREATH		=> 'magical breathing',
  ULTIMATE		=> 'ultimate artifact',
  DRAIN_EXP		=> 'drain experience',
  DRAIN_MANA		=> 'drain mana',
  DRAIN_HP		=> 'drain life',
  TELEPORT		=> 'random teleportation',
  AGGRAVATE		=> 'aggravation',
  CURSED		=> 'cursed',
  HEAVY_CURSE		=> 'heavy curse',
  PERMA_CURSE		=> 'permanent curse',
  TY_CURSE		=> 'ancient foul curse',
  DG_CURSE		=> 'ancient Morgothian curse',
  CURSE_NO_DROP		=> 'cannot be dropped while cursed',
  NEVER_BLOW		=> 'cannot attack',
  IMMOVABLE		=> 'cannot move while wielded',
  BLACK_BREATH		=> 'Black Breath',
  IGNORE_ACID		=> 'unharmed by acid',
  IGNORE_ELEC		=> 'unharmed by lightning',
  IGNORE_FIRE		=> 'unharmed by fire',
  IGNORE_COLD		=> 'unharmed by cold',
);
my @descr_flags =
  qw(COULD2H MUST2H LITE1 LITE2 LITE3 STR INT WIS DEX CON CHA STEALTH
     SEARCH INFRA TUNNEL LUCK SPEED BLOWS CRIT MANA SPELL LIFE BRAND_ACID
     BRAND_ELEC BRAND_FIRE BRAND_COLD BRAND_POIS SLAY_EVIL SLAY_UNDEAD
     SLAY_DEMON SLAY_ORC SLAY_TROLL SLAY_GIANT SLAY_DRAGON KILL_DRAGON
     KILL_DEMON KILL_UNDEAD VORPAL WOUNDING VAMPIRIC CHAOTIC IMPACT
     SLAY_ANIMAL SUST_STR SUST_INT SUST_WIS SUST_DEX SUST_CON SUST_CHR
     INVIS IM_ACID IM_ELEC IM_FIRE IM_COLD IM_NETHER SENS_FIRE REFLECT
     FREE_ACT HOLD_LIFE RES_ACID RES_ELEC RES_FIRE RES_COLD RES_POIS
     RES_FEAR RES_LITE RES_DARK RES_BLIND RES_CONF RES_SOUND RES_SHARDS
     RES_NETHER RES_NEXUS RES_CHAOS RES_DISEN SH_FIRE SH_ELEC AUTO_CURSE
     NO_TELE NO_MAGIC WRAITH RES_MORGUL FEATHER FLY CLIMB SEE_INVIS
     SLOW_DIGEST REGEN ANTIMAGIC_50 XTRA_MIGHT XTRA_SHOTS ESP_ORC ESP_TROLL
     ESP_DRAGON ESP_GIANT ESP_DEMON ESP_UNDEAD ESP_EVIL ESP_ANIMAL
     ESP_THUNDERLORD ESP_GOOD ESP_NONLIVING ESP_UNIQUE ESP_ALL ACTIVATE
     AUTO_ID BLESSED PRECOGNITION WATER_BREATH MAGIC_BREATH ULTIMATE
     DRAIN_EXP DRAIN_MANA DRAIN_HP TELEPORT AGGRAVATE CURSED HEAVY_CURSE
     PERMA_CURSE TY_CURSE DG_CURSE CURSE_NO_DROP NEVER_BLOW IMMOVABLE
     BLACK_BREATH IGNORE_ACID IGNORE_ELEC IGNORE_FIRE IGNORE_COLD);
my @grid_flags = (
  'Add Str', 'Add Int', 'Add Wis', 'Add Dex', 'Add Con', 'Add Chr',
  'Mul Mana', 'Mul SPower', 'Add Stea.', 'Add Sear.', 'Add Infra',
  'Add Tun..', 'Add Luck', 'Add Speed', 'Add Blows', 'Chaotic', 'Vampiric',
  'Slay Anim.', 'Slay Evil', 'Slay Und.', 'Slay Demon', 'Slay Orc',
  'Slay Troll', 'Slay Giant', 'Slay Drag.', 'Kill Drag.', 'Kill Demon',
  'Kill Und.', 'Sharpness',
  'Impact', 'Poison Brd', 'Acid Brand', 'Elec Brand', 'Fire Brand',
  'Cold Brand', 'Sust Str', 'Sust Int', 'Sust Wis', 'Sust Dex',
  'Sust Con', 'Sust Chr', 'Invisible', 'Mul life', 'Imm Acid',
  'Imm Elec', 'Imm Fire', 'Imm Cold', 'Sens Fire', 'Reflect', 'Free Act',
  'Hold Life', 'Res Acid', 'Res Elec', 'Res Fire', 'Res Cold', 'Res Pois',
  'Res Fear', 'Res Lite', 'Res Dark', 'Res Blind', 'Res Conf', 'Res Sound',
  'Res Shard', 'Res Neth', 'Res Nexus', 'Res Chaos', 'Res Disen',
  'Aura Fire', 'Aura Elec', 'NoTeleport', 'AntiMagic', 'WraithForm',
  'EvilCurse', 'Levitate', 'Lite', 'See Invis', 'Digestion', 'Regen',
  'Xtra Might', 'Xtra Shots', 'Activate', 'Drain Exp', 'Teleport',
  'Aggravate', 'Blessed', 'Cursed', 'Hvy Curse', 'Prm Curse', 'No blows',
  'Precogn.', 'B.Breath', 'Recharge', 'Fly', 'Mrg.Curse', 'Climb',
  'Imm Neth', 'Orc.ESP', 'Troll.ESP', 'Dragon.ESP', 'Giant.ESP',
  'Demon.ESP', 'Undead.ESP', 'Evil.ESP', 'Animal.ESP', 'TLord.ESP',
  'Good.ESP', 'Nlive.ESP', 'Unique.ESP', 'Full ESP',
);



# edit_file_name() -- Returns the path name of an edit file in $TOME_EDIT,
# formatted as appropriated for the system.
sub edit_file_name ($) {
  return File::Spec->catfile($TOME_EDIT, $_[0]);
}

# lib_dir_name() -- Returns the path name of a subdirectory of $TOME_LIB,
# formatted as appropriate for the system.
sub lib_dir_name (@) {
  return File::Spec->catdir($TOME_LIB, @_);
}

# lib_file_name() -- Returns the path name of a file in $TOME_LIB or a
# subdirectory thereof, formatted as appropriate for the system.
sub lib_file_name (@) {
  return File::Spec->catfile($TOME_LIB, @_);
}

# demonwear_slot() -- Returns the appropriate equipment position for
# Demonblades/Demonshields/Demonhorns.
sub demonwear_slot ($) {
  my $sval = $_[0];
  return 'INVEN_WIELD' if $sval == 55;
  return 'INVEN_ARM'   if $sval == 56;
  return 'INVEN_HEAD'  if $sval == 57;
}

# read_blob() -- read and return a group of non-empty lines from a
# FileHandle.
sub read_blob ($) {
  my $fh = $_[0];
  my $lines = '';
  local $_;

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

# read_info_file() -- read and extract information from one of ToME's
# internal info files.
sub read_info_file ($) {
  local $_;
  my $which = $_[0];
  my $file = edit_file_name "${which}_info.txt";
  my $fh = new FileHandle $file or die "Cannot open ${file}: $!\n";

  while ($_ = read_blob $fh) {
    if (/^I:(\d+):(\d+):/m) {
      my ($tval, $sval) = ($1, $2);
      next if !exists($wield_slots{$tval});

      my $tsval = "$tval.$sval";
      my $tmpl = (/^N:\d+:(.*)$/m, $1);
      my $name = $tmpl;
      $name =~ s/^\& //;
      $name =~ s/\~//;
      if (!/\bINSTA_ART\b/) {
	$name = "Ring of $name" if $tval == 45;
	$name = "Amulet of $name" if $tval == 40;
	$name = "Cloak of Mimicry $name" if $tval == 35 && $sval > 100;
      }
      if ($which eq 'a') {
	warn "No base item for artifact \"$name\" ($tsval)\n" and next
	  if !exists($base_by_tsval{$tsval});
	$name = "$base_by_tsval{$tsval} $name";
      }
      my $slot = $wield_slots{$tval};
      $slot = &$slot($sval) if ref $slot && ref $slot eq 'CODE';

      my $entry = {
	name => $name,
	tmpl => $tmpl,
	tval => $tval,
	sval => $sval,
	slot => $slot,
	flags => {},
      };
      for (/^F:(.*)$/mg) {
	for my $flag (split /\s*\|\s*/, $_ ) { $$entry{flags}{$flag} = 1 }
      }

      if ($which eq 'k') {
	# We store the base item under the singular and plural forms of its
	# name.  The plural form will be caught first if it matches, since
	# we test the base item names by decreasing order of length.
	my $plural = $tmpl;
	$plural =~ s/^\& //;
	$plural =~ s/([sh])\~/$1es/;
	$plural =~ s/\~/s/;
	if (!/\bINSTA_ART\b/) {
	  $plural = "Rings of $plural" if $tval == 45;
	  $plural = "Amulets of $plural" if $tval == 40;
	  $plural = "Cloaks of Mimicry $plural" if $tval == 35 && $sval > 100;
	}

	$base_items{$name} = $base_items{$plural} = $entry;
	$base_by_tsval{$tsval} = $name;
      }
      elsif ($which eq 'a') {
	$artifacts{$name} = $entry;
      }
    }
    elsif (/^T:/m) {
      # An ego type.  Skip it if it can't be applied to something
      # wieldable.
      my @tsvals = /^T:(\d+:\d+:\d+)$/mg;
      @tsvals = grep { /^(\d+):/ && exists $wield_slots{$1} } @tsvals;
      next if scalar @tsvals == 0;

      my $name = (/^N:\d+:(.*)$/m, $1);
      warn "No pfx/sfx info for ego type '$name'\n" and next if !/^X:([AB]):/m;
      my $side = $1;
      my $entry = { name => $name, tsvals => \@tsvals, flags => {} };
      my @probs = /^R:(\d+)$/mg;
      my @parts = split /^R:\d+\n/m, $_;
      push @parts, '' if /R:\d+\n$/;
      warn "??? @probs vs. @parts\n" if scalar @parts != 1 + scalar @probs;
      for my $i (0..$#probs) {
	# We only keep flags that have a 100% probability of occurring; to
	# see any other flags, they'll have to *ID* it.
	next if $probs[$i] != 100;
	for ($parts[$i+1] =~ /^F:(.*)$/mg) {
	  for my $flag (split /\s*\|\s*/, $_ ) { $$entry{flags}{$flag} = 1 }
	}
      }
      $ego_types{$side}{$name} ||= [];
      push @{$ego_types{$side}{$name}}, $entry;
    }
  }
}

# mimicry_cloak_hack() -- Annoying Hard-Coded Hack(TM) to add base info for
# v2.2.x Mimicry Cloaks, whose names are determined in Lua.
sub mimicry_cloak_hack () {
  my @names = ('Mouse Fur', 'Feathers Cloak', 'Wolf Pelt', 'Spider Web',
	       'Entish Bark');

  for my $name (@names) {
    my $plural = $name . 's';
    my $entry = {
      name => $name,
      tmpl => "\& $name\~",
      tval => 35,
      sval => 100,
      slot => 'INVEN_OUTER',
      flags => {},
    };
    $base_items{$name} = $base_items{$plural} = $entry;
    # This is a monstrous name collision.  Luckily, there are no artifact
    # Mimicry Cloaks in a_info.txt.
    $base_by_tsval{'35.100'} = $name;
  }
}

# ego_match_tsval() -- Return true if an item with the specified tval and
# sval can be of the specified ego type.
sub ego_match_tsval ($$$) {
  my ($matches, $tval, $sval) = @_;
  for my $match (@$matches) {
    my ($ok_tval, $min_sval, $max_sval) = split ':', $match, 3;
    return 1 if $tval == $ok_tval && $sval >= $min_sval && $sval <= $max_sval;
  }
  return 0;
}

sub by_length_desc { return length($b) <=> length ($a) }

# copy_entry() -- Create a copy of a data structure describing an object.
sub copy_entry ($) {
  my $obj = $_[0];
  my %obj = %$obj;
  $obj{flags} = { %{$obj{flags}} };
  return \%obj;
}

# parse_item_name() -- Attempt to match the given item name against known
# object types, ego types and artifacts.
sub parse_item_name ($) {
  local $_ = $_[0];

  # First try to match artifacts.
  for my $name (sort by_length_desc keys %artifacts) {
    next if !/\b$name\b/;
    return copy_entry $artifacts{$name};
  }
  # Then try to match base items.
  for my $base (sort by_length_desc keys %base_items) {
    next if !/\b\Q$base\E\b/;
    my $obj = copy_entry $base_items{$base};
    my $got_ego = 0;

    # Try to match ego types, prefix and suffix.
    for my $side (qw(A B)) {
      ONTHISSIDE:
      for my $type (sort by_length_desc keys %{$ego_types{$side}}) {
	for my $entry (@{$ego_types{$side}{$type}}) {
	  next unless ego_match_tsval $$entry{tsvals}, $$obj{tval}, $$obj{sval};
	  my $try = ($side eq 'A' ? "$base $type" : "$type $base");
	  next if !/\b\Q$try\E\b/;
	  $got_ego = 1;
	  for my $flag (keys %{$$entry{flags}}) { $$obj{flags}{$flag} = 1 }
	  last ONTHISSIDE;
	}
      }
    }

    # If we matched an ego type, that's probably enough of a sanity check;
    # if not, we need to check for an article or number in front of the
    # base name (or for body armor, check for the base at the start of the
    # item name), to avoid things like junkarts matching as weapons or a
    # Rune [Arrow] matching as ammo.
    next if !$got_ego && !/^([Aa]n?|The|\d+) $base\b/ &&
	    !($$obj{tmpl} !~ /^\& / && /^$base\b/);

    return $obj;
  }
  return undef;
}

# flags_sentence() -- Search the item description for a particular sentence
# describing one or more object flags; if present, store the flags in the
# object's data structure.
sub flags_sentence (\%$$\%) {
  # Note:  we share the local $_ from parse_descr().
  my ($obj, $type, $prefix, $flag_hash) = @_;
  my $flags = '';

  if ($prefix eq 'It increases your') {
    # Special case:  pull out the pval as well as the flags.
    return if !s/\s*It (in|de)creases your (.*?) by (\d+)(\%?)\.\s*//;
    $flags = $2;
    my ($sgn, $pval, $pct) = ($1, $3, $4);
    $pval /= 20 if $pct;
    $pval = -$pval if $sgn eq 'de';
    warn "Pval mismatch ($$obj{pval} vs. $pval)\n"
      if exists $$obj{pval} && $$obj{pval} != $pval;
    $$obj{pval} = $pval;
  } else {
    return if !s/\s*$prefix (.*?)\.\s*//;
    $flags = $1;
  }

  my @flags = split /,\s*|\s*and\s*/, $flags;
  @flags = split /,\s*|\s*or\s*/, $flags
    if $prefix eq 'It cannot be harmed by';
  for my $flag (@flags) {
    if (exists $$flag_hash{$flag}) {
      $$obj{flags}{$$flag_hash{$flag}} = 1;
    } else {
      warn "Unrecognized $type flag '$flag'\n";
    }
  }
}

# parse_descr() -- Parse an item description, storing extracted flags and
# other information in the object's data structure.
sub parse_descr (\%$) {
  my $obj = $_[0];
  local $_ = $_[1];

  # Strip off the origin of the item at the end, and other assorted bits we
  # just want to ignore.
  s/\s*You (found|bought|made) it.*$//;
  s/\s*It was given to you.*$//;
  for my $bit (@ignore) { s/\s*$bit\s*// }
  # A few things we can't handle yet.
  if (s/\s*It is sentient.*?\.\s*//) {
    # ???
  }
  if (s/\s*It can be activated for .*? if it is being worn\.\s*//) {
    # ???
  }
  if (s/\s*It can be activated for .*?\.\s*//) {
    # Both wieldable stuff and junkarts can be activated, so we have to
    # check for both permutations.
    # ???
  }
  if (s/\s*It grants you the power of .*? if it is being worn\.\s*//) {
    # ???
  }
  if (s/\s*It provides light \(radius (\d+)\) (forever|when fueled)\.\s*//) {
    my ($rad, $perm) = ($1, $2);
    $$obj{flags}{FUEL_LITE} = 1 if $perm eq 'when fueled';
    if ($rad > 3) {
      $$obj{flags}{"LITE${\($rad-3)}"} = $$obj{flags}{LITE3} = 1;
    } else {
      $$obj{flags}{"LITE$rad"} = 1;
    }
  }
  if (s/\s*It renders you especially vulnerable to fire\.\s*//) {
    $$obj{flags}{SENS_FIRE} = 1;
  }
  if (s/\s*It prevents the space-time continuum from being disrupted\.\s*//) {
    # ???
  }
  if (s/\s*It can be used to store a spell\.\s*// ||
      s/\s*It has a spell stored inside\.\s*//)
  {
    # ???
  }
  for my $flag (keys %singletons) {
    $$obj{flags}{$singletons{$flag}} = 1 if s/\s*$flag\s*//;
  }
  flags_sentence %$obj, 'pval', 'It increases your', %pval_flags;
  flags_sentence %$obj, 'pval', 'It increases your', %pval_pct_flags;
  flags_sentence %$obj, 'weapon-brand', 'It does extra damage from',
		 %brand_flags;
  flags_sentence %$obj, 'sustain-stat', 'It sustains your', %sustain_flags;
  flags_sentence %$obj, 'immunity', 'It provides immunity to', %imm_flags;
  flags_sentence %$obj, 'resist', 'It provides resistance to', %resist_flags;
  flags_sentence %$obj, 'ESP', 'It allows you to sense the presence of',
		 %esp_flags;
  flags_sentence %$obj, 'drain', 'It drains', %drain_flags;
  # If the object doesn't have all four ignores, it prints each one
  # separately -- which would get caught by flags_sentence() as a single
  # flag.  We call it three times to make sure all are caught.
  flags_sentence %$obj, 'ignore', 'It cannot be harmed by', %ignore_flags;
  flags_sentence %$obj, 'ignore', 'It cannot be harmed by', %ignore_flags;
  flags_sentence %$obj, 'ignore', 'It cannot be harmed by', %ignore_flags;

  s/^\s*$//;
  warn "Leftover junk in $$obj{name}:  '$_'\n" if $_;
}

# process_item() -- Create an object data structure from the given item
# name and description, and store the object information in all the
# appropriate places.
sub process_item ($$;$) {
  my ($item, $descr, $slot) = @_;
  my $obj = parse_item_name $item;
  return if !defined($obj);
  $$obj{name} = $item;
  parse_descr %$obj, $descr;

  # If the object has any pval-based flags and we don't have any pval
  # information for it, try to parse a pval out of the name.
  my $need_pval = 0;
  my $pval_pct = 0;
  for my $flag (keys %is_pval_flag) {
    next unless exists $$obj{flags}{$flag};
    $need_pval = 1;
    $pval_pct = 1 if exists $is_pval_pct_flag{$flag};
  }
  if ($need_pval && !exists($$obj{pval})) {
    # First look for a percent multiplier, then for a pval.
    if ($pval_pct && $item =~ /\(([+-]\d+)\%\)/) {
      $$obj{pval} = int($1/20);
    } elsif ($item =~ /\(([+-]\d+)[^-+,]*\)/) {
      $$obj{pval} = $1 + 0;
    }
  }

  $candidates_by_name{$item} = $obj;
  $candidates{$$obj{slot}} ||= [];
  push @{$candidates{$$obj{slot}}}, $item;
  $eq_current{$slot} = $item if $slot;
}

# set_module() -- Attempt to determine the module corresponding to the
# given character dump, and set up processing accordingly.
sub set_module ($) {
  local $_;
  open IN, "<$_[0]" or die "Cannot open $_[0]: $!\n";
  my $firstline = <IN>;
  close IN;

  print "Processing ToME character dump...\n" and return
    if $firstline =~ /\[ToME .* Character (?:Dump|Sheet)\]/;

  # No such luck.  Look for module subdirectories and check against their
  # listed names.
  my @mod_names = qw(ToME);
  my $mod_dir = lib_dir_name 'mods';
  if (-e $mod_dir && -d $mod_dir) {
    # Get the module subdirectories.
    opendir DIR, "$mod_dir" or die "Cannot opendir $mod_dir: $!\n";
    my @mods = grep { -d lib_dir_name('mods', $_) } readdir DIR;
    closedir DIR;

    for my $mod (@mods) {
      next if $mod eq '.' || $mod eq '..';

      # Get the module name out of module.lua.
      my $def_file = lib_file_name 'mods', $mod, 'module.lua';
      my $name = undef;

      next unless -e $def_file;
      open IN, "<$def_file" or (warn "Cannot open ${def_file}: $!\n" and next);
      while (<IN>) {
	next unless /\["name"\]\s*=\s*"([^"]+)",?\s*$/;
	$name = $1;
      }

      if (!$name) {
	warn "Could not find module name in $def_file\n";
      } else {
	push @mod_names, $name;
	if ($firstline =~ /\[\Q$name\E .* Character (?:Dump|Sheet)\]/) {
	  # Found our module.  Adjust search paths accordingly.  This will
	  # have to be fixed for ToME 3, which AIUI will be able to have
	  # different search paths for different edit files...
	  print "Processing $name character dump...\n";
	  my $editsub = lib_dir_name 'mods', $mod, 'edit';
	  $TOME_EDIT = $editsub if -e $editsub && -d $editsub;
	  
	  # And we're done.
	  return;
	}
      }
    }
  }

  # Couldn't find anything, apparently.
  my $errmsg =
    "This doesn't look like a character dump from any of the following\n" .
    "recognized ToME modules:\n" .
    join('', map { "\t$_\n" } @mod_names) .
    "Results may be entirely bogus.  Proceed at your own risk.\n";
  warn $errmsg;
}

# read_dump() -- Read and parse a character dump.
sub read_dump ($) {
  local $_;
  my ($item, $descr, $slot) = ('', '', '');
  my $grid_mode = 0;
  my $cur_eq = 0;

  open IN, "<$_[0]" or die "Cannot open $_[0]: $!\n";
  $_ = <IN>;
  while (<IN>) {
    chomp;
    last if /The (?:Mathom-house|Museum) Inventory/;
    next if m#^//#;
    $cur_eq = 1 if /Character Equipment/;
    $cur_eq = 0 if /Character Inventory/;

    if (!$grid_mode && /^\s+([$equip_slots]+)\@\s*$/) {
      # These are the available equipment slots.  We ignore the symbiote
      # slot for now; in a later version, we may try to find symbiotes in
      # the dump and include them in the selection process.
      my $slots_avail = $1;
      @slots_avail = grep { $_ ne 'z' } split '', $slots_avail;
      $grid_mode = 1;
    } elsif ($grid_mode) {
      ($grid_mode = 0), next if !$_;
      if (/^\s*(\S.*\S)\s*: ([1-9.+*]+)\s*$/) {
	# A row of the flags table.  Currently we use it to pick off the
	# player's innate flags; in a later version, we might catch flags
	# for the other slots to populate equipment items that haven't been
	# *ID*'d.
	my ($flag, $row) = ($1, $2);
	warn "Unrecognized grid flag '$flag'\n" and next
	  if !exists($grid_flags{$flag});
	$player_flags{$grid_flags{$flag}} = 1 if substr($row, -1, 1) ne '.';
      }
    }
    if (!$item) {
      if (/^([$equip_slots])\) (.*)$/) {
	# The start of an item.  Remember the slot if we're in the
	# equipment list.
	$item = $2;
	$slot = $1 if $cur_eq;
      }
    } else {
      # Accumulate description text until we get to the next item, then
      # parse it out and store it.
      if (!$_ || /^[$equip_slots]\)/) {
	process_item $item, $descr, $slot;
	$item = $descr = $slot = '';
	redo;
      }
      s/^\s+//;
      s/\s+$//;
      $descr = ($descr ? "$descr $_" : $_);
      $descr =~ s/(\w) ([,.]) /$1$2 /;
    }
  }
  close IN;
  process_item $item, $descr if $item && $descr;

  # Fill in any empty equipment slots with the dummy 'nothing' object.
  for my $slot (@slots_avail) { $eq_current{$slot} ||= '(nothing)' }
}

# initial_flags() -- Collect and store the flags provided by the initial
# equipment.
sub initial_flags () {
  my %eq = map { ($_ => $candidates_by_name{$eq_current{$_}}) } @slots_avail;

  for my $title (@grid_flags) {
    my $flag = $grid_flags{$title};
    my $is_pval = (exists $is_pval_flag{$flag});
    my $n = 0;

    for my $slot (@slots_avail) {
      my $eq = $eq{$slot};

      if ($flag eq 'LITE1') {
	for my $l (1..3) { $n += $l if exists $$eq{flags}{"LITE$l"} };
      } elsif (exists $$eq{flags}{$flag}) {
	if ($is_pval && exists $$eq{pval}) {
	  $n += $$eq{pval};
	} else {
	  $n = 1;
	}
      }
    }

    # Currently we can't do anything sane with pval-based player flags.
    if (exists $player_flags{$flag} && !$is_pval) { $n = 1 }

    if (($is_pval || $flag eq 'LITE1') && $n != 0) {
      $n = 5 if $n > 5 && $flag eq 'LITE1';
      $init_flags{$flag} = $n;
    } elsif ($n) {
      $init_flags{$flag} = 'y';
    }
  }
}

# exit_all() -- Close all windows and exit the program.
sub exit_all () {
  $W{info}->destroy();
  $W{items}->destroy();
  $W{help}->destroy();
  $W{main}->destroy();
}

# fmt_pval() -- Returns a formatted version of the pval for display in the
# flags grid.  If the $is_lite flag is present, then the given pval is
# actually a light radius, and should be formatted accordingly.
sub fmt_pval ($;$) {
  my ($pval, $is_lite) = @_;

  if ($is_lite) {
    return '    ' if $pval <= 0;
    $pval = 5 if $pval > 5;
    return sprintf ' r%d ', $pval;
  } else {
    return ' +**' if $pval > 99;
    return ' -**' if $pval < -99;
    return sprintf ' %+-3d', $pval;
  }
}

# update_grid() -- Update the flags grid to reflect the currently selected
# equipment.
sub update_grid () {
  my $grid = '           ' . join ('', @slots_avail) . '@';
  my $nslots = scalar @slots_avail;
  my $nrow = 1;
  my %eq = map { ($_ => $candidates_by_name{$eq_current{$_}}) } @slots_avail;
  my @hot = ();
  my @cold = ();
  my @had = ();
  my @stillhave = ();

  for my $title (@grid_flags) {
    my $hot = 0;
    my $pval_tot = 0;
    my $lite_tot = 0;
    $grid .= "\n";
    ++$nrow;
    $grid .= sprintf '%-10s ', $title;
    my $flag = $grid_flags{$title};
    for my $slot (@slots_avail) {
      my $c = '.';
      if ($flag eq 'LITE1') {
	my $r = 0;
	for my $l (1..3) { $r += $l if exists $eq{$slot}{flags}{"LITE$l"} }
	$lite_tot += $r;
	if ($r > 0) { $c = $r; $hot = 1 }
      } elsif (exists $eq{$slot}{flags}{$flag}) {
	$hot = 1;
	$c = '+';
	if (exists $is_pval_flag{$flag} && exists $eq{$slot}{pval}) {
	  my $pval = $eq{$slot}{pval};
	  $pval_tot += $pval;
	  $c = '-' if $pval < 0;
	  $c = $pval if $pval >= 0 && $pval <= 9;
	  $c = '*' if $pval >= 10;
	}
      }
      $grid .= $c;
    }
    $grid .= (exists $player_flags{$flag} ? '+' : '.');
    $hot = 1 if exists $player_flags{$flag} && !exists($is_pval_flag{$flag});

    # Row colors:  The row title will be blue for flags we originally had
    # and still have, yellow for flags we originally have but no longer
    # have, green for flags we didn't originally have but now have, and
    # white otherwise.  The row grid will simply be green for flags we have
    # and white for flags we don't.  The pval amount at the end will be
    # green for positive and red for negative; if there's an initial pval
    # for the flag, it will be displayed after the current pval in yellow
    # if it's different from the current.
    my $was_hot = (exists $init_flags{$flag});
    my @title = ("$nrow.0", "$nrow.10");

    push @hot, @title if $hot && !$was_hot;
    push @stillhave, @title if $hot && $was_hot;
    push @had, @title if !$hot && $was_hot;

    push @hot, "$nrow.11", "$nrow.${\(12+$nslots)}" if $hot;
    if ($hot || $was_hot) {
      my @pv1 = ("$nrow.${\(13+$nslots)}", "$nrow.${\(16+$nslots)}");
      my @pv2 = ("$nrow.${\(17+$nslots)}", "$nrow.${\(20+$nslots)}");

      if (exists $is_pval_flag{$flag}) {
	$grid .= fmt_pval $pval_tot;
	push @hot, @pv1 if $pval_tot >= 0;
	push @cold, @pv1 if $pval_tot < 0;
	if ($was_hot && $pval_tot != $init_flags{$flag}) {
	  $grid .= fmt_pval $init_flags{$flag};
	  push @had, @pv2;
	}
      } elsif ($flag eq 'LITE1' && $lite_tot > 0) {
	$lite_tot = 5 if $lite_tot > 5;
	$grid .= fmt_pval $lite_tot, 1;
	push @hot, @pv1;
	if ($was_hot && $lite_tot != $init_flags{$flag}) {
	  $grid .= fmt_pval $init_flags{$flag}, 1;
	  push @had, @pv2;
	}
      }
    }
  }

  $W{grid}->tagRemove('hot', '1.0' => 'end');
  $W{grid}->tagRemove('cold', '1.0' => 'end');
  $W{grid}->tagRemove('had', '1.0' => 'end');
  $W{grid}->tagRemove('stillhave', '1.0' => 'end');
  $W{grid}->delete('1.0' => 'end');
  $W{grid}->insert('1.0', $grid);
  $W{grid}->tagAdd('hot', @hot) if scalar @hot > 0;
  $W{grid}->tagAdd('cold', @cold) if scalar @cold > 0;
  $W{grid}->tagAdd('had', @had) if scalar @had > 0;
  $W{grid}->tagAdd('stillhave', @stillhave) if scalar @stillhave > 0;
}

# update_slot() -- Update displayed information based on the newly selected
# item in this equipment slot.
sub update_slot {
  my $slot = $_[0];
  # In a later version, we will check for conflicts here, like a two-handed
  # weapon with a shield.
  update_grid;
}

# flagmatch_window() -- Open a window listing all items with the specified
# object flag.
sub flagmatch_window {
  my ($w, $y) = @_;
  my $row = int($w->index("\@0,$y")) - 2;
  return if $row < 0;
  my $flag = $grid_flags{$grid_flags[$row]};
  my $text = '';

  # Just in case we accidentally selected any text in the grid, de-select it.
  $w->tagRemove('sel', '1.0' => 'end');

  for my $slot (@slots) {
    my $not_yet = 1;
    for my $name (@{$candidates{$slot} || []}) {
      my $obj = $candidates_by_name{$name};
      next if !exists($$obj{flags}{$flag});
      if ($not_yet) {
	$not_yet = 0;
	$text .= "$slot_names{$slot}:\n";
      }
      $text .= "  $name\n";
    }
  }
  chomp $text if $text;
  $text ||= 'No matches';

  $W{items_text}->Subwidget('scrolled')->delete('1.0', 'end');
  $W{items_text}->Subwidget('scrolled')->insert('1.0', $text);
  $W{items_lbl}->configure(-text => "Items that confer $flags_pretty{$flag}:");

  $W{items}->deiconify();
  $W{items}->raise();
  $W{items}->focus();
}

# show_item() -- Open a window listing all the properties of the specified
# item.
sub show_item ($) {
  my $obj = $candidates_by_name{$_[0]};
  my $lite_rad = 0;
  my @lines = ();

  for my $flag (@descr_flags) {
    if ($flag =~ /^LITE([123])$/) {
      $lite_rad += $1 if exists $$obj{flags}{$flag};
      push @lines, "Radius-$lite_rad light"
	if $flag eq 'LITE3' && $lite_rad > 0;
      next;
    }
    next if !exists($$obj{flags}{$flag});

    if (!exists($flags_pretty{$flag})) {
      push @lines, "??? $flag";
      next;
    }

    my $line = $flags_pretty{$flag};
    if (exists $is_pval_flag{$flag}) {
      my $pval = '+???';
      if (exists $$obj{pval}) {
	$pval = $$obj{pval};
	$pval *= 20 if exists $is_pval_pct_flag{$flag};
	$pval = "+$pval" if $pval >= 0;
	$pval .= '%' if exists $is_pval_pct_flag{$flag};
      }
      push @lines, "$pval $line";
    } else {
      $line = ucfirst $line;
      $line =~ s/^\*slay/\*Slay/;
      push @lines, $line;
    }
  }

  $W{info_text}->Subwidget('scrolled')->delete('1.0', 'end');
  $W{info_text}->Subwidget('scrolled')->insert('1.0', join("\n", @lines));
  $W{info_label}->configure(-text => $$obj{name});

  $W{info}->deiconify();
  $W{info}->raise();
  $W{info}->focus();
}

# show_eq_item() -- Show the properties of the item in the selected
# equipment slot.
sub show_eq_item {
  my ($w, $slot) = @_;
  show_item $eq_current{$slot};
}

# show_list_item() -- Show the properties of the selected item from the
# item list.
sub show_list_item {
  my ($w, $y) = @_;
  my $row = int($w->index("\@0,$y"));
  my $line =  $w->get("$row.0", "$row.end");
  return unless $line =~ /^  (.*)$/;
  my $obj = $1;
  show_item $obj;
}

# show_menu_item() -- Show the properties of the selected item from an
# equipment slot menu.
sub show_menu_item {
  my ($l, $w, $x, $y) = @_;
  my $obj = undef;

  $w->ButtonHack;
  if ($x >= 0 && $x <= $l->Width && $y >= 0 && $y <= $l->Height) {
    $obj = $l->get("\@$x,$y");
    $w->Popdown;
  } else {
    $w->LbClose;
  }

  show_item $obj if $obj;
}

# help_window() -- Open the help window.
sub help_window () {
  $W{help}->deiconify();
  $W{help}->raise();
  $W{help}->focus();
}

# make_text_win() -- Create a text window with specified title and optional
# label which can be popped up for later use.   The ROText and Label
# objects created within the window can be passed out by reference.
sub make_text_win ($;\$\$) {
  my ($title, $rtext, $rlabel) = @_;

  my $win = $W{main}->Toplevel;
  $win->withdraw();
  $win->title($title);

  if ($rlabel) {
    $$rlabel = $win->Label()->pack(-side => 'top', -fill => 'x');
  }

  my $fm_btn = $win->Frame->pack(-side => 'bottom', -fill => 'x');
  $fm_btn->Button(-text => 'Close', -command => sub { $win->withdraw() })
	 ->pack(-side => 'right');

  my $txt = $win->Scrolled('ROText', -setgrid => 1, -relief => 'sunken',
			   -font => [ qw(Courier 10) ],
			   -scrollbars => 'e');
  $txt->pack(-side => 'bottom', -fill => 'both');

  # UpArrow/DownArrow/PageUp/PageDown will scroll the text.
  $win->bind('<KeyPress-Up>' => sub { $txt->yviewScroll(-1, 'units') });
  $win->bind('<KeyPress-Down>' => sub { $txt->yviewScroll(1, 'units') });
  $win->bind('<KeyPress-Prior>' => sub { $txt->yviewScroll(-1, 'pages') });
  $win->bind('<KeyPress-Next>' => sub { $txt->yviewScroll(1, 'pages') });

  # The window manager's close-window button will hide the window.
  $win->protocol(WM_DELETE_WINDOW => sub { $win->withdraw() });

  $$rtext = $txt if $rtext;
  return $win;
}

# setup_windows() -- Create and populate all the program's Tk windows.
sub setup_windows () {
  $W{main}->title('ToME Equipment Optimizer');

  my $buttons = $W{main}->Frame->pack(-side => 'bottom', -fill => 'x');
  $buttons->Button(-text => 'Exit', -command => \&exit_all)
	  ->pack(-side => 'right');
  $buttons->Button(-text => 'Help', -command => \&help_window)
	  ->pack(-side => 'right');

  my $grid_wid = scalar(@slots_avail) + 20;
  $W{grid} = $W{main}->Scrolled('ROText', -setgrid => 1, -relief => 'sunken',
				-scrollbars => 'e', -width => $grid_wid,
				-fg => 'white', -bg => 'black',
				-font => [ qw(Courier 10) ]);
  $W{grid}->pack(-side => 'right', -fill => 'y');
  $W{grid}->tagConfigure('hot', -foreground => 'green');
  $W{grid}->tagConfigure('cold', -foreground => 'red');
  $W{grid}->tagConfigure('had', -foreground => 'yellow');
  $W{grid}->tagConfigure('stillhave', -foreground => 'blue');
  $W{main}->bind('Tk::ROText', '<Button-1>' => '');
  $W{grid}->bind('<Button-1>' => [ \&flagmatch_window, Ev('y') ]);

  my $sel_frame = $W{main}->Frame->pack(-side => 'left', -fill => 'both');
  my $sel_wid = 20;
  for my $names (values %candidates) {
    for my $name (@$names) {
      $sel_wid = length $name if $sel_wid < length $name;
    }
  }
  for my $slot (@slots_avail) {
    my @choices = ('(nothing)', @{$candidates{$eq_slots{$slot}} || []});
    my $sel = $sel_frame->BrowseEntry(-variable => \$eq_current{$slot},
				      -browsecmd => [ \&update_slot, $slot ],
				      -label => "$slot)",
				      -takefocus => 0,
				      -font => [ qw(Courier 10) ],
				      -width => $sel_wid,
				      -choices => \@choices);
    # Have to tunnel pretty deep here to touch the background of just the
    # entry, and not its label or button.
    $sel->Subwidget('entry')->Subwidget('entry')
	->configure(-fg => 'black', -bg => 'white');
    $sel->pack(-side => 'top');
    $sel->bind('<Button-1>' => [ \&show_eq_item, $slot ]);
    $sel->Subwidget('slistbox')->Subwidget('listbox')
	->bind('<Shift-ButtonRelease-1>' =>
	       [\&show_menu_item, $sel, Ev('x'), Ev('y')]);
  }
  $W{main}->bind('Tk::Entry', '<Button-1>' => '');
  $W{main}->bind('Tk::Entry', '<KeyPress>' => '');
  $W{main}->bind('<KeyPress-Up>' =>
		 sub { $W{grid}->yviewScroll(-1, 'units') });
  $W{main}->bind('<KeyPress-Down>' =>
		 sub { $W{grid}->yviewScroll(1, 'units') });
  $W{main}->bind('<KeyPress-Prior>' =>
		 sub { $W{grid}->yviewScroll(-1, 'pages') });
  $W{main}->bind('<KeyPress-Next>' =>
		 sub { $W{grid}->yviewScroll(1, 'pages') });

  update_grid;

  $W{info} = make_text_win 'Info', $W{info_text}, $W{info_label};

  my $h_text;
  $W{help} = make_text_win 'Help', $h_text;
  $h_text->Subwidget('scrolled')->insert('1.0', $help_text);

  $W{items} = make_text_win 'Match list', $W{items_text}, $W{items_lbl};
  $W{items_text}->bind('<Button-1>' => [ \&show_list_item, Ev('y') ]);
}

# select_file() -- Select a character dump file via a file selector dialog.
sub select_file () {
  my $fsel = $W{main}->FileSelect();
  return $fsel->Show();
}



my $file = $ARGV[0] || select_file;
exit 0 if !$file;
set_module $file;
read_info_file 'k';
mimicry_cloak_hack;
read_info_file 'a';
read_info_file 'e';
read_dump $file;
initial_flags;
setup_windows;
MainLoop;