-- Copyright (c) 2008--2011 Andres Loeh
-- Copyright (c) 2010--2021 Mikolaj Konarski and others (see git history)
-- This file is a part of the computer game Allure of the Stars
-- and is released under the terms of the GNU Affero General Public License.
-- For license and copyright information, see the file LICENSE.
--
-- | Definitions of items embedded in map tiles.
module Content.ItemKindEmbed
  ( -- * Group name patterns
    pattern SCRATCH_ON_WALL, pattern OBSCENE_PICTOGRAM, pattern SUBTLE_FRESCO, pattern SIGNAGE, pattern SMALL_FIRE, pattern SMALL_FIRE_5, pattern BIG_FIRE, pattern FROST, pattern RUBBLE, pattern DOORWAY_TRAP_UNKNOWN, pattern DOORWAY_TRAP, pattern STAIRS_UP, pattern STAIRS_DOWN, pattern ESCAPE, pattern STAIRS_TRAP_UP, pattern STAIRS_TRAP_DOWN, pattern LECTERN, pattern SHALLOW_WATER, pattern STRAIGHT_PATH, pattern FROZEN_GROUND
  , pattern STAIRS_UP_OUTDOOR, pattern STAIRS_DOWN_OUTDOOR, pattern ABANDONED_CACHE, pattern JEWELRY_DISPLAY_TRAP, pattern BLACK_STARRY_SKY, pattern DISENGAGED_DOCKING_GEAR, pattern RUINED_FIRST_AID_KIT, pattern FIRE_FIGHTING_GEAR, pattern DISPLAY_3D, pattern CRACKED_FLUE, pattern BLOOD_ON_WALL, pattern DEPOSIT_BOX, pattern JEWELRY_CASE, pattern EDIBLE_PLANT_RIPE, pattern STAIRS_TRAP_DOWN_OIL, pattern DOOR_TRAP_PUSH, pattern LIFT_UP, pattern LIFT_DOWN, pattern LIFT_TRAP, pattern SHUTTLE_HARDWARE, pattern OIL_PUDDLE, pattern DECONTAMINATION_CHAMBER, pattern BARREL_CONTENTS, pattern WORKSHOP_BENCH
  , pattern MUSEAL, pattern EDIBLE_PLANT, pattern FIRE_FIGHTING_ITEM, pattern STEEL_SCRAP, pattern HANDLE, pattern HANDLE_AND_STEEL, pattern POLE_AND_STEEL, pattern SPACESUIT_PART, pattern THICK_CLOTH, pattern PERFUME, pattern STARTING_HAMMER, pattern CLOTH_RAG
  , pattern S_ENCHANCED_BERRY, pattern S_COOKED_BERRY, pattern S_FRAYED_FUNGUS, pattern S_COOKED_FUNGUS, pattern S_THIC_LEAF, pattern S_COOKED_LEAF, pattern S_RECONFIGURED_FRUIT, pattern S_COOKED_FRUIT, pattern S_FRAGRANT_HERB, pattern S_COOKED_HERB, pattern S_DULL_FLOWER, pattern S_COOKED_FLOWER, pattern S_SPICY_BARK, pattern S_COOKED_BARK, pattern S_PUMPKIN, pattern S_COOKED_PUMPKIN, pattern S_REFRIGERATION_COIL, pattern S_DOUSED_WOODEN_TORCH, pattern S_DOUSED_OIL_LAMP, pattern S_OIL_LAMP, pattern S_ROSE_WATER_FLASK, pattern S_WATER_FLASK, pattern S_SPACESUIT_JACKET, pattern S_SPACESUIT_TROUSERS, pattern S_SPACESUIT_GLOVE, pattern S_SPACESUIT_HELMET, pattern S_SPACESUIT_BOOT, pattern S_SPACESUIT, pattern S_SPACESUIT_TORN, pattern S_HARPOON_CARGO, pattern S_HARPOON_SHARP, pattern S_SHIELD_BLUNT, pattern S_SHIELD_SHARP, pattern S_SHORT_BLUNT_HAMMER, pattern S_LONG_BLUNT_HAMMER, pattern S_SHORT_SHARP_HAMMER, pattern S_LONG_SHARP_HAMMER, pattern S_CLEAVER, pattern S_DAGGER, pattern S_RAPIER_BLUNT, pattern S_RAPIER_SHARP, pattern S_POLE_CLEAVER, pattern S_LONG_SPEAR, pattern S_SHORT_CLUB, pattern S_LONG_CLUB, pattern S_CROWBAR, pattern S_FIRE_AXE, pattern S_POLL_AXE, pattern S_HALBERD_BLUNT, pattern S_HALBERD_SHARP, pattern S_STAFF, pattern S_PIPE, pattern S_SHARPENED_PIPE
  , embedsGNSingleton, embedsGN
  , -- * Content
    embeds
  ) where

import Prelude ()

import Game.LambdaHack.Core.Prelude

import Game.LambdaHack.Content.ItemKind
import Game.LambdaHack.Core.Dice
import Game.LambdaHack.Definition.Ability
import Game.LambdaHack.Definition.Color
import Game.LambdaHack.Definition.Defs
import Game.LambdaHack.Definition.DefsInternal
import Game.LambdaHack.Definition.Flavour

import Content.ItemKindActor
import Content.ItemKindBlast
import Content.ItemKindOrgan
import Content.ItemKindTemporary

-- * Group name patterns

embedsGNSingleton :: [GroupName ItemKind]
embedsGNSingleton :: [GroupName ItemKind]
embedsGNSingleton =
       [GroupName ItemKind
S_ENCHANCED_BERRY, GroupName ItemKind
S_COOKED_BERRY, GroupName ItemKind
S_FRAYED_FUNGUS, GroupName ItemKind
S_COOKED_FUNGUS, GroupName ItemKind
S_THIC_LEAF, GroupName ItemKind
S_COOKED_LEAF, GroupName ItemKind
S_RECONFIGURED_FRUIT, GroupName ItemKind
S_COOKED_FRUIT, GroupName ItemKind
S_FRAGRANT_HERB, GroupName ItemKind
S_COOKED_HERB, GroupName ItemKind
S_DULL_FLOWER, GroupName ItemKind
S_COOKED_FLOWER, GroupName ItemKind
S_SPICY_BARK, GroupName ItemKind
S_COOKED_BARK, GroupName ItemKind
S_PUMPKIN, GroupName ItemKind
S_COOKED_PUMPKIN, GroupName ItemKind
S_REFRIGERATION_COIL, GroupName ItemKind
S_DOUSED_WOODEN_TORCH, GroupName ItemKind
S_DOUSED_OIL_LAMP, GroupName ItemKind
S_OIL_LAMP, GroupName ItemKind
S_ROSE_WATER_FLASK, GroupName ItemKind
S_WATER_FLASK, GroupName ItemKind
S_SPACESUIT_JACKET, GroupName ItemKind
S_SPACESUIT_TROUSERS, GroupName ItemKind
S_SPACESUIT_GLOVE, GroupName ItemKind
S_SPACESUIT_HELMET, GroupName ItemKind
S_SPACESUIT_BOOT, GroupName ItemKind
S_SPACESUIT, GroupName ItemKind
S_SPACESUIT_TORN, GroupName ItemKind
S_HARPOON_CARGO, GroupName ItemKind
S_HARPOON_SHARP, GroupName ItemKind
S_SHIELD_BLUNT, GroupName ItemKind
S_SHIELD_SHARP, GroupName ItemKind
S_SHORT_BLUNT_HAMMER, GroupName ItemKind
S_LONG_BLUNT_HAMMER, GroupName ItemKind
S_SHORT_SHARP_HAMMER, GroupName ItemKind
S_LONG_SHARP_HAMMER, GroupName ItemKind
S_CLEAVER, GroupName ItemKind
S_DAGGER, GroupName ItemKind
S_RAPIER_BLUNT, GroupName ItemKind
S_RAPIER_SHARP, GroupName ItemKind
S_POLE_CLEAVER, GroupName ItemKind
S_LONG_SPEAR, GroupName ItemKind
S_SHORT_CLUB, GroupName ItemKind
S_LONG_CLUB, GroupName ItemKind
S_CROWBAR, GroupName ItemKind
S_FIRE_AXE, GroupName ItemKind
S_POLL_AXE, GroupName ItemKind
S_HALBERD_BLUNT, GroupName ItemKind
S_HALBERD_SHARP, GroupName ItemKind
S_STAFF, GroupName ItemKind
S_PIPE, GroupName ItemKind
S_SHARPENED_PIPE]

pattern S_ENCHANCED_BERRY, S_COOKED_BERRY, S_FRAYED_FUNGUS, S_COOKED_FUNGUS, S_THIC_LEAF, S_COOKED_LEAF, S_RECONFIGURED_FRUIT, S_COOKED_FRUIT, S_FRAGRANT_HERB, S_COOKED_HERB, S_DULL_FLOWER, S_COOKED_FLOWER, S_SPICY_BARK, S_COOKED_BARK, S_PUMPKIN, S_COOKED_PUMPKIN, S_REFRIGERATION_COIL, S_DOUSED_WOODEN_TORCH, S_DOUSED_OIL_LAMP, S_OIL_LAMP, S_ROSE_WATER_FLASK, S_WATER_FLASK, S_SPACESUIT_JACKET, S_SPACESUIT_TROUSERS, S_SPACESUIT_GLOVE, S_SPACESUIT_HELMET, S_SPACESUIT_BOOT, S_SPACESUIT, S_SPACESUIT_TORN, S_HARPOON_CARGO, S_HARPOON_SHARP, S_SHIELD_BLUNT, S_SHIELD_SHARP, S_SHORT_BLUNT_HAMMER, S_LONG_BLUNT_HAMMER, S_SHORT_SHARP_HAMMER, S_LONG_SHARP_HAMMER, S_CLEAVER, S_DAGGER, S_RAPIER_BLUNT, S_RAPIER_SHARP, S_POLE_CLEAVER, S_LONG_SPEAR, S_SHORT_CLUB, S_LONG_CLUB, S_CROWBAR, S_FIRE_AXE, S_POLL_AXE, S_HALBERD_BLUNT, S_HALBERD_SHARP, S_STAFF, S_PIPE, S_SHARPENED_PIPE :: GroupName ItemKind

embedsGN :: [GroupName ItemKind]
embedsGN :: [GroupName ItemKind]
embedsGN =
       [GroupName ItemKind
SCRATCH_ON_WALL, GroupName ItemKind
OBSCENE_PICTOGRAM, GroupName ItemKind
SUBTLE_FRESCO, GroupName ItemKind
SIGNAGE, GroupName ItemKind
SMALL_FIRE, GroupName ItemKind
SMALL_FIRE_5, GroupName ItemKind
BIG_FIRE, GroupName ItemKind
FROST, GroupName ItemKind
RUBBLE, GroupName ItemKind
DOORWAY_TRAP_UNKNOWN, GroupName ItemKind
DOORWAY_TRAP, GroupName ItemKind
STAIRS_UP, GroupName ItemKind
STAIRS_DOWN, GroupName ItemKind
ESCAPE, GroupName ItemKind
STAIRS_TRAP_UP, GroupName ItemKind
STAIRS_TRAP_DOWN, GroupName ItemKind
LECTERN, GroupName ItemKind
SHALLOW_WATER, GroupName ItemKind
STRAIGHT_PATH, GroupName ItemKind
FROZEN_GROUND]
    [GroupName ItemKind]
-> [GroupName ItemKind] -> [GroupName ItemKind]
forall a. [a] -> [a] -> [a]
++ [GroupName ItemKind
STAIRS_UP_OUTDOOR, GroupName ItemKind
STAIRS_DOWN_OUTDOOR, GroupName ItemKind
ABANDONED_CACHE, GroupName ItemKind
JEWELRY_DISPLAY_TRAP, GroupName ItemKind
BLACK_STARRY_SKY, GroupName ItemKind
DISENGAGED_DOCKING_GEAR, GroupName ItemKind
RUINED_FIRST_AID_KIT, GroupName ItemKind
FIRE_FIGHTING_GEAR, GroupName ItemKind
DISPLAY_3D, GroupName ItemKind
CRACKED_FLUE, GroupName ItemKind
BLOOD_ON_WALL, GroupName ItemKind
DEPOSIT_BOX, GroupName ItemKind
JEWELRY_CASE, GroupName ItemKind
EDIBLE_PLANT_RIPE, GroupName ItemKind
STAIRS_TRAP_DOWN_OIL, GroupName ItemKind
DOOR_TRAP_PUSH, GroupName ItemKind
LIFT_UP, GroupName ItemKind
LIFT_DOWN, GroupName ItemKind
LIFT_TRAP, GroupName ItemKind
SHUTTLE_HARDWARE, GroupName ItemKind
OIL_PUDDLE, GroupName ItemKind
DECONTAMINATION_CHAMBER, GroupName ItemKind
BARREL_CONTENTS, GroupName ItemKind
WORKSHOP_BENCH]
    [GroupName ItemKind]
-> [GroupName ItemKind] -> [GroupName ItemKind]
forall a. [a] -> [a] -> [a]
++ [GroupName ItemKind
MUSEAL, GroupName ItemKind
EDIBLE_PLANT, GroupName ItemKind
FIRE_FIGHTING_ITEM, GroupName ItemKind
STEEL_SCRAP, GroupName ItemKind
HANDLE, GroupName ItemKind
HANDLE_AND_STEEL, GroupName ItemKind
POLE_AND_STEEL, GroupName ItemKind
SPACESUIT_PART, GroupName ItemKind
THICK_CLOTH, GroupName ItemKind
PERFUME, GroupName ItemKind
STARTING_HAMMER, GroupName ItemKind
CLOTH_RAG]

pattern SCRATCH_ON_WALL, OBSCENE_PICTOGRAM, SUBTLE_FRESCO, SIGNAGE, SMALL_FIRE, SMALL_FIRE_5, BIG_FIRE, FROST, RUBBLE, DOORWAY_TRAP_UNKNOWN, DOORWAY_TRAP, STAIRS_UP, STAIRS_DOWN, ESCAPE, STAIRS_TRAP_UP, STAIRS_TRAP_DOWN, LECTERN, SHALLOW_WATER, STRAIGHT_PATH, FROZEN_GROUND :: GroupName ItemKind

pattern STAIRS_UP_OUTDOOR, STAIRS_DOWN_OUTDOOR, ABANDONED_CACHE, JEWELRY_DISPLAY_TRAP, BLACK_STARRY_SKY, DISENGAGED_DOCKING_GEAR, RUINED_FIRST_AID_KIT, FIRE_FIGHTING_GEAR, DISPLAY_3D, CRACKED_FLUE, BLOOD_ON_WALL, DEPOSIT_BOX, JEWELRY_CASE, EDIBLE_PLANT_RIPE, STAIRS_TRAP_DOWN_OIL, DOOR_TRAP_PUSH, LIFT_UP, LIFT_DOWN, LIFT_TRAP, SHUTTLE_HARDWARE, OIL_PUDDLE, DECONTAMINATION_CHAMBER, BARREL_CONTENTS, WORKSHOP_BENCH :: GroupName ItemKind

pattern MUSEAL, EDIBLE_PLANT, FIRE_FIGHTING_ITEM, STEEL_SCRAP, HANDLE, HANDLE_AND_STEEL, POLE_AND_STEEL, SPACESUIT_PART, THICK_CLOTH, PERFUME, STARTING_HAMMER, CLOTH_RAG :: GroupName ItemKind

pattern $bSCRATCH_ON_WALL :: GroupName ItemKind
$mSCRATCH_ON_WALL :: forall r. GroupName ItemKind -> (Void# -> r) -> (Void# -> r) -> r
SCRATCH_ON_WALL = GroupName "scratch on wall"
pattern $bOBSCENE_PICTOGRAM :: GroupName ItemKind
$mOBSCENE_PICTOGRAM :: forall r. GroupName ItemKind -> (Void# -> r) -> (Void# -> r) -> r
OBSCENE_PICTOGRAM = GroupName "obscene pictogram"
pattern $bSUBTLE_FRESCO :: GroupName ItemKind
$mSUBTLE_FRESCO :: forall r. GroupName ItemKind -> (Void# -> r) -> (Void# -> r) -> r
SUBTLE_FRESCO = GroupName "subtle fresco"
pattern $bSIGNAGE :: GroupName ItemKind
$mSIGNAGE :: forall r. GroupName ItemKind -> (Void# -> r) -> (Void# -> r) -> r
SIGNAGE = GroupName "signage"
pattern $bSMALL_FIRE :: GroupName ItemKind
$mSMALL_FIRE :: forall r. GroupName ItemKind -> (Void# -> r) -> (Void# -> r) -> r
SMALL_FIRE = GroupName "small fire"
pattern $bSMALL_FIRE_5 :: GroupName ItemKind
$mSMALL_FIRE_5 :: forall r. GroupName ItemKind -> (Void# -> r) -> (Void# -> r) -> r
SMALL_FIRE_5 = GroupName "small fire embers"
pattern $bBIG_FIRE :: GroupName ItemKind
$mBIG_FIRE :: forall r. GroupName ItemKind -> (Void# -> r) -> (Void# -> r) -> r
BIG_FIRE = GroupName "big fire"
pattern $bFROST :: GroupName ItemKind
$mFROST :: forall r. GroupName ItemKind -> (Void# -> r) -> (Void# -> r) -> r
FROST = GroupName "frozen mass"
pattern $bRUBBLE :: GroupName ItemKind
$mRUBBLE :: forall r. GroupName ItemKind -> (Void# -> r) -> (Void# -> r) -> r
RUBBLE = GroupName "rubble"
pattern $bDOORWAY_TRAP_UNKNOWN :: GroupName ItemKind
$mDOORWAY_TRAP_UNKNOWN :: forall r. GroupName ItemKind -> (Void# -> r) -> (Void# -> r) -> r
DOORWAY_TRAP_UNKNOWN = GroupName "doorway trap unknown"
pattern $bDOORWAY_TRAP :: GroupName ItemKind
$mDOORWAY_TRAP :: forall r. GroupName ItemKind -> (Void# -> r) -> (Void# -> r) -> r
DOORWAY_TRAP = GroupName "doorway trap"
pattern $bSTAIRS_UP :: GroupName ItemKind
$mSTAIRS_UP :: forall r. GroupName ItemKind -> (Void# -> r) -> (Void# -> r) -> r
STAIRS_UP = GroupName "stairs up"
pattern $bSTAIRS_DOWN :: GroupName ItemKind
$mSTAIRS_DOWN :: forall r. GroupName ItemKind -> (Void# -> r) -> (Void# -> r) -> r
STAIRS_DOWN = GroupName "stairs down"
pattern $bESCAPE :: GroupName ItemKind
$mESCAPE :: forall r. GroupName ItemKind -> (Void# -> r) -> (Void# -> r) -> r
ESCAPE = GroupName "escape"
pattern $bSTAIRS_TRAP_UP :: GroupName ItemKind
$mSTAIRS_TRAP_UP :: forall r. GroupName ItemKind -> (Void# -> r) -> (Void# -> r) -> r
STAIRS_TRAP_UP = GroupName "stairs trap up"
pattern $bSTAIRS_TRAP_DOWN :: GroupName ItemKind
$mSTAIRS_TRAP_DOWN :: forall r. GroupName ItemKind -> (Void# -> r) -> (Void# -> r) -> r
STAIRS_TRAP_DOWN = GroupName "stairs trap down"
pattern $bLECTERN :: GroupName ItemKind
$mLECTERN :: forall r. GroupName ItemKind -> (Void# -> r) -> (Void# -> r) -> r
LECTERN = GroupName "lectern"
pattern $bSHALLOW_WATER :: GroupName ItemKind
$mSHALLOW_WATER :: forall r. GroupName ItemKind -> (Void# -> r) -> (Void# -> r) -> r
SHALLOW_WATER = GroupName "shallow water"
pattern $bSTRAIGHT_PATH :: GroupName ItemKind
$mSTRAIGHT_PATH :: forall r. GroupName ItemKind -> (Void# -> r) -> (Void# -> r) -> r
STRAIGHT_PATH = GroupName "straight path"
pattern $bFROZEN_GROUND :: GroupName ItemKind
$mFROZEN_GROUND :: forall r. GroupName ItemKind -> (Void# -> r) -> (Void# -> r) -> r
FROZEN_GROUND = GroupName "frozen ground"

-- ** Allure-specific
pattern $bSTAIRS_UP_OUTDOOR :: GroupName ItemKind
$mSTAIRS_UP_OUTDOOR :: forall r. GroupName ItemKind -> (Void# -> r) -> (Void# -> r) -> r
STAIRS_UP_OUTDOOR = GroupName "stairs outdoor up"
pattern $bSTAIRS_DOWN_OUTDOOR :: GroupName ItemKind
$mSTAIRS_DOWN_OUTDOOR :: forall r. GroupName ItemKind -> (Void# -> r) -> (Void# -> r) -> r
STAIRS_DOWN_OUTDOOR = GroupName "stairs outdoor down"
pattern $bABANDONED_CACHE :: GroupName ItemKind
$mABANDONED_CACHE :: forall r. GroupName ItemKind -> (Void# -> r) -> (Void# -> r) -> r
ABANDONED_CACHE = GroupName "abandoned cache"
pattern $bJEWELRY_DISPLAY_TRAP :: GroupName ItemKind
$mJEWELRY_DISPLAY_TRAP :: forall r. GroupName ItemKind -> (Void# -> r) -> (Void# -> r) -> r
JEWELRY_DISPLAY_TRAP = GroupName "jewelry display trap"
pattern $bBLACK_STARRY_SKY :: GroupName ItemKind
$mBLACK_STARRY_SKY :: forall r. GroupName ItemKind -> (Void# -> r) -> (Void# -> r) -> r
BLACK_STARRY_SKY = GroupName "black starry sky"
pattern $bDISENGAGED_DOCKING_GEAR :: GroupName ItemKind
$mDISENGAGED_DOCKING_GEAR :: forall r. GroupName ItemKind -> (Void# -> r) -> (Void# -> r) -> r
DISENGAGED_DOCKING_GEAR = GroupName "disengaged docking gear"
pattern $bRUINED_FIRST_AID_KIT :: GroupName ItemKind
$mRUINED_FIRST_AID_KIT :: forall r. GroupName ItemKind -> (Void# -> r) -> (Void# -> r) -> r
RUINED_FIRST_AID_KIT = GroupName "ruined first aid kit"
pattern $bFIRE_FIGHTING_GEAR :: GroupName ItemKind
$mFIRE_FIGHTING_GEAR :: forall r. GroupName ItemKind -> (Void# -> r) -> (Void# -> r) -> r
FIRE_FIGHTING_GEAR = GroupName "fire fighting gear"
pattern $bDISPLAY_3D :: GroupName ItemKind
$mDISPLAY_3D :: forall r. GroupName ItemKind -> (Void# -> r) -> (Void# -> r) -> r
DISPLAY_3D = GroupName "3D display"
pattern $bCRACKED_FLUE :: GroupName ItemKind
$mCRACKED_FLUE :: forall r. GroupName ItemKind -> (Void# -> r) -> (Void# -> r) -> r
CRACKED_FLUE = GroupName "cracked flue"
pattern $bBLOOD_ON_WALL :: GroupName ItemKind
$mBLOOD_ON_WALL :: forall r. GroupName ItemKind -> (Void# -> r) -> (Void# -> r) -> r
BLOOD_ON_WALL = GroupName "blood on wall"
pattern $bDEPOSIT_BOX :: GroupName ItemKind
$mDEPOSIT_BOX :: forall r. GroupName ItemKind -> (Void# -> r) -> (Void# -> r) -> r
DEPOSIT_BOX = GroupName "deposit box"
pattern $bJEWELRY_CASE :: GroupName ItemKind
$mJEWELRY_CASE :: forall r. GroupName ItemKind -> (Void# -> r) -> (Void# -> r) -> r
JEWELRY_CASE = GroupName "reinforced glass case"
pattern $bEDIBLE_PLANT_RIPE :: GroupName ItemKind
$mEDIBLE_PLANT_RIPE :: forall r. GroupName ItemKind -> (Void# -> r) -> (Void# -> r) -> r
EDIBLE_PLANT_RIPE = GroupName "edible vegetation"
pattern $bSTAIRS_TRAP_DOWN_OIL :: GroupName ItemKind
$mSTAIRS_TRAP_DOWN_OIL :: forall r. GroupName ItemKind -> (Void# -> r) -> (Void# -> r) -> r
STAIRS_TRAP_DOWN_OIL = GroupName "oil staircase trap"
pattern $bDOOR_TRAP_PUSH :: GroupName ItemKind
$mDOOR_TRAP_PUSH :: forall r. GroupName ItemKind -> (Void# -> r) -> (Void# -> r) -> r
DOOR_TRAP_PUSH = GroupName "weak door frame"
pattern $bLIFT_UP :: GroupName ItemKind
$mLIFT_UP :: forall r. GroupName ItemKind -> (Void# -> r) -> (Void# -> r) -> r
LIFT_UP = GroupName "lift up"
pattern $bLIFT_DOWN :: GroupName ItemKind
$mLIFT_DOWN :: forall r. GroupName ItemKind -> (Void# -> r) -> (Void# -> r) -> r
LIFT_DOWN = GroupName "lift down"
pattern $bLIFT_TRAP :: GroupName ItemKind
$mLIFT_TRAP :: forall r. GroupName ItemKind -> (Void# -> r) -> (Void# -> r) -> r
LIFT_TRAP = GroupName "lift trap"
pattern $bSHUTTLE_HARDWARE :: GroupName ItemKind
$mSHUTTLE_HARDWARE :: forall r. GroupName ItemKind -> (Void# -> r) -> (Void# -> r) -> r
SHUTTLE_HARDWARE = GroupName "shuttle hardware"
pattern $bOIL_PUDDLE :: GroupName ItemKind
$mOIL_PUDDLE :: forall r. GroupName ItemKind -> (Void# -> r) -> (Void# -> r) -> r
OIL_PUDDLE = GroupName "oil puddle"
pattern $bDECONTAMINATION_CHAMBER :: GroupName ItemKind
$mDECONTAMINATION_CHAMBER :: forall r. GroupName ItemKind -> (Void# -> r) -> (Void# -> r) -> r
DECONTAMINATION_CHAMBER = GroupName "decontamination chamber"
pattern $bBARREL_CONTENTS :: GroupName ItemKind
$mBARREL_CONTENTS :: forall r. GroupName ItemKind -> (Void# -> r) -> (Void# -> r) -> r
BARREL_CONTENTS = GroupName "barrel contents"
pattern $bWORKSHOP_BENCH :: GroupName ItemKind
$mWORKSHOP_BENCH :: forall r. GroupName ItemKind -> (Void# -> r) -> (Void# -> r) -> r
WORKSHOP_BENCH = GroupName "workshop bench"

pattern $bMUSEAL :: GroupName ItemKind
$mMUSEAL :: forall r. GroupName ItemKind -> (Void# -> r) -> (Void# -> r) -> r
MUSEAL = GroupName "museal item"
pattern $bEDIBLE_PLANT :: GroupName ItemKind
$mEDIBLE_PLANT :: forall r. GroupName ItemKind -> (Void# -> r) -> (Void# -> r) -> r
EDIBLE_PLANT = GroupName "edible plant"
pattern $bFIRE_FIGHTING_ITEM :: GroupName ItemKind
$mFIRE_FIGHTING_ITEM :: forall r. GroupName ItemKind -> (Void# -> r) -> (Void# -> r) -> r
FIRE_FIGHTING_ITEM = GroupName "fire fighting item"
pattern $bSTEEL_SCRAP :: GroupName ItemKind
$mSTEEL_SCRAP :: forall r. GroupName ItemKind -> (Void# -> r) -> (Void# -> r) -> r
STEEL_SCRAP = GroupName "steel scrap"
pattern $bHANDLE :: GroupName ItemKind
$mHANDLE :: forall r. GroupName ItemKind -> (Void# -> r) -> (Void# -> r) -> r
HANDLE = GroupName "handle"
pattern $bHANDLE_AND_STEEL :: GroupName ItemKind
$mHANDLE_AND_STEEL :: forall r. GroupName ItemKind -> (Void# -> r) -> (Void# -> r) -> r
HANDLE_AND_STEEL = GroupName "steel on a handle"
pattern $bPOLE_AND_STEEL :: GroupName ItemKind
$mPOLE_AND_STEEL :: forall r. GroupName ItemKind -> (Void# -> r) -> (Void# -> r) -> r
POLE_AND_STEEL = GroupName "steel on a pole"
pattern $bSPACESUIT_PART :: GroupName ItemKind
$mSPACESUIT_PART :: forall r. GroupName ItemKind -> (Void# -> r) -> (Void# -> r) -> r
SPACESUIT_PART = GroupName "spacesuit part"
pattern $bTHICK_CLOTH :: GroupName ItemKind
$mTHICK_CLOTH :: forall r. GroupName ItemKind -> (Void# -> r) -> (Void# -> r) -> r
THICK_CLOTH = GroupName "thick cloth"
pattern $bPERFUME :: GroupName ItemKind
$mPERFUME :: forall r. GroupName ItemKind -> (Void# -> r) -> (Void# -> r) -> r
PERFUME = GroupName "perfume"
pattern $bSTARTING_HAMMER :: GroupName ItemKind
$mSTARTING_HAMMER :: forall r. GroupName ItemKind -> (Void# -> r) -> (Void# -> r) -> r
STARTING_HAMMER = GroupName "starting hammer"
pattern $bCLOTH_RAG :: GroupName ItemKind
$mCLOTH_RAG :: forall r. GroupName ItemKind -> (Void# -> r) -> (Void# -> r) -> r
CLOTH_RAG = GroupName "cloth rag"

pattern $bS_ENCHANCED_BERRY :: GroupName ItemKind
$mS_ENCHANCED_BERRY :: forall r. GroupName ItemKind -> (Void# -> r) -> (Void# -> r) -> r
S_ENCHANCED_BERRY = GroupName "enhanced berry"
pattern $bS_COOKED_BERRY :: GroupName ItemKind
$mS_COOKED_BERRY :: forall r. GroupName ItemKind -> (Void# -> r) -> (Void# -> r) -> r
S_COOKED_BERRY = GroupName "cooked berry"
pattern $bS_FRAYED_FUNGUS :: GroupName ItemKind
$mS_FRAYED_FUNGUS :: forall r. GroupName ItemKind -> (Void# -> r) -> (Void# -> r) -> r
S_FRAYED_FUNGUS = GroupName "frayed fungus"
pattern $bS_COOKED_FUNGUS :: GroupName ItemKind
$mS_COOKED_FUNGUS :: forall r. GroupName ItemKind -> (Void# -> r) -> (Void# -> r) -> r
S_COOKED_FUNGUS = GroupName "cooked fungus"
pattern $bS_THIC_LEAF :: GroupName ItemKind
$mS_THIC_LEAF :: forall r. GroupName ItemKind -> (Void# -> r) -> (Void# -> r) -> r
S_THIC_LEAF = GroupName "thick leaf"
pattern $bS_COOKED_LEAF :: GroupName ItemKind
$mS_COOKED_LEAF :: forall r. GroupName ItemKind -> (Void# -> r) -> (Void# -> r) -> r
S_COOKED_LEAF = GroupName "cooked leaf"
pattern $bS_RECONFIGURED_FRUIT :: GroupName ItemKind
$mS_RECONFIGURED_FRUIT :: forall r. GroupName ItemKind -> (Void# -> r) -> (Void# -> r) -> r
S_RECONFIGURED_FRUIT = GroupName "reconfigured fruit"
pattern $bS_COOKED_FRUIT :: GroupName ItemKind
$mS_COOKED_FRUIT :: forall r. GroupName ItemKind -> (Void# -> r) -> (Void# -> r) -> r
S_COOKED_FRUIT = GroupName "cooked fruit"
pattern $bS_FRAGRANT_HERB :: GroupName ItemKind
$mS_FRAGRANT_HERB :: forall r. GroupName ItemKind -> (Void# -> r) -> (Void# -> r) -> r
S_FRAGRANT_HERB = GroupName "fragrant herb"
pattern $bS_COOKED_HERB :: GroupName ItemKind
$mS_COOKED_HERB :: forall r. GroupName ItemKind -> (Void# -> r) -> (Void# -> r) -> r
S_COOKED_HERB = GroupName "cooked herb"
pattern $bS_DULL_FLOWER :: GroupName ItemKind
$mS_DULL_FLOWER :: forall r. GroupName ItemKind -> (Void# -> r) -> (Void# -> r) -> r
S_DULL_FLOWER = GroupName "dull flower"
pattern $bS_COOKED_FLOWER :: GroupName ItemKind
$mS_COOKED_FLOWER :: forall r. GroupName ItemKind -> (Void# -> r) -> (Void# -> r) -> r
S_COOKED_FLOWER = GroupName "cooked flower"
pattern $bS_SPICY_BARK :: GroupName ItemKind
$mS_SPICY_BARK :: forall r. GroupName ItemKind -> (Void# -> r) -> (Void# -> r) -> r
S_SPICY_BARK = GroupName "spicy bark"
pattern $bS_COOKED_BARK :: GroupName ItemKind
$mS_COOKED_BARK :: forall r. GroupName ItemKind -> (Void# -> r) -> (Void# -> r) -> r
S_COOKED_BARK = GroupName "cooked bark"
pattern $bS_PUMPKIN :: GroupName ItemKind
$mS_PUMPKIN :: forall r. GroupName ItemKind -> (Void# -> r) -> (Void# -> r) -> r
S_PUMPKIN = GroupName "pumpkin"
pattern $bS_COOKED_PUMPKIN :: GroupName ItemKind
$mS_COOKED_PUMPKIN :: forall r. GroupName ItemKind -> (Void# -> r) -> (Void# -> r) -> r
S_COOKED_PUMPKIN = GroupName "cooked pumpkin"

pattern $bS_DOUSED_WOODEN_TORCH :: GroupName ItemKind
$mS_DOUSED_WOODEN_TORCH :: forall r. GroupName ItemKind -> (Void# -> r) -> (Void# -> r) -> r
S_DOUSED_WOODEN_TORCH = GroupName "doused wooden torch"
pattern $bS_DOUSED_OIL_LAMP :: GroupName ItemKind
$mS_DOUSED_OIL_LAMP :: forall r. GroupName ItemKind -> (Void# -> r) -> (Void# -> r) -> r
S_DOUSED_OIL_LAMP = GroupName "doused oil lamp"
pattern $bS_OIL_LAMP :: GroupName ItemKind
$mS_OIL_LAMP :: forall r. GroupName ItemKind -> (Void# -> r) -> (Void# -> r) -> r
S_OIL_LAMP = GroupName "oil lamp"
pattern $bS_REFRIGERATION_COIL :: GroupName ItemKind
$mS_REFRIGERATION_COIL :: forall r. GroupName ItemKind -> (Void# -> r) -> (Void# -> r) -> r
S_REFRIGERATION_COIL = GroupName "refrigeration coil"
pattern $bS_ROSE_WATER_FLASK :: GroupName ItemKind
$mS_ROSE_WATER_FLASK :: forall r. GroupName ItemKind -> (Void# -> r) -> (Void# -> r) -> r
S_ROSE_WATER_FLASK = GroupName "rose water flask"
pattern $bS_WATER_FLASK :: GroupName ItemKind
$mS_WATER_FLASK :: forall r. GroupName ItemKind -> (Void# -> r) -> (Void# -> r) -> r
S_WATER_FLASK = GroupName "water flask"
pattern $bS_SPACESUIT_JACKET :: GroupName ItemKind
$mS_SPACESUIT_JACKET :: forall r. GroupName ItemKind -> (Void# -> r) -> (Void# -> r) -> r
S_SPACESUIT_JACKET = GroupName "spacesuit jacket"
pattern $bS_SPACESUIT_TROUSERS :: GroupName ItemKind
$mS_SPACESUIT_TROUSERS :: forall r. GroupName ItemKind -> (Void# -> r) -> (Void# -> r) -> r
S_SPACESUIT_TROUSERS = GroupName "pair of space trousers"
pattern $bS_SPACESUIT_GLOVE :: GroupName ItemKind
$mS_SPACESUIT_GLOVE :: forall r. GroupName ItemKind -> (Void# -> r) -> (Void# -> r) -> r
S_SPACESUIT_GLOVE = GroupName "spacesuit glove"
pattern $bS_SPACESUIT_HELMET :: GroupName ItemKind
$mS_SPACESUIT_HELMET :: forall r. GroupName ItemKind -> (Void# -> r) -> (Void# -> r) -> r
S_SPACESUIT_HELMET = GroupName "spacesuit helmet"
pattern $bS_SPACESUIT_BOOT :: GroupName ItemKind
$mS_SPACESUIT_BOOT :: forall r. GroupName ItemKind -> (Void# -> r) -> (Void# -> r) -> r
S_SPACESUIT_BOOT = GroupName "spacesuit boot"
pattern $bS_SPACESUIT :: GroupName ItemKind
$mS_SPACESUIT :: forall r. GroupName ItemKind -> (Void# -> r) -> (Void# -> r) -> r
S_SPACESUIT = GroupName "spacesuit"
pattern $bS_SPACESUIT_TORN :: GroupName ItemKind
$mS_SPACESUIT_TORN :: forall r. GroupName ItemKind -> (Void# -> r) -> (Void# -> r) -> r
S_SPACESUIT_TORN = GroupName "torn spacesuit"
pattern $bS_HARPOON_CARGO :: GroupName ItemKind
$mS_HARPOON_CARGO :: forall r. GroupName ItemKind -> (Void# -> r) -> (Void# -> r) -> r
S_HARPOON_CARGO = GroupName "blunt harpoon"
pattern $bS_HARPOON_SHARP :: GroupName ItemKind
$mS_HARPOON_SHARP :: forall r. GroupName ItemKind -> (Void# -> r) -> (Void# -> r) -> r
S_HARPOON_SHARP = GroupName "sharp harpoon"
pattern $bS_SHIELD_BLUNT :: GroupName ItemKind
$mS_SHIELD_BLUNT :: forall r. GroupName ItemKind -> (Void# -> r) -> (Void# -> r) -> r
S_SHIELD_BLUNT = GroupName "blunted shield"
pattern $bS_SHIELD_SHARP :: GroupName ItemKind
$mS_SHIELD_SHARP :: forall r. GroupName ItemKind -> (Void# -> r) -> (Void# -> r) -> r
S_SHIELD_SHARP = GroupName "spiked shield"
pattern $bS_SHORT_BLUNT_HAMMER :: GroupName ItemKind
$mS_SHORT_BLUNT_HAMMER :: forall r. GroupName ItemKind -> (Void# -> r) -> (Void# -> r) -> r
S_SHORT_BLUNT_HAMMER = GroupName "sledgehammer"
pattern $bS_LONG_BLUNT_HAMMER :: GroupName ItemKind
$mS_LONG_BLUNT_HAMMER :: forall r. GroupName ItemKind -> (Void# -> r) -> (Void# -> r) -> r
S_LONG_BLUNT_HAMMER = GroupName "maul"
pattern $bS_SHORT_SHARP_HAMMER :: GroupName ItemKind
$mS_SHORT_SHARP_HAMMER :: forall r. GroupName ItemKind -> (Void# -> r) -> (Void# -> r) -> r
S_SHORT_SHARP_HAMMER = GroupName "sharp sledgehammer"
pattern $bS_LONG_SHARP_HAMMER :: GroupName ItemKind
$mS_LONG_SHARP_HAMMER :: forall r. GroupName ItemKind -> (Void# -> r) -> (Void# -> r) -> r
S_LONG_SHARP_HAMMER = GroupName "sharp maul"
pattern $bS_CLEAVER :: GroupName ItemKind
$mS_CLEAVER :: forall r. GroupName ItemKind -> (Void# -> r) -> (Void# -> r) -> r
S_CLEAVER = GroupName "cleaver"
pattern $bS_DAGGER :: GroupName ItemKind
$mS_DAGGER :: forall r. GroupName ItemKind -> (Void# -> r) -> (Void# -> r) -> r
S_DAGGER = GroupName "dagger"
pattern $bS_RAPIER_BLUNT :: GroupName ItemKind
$mS_RAPIER_BLUNT :: forall r. GroupName ItemKind -> (Void# -> r) -> (Void# -> r) -> r
S_RAPIER_BLUNT = GroupName "blunt rapier"
pattern $bS_RAPIER_SHARP :: GroupName ItemKind
$mS_RAPIER_SHARP :: forall r. GroupName ItemKind -> (Void# -> r) -> (Void# -> r) -> r
S_RAPIER_SHARP = GroupName "sharp rapier"
pattern $bS_POLE_CLEAVER :: GroupName ItemKind
$mS_POLE_CLEAVER :: forall r. GroupName ItemKind -> (Void# -> r) -> (Void# -> r) -> r
S_POLE_CLEAVER = GroupName "pole cleaver"
pattern $bS_LONG_SPEAR :: GroupName ItemKind
$mS_LONG_SPEAR :: forall r. GroupName ItemKind -> (Void# -> r) -> (Void# -> r) -> r
S_LONG_SPEAR = GroupName "long spear"
pattern $bS_SHORT_CLUB :: GroupName ItemKind
$mS_SHORT_CLUB :: forall r. GroupName ItemKind -> (Void# -> r) -> (Void# -> r) -> r
S_SHORT_CLUB = GroupName "short club"
pattern $bS_LONG_CLUB :: GroupName ItemKind
$mS_LONG_CLUB :: forall r. GroupName ItemKind -> (Void# -> r) -> (Void# -> r) -> r
S_LONG_CLUB = GroupName "long club"
pattern $bS_CROWBAR :: GroupName ItemKind
$mS_CROWBAR :: forall r. GroupName ItemKind -> (Void# -> r) -> (Void# -> r) -> r
S_CROWBAR = GroupName "crowbar"
pattern $bS_FIRE_AXE :: GroupName ItemKind
$mS_FIRE_AXE :: forall r. GroupName ItemKind -> (Void# -> r) -> (Void# -> r) -> r
S_FIRE_AXE = GroupName "fire axe"
pattern $bS_POLL_AXE :: GroupName ItemKind
$mS_POLL_AXE :: forall r. GroupName ItemKind -> (Void# -> r) -> (Void# -> r) -> r
S_POLL_AXE = GroupName "poll axe"
pattern $bS_HALBERD_BLUNT :: GroupName ItemKind
$mS_HALBERD_BLUNT :: forall r. GroupName ItemKind -> (Void# -> r) -> (Void# -> r) -> r
S_HALBERD_BLUNT = GroupName "blunt halberd"
pattern $bS_HALBERD_SHARP :: GroupName ItemKind
$mS_HALBERD_SHARP :: forall r. GroupName ItemKind -> (Void# -> r) -> (Void# -> r) -> r
S_HALBERD_SHARP = GroupName "sharp halberd"
pattern $bS_STAFF :: GroupName ItemKind
$mS_STAFF :: forall r. GroupName ItemKind -> (Void# -> r) -> (Void# -> r) -> r
S_STAFF = GroupName "staff"
pattern $bS_PIPE :: GroupName ItemKind
$mS_PIPE :: forall r. GroupName ItemKind -> (Void# -> r) -> (Void# -> r) -> r
S_PIPE = GroupName "pipe"
pattern $bS_SHARPENED_PIPE :: GroupName ItemKind
$mS_SHARPENED_PIPE :: forall r. GroupName ItemKind -> (Void# -> r) -> (Void# -> r) -> r
S_SHARPENED_PIPE = GroupName "sharpened pipe"

-- * Content

embeds :: [ItemKind]
embeds :: [ItemKind]
embeds =
  [ItemKind
scratchOnWall, ItemKind
obscenePictogram, ItemKind
subtleFresco, ItemKind
treasureCache, ItemKind
treasureCacheTrap, ItemKind
signageExit, ItemKind
signageEmbed, ItemKind
signageMerchandise, ItemKind
fireSmall, ItemKind
fireSmall5, ItemKind
fireBig, ItemKind
frost, ItemKind
rubble, ItemKind
doorwayTrapTemplate, ItemKind
doorwayTrap1, ItemKind
doorwayTrap2, ItemKind
doorwayTrap3, ItemKind
stairsUp, ItemKind
stairsDown, ItemKind
escape, ItemKind
stairsTrapUp, ItemKind
stairsTrapDown, ItemKind
lectern, ItemKind
shallowWater, ItemKind
straightPath, ItemKind
frozenGround]
  -- Allure-specific
  [ItemKind] -> [ItemKind] -> [ItemKind]
forall a. [a] -> [a] -> [a]
++ [ItemKind
stairsUpOutdoor, ItemKind
stairsDownOutdoor, ItemKind
blackStarrySky, ItemKind
disengagedDocking, ItemKind
desertedAirlock, ItemKind
ruinedFirstAidKit, ItemKind
fireFightingGear, ItemKind
fireFightingGearIntact, ItemKind
wall3dBillboard, ItemKind
crackedFlue, ItemKind
bloodOnWall, ItemKind
bloodOnWall2, ItemKind
bloodOnWall3, ItemKind
depositBox, ItemKind
depositBoxSummonHero, ItemKind
depositBoxSummonMonster, ItemKind
jewelryCase, ItemKind
ediblePlantRipe, ItemKind
stairsTrapDownOil, ItemKind
doorTrapPush, ItemKind
liftUp, ItemKind
liftDown, ItemKind
liftTrap, ItemKind
liftTrap2, ItemKind
liftTrap3, ItemKind
shuttleHardware, ItemKind
machineOil, ItemKind
crudeWeld, ItemKind
decontaminator, ItemKind
barrelFuel, ItemKind
barrelFertilizer, ItemKind
barrelOxidizer, ItemKind
barrelOil, ItemKind
barrelNitrogen, ItemKind
workshopBench, ItemKind
signageExitLuggage, ItemKind
signageEmbedLuggage, ItemKind
signageMerchandiseLuggage]

scratchOnWall,    obscenePictogram, subtleFresco, treasureCache, treasureCacheTrap, signageExit, signageEmbed, signageMerchandise, fireSmall, fireSmall5, fireBig, frost, rubble, doorwayTrapTemplate, doorwayTrap1, doorwayTrap2, doorwayTrap3, stairsUp, stairsDown, escape, stairsTrapUp, stairsTrapDown, lectern, shallowWater, straightPath, frozenGround :: ItemKind
-- Allure-specific
stairsUpOutdoor,       stairsDownOutdoor, blackStarrySky, disengagedDocking, desertedAirlock, ruinedFirstAidKit, fireFightingGear, fireFightingGearIntact, wall3dBillboard, crackedFlue, bloodOnWall, bloodOnWall2, bloodOnWall3, depositBox, depositBoxSummonHero, depositBoxSummonMonster, jewelryCase, ediblePlantRipe, stairsTrapDownOil, doorTrapPush, liftUp, liftDown, liftTrap, liftTrap2, liftTrap3, shuttleHardware, machineOil, crudeWeld, decontaminator, barrelFuel, barrelFertilizer, barrelOxidizer, barrelOil, barrelNitrogen, workshopBench, signageExitLuggage, signageEmbedLuggage, signageMerchandiseLuggage :: ItemKind

-- Make sure very few walls are substantially useful, e.g., caches,
-- and none that are secret. Otherwise the player will spend a lot of time
-- bumping walls, which is boring compared to fights or dialogues
-- and ever worse, the player will bump all secret walls, wasting time
-- and foregoing the fun of guessing how to find entrance to a disjoint part
-- of the level by bumping the least number of secret walls.
scratchOnWall :: ItemKind
scratchOnWall = ItemKind :: ContentSymbol ItemKind
-> Text
-> Freqs ItemKind
-> [Flavour]
-> Dice
-> Rarity
-> Text
-> Int
-> Dice
-> [Aspect]
-> [Effect]
-> [(GroupName ItemKind, CStore)]
-> Text
-> ItemKind
ItemKind
  { isymbol :: ContentSymbol ItemKind
isymbol  = ContentSymbol ItemKind -> ContentSymbol ItemKind
forall c. ContentSymbol ItemKind -> ContentSymbol ItemKind
toContentSymbol ContentSymbol ItemKind
'?'
  , iname :: Text
iname    = Text
"claw mark"
  , ifreq :: Freqs ItemKind
ifreq    = [(GroupName ItemKind
SCRATCH_ON_WALL, Int
1)]
  , iflavour :: [Flavour]
iflavour = [Color] -> [Flavour]
zipPlain [Color
BrBlack]
  , icount :: Dice
icount   = Dice
1
  , irarity :: Rarity
irarity  = [(Double
1, Int
1)]
  , iverbHit :: Text
iverbHit = Text
"scratch"
  , iweight :: Int
iweight  = Int
1000
  , idamage :: Dice
idamage  = Dice
0
  , iaspects :: [Aspect]
iaspects = [Flag -> Aspect
SetFlag Flag
Durable]
  , ieffects :: [Effect]
ieffects = [ Text -> Text -> Effect
VerbMsg Text
"start making sense of the scratches" Text
"."
               , DetectKind -> Int -> Effect
Detect DetectKind
DetectHidden Int
4 ]
  , idesc :: Text
idesc    = Text
"A seemingly random series of scratches, carved deep into the wall."
  , ikit :: [(GroupName ItemKind, CStore)]
ikit     = []
  }
obscenePictogram :: ItemKind
obscenePictogram = ItemKind :: ContentSymbol ItemKind
-> Text
-> Freqs ItemKind
-> [Flavour]
-> Dice
-> Rarity
-> Text
-> Int
-> Dice
-> [Aspect]
-> [Effect]
-> [(GroupName ItemKind, CStore)]
-> Text
-> ItemKind
ItemKind
  { isymbol :: ContentSymbol ItemKind
isymbol  = ContentSymbol ItemKind -> ContentSymbol ItemKind
forall c. ContentSymbol ItemKind -> ContentSymbol ItemKind
toContentSymbol ContentSymbol ItemKind
'*'
  , iname :: Text
iname    = Text
"repulsing graffiti"
  , ifreq :: Freqs ItemKind
ifreq    = [(GroupName ItemKind
OBSCENE_PICTOGRAM, Int
1)]
  , iflavour :: [Flavour]
iflavour = [Color] -> [Flavour]
zipPlain [Color
BrMagenta]
  , icount :: Dice
icount   = Dice
1
  , irarity :: Rarity
irarity  = [(Double
1, Int
1)]
  , iverbHit :: Text
iverbHit = Text
"infuriate"
  , iweight :: Int
iweight  = Int
1000
  , idamage :: Dice
idamage  = Dice
0
  , iaspects :: [Aspect]
iaspects = [Dice -> Aspect
Timeout Dice
7, Flag -> Aspect
SetFlag Flag
Durable]
  , ieffects :: [Effect]
ieffects = [ Text -> Text -> Effect
VerbMsg Text
"enter inexplicable rage at a glimpse of the inscrutable graffiti!" Text
""
               , Int -> Effect
RefillCalm (-Int
20)
               , [Effect] -> Effect
OneOf [ GroupName ItemKind -> Dice -> Effect
toOrganGood GroupName ItemKind
S_STRENGTHENED (Dice
3 Dice -> Dice -> Dice
forall a. Num a => a -> a -> a
+ Int
1 Int -> Int -> Dice
`d` Int
2)
                       , Maybe Int -> CStore -> GroupName ItemKind -> TimerDice -> Effect
CreateItem Maybe Int
forall a. Maybe a
Nothing CStore
CGround GroupName ItemKind
S_SANDSTONE_ROCK TimerDice
timerNone ]
               ]
  , idesc :: Text
idesc    = Text
""  -- alien writing? or runaway robot AI?
  , ikit :: [(GroupName ItemKind, CStore)]
ikit     = []
  }
subtleFresco :: ItemKind
subtleFresco = ItemKind :: ContentSymbol ItemKind
-> Text
-> Freqs ItemKind
-> [Flavour]
-> Dice
-> Rarity
-> Text
-> Int
-> Dice
-> [Aspect]
-> [Effect]
-> [(GroupName ItemKind, CStore)]
-> Text
-> ItemKind
ItemKind
  { isymbol :: ContentSymbol ItemKind
isymbol  = ContentSymbol ItemKind -> ContentSymbol ItemKind
forall c. ContentSymbol ItemKind -> ContentSymbol ItemKind
toContentSymbol ContentSymbol ItemKind
'*'
  , iname :: Text
iname    = Text
"subtle mural"
  , ifreq :: Freqs ItemKind
ifreq    = [(GroupName ItemKind
SUBTLE_FRESCO, Int
1)]
  , iflavour :: [Flavour]
iflavour = [Color] -> [Flavour]
zipPlain [Color
BrGreen]
  , icount :: Dice
icount   = Dice
1
  , irarity :: Rarity
irarity  = [(Double
1, Int
1)]
  , iverbHit :: Text
iverbHit = Text
"sooth"
  , iweight :: Int
iweight  = Int
1000
  , idamage :: Dice
idamage  = Dice
0
  , iaspects :: [Aspect]
iaspects = [Dice -> Aspect
Timeout Dice
10, Flag -> Aspect
SetFlag Flag
Durable]
  , ieffects :: [Effect]
ieffects = [ Text -> Text -> Effect
VerbMsg Text
"feel refreshed by the subtle fresco" Text
"."
               , GroupName ItemKind -> Dice -> Effect
toOrganGood GroupName ItemKind
S_FAR_SIGHTED (Dice
5 Dice -> Dice -> Dice
forall a. Num a => a -> a -> a
+ Int
1 Int -> Int -> Dice
`d` Int
2) ]
  , idesc :: Text
idesc    = Text
"Expensive yet tasteful."
  , ikit :: [(GroupName ItemKind, CStore)]
ikit     = []
  }
treasureCache :: ItemKind
treasureCache = ItemKind :: ContentSymbol ItemKind
-> Text
-> Freqs ItemKind
-> [Flavour]
-> Dice
-> Rarity
-> Text
-> Int
-> Dice
-> [Aspect]
-> [Effect]
-> [(GroupName ItemKind, CStore)]
-> Text
-> ItemKind
ItemKind
  { isymbol :: ContentSymbol ItemKind
isymbol  = ContentSymbol ItemKind -> ContentSymbol ItemKind
forall c. ContentSymbol ItemKind -> ContentSymbol ItemKind
toContentSymbol ContentSymbol ItemKind
'o'
  , iname :: Text
iname    = Text
"set"
  , ifreq :: Freqs ItemKind
ifreq    = [(GroupName ItemKind
ABANDONED_CACHE, Int
1)]
  , iflavour :: [Flavour]
iflavour = [Color] -> [Flavour]
zipPlain [Color
BrBlue]
  , icount :: Dice
icount   = Dice
1
  , irarity :: Rarity
irarity  = [(Double
1, Int
1)]
  , iverbHit :: Text
iverbHit = Text
"crash"
  , iweight :: Int
iweight  = Int
10000
  , idamage :: Dice
idamage  = Dice
0
  , iaspects :: [Aspect]
iaspects = [Text -> Aspect
ELabel Text
"of odds and ends", Flag -> Aspect
SetFlag Flag
Durable]
  , ieffects :: [Effect]
ieffects = [Maybe Int -> CStore -> GroupName ItemKind -> TimerDice -> Effect
CreateItem Maybe Int
forall a. Maybe a
Nothing CStore
CGround GroupName ItemKind
COMMON_ITEM TimerDice
timerNone]
  , idesc :: Text
idesc    = Text
"If this stash is hidden, it's in plain sight. Or, more probably, it's just tucked aside so that it doesn't get in the way. Whomever worked there, apparently failed to return and retrieve his belongings."
  , ikit :: [(GroupName ItemKind, CStore)]
ikit     = []
  }
reliefMsg :: Effect
reliefMsg :: Effect
reliefMsg = Text -> Text -> Effect
VerbMsg Text
"sigh with relief when nothing explodes in your face!" Text
""
treasureCacheTrap :: ItemKind
treasureCacheTrap = ItemKind :: ContentSymbol ItemKind
-> Text
-> Freqs ItemKind
-> [Flavour]
-> Dice
-> Rarity
-> Text
-> Int
-> Dice
-> [Aspect]
-> [Effect]
-> [(GroupName ItemKind, CStore)]
-> Text
-> ItemKind
ItemKind
  { isymbol :: ContentSymbol ItemKind
isymbol  = ContentSymbol ItemKind -> ContentSymbol ItemKind
forall c. ContentSymbol ItemKind -> ContentSymbol ItemKind
toContentSymbol ContentSymbol ItemKind
'^'
  , iname :: Text
iname    = Text
"anti-theft protection"
  , ifreq :: Freqs ItemKind
ifreq    = [(GroupName ItemKind
JEWELRY_DISPLAY_TRAP, Int
1)]
  , iflavour :: [Flavour]
iflavour = [Color] -> [Flavour]
zipPlain [Color
Red]
  , icount :: Dice
icount   = Dice
1
  , irarity :: Rarity
irarity  = [(Double
1, Int
1)]
  , iverbHit :: Text
iverbHit = Text
"taint"
  , iweight :: Int
iweight  = Int
1000
  , idamage :: Dice
idamage  = Dice
0
  , iaspects :: [Aspect]
iaspects = []  -- not Durable, springs at most once
  , ieffects :: [Effect]
ieffects = [[Effect] -> Effect
OneOf [ GroupName ItemKind -> Dice -> Effect
toOrganBad GroupName ItemKind
S_BLIND (Dice
10 Dice -> Dice -> Dice
forall a. Num a => a -> a -> a
+ Int
1 Int -> Int -> Dice
`d` Int
10)
                      , Int -> Effect
RefillCalm (-Int
99)
                      , GroupName ItemKind -> Effect
Explode GroupName ItemKind
S_FOCUSED_CONCUSSION
                      , Effect
reliefMsg, Effect
reliefMsg ]]
  , idesc :: Text
idesc    = Text
"A display of such kingly trinkets warrants an autonomous guarding device. The precaution is particularly understandable if some of the merchandise is capable of instantly frying video monitoring equipment across the hall."
  , ikit :: [(GroupName ItemKind, CStore)]
ikit     = []
  }
signageExit :: ItemKind
signageExit = ItemKind :: ContentSymbol ItemKind
-> Text
-> Freqs ItemKind
-> [Flavour]
-> Dice
-> Rarity
-> Text
-> Int
-> Dice
-> [Aspect]
-> [Effect]
-> [(GroupName ItemKind, CStore)]
-> Text
-> ItemKind
ItemKind
  { isymbol :: ContentSymbol ItemKind
isymbol  = ContentSymbol ItemKind -> ContentSymbol ItemKind
forall c. ContentSymbol ItemKind -> ContentSymbol ItemKind
toContentSymbol ContentSymbol ItemKind
'0'
  , iname :: Text
iname    = Text
"sticker"
  , ifreq :: Freqs ItemKind
ifreq    = [(GroupName ItemKind
SIGNAGE, Int
100)]
  , iflavour :: [Flavour]
iflavour = [Color] -> [Flavour]
zipPlain [Color
BrGreen]
  , icount :: Dice
icount   = Dice
1
  , irarity :: Rarity
irarity  = [(Double
1, Int
0), (Double
2, Int
1)]
  , iverbHit :: Text
iverbHit = Text
"whack"
  , iweight :: Int
iweight  = Int
10000
  , idamage :: Dice
idamage  = Dice
0
  , iaspects :: [Aspect]
iaspects = [Flag -> Aspect
SetFlag Flag
Durable]
  , ieffects :: [Effect]
ieffects = [DetectKind -> Int -> Effect
Detect DetectKind
DetectExit Int
100]  -- low tech, hence fully operational
  , idesc :: Text
idesc    = Text
"Mandatory emergency exit information in low-tech form."
                 -- This is a rare tile so use it to convey some more backstory.
  , ikit :: [(GroupName ItemKind, CStore)]
ikit     = []
  }
signageEmbed :: ItemKind
signageEmbed = ItemKind
signageExit
  { iname :: Text
iname    = Text
"notice"
  , ifreq :: Freqs ItemKind
ifreq    = [(GroupName ItemKind
SIGNAGE, Int
100)]
  , iflavour :: [Flavour]
iflavour = [Color] -> [Flavour]
zipPlain [Color
Cyan]
  , ieffects :: [Effect]
ieffects = [DetectKind -> Int -> Effect
Detect DetectKind
DetectEmbed Int
12]  -- low tech, hence fully operational
  , idesc :: Text
idesc    = Text
"Detailed schematics for the maintenance crew."
                 -- This is a rare tile so use it to convey some more backstory.
  }
signageMerchandise :: ItemKind
signageMerchandise = ItemKind
signageExit
  { iname :: Text
iname    = Text
"shop list"
  , ifreq :: Freqs ItemKind
ifreq    = [(GroupName ItemKind
SIGNAGE, Int
100)]
  , iflavour :: [Flavour]
iflavour = [Color] -> [Flavour]
zipPlain [Color
BrCyan]
  , ieffects :: [Effect]
ieffects = [DetectKind -> Int -> Effect
Detect DetectKind
DetectLoot Int
20]  -- high tech, so slightly confused
  , idesc :: Text
idesc    = Text
"A list of nearby commercial outlets, constantly updated by tracking merchandise not registered as passenger property. Customers are kindly requeted to refrain from littering in this heavily monitored public area."
  }
fireSmall :: ItemKind
fireSmall = ItemKind :: ContentSymbol ItemKind
-> Text
-> Freqs ItemKind
-> [Flavour]
-> Dice
-> Rarity
-> Text
-> Int
-> Dice
-> [Aspect]
-> [Effect]
-> [(GroupName ItemKind, CStore)]
-> Text
-> ItemKind
ItemKind
  { isymbol :: ContentSymbol ItemKind
isymbol  = ContentSymbol ItemKind -> ContentSymbol ItemKind
forall c. ContentSymbol ItemKind -> ContentSymbol ItemKind
toContentSymbol ContentSymbol ItemKind
'o'
  , iname :: Text
iname    = Text
"tiny fire"
  , ifreq :: Freqs ItemKind
ifreq    = [(GroupName ItemKind
SMALL_FIRE, Int
1), (GroupName ItemKind
FIRE_SOURCE, Int
1)]
  , iflavour :: [Flavour]
iflavour = [Color] -> [Flavour]
zipPlain [Color
BrRed]
  , icount :: Dice
icount   = Dice
1
  , irarity :: Rarity
irarity  = [(Double
1, Int
1)]
  , iverbHit :: Text
iverbHit = Text
"burn"
  , iweight :: Int
iweight  = Int
10000
  , idamage :: Dice
idamage  = Dice
0
  , iaspects :: [Aspect]
iaspects = [Text -> Aspect
ELabel Text
"of roasting", Flag -> Aspect
SetFlag Flag
Durable]
  , ieffects :: [Effect]
ieffects = [ Dice -> Effect
Burn Dice
1, GroupName ItemKind -> Effect
Explode GroupName ItemKind
S_SINGLE_SPARK
               , Effect -> Effect
OnCombine Effect
roastEffect ]
  , idesc :: Text
idesc    = Text
"A few embers and wisps of flame, glowing brightly."
  , ikit :: [(GroupName ItemKind, CStore)]
ikit     = []
  }
fireSmall5 :: ItemKind
fireSmall5 = ItemKind
fireSmall
  { iname :: Text
iname    = Text
"small fire"  -- whenever a lot of mass to burn, e.g., bush, oil
  , ifreq :: Freqs ItemKind
ifreq    = [(GroupName ItemKind
SMALL_FIRE_5, Int
1), (GroupName ItemKind
FIRE_SOURCE, Int
1)]
  , iflavour :: [Flavour]
iflavour = [Color] -> [Flavour]
zipPlain [Color
Red]
  , ieffects :: [Effect]
ieffects = [ Dice -> Effect
Burn Dice
1, GroupName ItemKind -> Effect
Explode GroupName ItemKind
S_SINGLE_SPARK
               , Effect -> Effect
OnCombine Effect
roastEffect5 ]
  }
fireBig :: ItemKind
fireBig = ItemKind
fireSmall
  { isymbol :: ContentSymbol ItemKind
isymbol  = ContentSymbol ItemKind -> ContentSymbol ItemKind
forall c. ContentSymbol ItemKind -> ContentSymbol ItemKind
toContentSymbol ContentSymbol ItemKind
'0'
  , iname :: Text
iname    = Text
"big fire"
  , ifreq :: Freqs ItemKind
ifreq    = [(GroupName ItemKind
BIG_FIRE, Int
1), (GroupName ItemKind
FIRE_SOURCE, Int
1)]
  , iflavour :: [Flavour]
iflavour = [Color] -> [Flavour]
zipPlain [Color
Red]
  , iaspects :: [Aspect]
iaspects = [Text -> Aspect
ELabel Text
"of immolation", Flag -> Aspect
SetFlag Flag
Durable]
  , ieffects :: [Effect]
ieffects = [ Dice -> Effect
Burn Dice
2
               , Maybe Int -> CStore -> GroupName ItemKind -> TimerDice -> Effect
CreateItem Maybe Int
forall a. Maybe a
Nothing CStore
CGround GroupName ItemKind
S_WOODEN_TORCH TimerDice
timerNone
               , GroupName ItemKind -> Effect
Explode GroupName ItemKind
S_SPARK ]
  , idesc :: Text
idesc    = Text
"Glowing with light and warmth."
  , ikit :: [(GroupName ItemKind, CStore)]
ikit     = []
  }
frost :: ItemKind
frost = ItemKind :: ContentSymbol ItemKind
-> Text
-> Freqs ItemKind
-> [Flavour]
-> Dice
-> Rarity
-> Text
-> Int
-> Dice
-> [Aspect]
-> [Effect]
-> [(GroupName ItemKind, CStore)]
-> Text
-> ItemKind
ItemKind
  { isymbol :: ContentSymbol ItemKind
isymbol  = ContentSymbol ItemKind -> ContentSymbol ItemKind
forall c. ContentSymbol ItemKind -> ContentSymbol ItemKind
toContentSymbol ContentSymbol ItemKind
'^'
  , iname :: Text
iname    = Text
"frozen mass"
  , ifreq :: Freqs ItemKind
ifreq    = [(GroupName ItemKind
FROST, Int
1), (GroupName ItemKind
COLD_SOURCE, Int
1)]
  , iflavour :: [Flavour]
iflavour = [Color] -> [Flavour]
zipPlain [Color
BrBlue]
  , icount :: Dice
icount   = Dice
1
  , irarity :: Rarity
irarity  = [(Double
1, Int
1)]
  , iverbHit :: Text
iverbHit = Text
"burn"
  , iweight :: Int
iweight  = Int
10000
  , idamage :: Dice
idamage  = Dice
0
  , iaspects :: [Aspect]
iaspects = [Flag -> Aspect
SetFlag Flag
Durable]
  , ieffects :: [Effect]
ieffects = [ Dice -> Effect
Burn Dice
1  -- sensory ambiguity between hot and cold
               , Int -> Effect
RefillCalm Int
20  -- cold reason
               , ThrowMod -> Effect
PushActor (Int -> Int -> Int -> ThrowMod
ThrowMod Int
400 Int
10 Int
1) ]  -- slippery ice
  , idesc :: Text
idesc    = Text
"Intricate patterns of shining ice. Too voluminous to be thawed, but fragile enough to be shattered."
  , ikit :: [(GroupName ItemKind, CStore)]
ikit     = []
  }
rubble :: ItemKind
rubble = ItemKind :: ContentSymbol ItemKind
-> Text
-> Freqs ItemKind
-> [Flavour]
-> Dice
-> Rarity
-> Text
-> Int
-> Dice
-> [Aspect]
-> [Effect]
-> [(GroupName ItemKind, CStore)]
-> Text
-> ItemKind
ItemKind
  { isymbol :: ContentSymbol ItemKind
isymbol  = ContentSymbol ItemKind -> ContentSymbol ItemKind
forall c. ContentSymbol ItemKind -> ContentSymbol ItemKind
toContentSymbol ContentSymbol ItemKind
'&'
  , iname :: Text
iname    = Text
"rubble"
  , ifreq :: Freqs ItemKind
ifreq    = [(GroupName ItemKind
RUBBLE, Int
1)]
  , iflavour :: [Flavour]
iflavour = [Color] -> [Flavour]
zipPlain [Color
BrYellow]
  , icount :: Dice
icount   = Dice
1
  , irarity :: Rarity
irarity  = [(Double
1, Int
1)]
  , iverbHit :: Text
iverbHit = Text
"bury"
  , iweight :: Int
iweight  = Int
100000
  , idamage :: Dice
idamage  = Dice
0
  , iaspects :: [Aspect]
iaspects = [Flag -> Aspect
SetFlag Flag
Durable]
  , ieffects :: [Effect]
ieffects = [[Effect] -> Effect
OneOf [ GroupName ItemKind -> Effect
Explode GroupName ItemKind
S_FOCUSED_GLASS_HAIL
                      , GroupName ItemKind -> Dice -> Effect
Summon GroupName ItemKind
MOBILE_ANIMAL (Dice -> Effect) -> Dice -> Effect
forall a b. (a -> b) -> a -> b
$ Int
1 Int -> Int -> Dice
`dL` Int
2
                      , GroupName ItemKind -> Effect
toOrganNoTimer GroupName ItemKind
S_POISONED
                      , Maybe Int -> CStore -> GroupName ItemKind -> TimerDice -> Effect
CreateItem Maybe Int
forall a. Maybe a
Nothing CStore
CGround GroupName ItemKind
ANY_ARROW TimerDice
timerNone
                      , Maybe Int -> CStore -> GroupName ItemKind -> TimerDice -> Effect
CreateItem Maybe Int
forall a. Maybe a
Nothing CStore
CGround GroupName ItemKind
STARTING_WEAPON TimerDice
timerNone
                      , Effect
reliefMsg, Effect
reliefMsg, Effect
reliefMsg
                      , Effect
reliefMsg, Effect
reliefMsg, Effect
reliefMsg ]]
  , idesc :: Text
idesc    = Text
"Broken chunks of foam concrete, glass and torn and burned equipment."
  , ikit :: [(GroupName ItemKind, CStore)]
ikit     = []
  }
doorwayTrapTemplate :: ItemKind
doorwayTrapTemplate = ItemKind :: ContentSymbol ItemKind
-> Text
-> Freqs ItemKind
-> [Flavour]
-> Dice
-> Rarity
-> Text
-> Int
-> Dice
-> [Aspect]
-> [Effect]
-> [(GroupName ItemKind, CStore)]
-> Text
-> ItemKind
ItemKind
  { isymbol :: ContentSymbol ItemKind
isymbol  = ContentSymbol ItemKind -> ContentSymbol ItemKind
forall c. ContentSymbol ItemKind -> ContentSymbol ItemKind
toContentSymbol ContentSymbol ItemKind
'+'
  , iname :: Text
iname    = Text
"doorway trap"
  , ifreq :: Freqs ItemKind
ifreq    = [(GroupName ItemKind
DOORWAY_TRAP_UNKNOWN, Int
1), (GroupName ItemKind
DOORWAY_TRAP, Int
0)]
      -- the void group needed to pick the item for tile triggering
      -- even when not yet identified
  , iflavour :: [Flavour]
iflavour = [Color] -> [Flavour]
zipPlain [Color]
brightCol
  , icount :: Dice
icount   = Dice
1
  , irarity :: Rarity
irarity  = [(Double
1, Int
1)]
  , iverbHit :: Text
iverbHit = Text
"cripple"
  , iweight :: Int
iweight  = Int
10000
  , idamage :: Dice
idamage  = Dice
0
  , iaspects :: [Aspect]
iaspects = [GroupName ItemKind -> Aspect
PresentAs GroupName ItemKind
DOORWAY_TRAP_UNKNOWN]
      -- not Durable, springs at most once
  , ieffects :: [Effect]
ieffects = []
  , idesc :: Text
idesc    = Text
"Just turn the handle..."
  , ikit :: [(GroupName ItemKind, CStore)]
ikit     = []
  }
doorwayTrap1 :: ItemKind
doorwayTrap1 = ItemKind
doorwayTrapTemplate
  { ifreq :: Freqs ItemKind
ifreq    = [(GroupName ItemKind
DOORWAY_TRAP, Int
50)]
  , ieffects :: [Effect]
ieffects = [GroupName ItemKind -> Dice -> Effect
toOrganBad GroupName ItemKind
S_BLIND (Dice -> Effect) -> Dice -> Effect
forall a b. (a -> b) -> a -> b
$ (Int
1 Int -> Int -> Dice
`dL` Int
4) Dice -> Dice -> Dice
forall a. Num a => a -> a -> a
* Dice
5]
  -- , idesc    = ""  -- TODO: once physical mechanism decided, also add ways
                      -- to disarm it, using up some items for that
  }
doorwayTrap2 :: ItemKind
doorwayTrap2 = ItemKind
doorwayTrapTemplate
  { ifreq :: Freqs ItemKind
ifreq    = [(GroupName ItemKind
DOORWAY_TRAP, Int
25)]
  , ieffects :: [Effect]
ieffects = [GroupName ItemKind -> Dice -> Effect
toOrganBad GroupName ItemKind
S_SLOWED (Dice -> Effect) -> Dice -> Effect
forall a b. (a -> b) -> a -> b
$ (Int
1 Int -> Int -> Dice
`dL` Int
4) Dice -> Dice -> Dice
forall a. Num a => a -> a -> a
* Dice
10]
  -- , idesc    = ""
  }
doorwayTrap3 :: ItemKind
doorwayTrap3 = ItemKind
doorwayTrapTemplate
  { ifreq :: Freqs ItemKind
ifreq    = [(GroupName ItemKind
DOORWAY_TRAP, Int
25)]
  , ieffects :: [Effect]
ieffects = [GroupName ItemKind -> Dice -> Effect
toOrganBad GroupName ItemKind
S_WEAKENED (Dice -> Effect) -> Dice -> Effect
forall a b. (a -> b) -> a -> b
$ (Int
1 Int -> Int -> Dice
`dL` Int
4) Dice -> Dice -> Dice
forall a. Num a => a -> a -> a
* Dice
10 ]
  -- , idesc    = ""
  }
stairsUp :: ItemKind
stairsUp = ItemKind :: ContentSymbol ItemKind
-> Text
-> Freqs ItemKind
-> [Flavour]
-> Dice
-> Rarity
-> Text
-> Int
-> Dice
-> [Aspect]
-> [Effect]
-> [(GroupName ItemKind, CStore)]
-> Text
-> ItemKind
ItemKind
  { isymbol :: ContentSymbol ItemKind
isymbol  = ContentSymbol ItemKind -> ContentSymbol ItemKind
forall c. ContentSymbol ItemKind -> ContentSymbol ItemKind
toContentSymbol ContentSymbol ItemKind
'<'
  , iname :: Text
iname    = Text
"flight"
  , ifreq :: Freqs ItemKind
ifreq    = [(GroupName ItemKind
STAIRS_UP, Int
1)]
  , iflavour :: [Flavour]
iflavour = [Color] -> [Flavour]
zipPlain [Color
BrWhite]
  , icount :: Dice
icount   = Dice
1
  , irarity :: Rarity
irarity  = [(Double
1, Int
1)]
  , iverbHit :: Text
iverbHit = Text
"crash"  -- the verb is only used when the item hits,
                        -- not when it's applied otherwise, e.g., from tile
  , iweight :: Int
iweight  = Int
100000
  , idamage :: Dice
idamage  = Dice
0
  , iaspects :: [Aspect]
iaspects = [Text -> Aspect
ELabel Text
"of steps", Flag -> Aspect
SetFlag Flag
Durable]
  , ieffects :: [Effect]
ieffects = [Bool -> Effect
Ascend Bool
True]
  , idesc :: Text
idesc    = Text
"Emergency stairs that rise towards the spaceship core. It takes slightly more effort to climb than descend, but in lowered gravity it's almost instantaneous in either case."
  , ikit :: [(GroupName ItemKind, CStore)]
ikit     = []
  }
stairsDown :: ItemKind
stairsDown = ItemKind
stairsUp
  { isymbol :: ContentSymbol ItemKind
isymbol  = ContentSymbol ItemKind -> ContentSymbol ItemKind
forall c. ContentSymbol ItemKind -> ContentSymbol ItemKind
toContentSymbol ContentSymbol ItemKind
'>'
  , ifreq :: Freqs ItemKind
ifreq    = [(GroupName ItemKind
STAIRS_DOWN, Int
1)]
  , ieffects :: [Effect]
ieffects = [Bool -> Effect
Ascend Bool
False]
  , idesc :: Text
idesc    = Text
"Emergency stairs that descend towards the outer ring. Narrow enough that only one person can comfortably use them at a time, but short enough that the whole team may climb down in quick succession."
  }
escape :: ItemKind
escape = ItemKind
stairsUp
  { isymbol :: ContentSymbol ItemKind
isymbol  = ContentSymbol ItemKind -> ContentSymbol ItemKind
forall c. ContentSymbol ItemKind -> ContentSymbol ItemKind
toContentSymbol ContentSymbol ItemKind
'>'
  , iname :: Text
iname    = Text
"way"
  , ifreq :: Freqs ItemKind
ifreq    = [(GroupName ItemKind
ESCAPE, Int
1)]
  , iflavour :: [Flavour]
iflavour = [Color] -> [Flavour]
zipPlain [Color
BrGreen]
  , iaspects :: [Aspect]
iaspects = [Flag -> Aspect
SetFlag Flag
Durable]
  , ieffects :: [Effect]
ieffects = [Effect
Escape]
  , idesc :: Text
idesc    = Text
"May this nightmare have an end?"
                 -- generic escape, so the text should be too;
                 -- for moon outdoors, spaceship, everywhere
  }
stairsTrapUp :: ItemKind
stairsTrapUp = ItemKind :: ContentSymbol ItemKind
-> Text
-> Freqs ItemKind
-> [Flavour]
-> Dice
-> Rarity
-> Text
-> Int
-> Dice
-> [Aspect]
-> [Effect]
-> [(GroupName ItemKind, CStore)]
-> Text
-> ItemKind
ItemKind
  { isymbol :: ContentSymbol ItemKind
isymbol  = ContentSymbol ItemKind -> ContentSymbol ItemKind
forall c. ContentSymbol ItemKind -> ContentSymbol ItemKind
toContentSymbol ContentSymbol ItemKind
'^'
  , iname :: Text
iname    = Text
"staircase trap"
  , ifreq :: Freqs ItemKind
ifreq    = [(GroupName ItemKind
STAIRS_TRAP_UP, Int
1)]
  , iflavour :: [Flavour]
iflavour = [Color] -> [Flavour]
zipPlain [Color
BrRed]
  , icount :: Dice
icount   = Dice
1
  , irarity :: Rarity
irarity  = [(Double
1, Int
1)]
  , iverbHit :: Text
iverbHit = Text
"buffet"
  , iweight :: Int
iweight  = Int
10000
  , idamage :: Dice
idamage  = Dice
0
  , iaspects :: [Aspect]
iaspects = []  -- not Durable, springs at most once
  , ieffects :: [Effect]
ieffects = [ Text -> Text -> Effect
VerbMsgFail Text
"be caught in decompression blast" Text
"."
               , Dice -> Effect
Teleport (Dice -> Effect) -> Dice -> Effect
forall a b. (a -> b) -> a -> b
$ Dice
3 Dice -> Dice -> Dice
forall a. Num a => a -> a -> a
+ Int
1 Int -> Int -> Dice
`dL` Int
10 ]
  , idesc :: Text
idesc    = Text
""
  , ikit :: [(GroupName ItemKind, CStore)]
ikit     = []
  }
-- Needs to be separate from stairsTrapUp, to make sure the item is
-- registered after up stairs (not only after down stairs)
-- so that effects are invoked in the proper order and, e.g., teleport works.
stairsTrapDown :: ItemKind
stairsTrapDown = ItemKind
stairsTrapUp
  { ifreq :: Freqs ItemKind
ifreq    = [(GroupName ItemKind
STAIRS_TRAP_DOWN, Int
1)]
  , iflavour :: [Flavour]
iflavour = [Color] -> [Flavour]
zipPlain [Color
Red]
  , iverbHit :: Text
iverbHit = Text
"open up under"
  , ieffects :: [Effect]
ieffects = [ Text -> Text -> Effect
VerbMsgFail Text
"fall down the stairwell" Text
"."
               , GroupName ItemKind -> Dice -> Effect
toOrganGood GroupName ItemKind
S_DRUNK (Dice
20 Dice -> Dice -> Dice
forall a. Num a => a -> a -> a
+ Int
1 Int -> Int -> Dice
`d` Int
5) ]
  , idesc :: Text
idesc    = Text
"A treacherous slab, to teach those who are too proud."
  }
lectern :: ItemKind
lectern = ItemKind :: ContentSymbol ItemKind
-> Text
-> Freqs ItemKind
-> [Flavour]
-> Dice
-> Rarity
-> Text
-> Int
-> Dice
-> [Aspect]
-> [Effect]
-> [(GroupName ItemKind, CStore)]
-> Text
-> ItemKind
ItemKind
  { isymbol :: ContentSymbol ItemKind
isymbol  = ContentSymbol ItemKind -> ContentSymbol ItemKind
forall c. ContentSymbol ItemKind -> ContentSymbol ItemKind
toContentSymbol ContentSymbol ItemKind
'?'
  , iname :: Text
iname    = Text
"VR harness"
  , ifreq :: Freqs ItemKind
ifreq    = [(GroupName ItemKind
LECTERN, Int
1)]
  , iflavour :: [Flavour]
iflavour = [Color] -> [Flavour]
zipFancy [Color
BrYellow]
  , icount :: Dice
icount   = Dice
1
  , irarity :: Rarity
irarity  = [(Double
1, Int
1)]
  , iverbHit :: Text
iverbHit = Text
"immerse"
  , iweight :: Int
iweight  = Int
10000
  , idamage :: Dice
idamage  = Dice
0
  , iaspects :: [Aspect]
iaspects = []  -- not Durable, springs at most once
  , ieffects :: [Effect]
ieffects = [ [Effect] -> Effect
OneOf [ Maybe Int -> CStore -> GroupName ItemKind -> TimerDice -> Effect
CreateItem Maybe Int
forall a. Maybe a
Nothing CStore
CGround GroupName ItemKind
ANY_SCROLL TimerDice
timerNone
                       , DetectKind -> Int -> Effect
Detect DetectKind
DetectAll Int
20
                       , Dice -> Effect
Paralyze (Dice -> Effect) -> Dice -> Effect
forall a b. (a -> b) -> a -> b
$ (Int
1 Int -> Int -> Dice
`dL` Int
6) Dice -> Dice -> Dice
forall a. Num a => a -> a -> a
* Dice
10
                       , GroupName ItemKind -> Dice -> Effect
toOrganGood GroupName ItemKind
S_DRUNK (Dice
20 Dice -> Dice -> Dice
forall a. Num a => a -> a -> a
+ Int
1 Int -> Int -> Dice
`d` Int
5) ]
               , GroupName ItemKind -> Effect
Explode GroupName ItemKind
STORY_TELLING ]
  , idesc :: Text
idesc    = Text
""
  , ikit :: [(GroupName ItemKind, CStore)]
ikit     = []
  }
shallowWater :: ItemKind
shallowWater = ItemKind :: ContentSymbol ItemKind
-> Text
-> Freqs ItemKind
-> [Flavour]
-> Dice
-> Rarity
-> Text
-> Int
-> Dice
-> [Aspect]
-> [Effect]
-> [(GroupName ItemKind, CStore)]
-> Text
-> ItemKind
ItemKind
  { isymbol :: ContentSymbol ItemKind
isymbol  = ContentSymbol ItemKind -> ContentSymbol ItemKind
forall c. ContentSymbol ItemKind -> ContentSymbol ItemKind
toContentSymbol ContentSymbol ItemKind
'~'
  , iname :: Text
iname    = Text
"shallow water"
  , ifreq :: Freqs ItemKind
ifreq    = [(GroupName ItemKind
SHALLOW_WATER, Int
1)]  -- may be too shallow to be source
  , iflavour :: [Flavour]
iflavour = [Color] -> [Flavour]
zipFancy [Color
BrCyan]
  , icount :: Dice
icount   = Dice
1
  , irarity :: Rarity
irarity  = [(Double
1, Int
1)]
  , iverbHit :: Text
iverbHit = Text
"impede"
  , iweight :: Int
iweight  = Int
10000
  , idamage :: Dice
idamage  = Dice
0
  , iaspects :: [Aspect]
iaspects = [Flag -> Aspect
SetFlag Flag
Durable]
  , ieffects :: [Effect]
ieffects = [Dice -> Effect
ParalyzeInWater Dice
2, Effect -> Effect
OnCombine Effect
waterEffect]
  , idesc :: Text
idesc    = Text
"Slows down movement. Essential when sharpening weapons."
  , ikit :: [(GroupName ItemKind, CStore)]
ikit     = []
  }
straightPath :: ItemKind
straightPath = ItemKind :: ContentSymbol ItemKind
-> Text
-> Freqs ItemKind
-> [Flavour]
-> Dice
-> Rarity
-> Text
-> Int
-> Dice
-> [Aspect]
-> [Effect]
-> [(GroupName ItemKind, CStore)]
-> Text
-> ItemKind
ItemKind
  { isymbol :: ContentSymbol ItemKind
isymbol  = ContentSymbol ItemKind -> ContentSymbol ItemKind
forall c. ContentSymbol ItemKind -> ContentSymbol ItemKind
toContentSymbol ContentSymbol ItemKind
'.'
  , iname :: Text
iname    = Text
"straight path"
  , ifreq :: Freqs ItemKind
ifreq    = [(GroupName ItemKind
STRAIGHT_PATH, Int
1)]
  , iflavour :: [Flavour]
iflavour = [Color] -> [Flavour]
zipFancy [Color
BrRed]
  , icount :: Dice
icount   = Dice
1
  , irarity :: Rarity
irarity  = [(Double
1, Int
1)]
  , iverbHit :: Text
iverbHit = Text
"propel"
  , iweight :: Int
iweight  = Int
10000
  , idamage :: Dice
idamage  = Dice
0
  , iaspects :: [Aspect]
iaspects = [Flag -> Aspect
SetFlag Flag
Durable]
  , ieffects :: [Effect]
ieffects = [Dice -> Effect
InsertMove Dice
2]
  , idesc :: Text
idesc    = Text
""
  , ikit :: [(GroupName ItemKind, CStore)]
ikit     = []
  }
frozenGround :: ItemKind
frozenGround = ItemKind :: ContentSymbol ItemKind
-> Text
-> Freqs ItemKind
-> [Flavour]
-> Dice
-> Rarity
-> Text
-> Int
-> Dice
-> [Aspect]
-> [Effect]
-> [(GroupName ItemKind, CStore)]
-> Text
-> ItemKind
ItemKind
  { isymbol :: ContentSymbol ItemKind
isymbol  = ContentSymbol ItemKind -> ContentSymbol ItemKind
forall c. ContentSymbol ItemKind -> ContentSymbol ItemKind
toContentSymbol ContentSymbol ItemKind
'.'
  , iname :: Text
iname    = Text
"shade"
  , ifreq :: Freqs ItemKind
ifreq    = [(GroupName ItemKind
FROZEN_GROUND, Int
1)]
  , iflavour :: [Flavour]
iflavour = [Color] -> [Flavour]
zipFancy [Color
BrBlue]
  , icount :: Dice
icount   = Dice
10  -- very thick ice and refreezes, but not too large and boring
  , irarity :: Rarity
irarity  = [(Double
1, Int
1)]
  , iverbHit :: Text
iverbHit = Text
"betray"
  , iweight :: Int
iweight  = Int
10000
  , idamage :: Dice
idamage  = Dice
0
  , iaspects :: [Aspect]
iaspects = [Text -> Aspect
ELabel Text
"of ice"]
                 -- no Durable or some items would be impossible to pick up
  , ieffects :: [Effect]
ieffects = [ThrowMod -> Effect
PushActor (Int -> Int -> Int -> ThrowMod
ThrowMod Int
400 Int
10 Int
1)]
  , idesc :: Text
idesc    = Text
""
  , ikit :: [(GroupName ItemKind, CStore)]
ikit     = []
  }

-- * Allure-specific

stairsUpOutdoor :: ItemKind
stairsUpOutdoor = ItemKind
stairsUp
  { ifreq :: Freqs ItemKind
ifreq    = [(GroupName ItemKind
STAIRS_UP_OUTDOOR, Int
1)]
  , idesc :: Text
idesc    = Text
"Stairs that rise towards the sky. It takes slightly more effort to climb than descend, but in the low gravity it's almost instantaneous in either case."
  }
stairsDownOutdoor :: ItemKind
stairsDownOutdoor = ItemKind
stairsDown
  { ifreq :: Freqs ItemKind
ifreq    = [(GroupName ItemKind
STAIRS_DOWN_OUTDOOR, Int
1)]
  , idesc :: Text
idesc    = Text
"Stairs that descend towards the underground. Narrow enough that only one person can comfortably use them at a time, but short enough that the whole team may climb down in quick succession."
  }
blackStarrySky :: ItemKind
blackStarrySky = ItemKind :: ContentSymbol ItemKind
-> Text
-> Freqs ItemKind
-> [Flavour]
-> Dice
-> Rarity
-> Text
-> Int
-> Dice
-> [Aspect]
-> [Effect]
-> [(GroupName ItemKind, CStore)]
-> Text
-> ItemKind
ItemKind
  { isymbol :: ContentSymbol ItemKind
isymbol  = ContentSymbol ItemKind -> ContentSymbol ItemKind
forall c. ContentSymbol ItemKind -> ContentSymbol ItemKind
toContentSymbol ContentSymbol ItemKind
' '
  , iname :: Text
iname    = Text
"black starry sky"
  , ifreq :: Freqs ItemKind
ifreq    = [(GroupName ItemKind
BLACK_STARRY_SKY, Int
1)]
  , iflavour :: [Flavour]
iflavour = [Color] -> [Flavour]
zipPlain [Color
Black]
  , icount :: Dice
icount   = Dice
1
  , irarity :: Rarity
irarity  = [(Double
1, Int
1)]
  , iverbHit :: Text
iverbHit = Text
"awe"
  , iweight :: Int
iweight  = Int
1000
  , idamage :: Dice
idamage  = Dice
0
  , iaspects :: [Aspect]
iaspects = [Flag -> Aspect
SetFlag Flag
Durable]
  , ieffects :: [Effect]
ieffects = [ Text -> Text -> Effect
VerbMsg Text
"look into the void and it looks back" Text
"."
               , Int -> Effect
RefillCalm (-Int
5) ]
  , idesc :: Text
idesc    = Text
"Occasionally a planet or the Sun zips by, but is unable to disperse the darkness. The black starscape constantly rotates. The frantic dance is silent, muted, indifferent. There is not even a hint of vibration, just the sense of heaviness and dizziness."  -- appears only on 100% flavour tiles (both floor and walls on some levels), useless and trivial to notice, so the writeup can be longer; who am I kidding, I can't make myself write condensed prose
  , ikit :: [(GroupName ItemKind, CStore)]
ikit     = []
  }
disengagedDocking :: ItemKind
disengagedDocking = ItemKind :: ContentSymbol ItemKind
-> Text
-> Freqs ItemKind
-> [Flavour]
-> Dice
-> Rarity
-> Text
-> Int
-> Dice
-> [Aspect]
-> [Effect]
-> [(GroupName ItemKind, CStore)]
-> Text
-> ItemKind
ItemKind
  { isymbol :: ContentSymbol ItemKind
isymbol  = ContentSymbol ItemKind -> ContentSymbol ItemKind
forall c. ContentSymbol ItemKind -> ContentSymbol ItemKind
toContentSymbol ContentSymbol ItemKind
'>'
  , iname :: Text
iname    = Text
"disengaged docking gear"
  , ifreq :: Freqs ItemKind
ifreq    = [(GroupName ItemKind
DISENGAGED_DOCKING_GEAR, Int
1)]
  , iflavour :: [Flavour]
iflavour = [Color] -> [Flavour]
zipPlain [Color
BrBlack]
  , icount :: Dice
icount   = Dice
1
  , irarity :: Rarity
irarity  = [(Double
1, Int
1)]
  , iverbHit :: Text
iverbHit = Text
"disappoint"
  , iweight :: Int
iweight  = Int
10000
  , idamage :: Dice
idamage  = Dice
0
  , iaspects :: [Aspect]
iaspects = [Flag -> Aspect
SetFlag Flag
Durable]
  , ieffects :: [Effect]
ieffects = []
  , idesc :: Text
idesc    = Text
"After a short examination it's clear this is not the airlock you arrived through. In fact, this airlock has no space boat attached at all. Many fine small craft were originally docked with such sockets and clamps, but after the spaceship spontaneously deorbited Neptune, a lot of them were seen jettisoned and drifting astern. What a waste. It seems the decks up, closer to the ship's core, have not been purged of shuttles as thoroughly.\nThe airlock still works, but to get out onto the outer hull surface, you'd need a spacesuit with an air tank."
  , ikit :: [(GroupName ItemKind, CStore)]
ikit     = []
  }
desertedAirlock :: ItemKind
desertedAirlock = ItemKind :: ContentSymbol ItemKind
-> Text
-> Freqs ItemKind
-> [Flavour]
-> Dice
-> Rarity
-> Text
-> Int
-> Dice
-> [Aspect]
-> [Effect]
-> [(GroupName ItemKind, CStore)]
-> Text
-> ItemKind
ItemKind
  { isymbol :: ContentSymbol ItemKind
isymbol  = ContentSymbol ItemKind -> ContentSymbol ItemKind
forall c. ContentSymbol ItemKind -> ContentSymbol ItemKind
toContentSymbol ContentSymbol ItemKind
'>'
  , iname :: Text
iname    = Text
"the Initial Entrance"
  , ifreq :: Freqs ItemKind
ifreq    = [(GroupName ItemKind
DISENGAGED_DOCKING_GEAR, Int
10000)]
  , iflavour :: [Flavour]
iflavour = [Color] -> [Flavour]
zipPlain [Color
Green]
  , icount :: Dice
icount   = Dice
1
  , irarity :: Rarity
irarity  = [(Double
1, Int
1), (Double
2, Int
0)]
  , iverbHit :: Text
iverbHit = Text
"worry"
  , iweight :: Int
iweight  = Int
10000
  , idamage :: Dice
idamage  = Dice
0
  , iaspects :: [Aspect]
iaspects = [Flag -> Aspect
SetFlag Flag
Unique, Flag -> Aspect
SetFlag Flag
Durable]
  , ieffects :: [Effect]
ieffects = []
  , idesc :: Text
idesc    = Text
"You recognize the inner airlock door smeared with guano in a familiar pattern, but you can't see the shuttle you left engaged to the airlock clamps outside. That's a chilling realization: your craft was among those shed by the spaceship. Now you have to find another lifeboat, likely on a deck high up towards the spaceship core, to which you now have to break through.\nMoreover, something's gone through your supplies, chewing, tearing and scattering most of them. Given that your stay just got prolonged, the shortage of food is almost as alarming as the scarcity of nano first aid vials that could patch the wounds from your recent struggles, until you are able to undergo a proper slow reconstruction in a hospital."
  , ikit :: [(GroupName ItemKind, CStore)]
ikit     = [ (GroupName ItemKind
COOKED_FOOD, CStore
CGround), (GroupName ItemKind
COOKED_FOOD, CStore
CGround)
               , (GroupName ItemKind
S_SPACESUIT_TORN, CStore
CGround)
               , (GroupName ItemKind
S_SHORT_BLUNT_HAMMER, CStore
CGround)
               , (GroupName ItemKind
S_CROWBAR, CStore
CGround) ]
  }
ruinedFirstAidKit :: ItemKind
ruinedFirstAidKit = ItemKind :: ContentSymbol ItemKind
-> Text
-> Freqs ItemKind
-> [Flavour]
-> Dice
-> Rarity
-> Text
-> Int
-> Dice
-> [Aspect]
-> [Effect]
-> [(GroupName ItemKind, CStore)]
-> Text
-> ItemKind
ItemKind
  { isymbol :: ContentSymbol ItemKind
isymbol  = ContentSymbol ItemKind -> ContentSymbol ItemKind
forall c. ContentSymbol ItemKind -> ContentSymbol ItemKind
toContentSymbol ContentSymbol ItemKind
'?'
  , iname :: Text
iname    = Text
"ruined first aid kit"
  , ifreq :: Freqs ItemKind
ifreq    = [(GroupName ItemKind
RUINED_FIRST_AID_KIT, Int
1)]
  , iflavour :: [Flavour]
iflavour = [Color] -> [Flavour]
zipPlain [Color
BrGreen]
  , icount :: Dice
icount   = Dice
1
  , irarity :: Rarity
irarity  = [(Double
1, Int
1)]
  , iverbHit :: Text
iverbHit = Text
"prick"
  , iweight :: Int
iweight  = Int
1000
  , idamage :: Dice
idamage  = Dice
0
  , iaspects :: [Aspect]
iaspects = []  -- not Durable, springs at most once
  , ieffects :: [Effect]
ieffects = [ Text -> Text -> Effect
VerbMsg Text
"inspect a tattered CPR instruction soaked in a residue of oily drugs" Text
"."
               , [Effect] -> Effect
OneOf [ GroupName ItemKind -> Effect
toOrganNoTimer GroupName ItemKind
S_SLOW_RESISTANT
                       , GroupName ItemKind -> Effect
toOrganNoTimer GroupName ItemKind
S_POISON_RESISTANT
                       , GroupName ItemKind -> Dice -> Effect
toOrganGood GroupName ItemKind
S_DRUNK (Dice
20 Dice -> Dice -> Dice
forall a. Num a => a -> a -> a
+ Int
1 Int -> Int -> Dice
`d` Int
5) ]
               , Maybe Int -> CStore -> GroupName ItemKind -> TimerDice -> Effect
CreateItem Maybe Int
forall a. Maybe a
Nothing CStore
CGround GroupName ItemKind
NEEDLE TimerDice
timerNone ]
  , idesc :: Text
idesc    = Text
""  -- regulations require; say HP not regenerated in the game; mention how to regain HP
  , ikit :: [(GroupName ItemKind, CStore)]
ikit     = []
  }
fireFightingGear :: ItemKind
fireFightingGear = ItemKind :: ContentSymbol ItemKind
-> Text
-> Freqs ItemKind
-> [Flavour]
-> Dice
-> Rarity
-> Text
-> Int
-> Dice
-> [Aspect]
-> [Effect]
-> [(GroupName ItemKind, CStore)]
-> Text
-> ItemKind
ItemKind
  { isymbol :: ContentSymbol ItemKind
isymbol  = ContentSymbol ItemKind -> ContentSymbol ItemKind
forall c. ContentSymbol ItemKind -> ContentSymbol ItemKind
toContentSymbol ContentSymbol ItemKind
'?'
  , iname :: Text
iname    = Text
"fire fighting gear"
  , ifreq :: Freqs ItemKind
ifreq    = [(GroupName ItemKind
FIRE_FIGHTING_GEAR, Int
1), (GroupName ItemKind
WATER_SOURCE, Int
1)]
  , iflavour :: [Flavour]
iflavour = [Color] -> [Flavour]
zipPlain [Color
BrRed]
  , icount :: Dice
icount   = Dice
1
  , irarity :: Rarity
irarity  = [(Double
1, Int
1)]
  , iverbHit :: Text
iverbHit = Text
"douse"
  , iweight :: Int
iweight  = Int
1000
  , idamage :: Dice
idamage  = Dice
0
  , iaspects :: [Aspect]
iaspects = []  -- not Durable, springs at most once
  , ieffects :: [Effect]
ieffects = [ Text -> Text -> Effect
VerbMsg Text
"disassemble and sort through the broken and leaking gear, taking away the least decrepit item" Text
"."
               , Maybe Int -> CStore -> GroupName ItemKind -> TimerDice -> Effect
CreateItem Maybe Int
forall a. Maybe a
Nothing CStore
CGround GroupName ItemKind
FIRE_FIGHTING_ITEM TimerDice
timerNone ]
  , idesc :: Text
idesc    = Text
"In addition to remains of firefighting tools, it contains a fire hydrant displaying old scars from being used in a hurry."  -- regulations require; hint that terrain can be ignited and doused
  , ikit :: [(GroupName ItemKind, CStore)]
ikit     = []
  }
fireFightingGearIntact :: ItemKind
fireFightingGearIntact = ItemKind :: ContentSymbol ItemKind
-> Text
-> Freqs ItemKind
-> [Flavour]
-> Dice
-> Rarity
-> Text
-> Int
-> Dice
-> [Aspect]
-> [Effect]
-> [(GroupName ItemKind, CStore)]
-> Text
-> ItemKind
ItemKind
  { isymbol :: ContentSymbol ItemKind
isymbol  = ContentSymbol ItemKind -> ContentSymbol ItemKind
forall c. ContentSymbol ItemKind -> ContentSymbol ItemKind
toContentSymbol ContentSymbol ItemKind
'?'
  , iname :: Text
iname    = Text
"the Fire Fighting Set"
  , ifreq :: Freqs ItemKind
ifreq    = [(GroupName ItemKind
FIRE_FIGHTING_GEAR, Int
1), (GroupName ItemKind
WATER_SOURCE, Int
1)]
  , iflavour :: [Flavour]
iflavour = [Color] -> [Flavour]
zipPlain [Color
Red]
  , icount :: Dice
icount   = Dice
1
  , irarity :: Rarity
irarity  = [(Double
1, Int
1)]
  , iverbHit :: Text
iverbHit = Text
"douse"
  , iweight :: Int
iweight  = Int
1000
  , idamage :: Dice
idamage  = Dice
0
  , iaspects :: [Aspect]
iaspects = [Flag -> Aspect
SetFlag Flag
Unique]  -- not Durable, springs at most once
  , ieffects :: [Effect]
ieffects = [ Text -> Text -> Effect
VerbMsg Text
"disassemble and sort through the old gear, taking away the least decrepit items" Text
"."
               , Maybe Int -> CStore -> GroupName ItemKind -> TimerDice -> Effect
CreateItem Maybe Int
forall a. Maybe a
Nothing CStore
CGround GroupName ItemKind
FIRE_FIGHTING_ITEM TimerDice
timerNone
               , Maybe Int -> CStore -> GroupName ItemKind -> TimerDice -> Effect
CreateItem Maybe Int
forall a. Maybe a
Nothing CStore
CGround GroupName ItemKind
S_FIRE_AXE TimerDice
timerNone ]
  , idesc :: Text
idesc    = Text
"This cabinet has not been broken open and used, so it contains a complete assortment of fire fighting implements. It also contains a fire hydrant in pristine condition."  -- regulations require; hint that terrain can be ignited and doused
  , ikit :: [(GroupName ItemKind, CStore)]
ikit     = []
  }
wall3dBillboard :: ItemKind
wall3dBillboard = ItemKind :: ContentSymbol ItemKind
-> Text
-> Freqs ItemKind
-> [Flavour]
-> Dice
-> Rarity
-> Text
-> Int
-> Dice
-> [Aspect]
-> [Effect]
-> [(GroupName ItemKind, CStore)]
-> Text
-> ItemKind
ItemKind
  { isymbol :: ContentSymbol ItemKind
isymbol  = ContentSymbol ItemKind -> ContentSymbol ItemKind
forall c. ContentSymbol ItemKind -> ContentSymbol ItemKind
toContentSymbol ContentSymbol ItemKind
'*'
  , iname :: Text
iname    = Text
"3D display"
  , ifreq :: Freqs ItemKind
ifreq    = [(GroupName ItemKind
DISPLAY_3D, Int
1)]
  , iflavour :: [Flavour]
iflavour = [Color] -> [Flavour]
zipPlain [Color
BrBlue]
  , icount :: Dice
icount   = Dice
1
  , irarity :: Rarity
irarity  = [(Double
1, Int
1)]
  , iverbHit :: Text
iverbHit = Text
"push"
  , iweight :: Int
iweight  = Int
1000
  , idamage :: Dice
idamage  = Dice
0
  , iaspects :: [Aspect]
iaspects = [Dice -> Aspect
Timeout Dice
3, Flag -> Aspect
SetFlag Flag
Durable]
  , ieffects :: [Effect]
ieffects = [ Text -> Text -> Effect
VerbMsg Text
"make it cough up a wobbly standalone hologram once more" Text
"."
               , [Effect] -> Effect
OneOf [ GroupName ItemKind -> Effect
Explode GroupName ItemKind
ADVERTISEMENT
                       , GroupName ItemKind -> Effect
Explode GroupName ItemKind
STORY_TELLING ] ]
  , idesc :: Text
idesc    = Text
"One can still make out excited moves of bleached shapes."
  , ikit :: [(GroupName ItemKind, CStore)]
ikit     = []
  }
crackedFlue :: ItemKind
crackedFlue = ItemKind :: ContentSymbol ItemKind
-> Text
-> Freqs ItemKind
-> [Flavour]
-> Dice
-> Rarity
-> Text
-> Int
-> Dice
-> [Aspect]
-> [Effect]
-> [(GroupName ItemKind, CStore)]
-> Text
-> ItemKind
ItemKind
  { isymbol :: ContentSymbol ItemKind
isymbol  = ContentSymbol ItemKind -> ContentSymbol ItemKind
forall c. ContentSymbol ItemKind -> ContentSymbol ItemKind
toContentSymbol ContentSymbol ItemKind
'|'
  , iname :: Text
iname    = Text
"cracked flue"
  , ifreq :: Freqs ItemKind
ifreq    = [(GroupName ItemKind
CRACKED_FLUE, Int
1)]  -- TODO: ("methane source", 1)?
  , iflavour :: [Flavour]
iflavour = [Color] -> [Flavour]
zipPlain [Color
BrBlack]
  , icount :: Dice
icount   = Dice
1
  , irarity :: Rarity
irarity  = [(Double
1, Int
1)]
  , iverbHit :: Text
iverbHit = Text
"blow"
  , iweight :: Int
iweight  = Int
1000
  , idamage :: Dice
idamage  = Dice
0
  , iaspects :: [Aspect]
iaspects = [Dice -> Aspect
Timeout Dice
10, Flag -> Aspect
SetFlag Flag
Durable]
  , ieffects :: [Effect]
ieffects = [ Text -> Text -> Effect
VerbMsg Text
"imagine the fragrance of roasted food wafting through the flue from upstairs" Text
"."
               , [Effect] -> Effect
OneOf [ GroupName ItemKind -> Dice -> Effect
toOrganGood GroupName ItemKind
S_KEEN_SMELLING (Dice
3 Dice -> Dice -> Dice
forall a. Num a => a -> a -> a
+ Int
1 Int -> Int -> Dice
`d` Int
2)
                       , Maybe Int -> CStore -> GroupName ItemKind -> TimerDice -> Effect
CreateItem Maybe Int
forall a. Maybe a
Nothing CStore
CGround GroupName ItemKind
STEEL_SCRAP TimerDice
timerNone ] ]
  , idesc :: Text
idesc    = Text
"The pipes ring with tumultuous echoes. Whenever you convince yourself it's an uneven updraft singing through the cracks, the noise suddenly stops, then picks up with a roar. Is there a fight over the food on some upper deck or are you just hungry?"
  , ikit :: [(GroupName ItemKind, CStore)]
ikit     = []
  }
bloodOnWall :: ItemKind
bloodOnWall = ItemKind :: ContentSymbol ItemKind
-> Text
-> Freqs ItemKind
-> [Flavour]
-> Dice
-> Rarity
-> Text
-> Int
-> Dice
-> [Aspect]
-> [Effect]
-> [(GroupName ItemKind, CStore)]
-> Text
-> ItemKind
ItemKind
  { isymbol :: ContentSymbol ItemKind
isymbol  = ContentSymbol ItemKind -> ContentSymbol ItemKind
forall c. ContentSymbol ItemKind -> ContentSymbol ItemKind
toContentSymbol ContentSymbol ItemKind
','
  , iname :: Text
iname    = Text
"blotch"
  , ifreq :: Freqs ItemKind
ifreq    = [(GroupName ItemKind
BLOOD_ON_WALL, Int
60)]
  , iflavour :: [Flavour]
iflavour = [Color] -> [Flavour]
zipPlain [Color
BrRed]
  , icount :: Dice
icount   = Int
1 Int -> Int -> Dice
`d` Int
6
  , irarity :: Rarity
irarity  = [(Double
1, Int
1)]
  , iverbHit :: Text
iverbHit = Text
"stain"
  , iweight :: Int
iweight  = Int
1
  , idamage :: Dice
idamage  = Dice
0
  , iaspects :: [Aspect]
iaspects = [Text -> Aspect
ELabel Text
"of red fluid"]
  , ieffects :: [Effect]
ieffects = [Int -> Effect
RefillCalm (-Int
5)]
  , idesc :: Text
idesc    = Text
""  -- probably enough said
  , ikit :: [(GroupName ItemKind, CStore)]
ikit     = []
  }
bloodOnWall2 :: ItemKind
bloodOnWall2 = ItemKind
bloodOnWall
  { ifreq :: Freqs ItemKind
ifreq    = [(GroupName ItemKind
BLOOD_ON_WALL, Int
30)]
  , iflavour :: [Flavour]
iflavour = [Color] -> [Flavour]
zipPlain [Color
BrGreen]
  , iaspects :: [Aspect]
iaspects = [Text -> Aspect
ELabel Text
"of green fluid"]
  , ieffects :: [Effect]
ieffects = [Int -> Effect
RefillCalm (-Int
10)]
  }
bloodOnWall3 :: ItemKind
bloodOnWall3 = ItemKind
bloodOnWall
  { ifreq :: Freqs ItemKind
ifreq    = [(GroupName ItemKind
BLOOD_ON_WALL, Int
10)]
  , iflavour :: [Flavour]
iflavour = [Color] -> [Flavour]
zipPlain [Color
BrBlue]
  , iaspects :: [Aspect]
iaspects = [Text -> Aspect
ELabel Text
"of blue fluid"]
  , ieffects :: [Effect]
ieffects = [Int -> Effect
RefillCalm (-Int
15)]
  }
depositBox :: ItemKind
depositBox = ItemKind
treasureCache
  { iname :: Text
iname    = Text
"intact deposit box"
  , ifreq :: Freqs ItemKind
ifreq    = [(GroupName ItemKind
DEPOSIT_BOX, Int
60)]
  , iaspects :: [Aspect]
iaspects = [Flag -> Aspect
SetFlag Flag
Durable]
  , ieffects :: [Effect]
ieffects = [Maybe Int -> CStore -> GroupName ItemKind -> TimerDice -> Effect
CreateItem Maybe Int
forall a. Maybe a
Nothing CStore
CGround GroupName ItemKind
COMMON_ITEM TimerDice
timerNone]
                 -- can't be VALUABLE or template items generated
  , idesc :: Text
idesc    = Text
"The reports of intact deposit boxes in the ship's safes have been greatly exaggerated, but there are still a few with glittering gems and gold, just waiting to be taken. Whomever looted these halls wasn't thorough or, judging from the damage to some of the boxes, was in an extreme hurry."
  }
depositBoxSummonHero :: ItemKind
depositBoxSummonHero = ItemKind
treasureCache
  { iname :: Text
iname    = Text
"the Noisy Large Safe"
  , ifreq :: Freqs ItemKind
ifreq    = [(GroupName ItemKind
DEPOSIT_BOX, Int
30)]
  , iflavour :: [Flavour]
iflavour = [Color] -> [Flavour]
zipFancy [Color
Blue]
  , iaspects :: [Aspect]
iaspects = [Flag -> Aspect
SetFlag Flag
Unique]
  , ieffects :: [Effect]
ieffects = [GroupName ItemKind -> Dice -> Effect
Summon GroupName ItemKind
HERO Dice
1, Maybe Int -> CStore -> GroupName ItemKind -> TimerDice -> Effect
CreateItem Maybe Int
forall a. Maybe a
Nothing CStore
CGround GroupName ItemKind
MUSEAL TimerDice
timerNone]
  , idesc :: Text
idesc    = Text
"Judging from the frantic sounds, this deposit cell with a time lock has trapped something big recently."
  }
depositBoxSummonMonster :: ItemKind
depositBoxSummonMonster = ItemKind
treasureCache
  { iname :: Text
iname    = Text
"throbbing deposit box"
  , ifreq :: Freqs ItemKind
ifreq    = [(GroupName ItemKind
DEPOSIT_BOX, Int
10)]
  , iflavour :: [Flavour]
iflavour = [Color] -> [Flavour]
zipFancy [Color
Red]
  , iaspects :: [Aspect]
iaspects = []
  , ieffects :: [Effect]
ieffects = [ GroupName ItemKind -> Dice -> Effect
Summon GroupName ItemKind
MOBILE_MONSTER Dice
1
               , Maybe Int -> CStore -> GroupName ItemKind -> TimerDice -> Effect
CreateItem Maybe Int
forall a. Maybe a
Nothing CStore
CGround GroupName ItemKind
TREASURE TimerDice
timerNone ]
  , idesc :: Text
idesc    = Text
"Judging from the incessant noises, this deposit cell with a time lock has trapped something recently."
  }
jewelryCase :: ItemKind
jewelryCase = ItemKind
treasureCache
  { iname :: Text
iname    = Text
"reinforced glass case"
  , ifreq :: Freqs ItemKind
ifreq    = [(GroupName ItemKind
JEWELRY_CASE, Int
1)]
  , iaspects :: [Aspect]
iaspects = [Flag -> Aspect
SetFlag Flag
Durable]
  , ieffects :: [Effect]
ieffects = [Maybe Int -> CStore -> GroupName ItemKind -> TimerDice -> Effect
CreateItem Maybe Int
forall a. Maybe a
Nothing CStore
CGround GroupName ItemKind
ANY_JEWELRY TimerDice
timerNone]
  , idesc :: Text
idesc    = Text
"The customers of these shops must have been extremely well off, judging from abundance and quality of the jewelry, often extremely valuable in each of the artistic, material and nanotechnology aspects. Outer Solar System trips are expensive, but they offer unique trade and investment opportunities. Many deals are of the kind that can only be negotiated in a sealed room out of reach of satellites and screened by both parties. Among the jewelry are portable versions of such screening hardware --- in a truly breathtaking package."
  }
ediblePlantRipe :: ItemKind
ediblePlantRipe = ItemKind
treasureCache
  { iname :: Text
iname    = Text
"edible vegetation"
  , ifreq :: Freqs ItemKind
ifreq    = [(GroupName ItemKind
EDIBLE_PLANT_RIPE, Int
1)]
  , iflavour :: [Flavour]
iflavour = [Color] -> [Flavour]
zipPlain [Color
Green]
  , iaspects :: [Aspect]
iaspects = [Flag -> Aspect
SetFlag Flag
Durable]
  , ieffects :: [Effect]
ieffects = [Maybe Int -> CStore -> GroupName ItemKind -> TimerDice -> Effect
CreateItem Maybe Int
forall a. Maybe a
Nothing CStore
CGround GroupName ItemKind
EDIBLE_PLANT TimerDice
timerNone]
  , idesc :: Text
idesc    = Text
""
  }
stairsTrapDownOil :: ItemKind
stairsTrapDownOil = ItemKind
stairsTrapUp
  { ifreq :: Freqs ItemKind
ifreq    = [(GroupName ItemKind
STAIRS_TRAP_DOWN_OIL, Int
1)]
  , iflavour :: [Flavour]
iflavour = [Color] -> [Flavour]
zipPlain [Color
Brown]
  , iverbHit :: Text
iverbHit = Text
"cause a chaotic skid"
  , ieffects :: [Effect]
ieffects = [ Text -> Text -> Effect
VerbMsgFail Text
"tumble down and shoot out of the stairwell" Text
"."
               , ThrowMod -> Effect
PushActor (Int -> Int -> Int -> ThrowMod
ThrowMod Int
400 Int
100 Int
1)]  -- 4 steps, 2 turns
  , idesc :: Text
idesc    = Text
""
  }
doorTrapPush :: ItemKind
doorTrapPush = ItemKind
doorwayTrapTemplate
  { isymbol :: ContentSymbol ItemKind
isymbol  = ContentSymbol ItemKind -> ContentSymbol ItemKind
forall c. ContentSymbol ItemKind -> ContentSymbol ItemKind
toContentSymbol ContentSymbol ItemKind
'+'
  , iname :: Text
iname    = Text
"weak door frame"
  , ifreq :: Freqs ItemKind
ifreq    = [(GroupName ItemKind
DOOR_TRAP_PUSH, Int
1)]
  , iflavour :: [Flavour]
iflavour = [Color] -> [Flavour]
zipPlain [Color
Blue]
  , iverbHit :: Text
iverbHit = Text
"give in"
  , iaspects :: [Aspect]
iaspects = []  -- identified; not Durable, springs at most once
  , ieffects :: [Effect]
ieffects = [ Text -> Text -> Effect
VerbMsgFail Text
"fly inwards after the crashed open doors" Text
"."
               , ThrowMod -> Effect
PushActor (Int -> Int -> Int -> ThrowMod
ThrowMod Int
400 Int
100 Int
1)]  -- 4 steps, 2 turns
  , idesc :: Text
idesc    = Text
""
  }
liftUp :: ItemKind
liftUp = ItemKind
stairsUp
  { iname :: Text
iname    = Text
"carriage"
  , iflavour :: [Flavour]
iflavour = [Color] -> [Flavour]
zipPlain [Color
Blue]
  , ifreq :: Freqs ItemKind
ifreq    = [(GroupName ItemKind
LIFT_UP, Int
1)]
  , iaspects :: [Aspect]
iaspects = [Flag -> Aspect
SetFlag Flag
Durable]
  , idesc :: Text
idesc    = Text
"Surprisingly, this lift still functions, while others are wrecked."  -- describe inner levels of the ship
  }
liftDown :: ItemKind
liftDown = ItemKind
stairsDown
  { iname :: Text
iname    = Text
"carriage"
  , iflavour :: [Flavour]
iflavour = [Color] -> [Flavour]
zipPlain [Color
Blue]
  , ifreq :: Freqs ItemKind
ifreq    = [(GroupName ItemKind
LIFT_DOWN, Int
1)]
  , iaspects :: [Aspect]
iaspects = [Flag -> Aspect
SetFlag Flag
Durable]
  , idesc :: Text
idesc    = Text
"Surprisingly, this one shaft is still open, while others are ruined and blocked."  -- describe outer levels of the ship
  }
liftTrap :: ItemKind
liftTrap = ItemKind
stairsTrapUp
  { iname :: Text
iname    = Text
"elevator trap"  -- hat tip to US heroes
  , ifreq :: Freqs ItemKind
ifreq    = [(GroupName ItemKind
LIFT_TRAP, Int
100)]
  , iflavour :: [Flavour]
iflavour = [Color] -> [Flavour]
zipPlain [Color
Cyan]
  , iverbHit :: Text
iverbHit = Text
"squeeze"
  , ieffects :: [Effect]
ieffects = [ Text -> Text -> Effect
VerbMsgFail Text
"be crushed by the sliding doors" Text
"."
               , Int -> Int -> CStore -> GroupName ItemKind -> Effect
DropItem Int
forall a. Bounded a => a
maxBound Int
1 CStore
CEqp GroupName ItemKind
STARTING_WEAPON, Dice -> Effect
Paralyze Dice
10 ]
  , idesc :: Text
idesc    = Text
""
  }
liftTrap2 :: ItemKind
liftTrap2 = ItemKind
liftTrap
  { ifreq :: Freqs ItemKind
ifreq    = [(GroupName ItemKind
LIFT_TRAP, Int
50)]
  , iflavour :: [Flavour]
iflavour = [Color] -> [Flavour]
zipFancy [Color
BrMagenta]
  , iverbHit :: Text
iverbHit = Text
"choke"
  , ieffects :: [Effect]
ieffects = [ Text -> Text -> Effect
VerbMsgFail Text
"inhale the gas lingering inside the cab" Text
"."
               , GroupName ItemKind -> Dice -> Effect
toOrganBad GroupName ItemKind
S_SLOWED (Dice -> Effect) -> Dice -> Effect
forall a b. (a -> b) -> a -> b
$ (Int
1 Int -> Int -> Dice
`dL` Int
4) Dice -> Dice -> Dice
forall a. Num a => a -> a -> a
* Dice
10 ]
  , idesc :: Text
idesc    = Text
""
  }
liftTrap3 :: ItemKind
liftTrap3 = ItemKind
liftTrap
  { ifreq :: Freqs ItemKind
ifreq    = [(GroupName ItemKind
LIFT_TRAP, Int
50)]
  , iflavour :: [Flavour]
iflavour = [Color] -> [Flavour]
zipFancy [Color
BrBlue]
  , iverbHit :: Text
iverbHit = Text
"shock"
  , ieffects :: [Effect]
ieffects = [ Text -> Text -> Effect
VerbMsgFail Text
"be electrocuted upon touching the control pad" Text
"."
               , Int -> Dice -> Effect
Discharge Int
5 (Dice -> Effect) -> Dice -> Effect
forall a b. (a -> b) -> a -> b
$ Dice
80 Dice -> Dice -> Dice
forall a. Num a => a -> a -> a
- Int
1 Int -> Int -> Dice
`d` Int
40 ]
  , idesc :: Text
idesc    = Text
""
  }
shuttleHardware :: ItemKind
shuttleHardware = ItemKind :: ContentSymbol ItemKind
-> Text
-> Freqs ItemKind
-> [Flavour]
-> Dice
-> Rarity
-> Text
-> Int
-> Dice
-> [Aspect]
-> [Effect]
-> [(GroupName ItemKind, CStore)]
-> Text
-> ItemKind
ItemKind
  { isymbol :: ContentSymbol ItemKind
isymbol  = ContentSymbol ItemKind -> ContentSymbol ItemKind
forall c. ContentSymbol ItemKind -> ContentSymbol ItemKind
toContentSymbol ContentSymbol ItemKind
'#'
  , iname :: Text
iname    = Text
"shuttle hardware"
  , ifreq :: Freqs ItemKind
ifreq    = [(GroupName ItemKind
SHUTTLE_HARDWARE, Int
1)]
  , iflavour :: [Flavour]
iflavour = [Color] -> [Flavour]
zipPlain [Color
BrWhite]
  , icount :: Dice
icount   = Dice
1
  , irarity :: Rarity
irarity  = [(Double
1, Int
1)]
  , iverbHit :: Text
iverbHit = Text
"resist"
  , iweight :: Int
iweight  = Int
10000
  , idamage :: Dice
idamage  = Dice
0
  , iaspects :: [Aspect]
iaspects = [Flag -> Aspect
SetFlag Flag
Durable]
  , ieffects :: [Effect]
ieffects = []
  , idesc :: Text
idesc    = Text
"While the hull of the spacecraft is intact, the flight hardware that normally lines the walls seems broken, worn out and often missing. This shuttle was probably scavenged for spare parts to repair other craft and it's unlikely that anything of use remains. This was the common \"taxi\" kind, fit only for lunar and orbital courier duties and single family trips. It's relatively cheap to operate, because no permanent airlock needs to be leased. Instead, the craft is brought through a large airlock to a dry-dock and serviced and even stored inside."
  , ikit :: [(GroupName ItemKind, CStore)]
ikit     = []
  }
machineOil :: ItemKind
machineOil = ItemKind :: ContentSymbol ItemKind
-> Text
-> Freqs ItemKind
-> [Flavour]
-> Dice
-> Rarity
-> Text
-> Int
-> Dice
-> [Aspect]
-> [Effect]
-> [(GroupName ItemKind, CStore)]
-> Text
-> ItemKind
ItemKind
  { isymbol :: ContentSymbol ItemKind
isymbol  = ContentSymbol ItemKind -> ContentSymbol ItemKind
forall c. ContentSymbol ItemKind -> ContentSymbol ItemKind
toContentSymbol ContentSymbol ItemKind
'~'
  , iname :: Text
iname    = Text
"oil layer"
  , ifreq :: Freqs ItemKind
ifreq    = [(GroupName ItemKind
OIL_PUDDLE, Int
1), (GroupName ItemKind
OIL_SOURCE, Int
1)]
  , iflavour :: [Flavour]
iflavour = [Color] -> [Flavour]
zipPlain [Color
BrYellow]
  , icount :: Dice
icount   = Dice
5  -- not durable, wears off
  , irarity :: Rarity
irarity  = [(Double
1, Int
1)]
  , iverbHit :: Text
iverbHit = Text
"oil"
  , iweight :: Int
iweight  = Int
1000
  , idamage :: Dice
idamage  = Dice
0
  , iaspects :: [Aspect]
iaspects = []
  , ieffects :: [Effect]
ieffects = [ThrowMod -> Effect
PushActor (Int -> Int -> Int -> ThrowMod
ThrowMod Int
600 Int
10 Int
1), Effect -> Effect
OnCombine Effect
oilEffect]
                  -- the high speed represents gliding rather than flying
                  -- and so no need to lift actor's weight off the ground;
                  -- low linger comes from abrupt halt over normal surface
  , idesc :: Text
idesc    = Text
"Slippery run out, probably from a life support equipment or vehicle engine."
  , ikit :: [(GroupName ItemKind, CStore)]
ikit     = []
  }
crudeWeld :: ItemKind
crudeWeld = ItemKind :: ContentSymbol ItemKind
-> Text
-> Freqs ItemKind
-> [Flavour]
-> Dice
-> Rarity
-> Text
-> Int
-> Dice
-> [Aspect]
-> [Effect]
-> [(GroupName ItemKind, CStore)]
-> Text
-> ItemKind
ItemKind  -- this is also an organ
  { isymbol :: ContentSymbol ItemKind
isymbol  = ContentSymbol ItemKind -> ContentSymbol ItemKind
forall c. ContentSymbol ItemKind -> ContentSymbol ItemKind
toContentSymbol ContentSymbol ItemKind
'_'
  , iname :: Text
iname    = Text
"crude weld"
  , ifreq :: Freqs ItemKind
ifreq    = [(GroupName ItemKind
S_CRUDE_WELD, Int
1)]
  , iflavour :: [Flavour]
iflavour = [Color] -> [Flavour]
zipPlain [Color
BrMagenta]
  , icount :: Dice
icount   = Dice
1
  , irarity :: Rarity
irarity  = [(Double
1, Int
1)]
  , iverbHit :: Text
iverbHit = Text
"weld"
  , iweight :: Int
iweight  = Int
3000
  , idamage :: Dice
idamage  = Dice
0
  , iaspects :: [Aspect]
iaspects = [Skill -> Dice -> Aspect
AddSkill Skill
SkMove (-Dice
5), Skill -> Dice -> Aspect
AddSkill Skill
SkDisplace (-Dice
1), Flag -> Aspect
SetFlag Flag
Durable]
  , ieffects :: [Effect]
ieffects = [GroupName ItemKind -> Effect
Explode GroupName ItemKind
S_SPARK]
  , idesc :: Text
idesc    = Text
"Such a superfluous mass of molten metal was layered on with messy welds that no amount of kicking nor hammering has any effect. A heavy duty cutting tool would be required or skilled thermal cycling. Whomever did the melding may still be around, but convincing him to yield his fiery implements may be a dangerous endeavour."
  , ikit :: [(GroupName ItemKind, CStore)]
ikit     = []
  }
decontaminator :: ItemKind
decontaminator = ItemKind :: ContentSymbol ItemKind
-> Text
-> Freqs ItemKind
-> [Flavour]
-> Dice
-> Rarity
-> Text
-> Int
-> Dice
-> [Aspect]
-> [Effect]
-> [(GroupName ItemKind, CStore)]
-> Text
-> ItemKind
ItemKind
  { isymbol :: ContentSymbol ItemKind
isymbol  = ContentSymbol ItemKind -> ContentSymbol ItemKind
forall c. ContentSymbol ItemKind -> ContentSymbol ItemKind
toContentSymbol ContentSymbol ItemKind
'D'
  , iname :: Text
iname    = Text
"decontamination chamber"
  , ifreq :: Freqs ItemKind
ifreq    = [(GroupName ItemKind
DECONTAMINATION_CHAMBER, Int
1)]
  , iflavour :: [Flavour]
iflavour = [Color] -> [Flavour]
zipPlain [Color
BrBlue]
  , icount :: Dice
icount   = Dice
1
  , irarity :: Rarity
irarity  = [(Double
1, Int
1)]
  , iverbHit :: Text
iverbHit = Text
"cleanse"
  , iweight :: Int
iweight  = Int
500000
  , idamage :: Dice
idamage  = Dice
0
  , iaspects :: [Aspect]
iaspects = [Flag -> Aspect
SetFlag Flag
Durable]
  , ieffects :: [Effect]
ieffects = [ Int -> Int -> CStore -> GroupName ItemKind -> Effect
DropItem Int
1 Int
1 CStore
COrgan GroupName ItemKind
GENETIC_FLAW
               , Int -> Int -> CStore -> GroupName ItemKind -> Effect
DropItem Int
forall a. Bounded a => a
maxBound Int
forall a. Bounded a => a
maxBound CStore
CEqp GroupName ItemKind
COMMON_ITEM
               , Int -> Int -> CStore -> GroupName ItemKind -> Effect
DropItem Int
forall a. Bounded a => a
maxBound Int
forall a. Bounded a => a
maxBound CStore
CStash GroupName ItemKind
COMMON_ITEM
               , Int -> Int -> CStore -> GroupName ItemKind -> Effect
DropItem Int
forall a. Bounded a => a
maxBound Int
forall a. Bounded a => a
maxBound CStore
CEqp GroupName ItemKind
CRAWL_ITEM
               , Int -> Int -> CStore -> GroupName ItemKind -> Effect
DropItem Int
forall a. Bounded a => a
maxBound Int
forall a. Bounded a => a
maxBound CStore
CStash GroupName ItemKind
CRAWL_ITEM
               , Int -> Int -> CStore -> GroupName ItemKind -> Effect
DropItem Int
forall a. Bounded a => a
maxBound Int
forall a. Bounded a => a
maxBound CStore
CEqp GroupName ItemKind
TREASURE
               , Int -> Int -> CStore -> GroupName ItemKind -> Effect
DropItem Int
forall a. Bounded a => a
maxBound Int
forall a. Bounded a => a
maxBound CStore
CStash GroupName ItemKind
TREASURE
                   -- With movable shared stash location this puzzle now has
                   -- more solutions, including one for a lone wolf.
               , GroupName ItemKind -> Dice -> Effect
toOrganGood GroupName ItemKind
S_ROSE_SMELLING (Dice
20 Dice -> Dice -> Dice
forall a. Num a => a -> a -> a
+ Int
1 Int -> Int -> Dice
`d` Int
5)
               ]
  , idesc :: Text
idesc    = Text
"The area is under quarantine. No departure is permitted without decontamination. Personal belongings are to be decontaminated separately."
  , ikit :: [(GroupName ItemKind, CStore)]
ikit     = []
  }
barrelFuel :: ItemKind
barrelFuel = ItemKind :: ContentSymbol ItemKind
-> Text
-> Freqs ItemKind
-> [Flavour]
-> Dice
-> Rarity
-> Text
-> Int
-> Dice
-> [Aspect]
-> [Effect]
-> [(GroupName ItemKind, CStore)]
-> Text
-> ItemKind
ItemKind
  { isymbol :: ContentSymbol ItemKind
isymbol  = ContentSymbol ItemKind -> ContentSymbol ItemKind
forall c. ContentSymbol ItemKind -> ContentSymbol ItemKind
toContentSymbol ContentSymbol ItemKind
'b'
  , iname :: Text
iname    = Text
"fuel"
  , ifreq :: Freqs ItemKind
ifreq    = [(GroupName ItemKind
BARREL_CONTENTS, Int
20), (GroupName ItemKind
OIL_SOURCE, Int
1)]
  , iflavour :: [Flavour]
iflavour = [Color] -> [Flavour]
zipPlain [Color
BrYellow]
  , icount :: Dice
icount   = Dice
1
  , irarity :: Rarity
irarity  = [(Double
1, Int
1)]
  , iverbHit :: Text
iverbHit = Text
"block"
  , iweight :: Int
iweight  = Int
100000
  , idamage :: Dice
idamage  = Dice
0
  , iaspects :: [Aspect]
iaspects = []
  , ieffects :: [Effect]
ieffects = [GroupName ItemKind -> Effect
Explode GroupName ItemKind
S_FOCUSED_BURNING_OIL_3, Effect -> Effect
OnCombine Effect
oilEffect]
  , idesc :: Text
idesc    = Text
""
  , ikit :: [(GroupName ItemKind, CStore)]
ikit     = []
  }
barrelFertilizer :: ItemKind
barrelFertilizer = ItemKind
barrelFuel
  { iname :: Text
iname    = Text
"fertilizer"
  , ifreq :: Freqs ItemKind
ifreq    = [(GroupName ItemKind
BARREL_CONTENTS, Int
30), (GroupName ItemKind
FIRE_SOURCE, Int
1)]
  , iflavour :: [Flavour]
iflavour = [Color] -> [Flavour]
zipPlain [Color
Red]
  , ieffects :: [Effect]
ieffects = [GroupName ItemKind -> Effect
Explode GroupName ItemKind
S_FOCUSED_FRAGMENTATION, Effect -> Effect
OnCombine Effect
roastEffect5]
                 -- no S_FOCUSED_CONCUSSION; a barrel would destroy the ship;
                 -- no water barrel either, basins and running water in taps;
                 -- no VIOLENT variants of the blasts or bumping a lone
                 -- barrel would be safe
  , idesc :: Text
idesc    = Text
""
  }
barrelOxidizer :: ItemKind
barrelOxidizer = ItemKind
barrelFuel
  { iname :: Text
iname    = Text
"oxidizer"
  , ifreq :: Freqs ItemKind
ifreq    = [(GroupName ItemKind
BARREL_CONTENTS, Int
20), (GroupName ItemKind
FIRE_SOURCE, Int
1)]
  , iflavour :: [Flavour]
iflavour = [Color] -> [Flavour]
zipPlain [Color
BrWhite]
  , ieffects :: [Effect]
ieffects = [GroupName ItemKind -> Effect
Explode GroupName ItemKind
S_FOCUSED_FLASH, Effect -> Effect
OnCombine Effect
roastEffect5]
  , idesc :: Text
idesc    = Text
""
  }
barrelOil :: ItemKind
barrelOil = ItemKind
barrelFuel
  { iname :: Text
iname    = Text
"lubricant oil"
  , ifreq :: Freqs ItemKind
ifreq    = [(GroupName ItemKind
BARREL_CONTENTS, Int
20), (GroupName ItemKind
OIL_SOURCE, Int
1)]
  , iflavour :: [Flavour]
iflavour = [Color] -> [Flavour]
zipPlain [Color
Brown]
  , ieffects :: [Effect]
ieffects = [GroupName ItemKind -> Effect
Explode GroupName ItemKind
S_MELEE_PROTECTIVE_BALM, Effect -> Effect
OnCombine Effect
oilEffect]
                 -- beneficial, so OK not to affect the triggering actor
  , idesc :: Text
idesc    = Text
""
  }
barrelNitrogen :: ItemKind
barrelNitrogen = ItemKind
barrelFuel
  { iname :: Text
iname    = Text
"liquid nitrogen"
  , ifreq :: Freqs ItemKind
ifreq    = [(GroupName ItemKind
BARREL_CONTENTS, Int
40), (GroupName ItemKind
COLD_SOURCE, Int
1)]
  , iflavour :: [Flavour]
iflavour = [Color] -> [Flavour]
zipPlain [Color
BrBlack]
  , ieffects :: [Effect]
ieffects = [GroupName ItemKind -> Effect
Explode GroupName ItemKind
S_FOCUSED_SLOWNESS_MIST]
                 -- may exploit to harm foes; watch out for friends
  , idesc :: Text
idesc    = Text
""
  }
workshopBench :: ItemKind
workshopBench = ItemKind :: ContentSymbol ItemKind
-> Text
-> Freqs ItemKind
-> [Flavour]
-> Dice
-> Rarity
-> Text
-> Int
-> Dice
-> [Aspect]
-> [Effect]
-> [(GroupName ItemKind, CStore)]
-> Text
-> ItemKind
ItemKind
  { isymbol :: ContentSymbol ItemKind
isymbol  = ContentSymbol ItemKind -> ContentSymbol ItemKind
forall c. ContentSymbol ItemKind -> ContentSymbol ItemKind
toContentSymbol ContentSymbol ItemKind
':'
  , iname :: Text
iname    = Text
"bench"
  , ifreq :: Freqs ItemKind
ifreq    = [(GroupName ItemKind
WORKSHOP_BENCH, Int
1)]
  , iflavour :: [Flavour]
iflavour = [Color] -> [Flavour]
zipPlain [Color
BrBlue]
  , icount :: Dice
icount   = Dice
1
  , irarity :: Rarity
irarity  = [(Double
1, Int
1)]
  , iverbHit :: Text
iverbHit = Text
"bury"
  , iweight :: Int
iweight  = Int
100000
  , idamage :: Dice
idamage  = Dice
0
  , iaspects :: [Aspect]
iaspects = [Flag -> Aspect
SetFlag Flag
Durable]
  , ieffects :: [Effect]
ieffects = [Effect -> Effect
OnCombine Effect
workshopEffect]
  , idesc :: Text
idesc    = Text
"A sturdy table with an anvil, a vice and an overhang of pipes, tubes, wires and probes. Place the components and tools adjacent to the table, stand over them and craft by trying to modify the bench with the 'M' command."
  , ikit :: [(GroupName ItemKind, CStore)]
ikit     = []
  }
signageExitLuggage :: ItemKind
signageExitLuggage = ItemKind
signageExit
  { irarity :: Rarity
irarity  = [(Double
1, Int
1), (Double
2, Int
0)]
  , idesc :: Text
idesc    = ItemKind -> Text
idesc ItemKind
signageExit
               Text -> Text -> Text
<+> Text
"If exits blocked, luggage claim area marked with 'L' is the concentration point."
  }
signageEmbedLuggage :: ItemKind
signageEmbedLuggage = ItemKind
signageEmbed
  { irarity :: Rarity
irarity  = [(Double
1, Int
1), (Double
2, Int
0)]
  , idesc :: Text
idesc    = ItemKind -> Text
idesc ItemKind
signageEmbed
               Text -> Text -> Text
<+> Text
"Keys and tools are held in the luggage claim booth marked with 'L'."
  }
signageMerchandiseLuggage :: ItemKind
signageMerchandiseLuggage = ItemKind
signageMerchandise
  { irarity :: Rarity
irarity  = [(Double
1, Int
1), (Double
2, Int
0)]
  , idesc :: Text
idesc    = ItemKind -> Text
idesc ItemKind
signageMerchandise
               Text -> Text -> Text
<+> Text
"Queries and complaints can be filed to the port officer and luggage attendant this way under the 'L' sign."
  }

combineEffect :: Text -> [( [(Int, GroupName ItemKind)]
                          , [(Int, GroupName ItemKind)]
                          , [(Int, GroupName ItemKind)] )]
              -> Effect
combineEffect :: Text
-> [([(Int, GroupName ItemKind)], [(Int, GroupName ItemKind)],
     [(Int, GroupName ItemKind)])]
-> Effect
combineEffect Text
msg [([(Int, GroupName ItemKind)], [(Int, GroupName ItemKind)],
  [(Int, GroupName ItemKind)])]
ass =
  let createOne :: (Int, GroupName ItemKind) -> Effect
      createOne :: (Int, GroupName ItemKind) -> Effect
createOne (Int
count, GroupName ItemKind
grp) = Maybe Int -> CStore -> GroupName ItemKind -> TimerDice -> Effect
CreateItem (Int -> Maybe Int
forall a. a -> Maybe a
Just Int
count) CStore
CGround GroupName ItemKind
grp TimerDice
timerNone
      createList :: [(Int, GroupName ItemKind)] -> Effect
      createList :: [(Int, GroupName ItemKind)] -> Effect
createList = [Effect] -> Effect
SeqEffect ([Effect] -> Effect)
-> ([(Int, GroupName ItemKind)] -> [Effect])
-> [(Int, GroupName ItemKind)]
-> Effect
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((Int, GroupName ItemKind) -> Effect)
-> [(Int, GroupName ItemKind)] -> [Effect]
forall a b. (a -> b) -> [a] -> [b]
map (Int, GroupName ItemKind) -> Effect
createOne
      cookOne :: ( [(Int, GroupName ItemKind)]
                 , [(Int, GroupName ItemKind)]
                 , [(Int, GroupName ItemKind)] )
              -> Effect
      cookOne :: ([(Int, GroupName ItemKind)], [(Int, GroupName ItemKind)],
 [(Int, GroupName ItemKind)])
-> Effect
cookOne ([(Int, GroupName ItemKind)]
tools, [(Int, GroupName ItemKind)]
raw, [(Int, GroupName ItemKind)]
cooked) =
        [(Int, GroupName ItemKind)]
-> [(Int, GroupName ItemKind)] -> Effect
ConsumeItems [(Int, GroupName ItemKind)]
tools [(Int, GroupName ItemKind)]
raw  -- either all destroyed or none
        Effect -> Effect -> Effect
`AndEffect`  -- either destroy and create, or none
        [(Int, GroupName ItemKind)] -> Effect
createList [(Int, GroupName ItemKind)]
cooked
      f :: ( [(Int, GroupName ItemKind)]
           , [(Int, GroupName ItemKind)]
           , [(Int, GroupName ItemKind)] )
        -> Effect
        -> Effect
      f :: ([(Int, GroupName ItemKind)], [(Int, GroupName ItemKind)],
 [(Int, GroupName ItemKind)])
-> Effect -> Effect
f ([(Int, GroupName ItemKind)], [(Int, GroupName ItemKind)],
 [(Int, GroupName ItemKind)])
roolsRawCooked Effect
eff = ([(Int, GroupName ItemKind)], [(Int, GroupName ItemKind)],
 [(Int, GroupName ItemKind)])
-> Effect
cookOne ([(Int, GroupName ItemKind)], [(Int, GroupName ItemKind)],
 [(Int, GroupName ItemKind)])
roolsRawCooked Effect -> Effect -> Effect
`OrEffect` Effect
eff
      initial :: Effect
initial = Text -> Text -> Effect
VerbMsgFail Text
msg Text
"."  -- noop; emits @UseId@ to correctly abort
  in (([(Int, GroupName ItemKind)], [(Int, GroupName ItemKind)],
  [(Int, GroupName ItemKind)])
 -> Effect -> Effect)
-> Effect
-> [([(Int, GroupName ItemKind)], [(Int, GroupName ItemKind)],
     [(Int, GroupName ItemKind)])]
-> Effect
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr ([(Int, GroupName ItemKind)], [(Int, GroupName ItemKind)],
 [(Int, GroupName ItemKind)])
-> Effect -> Effect
f Effect
initial [([(Int, GroupName ItemKind)], [(Int, GroupName ItemKind)],
  [(Int, GroupName ItemKind)])]
ass

oilEffect :: Effect
oilEffect :: Effect
oilEffect = Text
-> [([(Int, GroupName ItemKind)], [(Int, GroupName ItemKind)],
     [(Int, GroupName ItemKind)])]
-> Effect
combineEffect Text
"have nothing to oil"
              [ ( [], [(Int
1, GroupName ItemKind
S_STAFF), (Int
1, GroupName ItemKind
THICK_CLOTH)]
                , [(Int
1, GroupName ItemKind
S_DOUSED_WOODEN_TORCH)] )
              , ( [], [(Int
1, GroupName ItemKind
S_EMPTY_FLASK), (Int
1, GroupName ItemKind
THICK_CLOTH)]
                , [(Int
1, GroupName ItemKind
S_DOUSED_OIL_LAMP)] ) ]

roastEffect :: Effect
roastEffect :: Effect
roastEffect = Text
-> [([(Int, GroupName ItemKind)], [(Int, GroupName ItemKind)],
     [(Int, GroupName ItemKind)])]
-> Effect
combineEffect Text
"have nothing to roast"
              ([([(Int, GroupName ItemKind)], [(Int, GroupName ItemKind)],
   [(Int, GroupName ItemKind)])]
 -> Effect)
-> [([(Int, GroupName ItemKind)], [(Int, GroupName ItemKind)],
     [(Int, GroupName ItemKind)])]
-> Effect
forall a b. (a -> b) -> a -> b
$ [([(Int, GroupName ItemKind)], [(Int, GroupName ItemKind)],
  [(Int, GroupName ItemKind)])]
extraRoastAssocs
                [([(Int, GroupName ItemKind)], [(Int, GroupName ItemKind)],
  [(Int, GroupName ItemKind)])]
-> [([(Int, GroupName ItemKind)], [(Int, GroupName ItemKind)],
     [(Int, GroupName ItemKind)])]
-> [([(Int, GroupName ItemKind)], [(Int, GroupName ItemKind)],
     [(Int, GroupName ItemKind)])]
forall a. [a] -> [a] -> [a]
++ ((GroupName ItemKind, GroupName ItemKind)
 -> ([(Int, GroupName ItemKind)], [(Int, GroupName ItemKind)],
     [(Int, GroupName ItemKind)]))
-> [(GroupName ItemKind, GroupName ItemKind)]
-> [([(Int, GroupName ItemKind)], [(Int, GroupName ItemKind)],
     [(Int, GroupName ItemKind)])]
forall a b. (a -> b) -> [a] -> [b]
map (\(GroupName ItemKind
raw, GroupName ItemKind
cooked) ->
                          ([], [(Int
1, GroupName ItemKind
raw)], [(Int
1, GroupName ItemKind
cooked)])) [(GroupName ItemKind, GroupName ItemKind)]
cookingAssocs

roastEffect5 :: Effect
roastEffect5 :: Effect
roastEffect5 = Text
-> [([(Int, GroupName ItemKind)], [(Int, GroupName ItemKind)],
     [(Int, GroupName ItemKind)])]
-> Effect
combineEffect Text
"have nothing to roast"
               ([([(Int, GroupName ItemKind)], [(Int, GroupName ItemKind)],
   [(Int, GroupName ItemKind)])]
 -> Effect)
-> [([(Int, GroupName ItemKind)], [(Int, GroupName ItemKind)],
     [(Int, GroupName ItemKind)])]
-> Effect
forall a b. (a -> b) -> a -> b
$ [([(Int, GroupName ItemKind)], [(Int, GroupName ItemKind)],
  [(Int, GroupName ItemKind)])]
extraRoastAssocs
                 [([(Int, GroupName ItemKind)], [(Int, GroupName ItemKind)],
  [(Int, GroupName ItemKind)])]
-> [([(Int, GroupName ItemKind)], [(Int, GroupName ItemKind)],
     [(Int, GroupName ItemKind)])]
-> [([(Int, GroupName ItemKind)], [(Int, GroupName ItemKind)],
     [(Int, GroupName ItemKind)])]
forall a. [a] -> [a] -> [a]
++ ((GroupName ItemKind, GroupName ItemKind)
 -> [([(Int, GroupName ItemKind)], [(Int, GroupName ItemKind)],
      [(Int, GroupName ItemKind)])])
-> [(GroupName ItemKind, GroupName ItemKind)]
-> [([(Int, GroupName ItemKind)], [(Int, GroupName ItemKind)],
     [(Int, GroupName ItemKind)])]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (\(GroupName ItemKind
raw, GroupName ItemKind
cooked) ->
                                 [ ([], [(Int
5, GroupName ItemKind
raw)], [(Int
5, GroupName ItemKind
cooked)])
                                 , ([], [(Int
4, GroupName ItemKind
raw)], [(Int
4, GroupName ItemKind
cooked)])
                                 , ([], [(Int
3, GroupName ItemKind
raw)], [(Int
3, GroupName ItemKind
cooked)])
                                 , ([], [(Int
2, GroupName ItemKind
raw)], [(Int
2, GroupName ItemKind
cooked)])
                                 , ([], [(Int
1, GroupName ItemKind
raw)], [(Int
1, GroupName ItemKind
cooked)])
                                 ])
                              [(GroupName ItemKind, GroupName ItemKind)]
cookingAssocs

waterEffect :: Effect
waterEffect :: Effect
waterEffect = Text
-> [([(Int, GroupName ItemKind)], [(Int, GroupName ItemKind)],
     [(Int, GroupName ItemKind)])]
-> Effect
combineEffect Text
"lack a sharpening tool or a weapon to sharpen or an item to fill with water"
              ([([(Int, GroupName ItemKind)], [(Int, GroupName ItemKind)],
   [(Int, GroupName ItemKind)])]
 -> Effect)
-> [([(Int, GroupName ItemKind)], [(Int, GroupName ItemKind)],
     [(Int, GroupName ItemKind)])]
-> Effect
forall a b. (a -> b) -> a -> b
$ (([(Int, GroupName ItemKind)], GroupName ItemKind,
  GroupName ItemKind)
 -> ([(Int, GroupName ItemKind)], [(Int, GroupName ItemKind)],
     [(Int, GroupName ItemKind)]))
-> [([(Int, GroupName ItemKind)], GroupName ItemKind,
     GroupName ItemKind)]
-> [([(Int, GroupName ItemKind)], [(Int, GroupName ItemKind)],
     [(Int, GroupName ItemKind)])]
forall a b. (a -> b) -> [a] -> [b]
map (\([(Int, GroupName ItemKind)]
tools, GroupName ItemKind
raw, GroupName ItemKind
cooked) ->
                      ([(Int, GroupName ItemKind)]
tools, [(Int
1, GroupName ItemKind
raw)], [(Int
1, GroupName ItemKind
cooked)])) [([(Int, GroupName ItemKind)], GroupName ItemKind,
  GroupName ItemKind)]
sharpeningAssocs
                [([(Int, GroupName ItemKind)], [(Int, GroupName ItemKind)],
  [(Int, GroupName ItemKind)])]
-> [([(Int, GroupName ItemKind)], [(Int, GroupName ItemKind)],
     [(Int, GroupName ItemKind)])]
-> [([(Int, GroupName ItemKind)], [(Int, GroupName ItemKind)],
     [(Int, GroupName ItemKind)])]
forall a. [a] -> [a] -> [a]
++ [([(Int, GroupName ItemKind)], [(Int, GroupName ItemKind)],
  [(Int, GroupName ItemKind)])]
extraWaterAssocs

workshopEffect :: Effect
workshopEffect :: Effect
workshopEffect = Text
-> [([(Int, GroupName ItemKind)], [(Int, GroupName ItemKind)],
     [(Int, GroupName ItemKind)])]
-> Effect
combineEffect Text
"have not enough tools and components"
                               [([(Int, GroupName ItemKind)], [(Int, GroupName ItemKind)],
  [(Int, GroupName ItemKind)])]
workshopAssocs

cookingAssocs :: [(GroupName ItemKind, GroupName ItemKind)]
cookingAssocs :: [(GroupName ItemKind, GroupName ItemKind)]
cookingAssocs =
  [ (GroupName ItemKind
RAW_MEAT_CHUNK, GroupName ItemKind
ROASTED_MEAT_CHUNK)
  , (GroupName ItemKind
S_ENCHANCED_BERRY, GroupName ItemKind
S_COOKED_BERRY)
  , (GroupName ItemKind
S_FRAYED_FUNGUS, GroupName ItemKind
S_COOKED_FUNGUS)
  , (GroupName ItemKind
S_THIC_LEAF, GroupName ItemKind
S_COOKED_LEAF)
  , (GroupName ItemKind
S_RECONFIGURED_FRUIT, GroupName ItemKind
S_COOKED_FRUIT)
  , (GroupName ItemKind
S_FRAGRANT_HERB, GroupName ItemKind
S_COOKED_HERB)
  , (GroupName ItemKind
S_DULL_FLOWER, GroupName ItemKind
S_COOKED_FLOWER)
  , (GroupName ItemKind
S_SPICY_BARK, GroupName ItemKind
S_COOKED_BARK)
  , (GroupName ItemKind
S_PUMPKIN, GroupName ItemKind
S_COOKED_PUMPKIN)
  ]

extraRoastAssocs :: [( [(Int, GroupName ItemKind)]
                     , [(Int, GroupName ItemKind)]
                     , [(Int, GroupName ItemKind)] )]
extraRoastAssocs :: [([(Int, GroupName ItemKind)], [(Int, GroupName ItemKind)],
  [(Int, GroupName ItemKind)])]
extraRoastAssocs =
  [ ([], [(Int
1, GroupName ItemKind
S_DOUSED_WOODEN_TORCH)], [(Int
1, GroupName ItemKind
S_WOODEN_TORCH)])
  , ([], [(Int
1, GroupName ItemKind
S_DOUSED_OIL_LAMP)], [(Int
1, GroupName ItemKind
S_OIL_LAMP)])
  , ([], [(Int
1, GroupName ItemKind
WASTE_CONTAINER)], [(Int
1, GroupName ItemKind
S_REFRIGERATION_COIL)])
  ]

sharpeningAssocs :: [( [(Int, GroupName ItemKind)]
                     , GroupName ItemKind
                     , GroupName ItemKind )]
sharpeningAssocs :: [([(Int, GroupName ItemKind)], GroupName ItemKind,
  GroupName ItemKind)]
sharpeningAssocs =
  [ ([(Int
1, GroupName ItemKind
SHARPENING_TOOL)], GroupName ItemKind
S_HARPOON_CARGO, GroupName ItemKind
S_HARPOON_SHARP)
  , ([(Int
1, GroupName ItemKind
SHARPENING_TOOL), (Int
1, GroupName ItemKind
BREACHING_TOOL)], GroupName ItemKind
S_PIPE, GroupName ItemKind
S_SHARPENED_PIPE)
  , ([(Int
1, GroupName ItemKind
SHARPENING_TOOL)], GroupName ItemKind
S_SHIELD_BLUNT, GroupName ItemKind
S_SHIELD_SHARP)
  , ([(Int
2, GroupName ItemKind
SHARPENING_TOOL)], GroupName ItemKind
S_SHORT_BLUNT_HAMMER, GroupName ItemKind
S_SHORT_SHARP_HAMMER)
  , ([(Int
2, GroupName ItemKind
SHARPENING_TOOL)], GroupName ItemKind
S_LONG_BLUNT_HAMMER, GroupName ItemKind
S_LONG_SHARP_HAMMER)
  , ([(Int
2, GroupName ItemKind
SHARPENING_TOOL)], GroupName ItemKind
S_CLEAVER, GroupName ItemKind
S_DAGGER)
  , ([(Int
1, GroupName ItemKind
SHARPENING_TOOL)], GroupName ItemKind
S_RAPIER_BLUNT, GroupName ItemKind
S_RAPIER_SHARP)
  , ([(Int
2, GroupName ItemKind
SHARPENING_TOOL)], GroupName ItemKind
S_POLE_CLEAVER, GroupName ItemKind
S_LONG_SPEAR)
  , ([(Int
1, GroupName ItemKind
SHARPENING_TOOL)], GroupName ItemKind
S_HALBERD_BLUNT, GroupName ItemKind
S_HALBERD_SHARP)
  ]

extraWaterAssocs :: [( [(Int, GroupName ItemKind)]
                     , [(Int, GroupName ItemKind)]
                     , [(Int, GroupName ItemKind)] )]
extraWaterAssocs :: [([(Int, GroupName ItemKind)], [(Int, GroupName ItemKind)],
  [(Int, GroupName ItemKind)])]
extraWaterAssocs =
  [ ( [(Int
1, GroupName ItemKind
PERFUME)], [(Int
5, GroupName ItemKind
S_EMPTY_FLASK)], [(Int
5, GroupName ItemKind
S_ROSE_WATER_FLASK)] )
  , ( [], [(Int
1, GroupName ItemKind
S_EMPTY_FLASK)], [(Int
1, GroupName ItemKind
S_WATER_FLASK)] )
  ]

workshopAssocs :: [( [(Int, GroupName ItemKind)]
                   , [(Int, GroupName ItemKind)]
                   , [(Int, GroupName ItemKind)] )]
workshopAssocs :: [([(Int, GroupName ItemKind)], [(Int, GroupName ItemKind)],
  [(Int, GroupName ItemKind)])]
workshopAssocs =
  [ ( [(Int
1, GroupName ItemKind
BONDING_TOOL)], [(Int
1, GroupName ItemKind
POLE), (Int
1, GroupName ItemKind
S_SHORT_BLUNT_HAMMER)]
    , [(Int
1, GroupName ItemKind
S_LONG_BLUNT_HAMMER), (Int
1, GroupName ItemKind
HANDLE)] )
  , ( [(Int
1, GroupName ItemKind
BONDING_TOOL)], [(Int
1, GroupName ItemKind
POLE), (Int
1, GroupName ItemKind
S_SHORT_SHARP_HAMMER)]
    , [(Int
1, GroupName ItemKind
S_LONG_SHARP_HAMMER), (Int
1, GroupName ItemKind
HANDLE)] )
  , ( [(Int
1, GroupName ItemKind
BONDING_TOOL)], [(Int
1, GroupName ItemKind
POLE), (Int
1, GroupName ItemKind
S_FIRE_AXE)]
    , [(Int
1, GroupName ItemKind
S_POLL_AXE), (Int
1, GroupName ItemKind
HANDLE)] )
  , ( [(Int
2, GroupName ItemKind
BONDING_TOOL)], [(Int
1, GroupName ItemKind
POLE), (Int
1, GroupName ItemKind
S_CLEAVER)]
    , [(Int
1, GroupName ItemKind
S_POLE_CLEAVER)] )
  , ( [(Int
2, GroupName ItemKind
BONDING_TOOL)], [(Int
1, GroupName ItemKind
POLE), (Int
1, GroupName ItemKind
S_DAGGER)]
    , [(Int
1, GroupName ItemKind
S_LONG_SPEAR)] )
  , ( [], [(Int
1, GroupName ItemKind
S_STAFF), (Int
1, GroupName ItemKind
STEEL_SCRAP)], [(Int
1, GroupName ItemKind
S_SHORT_CLUB)] )
  , ( [], [(Int
1, GroupName ItemKind
POLE), (Int
2, GroupName ItemKind
STEEL_SCRAP)], [(Int
1, GroupName ItemKind
S_LONG_CLUB)] )
  -- Perfect the perfection. Comes after the productive rules.
  -- Only include the most augmented items with random stats to re-roll.
  , ( [(Int
1, GroupName ItemKind
BONDING_TOOL)], [(Int
1, GroupName ItemKind
S_LONG_SHARP_HAMMER)]
    , [(Int
1, GroupName ItemKind
S_LONG_SHARP_HAMMER)] )
  , ( [(Int
1, GroupName ItemKind
BONDING_TOOL)], [(Int
1, GroupName ItemKind
S_POLL_AXE)], [(Int
1, GroupName ItemKind
S_POLL_AXE)] )
  , ( [(Int
1, GroupName ItemKind
BONDING_TOOL)], [(Int
1, GroupName ItemKind
S_LONG_SPEAR)], [(Int
1, GroupName ItemKind
S_LONG_SPEAR)] )
  , ( [(Int
3, GroupName ItemKind
BONDING_TOOL)]
    , [ (Int
1, GroupName ItemKind
S_SPACESUIT_JACKET), (Int
1, GroupName ItemKind
S_SPACESUIT_TROUSERS)
      , (Int
2, GroupName ItemKind
S_SPACESUIT_GLOVE), (Int
1, GroupName ItemKind
S_SPACESUIT_HELMET)
      , (Int
2, GroupName ItemKind
S_SPACESUIT_BOOT) ]
    , [(Int
1, GroupName ItemKind
S_SPACESUIT)] )
  -- Recipes that destroy more useful things than other recipes come last.
  , ( [(Int
1, GroupName ItemKind
WIRECUTTING_TOOL)], [(Int
1, GroupName ItemKind
S_SPACESUIT_TORN)]
    , [(Int
1, GroupName ItemKind
SPACESUIT_PART), (Int
1, GroupName ItemKind
SPACESUIT_PART), (Int
1, GroupName ItemKind
CLOTH_RAG)] )
  , ( [(Int
1, GroupName ItemKind
PERFUME)], [(Int
1, GroupName ItemKind
WATER_SOURCE), (Int
5, GroupName ItemKind
S_EMPTY_FLASK)]
    , [(Int
6, GroupName ItemKind
S_ROSE_WATER_FLASK)] )  -- the extra container is from water source
  , ( [(Int
1, GroupName ItemKind
BREACHING_TOOL)], [(Int
1, GroupName ItemKind
POLE_AND_STEEL)]  -- harder to dismantle
    , [(Int
1, GroupName ItemKind
POLE), (Int
1, GroupName ItemKind
STEEL_SCRAP)] )
  , ([], [(Int
1, GroupName ItemKind
HANDLE_AND_STEEL)], [(Int
1, GroupName ItemKind
HANDLE), (Int
1, GroupName ItemKind
STEEL_SCRAP)])
  ]