#!/usr/bin/perl -w =pod =head1 NAME autoparse - Convert ToME automatizer files between XML and ATP format =head1 SYNTAX autoparse [ |- [ |- ] ] =head1 DESCRIPTION C parses and translates automatizer rules files used by the Angband variant Tales of Middle Earth (ToME). It converts between ToME's standard XML-based rules language and C's own rules language, ATP; which conversion is done is determined automatically by examining the input. The input and output filenames may be omitted or specified as 'C<->', defaulting to standard in and standard out, respectively. =head1 ATP SYNTAX The ATP language is intended to be human-readable, so its syntax is fairly English-like. The following example should demonstrate most of its intricacies: module "Fred"; # Rules after this should be used with the Fred module. # Comments begin with a '#' and extend to end of line. rule "example rule" # Rule name is a string, and is required destroy if # Rule type is 'destroy' or 'pickup' not (race = "Elf" or class = Mage or subrace = "LostSoul") and (tval = TV_RING, TV_ROD, TV_BOOTS or name = "Scroll of Nothing" or contain = "potion of restore" or tval = 21 # = TV_HAFTED and sval = SV_CLUB-SV_MACE, 8, SV_FLAIL, 18-20) and skill "Hafted-mastery" = 25-50 and level = 20-30; # Rule ends with ';'. module; # Rules after this should be used with standard ToME. The 'C' command specifies that all subsequent rules should be used with the specified module. By default (or after the command 'C', with no module name specified), rules aren't associated with any module, and thus are only used with ToME itself. The special module name "C" specifies that the rules should be used with ToME and all modules. There are three type of rules: 'C', 'C' and 'C', which do exactly what they sound like they do. For inscribing rules, the inscription to be added to the item is defined in a string after the 'C' token, as in: rule "inscribe oil" inscribe "@F1" if name = "Flask of oil"; The meat of the rule is a collection of clauses that describe conditions that must be satisfied for the rule to match: =over 4 =item race Required character race. Value type is a string or token (a single "word" of alphanumeric characters, with no space or '-'). =item subrace Required character subrace. Value type is a string or token. =item class Required character class. Value type is a string or token. =item name Exact name of the item to be matched. Value type is a string, case-insensitive. =item contain Text contained in the name of the item[s] to be matched. Value type is a string, case-insensitive. =item symbol On-screen symbol of the item[s] to be matched. Value type is a single-character string. =item state Whether or not the item has been identified. Value type is one of 'C' or 'C'. =item status Pseudo-ID-like status of the item. Value type is a string, one of the following: "very bad" Corresponds to {worthless} pseudo-ID "bad" Corresponds to {cursed} pseudo-ID "average" Corresponds to {average} pseudo-ID "good" Corresponds to {good} pseudo-ID "very good" Corresponds to {excellent} pseudo-ID "special" Corresponds to {special} pseudo-ID "terrible" Corresponds to {terrible} pseudo-ID "empty" Used for chests =item tval The internal tval, or object type, of the item. Value type is a number or a C symbol as listed in C. =item sval The internal sval, or object subtype, of the item. Value type is a number or a C symbol as listed in C, or a range of values specified in the form CminE-EmaxE>. =item level Required character level. Value type is a numeric range specified in the form CminE-EmaxE>. =item skill Required skill level. This clause has two value types: the skill name, specified as a string before the 'C<=>', and a numeric range, specified in the form CminE-EmaxE> after the 'C<=>'. =item ability Required ability. Value type is the ability name, specified as a string. =item inscribed Text contained in the inscription on the item[s] to be matched. Value type is a string, case-insensitive. Requires ToME 2.2.0 or higher. =item discount The item's discount. Value type is a numeric range specified in the form CminE-EmaxE>. Requires ToME 2.2.0 or higher. =back For all clauses except C, C and C, a comma-separated list of values may be specified; this is equivalent to several separate clauses joined by C. There are two additional clauses with different syntax; they must be followed by a parenthesized clause (or group of clauses combined with C and C in the usual way), and specifies that some I item or items must match the specified conditions: =over 4 =item inventory Some item in the player's inventory must match the specified conditions. =item equipment Some item in the player's equipment must match the specified conditions. =back Note that these extra clauses require the 'tome-autoinv' patch, available from (). Clauses can then be combined in the obvious way with C and C. Comma-separated lists have higher precedence for grouping purposes than C, which in turn has higher precedence than C; so, for instance, rule "yeeg" destroy if race=Orc and class=Mage or race=Ent and class=Warrior; translates to: clean_ruleset() add_ruleset [[ Orc Mage Ent Warrior ]] and: rule "blarg" destroy if class=Mage or race=Ent, Orc and level=12-50; translates to: clean_ruleset() add_ruleset [[ Mage Ent Orc ]] If in doubt, you can use C to convert your ATP to XML and back to ATP, which will be fully parenthesized as the parser grouped it. When you are satisfied with your converted ruleset, you can copy it over ToME's original C (keeping a backup copy of the original, just in case); ToME will use your rules the next time it is run. =head1 BUGS =over 4 =item C makes no attempt to format its ATP output prettily, instead printing the rule in one single long line. =back =head1 WARNING B At worst, it may generate malformed XML which will choke ToME's Lua XML parser, and you won't get all (or any) of your automatizer rules. Should this happen, save and exit, copy back the original C rules file (which you I keep a copy of, right?), and resume your game. =cut # Changes: # # 2007-01-01: # Output ATP in new "wrapped" Lua-executable form, and accept same as # input. # # 2006-12-31: # The 'discount' clause shouldn't take sval tokens as value types... :-} # # 2004-09-05: # New command 'module' to associate all subsequent rules with the # specified module. # # 2004-05-05: # Handle clauses 'inventory' and 'equipment' from my 'tome-autoinv' # patch (). # # 2003-09-14: # Added support for inscribe rules and the 'ability' clause. # # 2003-08-23: # Added some missing tvals and svals, and removed some duplicated tvals. # # 2003-06-17: # - The 'inscribed' and 'discount' clauses are in the official release as # of ToME 2.2.0; updated documentation accordingly. In particular, the # patch mentioned below is no longer necessary. # - Updated race/subrace/class lists, adding Geomancer and Bard and # removing some extraneous spaces. Retained the Elementalist class # from 2.1.2 for backward compatibility. # # 2003-06-07: # Handle clauses 'inscribed' and 'discount' from my 'tome-autoinsc' # patch (). use XML::Parser; # Various kinds of input we need to be able to recognize. my $chars = ']()=;,-'; my @tvals = qw(TV_SKELETON TV_BOTTLE TV_BATERIE TV_SPIKE TV_MSTAFF TV_CHEST TV_PARCHMENT TV_PARCHEMENT TV_CORPSE TV_EGG TV_JUNK TV_TOOL TV_INSTRUMENT TV_BOOMERANG TV_SHOT TV_ARROW TV_BOLT TV_BOW TV_DIGGING TV_HAFTED TV_POLEARM TV_SWORD TV_AXE TV_BOOTS TV_GLOVES TV_HELM TV_CROWN TV_SHIELD TV_CLOAK TV_SOFT_ARMOR TV_HARD_ARMOR TV_DRAG_ARMOR TV_LITE TV_AMULET TV_RING TV_TRAPKIT TV_STAFF TV_WAND TV_ROD TV_ROD_MAIN TV_SCROLL TV_POTION TV_POTION2 TV_FLASK TV_FOOD TV_HYPNOS TV_GOLD TV_RANDART TV_RUNE1 TV_RUNE2 TV_BOOK TV_SYMBIOTIC_BOOK TV_MUSIC_BOOM TV_DRUID_BOOK TV_DAEMON_BOOK); my @svals = qw(SV_TOOL_CLIMB SV_PORTABLE_HOLE SV_MSTAFF SV_AMMO_LIGHT SV_AMMO_NORMAL SV_AMMO_HEAVY SV_FLUTE SV_BANJO SV_LUTE SV_MANDOLIN SV_DRUM SV_HARP SV_HORN SV_TRAPKIT_SLING SV_TRAPKIT_BOW SV_TRAPKIT_XBOW SV_TRAPKIT_POTION SV_TRAPKIT_SCROLL SV_TRAPKIT_DEVICE SV_BOOM_S_WOOD SV_BOOM_WOOD SV_BOOM_S_METAL SV_BOOM_METAL SV_SLING SV_SHORT_BOW SV_LONG_BOW SV_LIGHT_XBOW SV_HEAVY_XBOW SV_SHOVEL SV_GNOMISH_SHOVEL SV_DWARVEN_SHOVEL SV_PICK SV_ORCISH_PICK SV_DWARVEN_PICK SV_MATTOCK SV_CLUB SV_WHIP SV_QUARTERSTAFF SV_NUNCHAKU SV_MACE SV_BALL_AND_CHAIN SV_WAR_HAMMER SV_LUCERN_HAMMER SV_THREE_PIECE_ROD SV_MORNING_STAR SV_FLAIL SV_LEAD_FILLED_MACE SV_TWO_HANDED_FLAIL SV_GREAT_HAMMER SV_MACE_OF_DISRUPTION SV_GROND SV_HATCHET SV_CLEAVER SV_LIGHT_WAR_AXE SV_BEAKED_AXE SV_BROAD_AXE SV_BATTLE_AXE SV_GREAT_AXE SV_LOCHABER_AXE SV_SLAUGHTER_AXE SV_SPEAR SV_SICKLE SV_AWL_PIKE SV_TRIDENT SV_FAUCHARD SV_BROAD_SPEAR SV_PIKE SV_GLAIVE SV_HALBERD SV_GUISARME SV_SCYTHE SV_LANCE SV_TRIFURCATE_SPEAR SV_HEAVY_LANCE SV_SCYTHE_OF_SLICING SV_BROKEN_DAGGER SV_BROKEN_SWORD SV_DAGGER SV_MAIN_GAUCHE SV_RAPIER SV_SMALL_SWORD SV_BASILLARD SV_SHORT_SWORD SV_SABRE SV_CUTLASS SV_KHOPESH SV_TULWAR SV_BROAD_SWORD SV_LONG_SWORD SV_SCIMITAR SV_KATANA SV_BASTARD_SWORD SV_GREAT_SCIMITAR SV_CLAYMORE SV_ESPADON SV_TWO_HANDED_SWORD SV_FLAMBERGE SV_EXECUTIONERS_SWORD SV_ZWEIHANDER SV_BLADE_OF_CHAOS SV_SHADOW_BLADE SV_BLUESTEEL_BLADE SV_DARK_SWORD SV_SMALL_LEATHER_SHIELD SV_SMALL_METAL_SHIELD SV_LARGE_LEATHER_SHIELD SV_LARGE_METAL_SHIELD SV_DRAGON_SHIELD SV_SHIELD_OF_DEFLECTION SV_HARD_LEATHER_CAP SV_METAL_CAP SV_IRON_HELM SV_STEEL_HELM SV_DRAGON_HELM SV_IRON_CROWN SV_GOLDEN_CROWN SV_JEWELED_CROWN SV_MORGOTH SV_PAIR_OF_SOFT_LEATHER_BOOTS SV_PAIR_OF_HARD_LEATHER_BOOTS SV_PAIR_OF_METAL_SHOD_BOOTS SV_CLOAK SV_ELVEN_CLOAK SV_FUR_CLOAK SV_SHADOW_CLOAK SV_SET_OF_LEATHER_GLOVES SV_SET_OF_GAUNTLETS SV_SET_OF_CESTI SV_FILTHY_RAG SV_ROBE SV_PAPER_ARMOR SV_SOFT_LEATHER_ARMOR SV_SOFT_STUDDED_LEATHER SV_HARD_LEATHER_ARMOR SV_HARD_STUDDED_LEATHER SV_RHINO_HIDE_ARMOR SV_CORD_ARMOR SV_PADDED_ARMOR SV_LEATHER_SCALE_MAIL SV_LEATHER_JACK SV_STONE_AND_HIDE_ARMOR SV_THUNDERLORD_SUIT SV_RUSTY_CHAIN_MAIL SV_RING_MAIL SV_METAL_SCALE_MAIL SV_CHAIN_MAIL SV_DOUBLE_RING_MAIL SV_AUGMENTED_CHAIN_MAIL SV_DOUBLE_CHAIN_MAIL SV_BAR_CHAIN_MAIL SV_METAL_BRIGANDINE_ARMOUR SV_SPLINT_MAIL SV_PARTIAL_PLATE_ARMOUR SV_METAL_LAMELLAR_ARMOUR SV_FULL_PLATE_ARMOUR SV_RIBBED_PLATE_ARMOUR SV_MITHRIL_CHAIN_MAIL SV_MITHRIL_PLATE_MAIL SV_ADAMANTITE_PLATE_MAIL SV_DRAGON_BLACK SV_DRAGON_BLUE SV_DRAGON_WHITE SV_DRAGON_RED SV_DRAGON_GREEN SV_DRAGON_MULTIHUED SV_DRAGON_SHINING SV_DRAGON_LAW SV_DRAGON_BRONZE SV_DRAGON_GOLD SV_DRAGON_CHAOS SV_DRAGON_BALANCE SV_DRAGON_POWER SV_LITE_TORCH SV_LITE_LANTERN SV_LITE_TORCH_EVER SV_LITE_DWARVEN SV_LITE_FEANORIAN SV_LITE_GALADRIEL SV_LITE_ELENDIL SV_LITE_THRAIN SV_LITE_UNDEATH SV_LITE_PALANTIR SV_ANCHOR_SPACETIME SV_STONE_LORE SV_AMULET_DOOM SV_AMULET_TELEPORT SV_AMULET_ADORNMENT SV_AMULET_SLOW_DIGEST SV_AMULET_RESIST_ACID SV_AMULET_SEARCHING SV_AMULET_BRILLANCE SV_AMULET_CHARISMA SV_AMULET_THE_MAGI SV_AMULET_REFLECTION SV_AMULET_CARLAMMAS SV_AMULET_INGWE SV_AMULET_DWARVES SV_AMULET_NO_MAGIC SV_AMULET_NO_TELE SV_AMULET_RESISTANCE SV_AMULET_NOTHING SV_AMULET_SERPENT SV_AMULET_TORIS_MEJISTOS SV_AMULET_TRICKERY SV_AMULET_DEVOTION SV_AMULET_WEAPONMASTERY SV_AMULET_WISDOM SV_AMULET_INFRA SV_AMULET_SPELL SV_RING_WOE SV_RING_AGGRAVATION SV_RING_WEAKNESS SV_RING_STUPIDITY SV_RING_TELEPORTATION SV_RING_SPECIAL SV_RING_SLOW_DIGESTION SV_RING_FEATHER_FALL SV_RING_RESIST_FIRE SV_RING_RESIST_COLD SV_RING_SUSTAIN_STR SV_RING_SUSTAIN_INT SV_RING_SUSTAIN_WIS SV_RING_SUSTAIN_DEX SV_RING_SUSTAIN_CON SV_RING_SUSTAIN_CHR SV_RING_PROTECTION SV_RING_ACID SV_RING_FLAMES SV_RING_ICE SV_RING_RESIST_POIS SV_RING_FREE_ACTION SV_RING_SEE_INVIS SV_RING_SEARCHING SV_RING_STR SV_RING_INT SV_RING_DEX SV_RING_CON SV_RING_ACCURACY SV_RING_DAMAGE SV_RING_SLAYING SV_RING_SPEED SV_RING_BARAHIR SV_RING_TULKAS SV_RING_NARYA SV_RING_NENYA SV_RING_VILYA SV_RING_POWER SV_RING_RES_FEAR SV_RING_RES_LD SV_RING_RES_NETHER SV_RING_RES_NEXUS SV_RING_RES_SOUND SV_RING_RES_CONFUSION SV_RING_RES_SHARDS SV_RING_RES_DISENCHANT SV_RING_RES_CHAOS SV_RING_RES_BLINDNESS SV_RING_LORDLY SV_RING_ATTACKS SV_RING_NOTHING SV_RING_PRECONITION SV_RING_FLAR SV_RING_INVIS SV_RING_FLYING SV_RING_WRAITH SV_RING_ELEC SV_RING_CRIT SV_RING_SPELL SV_STAFF_SCHOOL SV_STAFF_NOTHING SV_WAND_SCHOOL SV_WAND_NOTHING SV_ROD_NOTHING SV_ROD_DETECT_DOOR SV_ROD_IDENTIFY SV_ROD_RECALL SV_ROD_ILLUMINATION SV_ROD_MAPPING SV_ROD_DETECTION SV_ROD_PROBING SV_ROD_CURING SV_ROD_HEALING SV_ROD_RESTORATION SV_ROD_SPEED SV_ROD_TELEPORT_AWAY SV_ROD_DISARMING SV_ROD_LITE SV_ROD_SLEEP_MONSTER SV_ROD_SLOW_MONSTER SV_ROD_DRAIN_LIFE SV_ROD_POLYMORPH SV_ROD_ACID_BOLT SV_ROD_ELEC_BOLT SV_ROD_FIRE_BOLT SV_ROD_COLD_BOLT SV_ROD_ACID_BALL SV_ROD_ELEC_BALL SV_ROD_FIRE_BALL SV_ROD_COLD_BALL SV_ROD_HAVOC SV_ROD_DETECT_TRAP SV_ROD_HOME SV_ROD_WOODEN SV_ROD_COPPER SV_ROD_IRON SV_ROD_ALUMINIUM SV_ROD_SILVER SV_ROD_GOLDEN SV_ROD_MITHRIL SV_ROD_ADMANTITE SV_SCROLL_DARKNESS SV_SCROLL_AGGRAVATE_MONSTER SV_SCROLL_CURSE_ARMOR SV_SCROLL_CURSE_WEAPON SV_SCROLL_SUMMON_MONSTER SV_SCROLL_SUMMON_UNDEAD SV_SCROLL_SUMMON_MINE SV_SCROLL_TRAP_CREATION SV_SCROLL_PHASE_DOOR SV_SCROLL_TELEPORT SV_SCROLL_TELEPORT_LEVEL SV_SCROLL_WORD_OF_RECALL SV_SCROLL_IDENTIFY SV_SCROLL_STAR_IDENTIFY SV_SCROLL_REMOVE_CURSE SV_SCROLL_STAR_REMOVE_CURSE SV_SCROLL_ENCHANT_ARMOR SV_SCROLL_ENCHANT_WEAPON_TO_HIT SV_SCROLL_ENCHANT_WEAPON_TO_DAM SV_SCROLL_ENCHANT_WEAPON_PVAL SV_SCROLL_STAR_ENCHANT_ARMOR SV_SCROLL_STAR_ENCHANT_WEAPON SV_SCROLL_RECHARGING SV_SCROLL_RESET_RECALL SV_SCROLL_LIGHT SV_SCROLL_MAPPING SV_SCROLL_DETECT_GOLD SV_SCROLL_DETECT_ITEM SV_SCROLL_DETECT_TRAP SV_SCROLL_DETECT_DOOR SV_SCROLL_DETECT_INVIS SV_SCROLL_DIVINATION SV_SCROLL_SATISFY_HUNGER SV_SCROLL_BLESSING SV_SCROLL_HOLY_CHANT SV_SCROLL_HOLY_PRAYER SV_SCROLL_MONSTER_CONFUSION SV_SCROLL_PROTECTION_FROM_EVIL SV_SCROLL_RUNE_OF_PROTECTION SV_SCROLL_TRAP_DOOR_DESTRUCTION SV_SCROLL_DEINCARNATION SV_SCROLL_STAR_DESTRUCTION SV_SCROLL_DISPEL_UNDEAD SV_SCROLL_MASS_RESURECTION SV_SCROLL_GENOCIDE SV_SCROLL_MASS_GENOCIDE SV_SCROLL_ACQUIREMENT SV_SCROLL_STAR_ACQUIREMENT SV_SCROLL_FIRE SV_SCROLL_ICE SV_SCROLL_CHAOS SV_SCROLL_RUMOR SV_SCROLL_ARTIFACT SV_SCROLL_NOTHING SV_SCROLL_SPELL SV_POTION_WATER SV_POTION_APPLE_JUICE SV_POTION_SLIME_MOLD SV_POTION_BLOOD SV_POTION_SLOWNESS SV_POTION_SALT_WATER SV_POTION_POISON SV_POTION_BLINDNESS SV_POTION_INVIS SV_POTION_CONFUSION SV_POTION_MUTATION SV_POTION_SLEEP SV_POTION_LEARNING SV_POTION_LOSE_MEMORIES SV_POTION_RUINATION SV_POTION_DEC_STR SV_POTION_DEC_INT SV_POTION_DEC_WIS SV_POTION_DEC_DEX SV_POTION_DEC_CON SV_POTION_DEC_CHR SV_POTION_DETONATIONS SV_POTION_DEATH SV_POTION_INFRAVISION SV_POTION_DETECT_INVIS SV_POTION_SLOW_POISON SV_POTION_CURE_POISON SV_POTION_BOLDNESS SV_POTION_SPEED SV_POTION_RESIST_HEAT SV_POTION_RESIST_COLD SV_POTION_HEROISM SV_POTION_BESERK_STRENGTH SV_POTION_CURE_LIGHT SV_POTION_CURE_SERIOUS SV_POTION_CURE_CRITICAL SV_POTION_HEALING SV_POTION_STAR_HEALING SV_POTION_LIFE SV_POTION_RESTORE_MANA SV_POTION_RESTORE_EXP SV_POTION_RES_STR SV_POTION_RES_INT SV_POTION_RES_WIS SV_POTION_RES_DEX SV_POTION_RES_CON SV_POTION_RES_CHR SV_POTION_INC_STR SV_POTION_INC_INT SV_POTION_INC_WIS SV_POTION_INC_DEX SV_POTION_INC_CON SV_POTION_INC_CHR SV_POTION_AUGMENTATION SV_POTION_ENLIGHTENMENT SV_POTION_STAR_ENLIGHTENMENT SV_POTION_SELF_KNOWLEDGE SV_POTION_EXPERIENCE SV_POTION_RESISTANCE SV_POTION_CURING SV_POTION_INVULNERABILITY SV_POTION_NEW_LIFE SV_POTION2_MIMIC SV_POTION2_MIMIC_ABOMINATION SV_POTION2_MIMIC_WOLF SV_POTION2_MIMIC_APE SV_POTION2_MIMIC_GOAT SV_POTION2_MIMIC_INSECT SV_POTION2_MIMIC_SPARROW SV_POTION2_MIMIC_STATUE SV_POTION2_MIMIC_VAMPIRE SV_POTION2_MIMIC_SPIDER SV_POTION2_MIMIC_MANA_BALL SV_POTION2_MIMIC_FIRE_CLOUD SV_POTION2_MIMIC_COLD_CLOUD SV_POTION2_MIMIC_CHAOS_CLOUD SV_POTION2_CURE_LIGHT_SANITY SV_POTION2_CURE_SERIOUS_SANITY SV_POTION2_CURE_CRITICAL_SANITY SV_POTION2_CURE_SANITY SV_POTION2_CURE_WATER SV_FOOD_POISON SV_FOOD_BLINDNESS SV_FOOD_PARANOIA SV_FOOD_CONFUSION SV_FOOD_HALLUCINATION SV_FOOD_PARALYSIS SV_FOOD_WEAKNESS SV_FOOD_SICKNESS SV_FOOD_STUPIDITY SV_FOOD_NAIVETY SV_FOOD_UNHEALTH SV_FOOD_DISEASE SV_FOOD_CURE_POISON SV_FOOD_CURE_BLINDNESS SV_FOOD_CURE_PARANOIA SV_FOOD_CURE_CONFUSION SV_FOOD_CURE_SERIOUS SV_FOOD_RESTORE_STR SV_FOOD_RESTORE_CON SV_FOOD_RESTORING SV_FOOD_BISCUIT SV_FOOD_JERKY SV_FOOD_RATION SV_FOOD_SLIME_MOLD SV_FOOD_WAYBREAD SV_FOOD_PINT_OF_ALE SV_FOOD_PINT_OF_WINE SV_FOOD_ATHELAS SV_FOOD_GREAT_HEALTH SV_FOOD_FORTUNE_COOKIE SV_BATERIE_POISON SV_BATERIE_EXPLOSION SV_BATERIE_TELEPORT SV_BATERIE_COLD SV_BATERIE_FIRE SV_BATERIE_ACID SV_BATERIE_LIFE SV_BATERIE_CONFUSION SV_BATERIE_LITE SV_BATERIE_CHAOS SV_BATERIE_TIME SV_BATERIE_MAGIC SV_BATERIE_XTRA_LIFE SV_BATERIE_DARKNESS SV_BATERIE_KNOWLEDGE SV_BATERIE_FORCE SV_BATERIE_LIGHTNING SV_BATERIE_MANA SV_CORPSE_CORPSE SV_CORPSE_SKELETON SV_CORPSE_HEAD SV_CORPSE_SKULL SV_CORPSE_MEAT SV_DEMONBLADE SV_DEMONSHIELD SV_DEMONHORN); my @races = qw(Human Half-Elf Elf Hobbit Gnome Dwarf Orc Troll Dunadan High-Elf Half-Ogre Beorning Kobold Petty-Dwarf Dark-Elf Ent RohanKnight Thunderlord DeathMold Yeek Wood-Elf Maia); my @subraces = qw(Classical Vampire Spectre Skeleton Zombie Barbarian Hermit Corrupted LostSoul); my @classes = qw(Warrior Swordmaster Axemaster Haftedmaster Polearmmaster Unbeliever Demonologist Mage Geomancer Elementalist Warper Sorceror Necromancer Runecrafter Thaumaturgist Alchemist Archer Ranger Rogue Assassin Loremaster Possessor Mimic Symbiant Summoner Monk Bard Priest(Eru) Priest(Manwe) Druid Dark-Priest Paladin Mindcrafter); # What types of values are allowed for each matching condition. my %valtypes = ( name => [ '_STRING' ], contain => [ '_STRING' ], inscribed => [ '_STRING' ], symbol => [ '_STRING' ], state => [ qw(identified unidentified) ], status => [ 'very bad', 'bad', 'average', 'good', 'very good', 'special', 'terrible', 'empty' ], tval => [ '_NUMBER', @tvals ], race => [ @races ], subrace => [ @subraces ], class => [ @classes ], ability => [ '_STRING' ], # Conditions that expect a range. |pfx|, if defined, is a value type # that must appear before the '='; |types| are the value types allowed # for the min and max values. If |ok1| is true, a singleton value can be # provided, and will be used for both min and max. discount => { pfx => undef, ok1 => 1, types => [ '_NUMBER' ] }, sval => { pfx => undef, ok1 => 1, types => [ '_NUMBER', @svals ] }, level => { pfx => undef, ok1 => 0, types => [ '_NUMBER' ] }, skill => { pfx => '_STRING', ok1 => 0, types => [ '_NUMBER' ] }, ); my $data = ''; # Data read from input so far. my $token = undef; # Most recent token read from input. my $toktype = ''; # Type of most recent token. my @rules = (); # Rules we've read so far. my $cur_module = ''; # The prevailing module; # by_sval() -- Utility function to sort a list of sval clauses by their min # and max values. my %sval2num = ( ( map { ($svals[$_] => $_) } 0..$#svals ), ( map { ($_ => $_) } 0..$#svals ), ); sub by_sval { return $sval2num{$$a{min}} <=> $sval2num{$$b{min}} || $sval2num{$$a{max}} <=> $sval2num{$$b{max}}; } # fetch() -- Read data from the input file a line a time, stripping # comments and leading whitespace, until we have some non-whitespace # characters. The optional argument is a line of data, which we will # pretend to have read from the file before anything else. sub fetch (;$) { local $_ = $_[0] || ''; for (;;) { return if !$_ && eof IN; $_ = if !$_; chomp; s/^\s+//; s/\s*#.*$//; last if $_; } $data = ($data ? "$data $_" : $_); } # token() -- Extract a lexical token from the input data read from fetch(). # If a token has already been read previously and not yet processed, use # that instead. Sets $token to the text of the token and $toktype to the # type of the token. Returns the cached token, or the token read from # input, or undef at end of file. sub token () { return $token if defined $token; fetch while !$data && !eof IN; return undef if !$data && eof IN; if ($data =~ /^[$chars]/o) { # A single punctuation character, as above. $data =~ s/^([$chars])\s*//o; $token = $1; $toktype = '_LITERAL'; } elsif ($data =~ /^"/) { # A double-quoted string. We may need to read in more data if the # terminating quote is not on this line. fetch while !eof IN && $data !~ /^"[^"]*"/; return undef if eof IN && $data !~ /^"[^"]*"/; $data =~ s/^"([^"]*)"\s*//; $token = $1; $toktype = '_STRING'; } elsif ($data =~ /^\d+/) { # A number. $data =~ s/^(\d+)\s*//; $token = $1; $toktype = '_NUMBER'; } elsif ($data =~ /^[A-Za-z][A-Za-z0-9_]*/) { # A word token. $data =~ s/^([A-Za-z][A-Za-z0-9_]*)\s*//; $token = $1; $toktype = '_TOKEN'; } else { die "syntax error before '$data'"; } return $token; } # look() -- Check the next token in the input and return true if it matches # any of the provided tokens or token types. sub look (@) { $token = token if !defined($token); return 1 if scalar @_ == 0; for (@_) { return 1 if !defined $token && !defined $_; next if (defined $token) != (defined $_); return 1 if $_ eq $token || $_ eq $toktype; } return 0; } # maybe_match() -- Consume and return the next token if it matches any of # the provided tokens or token types; otherwise, leave the token in the # cache and return undef. sub maybe_match (@) { return undef if !look(@_); my $t = $token; undef $token; return $t; } # match() -- Consume and return the next token if it matches any of the # provided tokens or token types; otherwise, die with an error. sub match (@) { if (look(@_)) { my $t = $token; undef $token; return $t; } else { my $expect = join ' ', map { /^_(\w+)$/ ? lc $1 : "'$_'" } @_; $expect = "one of [$expect]" if scalar @_ > 1; my $found = (defined $token ? "'$token'" : 'end of file'); die "expected $expect instead of $found"; } } # clause() -- matches a single ATP matching condition, possibly preceded by # 'not', or a parenthesized list of such clauses. Returns a data structure # representing the clause. sub clause (); sub clauses ($); sub clause () { # Catch 'not' and parenthesized expressions first. if (maybe_match '(') { my $ret = clauses('or'); match ')'; return $ret; } if (maybe_match 'not') { return { key => 'not', clause => clause() }; } # Catch inventory and equipment clauses. if (look qw(inventory equipment)) { return { key => match(), clause => clause() }; } # So now we're looking for a matching condition. my %clause = (); $clause{key} = match keys %valtypes; my $valtypes = $valtypes{$clause{key}}; my $preval = ''; # Some matching conditions, like 'skill', will have an extra token to # match before the '='. if (ref $valtypes eq 'HASH' && $$valtypes{pfx}) { $preval = match $$valtypes{pfx}; } match '='; if (ref $valtypes eq 'HASH') { # Match a numeric range like '1-50'. $clause{value} = $preval if $preval; $clause{min} = $clause{max} = match @{$$valtypes{types}}; if (!$$valtypes{ok1} || look '-') { match '-'; $clause{max} = match @{$$valtypes{types}}; } # For sval, optionally match a comma-separated list of svals or sval # ranges. We attempt to sort and combine adjacent sval ranges. if ($clause{key} eq 'sval' && look ',') { my @clauses = ( { %clause } ); while (maybe_match ',') { $clause{min} = $clause{max} = match @{$$valtypes{types}}; if (maybe_match '-') { $clause{max} = match @{$$valtypes{types}}; } push @clauses, { %clause }; } # Sort the svals in increasing order, and combine any ranges that are # adjacent or overlapping. @clauses = sort by_sval @clauses; for (my $i = 0; $i < $#clauses; $i++) { next if $sval2num{$clauses[$i+1]{min}} > $sval2num{$clauses[$i]{max}} + 1; $clauses[$i]{max} = $clauses[$i+1]{max}; splice @clauses, $i+1, 1; $i--; } %clause = ( key => 'or', clauses => \@clauses ); } } else { # Match a single token of one of the allowed types, or a comma- # separated list of same. $clause{value} = match @$valtypes; if (look ',') { my @clauses = ( { %clause } ); while (maybe_match ',') { $clause{value} = match @$valtypes; push @clauses, { %clause }; } %clause = ( key => 'or', clauses => \@clauses ); } } return \%clause; } # clauses() -- Matches one or more ATP clauses separated by 'and', or one # or more groups of 'and'-ed clauses separated by 'or', as per the provided # paramter. Returns a data structure representing the combined clauses. sub clauses ($) { my $join = $_[0]; my $ret = ($join eq 'or' ? clauses('and') : clause()); while (maybe_match $join) { my $clause = ($join eq 'or' ? clauses('and') : clause()); if ($$ret{key} eq $join) { if ($$clause{key} eq $join) { push @{$$ret{clauses}}, @{$$clause{clauses}}; } else { push @{$$ret{clauses}}, $clause; } } elsif ($$clause{key} eq $join) { unshift @{$$clause{clauses}}, $ret; $ret = $clause; } else { $ret = { key => $join, clauses => [ $ret, $clause ] }; } } return $ret; } # rule() -- Matches an ATP rule. Returns a data structure representing the # rule. sub rule () { my %rule = (); match 'rule'; $rule{name} = match '_STRING' or die 'expected string'; $rule{action} = match qw(destroy pickup inscribe); $rule{inscription} = match '_STRING' if $rule{action} eq 'inscribe'; match 'if'; $rule{rule} = clauses('or'); match ';'; $rule{module} = $cur_module; return \%rule; } sub parse_atp_file () { for (;;) { if (look 'rule') { push @rules, rule(); } elsif (look 'module') { match 'module'; $cur_module = maybe_match('_STRING') || ''; match ';'; } elsif (look undef, ']') { return; } else { # We know this will fail; we just do it to get the error message. match qw(rule module); } } } # parse_xml_clause() -- Matches an XML clause, possibly containing # subclauses. Returns a data structure representing the clause. sub parse_xml_clause ($$); sub parse_xml_clause ($$) { my ($key, $content) = @_; my $clause = { key => $key }; my $has_subcl = ($key eq 'and' || $key eq 'or' || $key eq 'not' || $key eq 'inventory' || $key eq 'equipment'); # Pull off the attribute values. die "BUGCHK 1" if scalar @$content == 0; my $attrs = shift @$content; # 'level' and 'sval' shouldn't have any content at all. die "BUGCHK 2 (@$content)" if ($key eq 'level' || $key eq 'sval') && scalar @$content != 0; # Only 'and' and 'or should have multiple subclauses. die "BUGCHK 3 ($key: @$content)" if $key ne 'and' && $key ne 'or' && $key ne 'level' && $key ne 'sval' && scalar @$content != 2; # Only 'and', 'or' and 'not' should have non-text content. die "BUGCHK 4 ($$content[1])" if !$has_subcl && scalar @$content > 0 && $$content[0] ne '0'; if (exists $$attrs{max}) { @$clause{qw(min max)} = @$attrs{qw(min max)}; } if (!$has_subcl && scalar @$content > 0) { $$clause{value} = $$content[1]; } elsif ($key eq 'not' || $key eq 'inventory' || $key eq 'equipment') { $$clause{clause} = parse_xml_clause $$content[0], $$content[1]; } elsif ($key eq 'and' || $key eq 'or') { my @clauses = (); $$clause{clauses} = \@clauses; die "BUGCHK 4 ($#$content)" if scalar(@$content) % 2 != 0; for (my $i = 0; $i < $#$content; $i += 2) { push @clauses, parse_xml_clause $$content[$i], $$content[$i+1]; } } return $clause; } # parse_xml_rules() -- Match all XML rules in the input file, and store # them in the @rules array. sub parse_xml_rules () { # We have to suck in the entire file at once, because this really isn't # an XML document; it's got junk at the beginning and end, and it's # missing an overarching ... or similar top-level element. my @lines = ; shift @lines; pop @lines; map { chomp; s/^\s+//; s/\s+$// } @lines; unshift @lines, ''; push @lines, ''; my $P = new XML::Parser(Style => 'Tree'); my $tree = $P->parse(join '', @lines); die "BUGCHK 5 (@$tree)" if scalar @$tree != 2 || $$tree[0] ne 'rules' || !$$tree[1] || ref $$tree[1] ne 'ARRAY'; my $rules = $$tree[1]; die "BUGCHK 6 (@$rules)" if scalar(@$rules) % 2 != 1; shift @$rules; for (my $i = 0; $i < $#$rules; $i += 2) { my ($key, $content) = @$rules[($i, $i+1)]; my $rule = {}; die "BUGCHK 7 ('$key')" if $key ne 'rule'; die "BUGCHK 8" if !$content || ref $content ne 'ARRAY'; my $attrs = shift @$content; @$rule{qw(name action)} = @$attrs{qw(name type)}; $$rule{module} = $$attrs{module} || ''; $$rule{inscription} = $$attrs{inscription} if $$rule{action} eq 'inscribe'; # There should be only one overarching clause in a rule -- which may, # of course, contain several subclauses. die "BUGCHK 9 (${key}: @$content)" if scalar @$content != 2; $$rule{rule} = parse_xml_clause $$content[0], $$content[1]; push @rules, $rule; } } # output_clause_as_xml() -- Write an XML representation of a clause to the # output. sub output_clause_as_xml ($$); sub output_clause_as_xml ($$) { my ($clause, $indent) = @_; my $nested = "$indent "; if (exists $$clause{clauses}) { # An or clause. print "$indent<$$clause{key}>\n"; for (@{$$clause{clauses}}) { output_clause_as_xml($_, $nested) } print "$indent\n"; } elsif (exists $$clause{clause}) { # A , or clause. print "$indent<$$clause{key}>\n"; output_clause_as_xml($$clause{clause}, $nested); print "$indent\n"; } elsif (exists $$clause{min}) { # A or matching condition with min and max attributes. my $value = $$clause{value} || ''; print "$indent<$$clause{key} min=\"$$clause{min}\" max=\"$$clause{max}\">" . "$value\n"; } elsif (exists $$clause{value}) { # All the other matching conditions. print "$indent<$$clause{key}>$$clause{value}\n" } else { # An error. print "$indent\n"; } } # output_rules_as_xml() -- Write the current rules to the output file in # XML form, suitable for use as a ToME automat.atm file. sub output_rules_as_xml () { print <\n"; output_clause_as_xml $$rule{rule}, ' '; print "\n"; } print "]]\n"; } # output_clause_as_atp() -- Write an ATP representation of a clause to the # output file. sub output_clause_as_atp ($;$); sub output_clause_as_atp ($;$) { my ($clause, $val_only) = @_; my $key = $$clause{key}; if (exists $$clause{clauses}) { # A parenthesized list of clauses joined by 'or' or 'and'. my $clauses = $$clause{clauses}; print '('; output_clause_as_atp $$clauses[0]; for my $i (1..$#$clauses) { my $subkey = $$clauses[$i]{key}; my $commaize = ($key eq 'or' && $$clauses[$i-1]{key} eq $subkey && exists $valtypes{$subkey} && (ref $valtypes{$subkey} eq 'ARRAY' || $subkey eq 'sval')); if ($commaize) { print ', '; output_clause_as_atp($$clauses[$i], 1); } else { print " $key "; output_clause_as_atp($$clauses[$i]); } } print ')'; } elsif (exists $$clause{clause}) { # A 'not (...)', 'inventory (...)' or 'equipment (...)' clause. print "$key ("; output_clause_as_atp($$clause{clause}); print ')'; } elsif (exists $$clause{min}) { # An 'sval', 'skill' or 'level' matching condition with a ranged value. if (!$val_only) { print "$key "; print "\"$$clause{value}\" " if exists $$clause{value}; print "= "; } if ($key eq 'sval' && $$clause{min} eq $$clause{max}) { print $$clause{min}; } else { print "$$clause{min}-$$clause{max}"; } } elsif (exists $$clause{value}) { # All the other matching conditions. my $value = $$clause{value}; $value = "\"$value\"" if $key ne 'tval' && $key ne 'sval'; $value = "$key = $value" if !$val_only; print $value; } else { # An error. print "BUGCHK{"; print join(', ', map { "$_ => $$clause{$_}" } keys %$clause); print '}'; } } # output_rules_as_atp() -- Write the current rules to the output file in # ATP form, suitable for re-input into autoparse. sub output_rules_as_atp () { print < 2; usage: $0 [ []] Input defaults to stdin; output defaults to stdout. A single '-' can be used for either or to specify, respectively, stdin or stdout. EOF my $infile = shift(@ARGV) || '-'; my $outfile = shift(@ARGV) || '-'; open IN, ($infile eq '-' ? '<&STDIN' : "<$infile") or die "Cannot open '$infile': $!\n"; if ($outfile ne '-') { open OUT, ">$outfile" or die "Cannot open '$outfile': $!\n"; select OUT; } # Read in the first line to determine the syntax of the input file. $_ = ; if (/^clean_ruleset/) { # An "executable" Lua file, either ATP or XML; the next line should # distinguish. $_ = ; if (/^add_atp_ruleset/) { # "Executable" ATP; convert to "executable" XML. $_ = ; parse_atp_file; output_rules_as_xml; } else { # "Executable" XML; convert to "executable" ATP. parse_xml_rules; output_rules_as_atp; } } else { # "Bare" ATP file; convert to "executable" XML. fetch $_; parse_atp_file; output_rules_as_xml; } close IN; close OUT;