#!/usr/bin/perl -w
no utf8;
use encoding 'euc-jp';
use strict;
use warnings;
use File::Spec;
use FileHandle;
use Tk;
use Tk::ROText;
use Tk::BrowseEntry;
use Tk::FileSelect;
use Encode;
my $font=['MS Gothic', 10, 'normal'];

# Base directory containing ToME's data files.  Adjust as necessary for
# your configuration.
my $TOME_LIB = 'c:\tome2-japanese\lib';
# 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\jp');

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 = (
    '腕力'			=> 'STR',
    '知能'			=> 'INT',
    '賢さ'			=> 'WIS',
    '器用さ'			=> 'DEX',
    '耐久力'			=> 'CON',
    '魅力'			=> 'CHA',
    '隠密能力'			=> 'STEALTH',
    '探索能力'			=> 'SEARCH',
    '赤外線視力'		=> 'INFRA',
    '採掘能力'			=> 'TUNNEL',
    'スピード'			=> 'SPEED',
    '打撃回数'			=> 'BLOWS',
    'クリティカルヒットの確率'	=> 'CRIT',
    '幸運'			=> 'LUCK',
    '呪文の効果'		=> 'SPELL',
    '最大ＭＰ'			=> 'MANA',
    '最大ＨＰ'			=> 'LIFE',
    );
my %pval_pct_flags = (
#    '呪文の効果'	=> 'SPELL',
    '最大ＭＰ'		=> 'MANA',
    '最大ＨＰ'		=> 'LIFE',
);
my %is_pval_flag = map { ($_ => 1) } values %pval_flags;
my %is_pval_pct_flag = map { ($_ => 1) } values %pval_pct_flags;
my %brand_flags = (
    '酸'	=> 'BRAND_ACID',
    '電撃'	=> 'BRAND_ELEC',
    '火炎'	=> 'BRAND_FIRE',
    '冷気'	=> 'BRAND_COLD',
    );
my %sustain_flags = (
    '腕力'	=> 'SUST_STR',
    '知能'	=> 'SUST_INT',
    '賢さ'	=> 'SUST_WIS',
    '器用さ'	=> 'SUST_DEX',
    '耐久力'	=> 'SUST_CON',
    '魅力'	=> 'SUST_CHA',
);
my %imm_flags = (
  '酸'		=> 'IM_ACID',
  '電撃'	=> 'IM_ELEC',
  '火炎'	=> 'IM_FIRE',
  '冷気'	=> 'IM_COLD',
  '地獄'	=> 'IM_NETHER',
);
my %resist_flags = (
    '生命力吸収'	=> 'HOLD_LIFE',
    '酸'		=> 'RES_ACID',
    '電撃'		=> 'RES_ELEC',
    '火炎'		=> 'RES_FIRE',
    '冷気'		=> 'RES_COLD',
    '毒'		=> 'RES_POIS',
    '閃光'		=> 'RES_LITE',
    '暗黒'		=> 'RES_DARK',
    '盲目'		=> 'RES_BLIND',
    '混乱'		=> 'RES_CONF',
    '轟音'		=> 'RES_SOUND',
    '破片'		=> 'RES_SHARDS',
    '地獄'		=> 'RES_NETHER',
    '因果混乱'		=> 'RES_NEXUS',
    'カオス'		=> 'RES_CHAOS',
    '劣化'	        => 'RES_DISEN',
);
my %esp_flags = (
    'オーク'		=> 'ESP_ORC',
    'トロル'		=> 'ESP_TROLL',
    'ドラゴン'		=> 'ESP_DRAGON',
    '蜘蛛'		=> 'ESP_SPIDER',
    'ジャイアント'	=> 'ESP_GIANT',
    'デーモン'		=> 'ESP_DEMON',
    'アンデッド'	=> 'ESP_UNDEAD',
    '邪悪なモンスター'	=> 'ESP_EVIL',
    '動物'		=> 'ESP_ANIMAL',
    'thunderlords'	=> 'ESP_THUNDERLORD',
    '善良なモンスター'	=> 'ESP_GOOD',
    '生物でないモンスター'	=> 'ESP_NONLIVING',
    'ユニーク・モンスター'	=> 'ESP_UNIQUE',
    );
my %drain_flags = (
    '魔力'	=> 'DRAIN_MANA',
    '生命力'	=> 'DRAIN_HP',
    '経験値'	=> 'DRAIN_EXP',
    );
my %ignore_flags = (
    '酸'	=> 'IGNORE_ACID',
    '電撃'	=> 'IGNORE_ELEC',
    '火炎'	=> 'IGNORE_FIRE',
    '冷気'	=> 'IGNORE_COLD',
    );
my %singletons = (
    'それは両手で持つことができる。'			=> 'COULD2H',
    'それは両手で持たなければならない。'		=> 'MUST2H',
    'それは敵を毒する。'				=> 'BRAND_POIS',
    'それはカオス的な効果を及ぼす。'			=> 'CHAOTIC',
    'それは敵からヒットポイントを吸収する。'		=> 'VAMPIRIC',
    'それは地震を起こすことができる。'			=> 'IMPACT',
    'それは非常に切れ味が鋭く敵を切断することができる。'=> 'VORPAL',
    'それは非常に切れ味が鋭く敵を出血させることができる。'	=> 'WOUNDING',
    # A duplicate of the previous, to accommodate a 2.1.2 typo.
    'それは非常に切れ味が鋭く敵を出血させることができる。'	=> 'WOUNDING',
    'それはドラゴンにとっての天敵である。'			=> 'KILL_DRAGON',
    'それはドラゴンに対して特に恐るべき力を発揮する。'		=> 'SLAY_DRAGON',
    'それはオークに対して特に恐るべき力を発揮する。'		=> 'SLAY_ORC',
    'それはトロルに対して特に恐るべき力を発揮する。'		=> 'SLAY_TROLL',
    'それはジャイアントに対して特に恐るべき力を発揮する。'	=> 'SLAY_GIANTS',
    'それはデーモンにとっての天敵である。'			=> 'KILL_DEMON',
    'それはデーモンに対して聖なる力を発揮する。'		=> 'SLAY_DEMON',
    'それはアンデッドにとっての天敵である。'			=> 'KILL_UNDEAD',
    'それはアンデッドに対して聖なる力を発揮する。'		=> 'SLAY_UNDEAD',
    'それは邪悪なる存在に対して聖なる力で攻撃する。'		=> 'SLAY_EVIL',
    'それは自然界の動物に対して特に恐るべき力を発揮する。'	=> 'SLAY_ANIMAL',
    'それはあなたを透明にする。'				=> 'INVIS',
    'それは麻痺に対する完全な免疫を授ける。'			=> 'FREE_ACT',
    'それは恐怖への完全な耐性を授ける。'			=> 'RES_FEAR',
    'それはあなたを幽体化する。'				=> 'WRAITH',
    'それは水中で呼吸することを可能にする。'		=> 'WATER_BREATH',
    'それは空気のないところで呼吸することを可能にする。'		=> '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',
    'それは宙に浮くことを可能にする。'				=> 'FEATHER',
    'それは空を飛ぶことを可能にする。'				=> 'FLY',
    'それは高い山に登ることを可能にする。'			=> 'CLIMB',
    'それは透明なモンスターを見ることを可能にする。'		=> 'SEE_INVIS',
    'それはテレパシー能力を授ける。'				=> 'ESP_ALL',
    'それはあなたの新陳代謝を遅くする。'				=> 'SLOW_DIGEST',
    'それは体力回復力を強化する。'			=> 'REGEN',
    'それは矢やボルトを反射する。'			=> 'REFLECT',
    'それは炎のバリアを張る。'				=> 'SH_FIRE',
    'それは電気のバリアを張る。'			=> 'SH_ELEC',
    'それは反魔法バリアを張る。'			=> 'NO_MAGIC',
    'それは反魔法フィールドを生成する。'			=> 'ANTIMAGIC_50',
    'それはテレポートを邪魔する。'				=> 'NO_TELE',
    'それは矢／ボルト／弾をより強力に発射することができる。'			=> 'XTRA_MIGHT',
    'それは矢／ボルト／弾を非常に早く発射することができる。'			=> 'XTRA_SHOTS',
    'それは神々に祝福されている。'			=> 'BLESSED',
    'それは全てのアイテムを鑑定する。'			=> 'AUTO_ID',
    'それはランダムなテレポートを引き起こす。'			=> 'TELEPORT',
    'それは付近のモンスターを怒らせる。'			=> 'AGGRAVATE',
    'それは攻撃できない。'					=> 'NEVER_BLOW',
    'それはあなたを黒い息で満たす。'			=> 'BLACK_BREATH',
    'それは永遠の呪いがかけられている。'				=> 'PERMA_CURSE',
    'それは強力な呪いがかけられている。'				=> 'HEAVY_CURSE',
    'それは呪われている。'					=> 'CURSE',
    'それは太古の忌まわしい呪いがかかっている。'			=> 'TY_CURSE',
    'それは太古のモルゴスの呪いがかかっている。'		=> 'DG_CURSE',
    'それはモンスターを複製する。'				=> 'CLONE',
    'それは呪われていると手放すことができない。'			=> 'CURSE_NO_DROP',
    'それはそれ自身に呪いをかけなおすことができる。'				=> 'AUTO_CURSE',
    'それはモルグルの存在によって破壊されない。'	=> 'RES_MORGUL',
    'それは三つの究極の武器の一つだ。'	=> 'ULTIMATE',
    'それは究極の鎧だ。'				=> 'ULTIMATE',
    );
my @ignore = (
    'それはより多くの魔力を蓄えることができる。',
    'それはより多くの魔力を蓄えることができる。',
    'それはより速く魔法を使うことができる。',
    'それは魔力を回復するのが速い。',
    'それは見つかりにくい。',
    'それは自動的に再装備できる。',
    'それは自動的に再装備する。',
    'それは幽霊に効果的である。',
    'それはモンスターをあなたのそばへ引き寄せる。',
    'それはドラゴンにしか効果がない。',
    'それは悪魔にしか効果がない。',
    'それはアンデッドにしか効果がない。',
    'それは動物にしか効果がない。',
    'それは邪悪なる存在にしか効果がない。',
);
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	=> '打撃用',
    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 %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 = (
    '+腕力'	=> 'STR',
    '+知能'	=> 'INT',
    '+賢さ'	=> 'WIS',
    '+器用'	=> 'DEX',
    '+耐久'	=> 'CON',
    '+魅力'	=> 'CHA',
    '最大MP増加'	=> 'MANA',
    '+魔法効果'	=> 'SPELL',
    '+隠密行動'	=> 'STEALTH',
    '+探索'	=> 'SEARCH',
    '+赤外線視'	=> 'INFRA',
    '+掘削'	=> 'TUNNEL',
    '+幸運'	=> 'LUCK',
    '+スピード'	=> 'SPEED',
    '+打撃回数'	=> 'BLOWS',
    'カオス効果'	=> 'CHAOTIC',
    '吸血'	=> 'VAMPIRIC',
    '動物 倍打'	=> 'SLAY_ANIMAL',
    '邪悪 倍打'	=> 'SLAY_EVIL',
    '不死 倍打'	=> 'SLAY_UNDEAD',
    '悪魔 倍打'	=> 'SLAY_DEMON',
    'オーク倍打'	=> 'SLAY_ORC',
    'トロル倍打'	=> 'SLAY_TROLL',
    '巨人 倍打'	=> 'SLAY_GIANT',
    '龍 倍打'	=> 'SLAY_DRAGON',
    '龍 倍倍打'	=> 'KILL_DRAGON',
    '悪魔倍倍打'	=> 'KILL_DEMON',
    '不死倍倍打'	=> 'KILL_UNDEAD',
    '鋭刃'	=> 'VORPAL',
    '地震発生'	=> 'IMPACT',
    '毒属性攻撃'	=> 'BRAND_POIS',
    '酸属性攻撃'	=> 'BRAND_ACID',
    '雷属性攻撃'	=> 'BRAND_ELEC',
    '火属性攻撃'	=> 'BRAND_FIRE',
    '冷属性攻撃'	=> 'BRAND_COLD',
    '腕力 保持'	=> 'SUST_STR',
    '知能 保持'	=> 'SUST_INT',
    '賢さ 保持'	=> 'SUST_WIS',
    '器用 保持'	=> 'SUST_DEX',
    '耐久 保持'	=> 'SUST_CON',
    '魅力 保持'	=> 'SUST_CHR',
    '不可視'	=> 'INVIS',
    '最大HP増加'	=> 'LIFE',
    '酸免疫'	=> 'IM_ACID',
    '電撃免疫'	=> 'IM_ELEC',
    '火炎免疫'	=> 'IM_FIRE',
    '冷気免疫'	=> 'IM_COLD',
    'Sens Fire'	=> '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',
    '防テレポ'	=> 'NO_TELE',
    '反魔法'	=> 'NO_MAGIC',
    '幽体化'	=> 'WRAITH',
    '邪悪な怨念'	=> 'TY_CURSE',
    'Easy Know'	=> 'EASY_KNOW',
    'Hide Type'	=> 'HIDE_TYPE',
    'Show Mods'	=> 'SHOW_MODS',
    'Insta Art'	=> 'INSTA_ART',
    '浮遊'	=> 'FEATHER',
    '光源'	=> 'LITE1',
    '透明視認'	=> 'SEE_INVIS',
    '遅消化'	=> 'SLOW_DIGEST',
    '急回復'	=> 'REGEN',
    '強力射撃'	=> 'XTRA_MIGHT',
    '高速射撃'	=> 'XTRA_SHOTS',
    'Ign Acid'	=> 'IGNORE_ACID',
    'Ign Elec'	=> 'IGNORE_ELEC',
    'Ign Fire'	=> 'IGNORE_FIRE',
    'Ign Cold'	=> 'IGNORE_COLD',
    '始動'	=> 'ACTIVATE',
    '経験吸収'	=> 'DRAIN_EXP',
    'テレポート'	=> 'TELEPORT',
    '反感'	=> 'AGGRAVATE',
    '祝福'	=> 'BLESSED',
    '呪い'	=> 'CURSED',
    '重い呪い'	=> 'HEAVY_CURSE',
    '永遠の呪い'	=> 'PERMA_CURSE',
    '打撃無'	=> 'NEVER_BLOW',
    '予知'	=> 'PRECOGNITION',
    '黒い息'	=> 'BLACK_BREATH',
    '再充填'	=> 'RECHARGE',
    '飛行'	=> 'FLY',
    'モルゴス呪'	=> 'DG_CURSE',
    '登攀'	=> 'CLIMB',
    'Imm Neth'	=> 'IM_NETHER',
    'Sentient'	=> 'LEVELS',
    'オーク ESP'	=> 'ESP_ORC',
    'トロル ESP'	=> 'ESP_TROLL',
    '龍 ESP'	=> 'ESP_DRAGON',
    '巨人 ESP'	=> 'ESP_GIANT',
    '悪魔 ESP'	=> 'ESP_DEMON',
    '不死 ESP'	=> 'ESP_UNDEAD',
    '邪悪 ESP'	=> 'ESP_EVIL',
    '動物 ESP'	=> 'ESP_ANIMAL',
    'TLord.ESP'	=> 'ESP_THUNDERLORD',
    '善良 ESP'	=> 'ESP_GOOD',
    '無生物 ESP'	=> 'ESP_NONLIVING',
    'ユニ ESP'	=> 'ESP_UNIQUE',
    '完全 ESP'	=> 'ESP_ALL',
    );
my %flags_pretty = (
  COULD2H		=> '両手で持つことができる',
    MUST2H		=> '両手で持たなければならない',
    LITE1			=> '半径1の光源',
    LITE2			=> '半径2の光源',
    LITE3			=> '半径3の光源',
    STR			=> '腕力',
    INT			=> '知力',
    WIS			=> '賢さ',
    DEX			=> '器用さ',
    CON			=> '耐久力',
    CHA			=> '魅力',
    STEALTH		=> '隠密能力',
    SEARCH		=> '探索能力',
    INFRA			=> '赤外線視力',
    TUNNEL		=> '採掘能力',
    LUCK			=> '幸運',
    SPEED			=> 'スピード',
    BLOWS			=> '打撃回数',
    CRIT			=> 'クリティカルヒットの確率',
    MANA			=> '最大MP',
    SPELL			=> '呪文の効果',
    LIFE			=> '最大HP',
    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	=> 'それはthunderlordsの存在を感知する能力を授ける',
    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 @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 = (
    '+腕力', '+知能', '+賢さ', '+器用', '+耐久', '+魅力',
    '最大MP増加', '+魔法効果', '+隠密行動', '+探索', '+赤外線視',
    '+掘削', '+幸運', '+スピード', '+打撃回数', 'カオス効果', '吸血',
    '動物 倍打', '邪悪 倍打', '不死 倍打', '悪魔 倍打', 'オーク倍打',
    'トロル倍打', '巨人 倍打', '龍 倍打', '龍 倍倍打', '悪魔倍倍打',
    '不死倍倍打', '鋭刃',
    '地震発生', '毒属性攻撃', '酸属性攻撃', '雷属性攻撃', '火属性攻撃',
    '冷属性攻撃', '腕力 保持', '知能 保持', '賢さ 保持', '器用 保持',
    '耐久 保持', '魅力 保持', '不可視', '最大HP増加', '酸免疫',
    '電撃免疫', '火炎免疫', '冷気免疫', 'Sens Fire', '反射', '耐麻痺',
    '経験値保持', '耐酸', '耐電撃', '耐火炎', '耐冷気', '耐毒',
    '耐恐怖', '耐閃光', '耐暗黒', '耐盲目', '耐混乱', '耐轟音',
    '耐破片', '耐地獄', '耐因混', '耐カオ', '耐劣化',
    '火炎オーラ', '電気オーラ', '防テレポ', '反魔法', '幽体化',
    '邪悪な怨念', '浮遊', '光源', '透明視認', '遅消化', '急回復',
    '強力射撃', '高速射撃', '始動', '経験吸収', 'テレポート',
    '反感', '祝福', '呪い', '重い呪い', '永遠の呪い', '打撃無',
    '予知', '黒い息', '再充填', '飛行', 'モルゴス呪', '登攀',
    'Imm Neth', 'オーク ESP', 'トロル ESP', '龍 ESP', '巨人 ESP',
    '悪魔 ESP', '不死 ESP', '邪悪 ESP', '動物 ESP', 'TLord.ESP',
    '善良 ESP', '無生物 ESP', 'ユニ ESP', '完全 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";
  binmode $fh, ":encoding(sjis)";
  
  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 $tmpl = (/^J:(.*)$/m, $1);
      my $name = $tmpl;
      $name =~ s/^\& //;
      $name =~ s/\~//;
      if (!/\bINSTA_ART\b/) {
        $name = "$name"."の指輪" if $tval == 45;
        $name = "$name"."のアミュレット" if $tval == 40;
        $name = "$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";
        if ( $name =~ /^(『.*』)$/){
          $name = "★" . $base_by_tsval{$tsval} . $1;
        } else {
          $name = "★" . $name . $base_by_tsval{$tsval};
        }
        
      }
      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 = "$plural"."の指輪" if $tval == 45;
          $plural = "$plural"."のアミュレット" if $tval == 40;
          $plural = "$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);
      my $name = (/^J:(.*)$/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');
  my @names = ('鼠の毛皮', '羽のクローク', '狼の毛皮', '蜘蛛の糸',
	       'エントの樹皮');

  for my $name (@names) {
      my $plural = $name;
      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 !/.*\Q$name\E.*/;
	#next if !/.+\s.+/;
	return copy_entry $artifacts{$name};
    }
    
    # Then try to match base items.
    for my $base (sort by_length_desc keys %base_items) {
	next if !/.*\Q$base\E.*/;
	my $obj = copy_entry $base_items{$base};
	return $obj if /^\Q☆\E.*$/;
	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/;
		    next if !(/.*\Q$type\E.*/ && /.*\Q$base\E.*/);
		    $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 && !/^$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 '上昇させる') {
	# Special case:  pull out the pval as well as the flags.
	#return if !s/\s*It (in|de)creases your (.*?) by (\d+)(\%?)\.\s*//;
	return if !s/\s*それは(.*?)を\s*(\d+)(\%?)\s*(上昇|低下)させる。\s*//;
	$flags = $1;
	#    my ($sgn, $pval, $pct) = ($1, $3, $4);
	my ($sgn, $pval, $pct) = ($4, $2, $3);
	$pval /= 20 if $pct;
	$pval = -$pval if $sgn eq '低下';
	warn "Pval mismatch ($$obj{pval} vs. $pval)\n"
	    if exists $$obj{pval} && $$obj{pval} != $pval;
	$$obj{pval} = $pval;
    } elsif ($prefix eq 'を維持する') {
	return if !s/\s*それはあなたの(.*?)$prefix。\s*//;
	$flags = $1;
    } else {
	return if !s/\s*それは(.*?)$prefix。\s*//;
	$flags = $1;
    }
    #上記以外を拾う条件追加

    my @flags = split /、\s*|\s*、\s*/, $flags;
    @flags = split /、\s*|\s*、\s*/, $flags
	if $prefix eq 'では傷つかない';
    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.
  # それは･･･アイテムだ。の取得場所を示す文を削除
  # 最後の文がそれに相当すると仮定
  if($_ ne ""){
    @_ = split(/。/, $_);
    pop @_;
    $_ = join("。",@_)."。";
  }

  #無視したいclauseを削除
  for my $bit (@ignore) { s/\s*$bit\s*// }
  # A few things we can't handle yet.
  if (s/\s*それには意識がある。\s*//) {
    # ???
  }
  #  if (s/\s*It can be activated for .*? if it is being worn\.\s*//) {
  if (s/\s*それを(装備して|)始動したときの効果は.*?。\s*//) {
    # ???
  }
  if (s/\s*それを装備していれば.*?の力を与える。\s*//) {
    # ???
  }
  if (s/\s*それは(永遠なる|燃料補給によって)明かり\(半径\s*(\d+)\)を授ける。\s*//) {
    my ($rad, $perm) = ($2, $1);
    $$obj{flags}{FUEL_LITE} = 1 if $perm eq '燃料補給によって';
    if ($rad > 3) {
      $$obj{flags}{"LITE${\($rad-3)}"} = $$obj{flags}{LITE3} = 1;
    } else {
      $$obj{flags}{"LITE$rad"} = 1;
    }
  }
  if (s/\s*それはあなたを特に炎に対して弱くする。\s*//) {
    $$obj{flags}{SENS_FIRE} = 1;
  }
  if (s/\s*それは時空連続体が歪められるのを阻止する。\s*//) {
    # ???
  }
  if (s/\s*それは呪文を格納することが出来る。\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', '上昇させる', %pval_flags;
  flags_sentence %$obj, 'pval', '上昇させる', %pval_pct_flags;
  flags_sentence %$obj, 'weapon-brand', 'によって大きなダメージを与える',
  %brand_flags;
  flags_sentence %$obj, 'sustain-stat', 'を維持する', %sustain_flags;
  flags_sentence %$obj, 'immunity', 'に対する完全な免疫を授ける', %imm_flags;
  flags_sentence %$obj, 'resist', 'への耐性を授ける', %resist_flags;
  flags_sentence %$obj, 'ESP', 'の存在を感知する能力を授ける',
  %esp_flags;
  flags_sentence %$obj, 'drain', 'を吸収する', %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', 'では傷つかない', %ignore_flags;
  flags_sentence %$obj, 'ignore', 'では傷つかない', %ignore_flags;
  flags_sentence %$obj, 'ignore', 'では傷つかない', %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 "$_[0]が開けません $!\n";
    my $firstline = <IN>;
    close IN;

    print "Processing ToME character dump...\n" and return
	if $firstline =~ /ToME \d\.\d\.\d-J\d.\d.\d/;

    # 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 "$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 '..' || $mod eq 'jp';
	    next if !($mod eq 'modules.lua');
	    # 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 "${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";
  binmode(IN, ":encoding(sjis) :crlf :utf8");
  $_ = <IN>;
  while (<IN>) {
    chomp;
    last if /マゾム館のアイテム/;
    next if m#^//#;
    $cur_eq = 1 if /キャラクタの装備/;
    $cur_eq = 0 if /キャラクタの持ち物/;

    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;
    # \p{Han}とか使って分けたら？
    $grid .= sprintf('%-16s', encode('euc-jp',$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 $diff = length($title)-length(encode('euc-jp',$title));
    my @title = ("$nrow.0", "$nrow.${\(16+$diff)}");

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

    push @hot, "$nrow.${\(17+$diff)}", "$nrow.${\(18+$nslots+$diff)}" if $hot;
    if ($hot || $was_hot) {
      my @pv1 = ("$nrow.${\(19+$nslots+$diff)}", "$nrow.${\(22+$nslots+$diff)}");
      my @pv2 = ("$nrow.${\(23+$nslots+$diff)}", "$nrow.${\(26+$nslots+$diff)}");

      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;
	  }
      }
    }
  }
  utf8::decode($grid);
  $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',
                           -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');
  $W{main}->optionAdd('*font' => $font);

  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) + 30;
  $W{grid} = $W{main}->Scrolled('ROText', -setgrid => 1, -relief => 'sunken',
				-scrollbars => 'e', -width => $grid_wid,
				-fg => 'white', -bg => 'black');
  $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 = 70;
  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,
				      -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;
