-- 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.
--
-- | Actor organ definitions.
module Content.ItemKindOrgan
  ( -- * Group name patterns
    pattern S_FIST, pattern S_FOOT, pattern S_HOOKED_CLAW, pattern S_SMALL_CLAW, pattern S_SNOUT, pattern S_SMALL_JAW, pattern S_JAW, pattern S_LARGE_JAW, pattern S_ANTLER, pattern S_HORN, pattern S_RHINO_HORN, pattern S_TENTACLE, pattern S_TIP, pattern S_LIP, pattern S_THORN, pattern S_BOILING_FISSURE, pattern S_BEE_STING, pattern S_STING, pattern S_VENOM_TOOTH, pattern S_VENOM_FANG, pattern S_SCREECHING_BEAK, pattern S_LARGE_TAIL, pattern S_HUGE_TAIL, pattern S_ARMORED_SKIN, pattern S_BARK, pattern S_NOSTRIL, pattern S_RATLLE, pattern S_INSECT_MORTALITY, pattern S_SAPIENT_BRAIN, pattern S_ANIMAL_BRAIN, pattern S_SCENT_GLAND, pattern S_BOILING_VENT, pattern S_EYE_3, pattern S_EYE_6, pattern S_EYE_8, pattern S_VISION_6, pattern S_VISION_12, pattern S_VISION_16, pattern S_EAR_3, pattern S_EAR_6, pattern S_EAR_8, pattern S_SPEED_GLAND_5, pattern S_SPEED_GLAND_10
  , pattern SCAVENGER, pattern ALCOHOL
  , pattern S_ANIMAL_STOMACH, pattern S_HUNGRY, pattern S_RAZOR, pattern S_FLOTATION_BAG, pattern S_INK_SAC, pattern S_POWERFUL_HIND_LEGS, pattern S_COILED_TAIL, pattern S_JET_BOOSTER, pattern S_RHINO_INERTIA, pattern S_SMALL_BEAK, pattern S_LIVE_WIRE, pattern S_COOLING_VENT, pattern S_COOLING_FISSURE, pattern S_MEDBOT_VENT, pattern S_MEDBOT_FISSURE, pattern S_DUST_VENT, pattern S_DUST_FISSURE, pattern S_FUEL_VENT, pattern S_FUEL_FISSURE, pattern S_ROBOT_BRAIN, pattern S_HULL_PLATING, pattern S_MOUTH_VENT, pattern S_CRUDE_WELD
  , pattern ELECTRIC_AMBIENCE, pattern GENETIC_FLAW_3, pattern GENETIC_FLAW_10, pattern GENETIC_FLAW, pattern BACKSTORY, pattern BACKSTORY_FLUFF, pattern BACKSTORY_GOOD, pattern BACKSTORY_BAD, pattern BACKSTORY_MIXED, pattern BACKSTORY_NEUTRAL
  , organsGNSingleton, organsGN
  , -- * Content
    organs
  ) where

import Prelude ()

import Game.LambdaHack.Core.Prelude

import Content.ItemKindBlast
import Content.ItemKindTemporary
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.Flavour

-- * Group name patterns

organsGNSingleton :: [GroupName ItemKind]
organsGNSingleton :: [GroupName ItemKind]
organsGNSingleton =
       [GroupName ItemKind
S_FIST, GroupName ItemKind
S_FOOT, GroupName ItemKind
S_HOOKED_CLAW, GroupName ItemKind
S_SMALL_CLAW, GroupName ItemKind
S_SNOUT, GroupName ItemKind
S_SMALL_JAW, GroupName ItemKind
S_JAW, GroupName ItemKind
S_LARGE_JAW, GroupName ItemKind
S_ANTLER, GroupName ItemKind
S_HORN, GroupName ItemKind
S_RHINO_HORN, GroupName ItemKind
S_TENTACLE, GroupName ItemKind
S_TIP, GroupName ItemKind
S_LIP, GroupName ItemKind
S_THORN, GroupName ItemKind
S_BOILING_FISSURE, GroupName ItemKind
S_BEE_STING, GroupName ItemKind
S_STING, GroupName ItemKind
S_VENOM_TOOTH, GroupName ItemKind
S_VENOM_FANG, GroupName ItemKind
S_SCREECHING_BEAK, GroupName ItemKind
S_LARGE_TAIL, GroupName ItemKind
S_HUGE_TAIL, GroupName ItemKind
S_ARMORED_SKIN, GroupName ItemKind
S_BARK, GroupName ItemKind
S_NOSTRIL, GroupName ItemKind
S_RATLLE, GroupName ItemKind
S_INSECT_MORTALITY, GroupName ItemKind
S_SAPIENT_BRAIN, GroupName ItemKind
S_ANIMAL_BRAIN, GroupName ItemKind
S_SCENT_GLAND, GroupName ItemKind
S_BOILING_VENT, GroupName ItemKind
S_EYE_3, GroupName ItemKind
S_EYE_6, GroupName ItemKind
S_EYE_8, GroupName ItemKind
S_VISION_6, GroupName ItemKind
S_VISION_12, GroupName ItemKind
S_VISION_16, GroupName ItemKind
S_EAR_3, GroupName ItemKind
S_EAR_6, GroupName ItemKind
S_EAR_8, GroupName ItemKind
S_SPEED_GLAND_5, GroupName ItemKind
S_SPEED_GLAND_10]
    [GroupName ItemKind]
-> [GroupName ItemKind] -> [GroupName ItemKind]
forall a. [a] -> [a] -> [a]
++ [GroupName ItemKind
S_ANIMAL_STOMACH, GroupName ItemKind
S_HUNGRY, GroupName ItemKind
S_RAZOR, GroupName ItemKind
S_FLOTATION_BAG, GroupName ItemKind
S_INK_SAC, GroupName ItemKind
S_POWERFUL_HIND_LEGS, GroupName ItemKind
S_COILED_TAIL, GroupName ItemKind
S_JET_BOOSTER, GroupName ItemKind
S_RHINO_INERTIA, GroupName ItemKind
S_SMALL_BEAK, GroupName ItemKind
S_LIVE_WIRE, GroupName ItemKind
S_COOLING_VENT, GroupName ItemKind
S_COOLING_FISSURE, GroupName ItemKind
S_MEDBOT_VENT, GroupName ItemKind
S_MEDBOT_FISSURE, GroupName ItemKind
S_DUST_VENT, GroupName ItemKind
S_DUST_FISSURE, GroupName ItemKind
S_FUEL_VENT, GroupName ItemKind
S_FUEL_FISSURE, GroupName ItemKind
S_ROBOT_BRAIN, GroupName ItemKind
S_HULL_PLATING, GroupName ItemKind
S_MOUTH_VENT, GroupName ItemKind
S_CRUDE_WELD, GroupName ItemKind
BACKSTORY_FLUFF_UNKNOWN, GroupName ItemKind
BACKSTORY_GOOD_UNKNOWN, GroupName ItemKind
BACKSTORY_BAD_UNKNOWN, GroupName ItemKind
BACKSTORY_MIXED_UNKNOWN, GroupName ItemKind
BACKSTORY_NEUTRAL_UNKNOWN]

pattern S_FIST, S_FOOT, S_HOOKED_CLAW, S_SMALL_CLAW, S_SNOUT, S_SMALL_JAW, S_JAW, S_LARGE_JAW, S_ANTLER, S_HORN, S_RHINO_HORN, S_TENTACLE, S_TIP, S_LIP, S_THORN, S_BOILING_FISSURE, S_BEE_STING, S_STING, S_VENOM_TOOTH, S_VENOM_FANG, S_SCREECHING_BEAK, S_LARGE_TAIL, S_HUGE_TAIL, S_ARMORED_SKIN, S_BARK, S_NOSTRIL, S_RATLLE, S_INSECT_MORTALITY, S_SAPIENT_BRAIN, S_ANIMAL_BRAIN, S_SCENT_GLAND, S_BOILING_VENT, S_EYE_3, S_EYE_6, S_EYE_8, S_VISION_6, S_VISION_12, S_VISION_16, S_EAR_3, S_EAR_6, S_EAR_8, S_SPEED_GLAND_5, S_SPEED_GLAND_10 :: GroupName ItemKind

pattern S_ANIMAL_STOMACH, S_HUNGRY, S_RAZOR, S_FLOTATION_BAG, S_INK_SAC, S_POWERFUL_HIND_LEGS, S_COILED_TAIL, S_JET_BOOSTER, S_RHINO_INERTIA, S_SMALL_BEAK, S_LIVE_WIRE, S_COOLING_VENT, S_COOLING_FISSURE, S_MEDBOT_VENT, S_MEDBOT_FISSURE, S_DUST_VENT, S_DUST_FISSURE, S_FUEL_VENT, S_FUEL_FISSURE, S_ROBOT_BRAIN, S_HULL_PLATING, S_MOUTH_VENT, S_CRUDE_WELD, BACKSTORY_FLUFF_UNKNOWN, BACKSTORY_GOOD_UNKNOWN, BACKSTORY_BAD_UNKNOWN, BACKSTORY_MIXED_UNKNOWN, BACKSTORY_NEUTRAL_UNKNOWN :: GroupName ItemKind

organsGN :: [GroupName ItemKind]
organsGN :: [GroupName ItemKind]
organsGN =
     GroupName ItemKind
SCAVENGER GroupName ItemKind -> [GroupName ItemKind] -> [GroupName ItemKind]
forall a. a -> [a] -> [a]
: GroupName ItemKind
ALCOHOL
     GroupName ItemKind -> [GroupName ItemKind] -> [GroupName ItemKind]
forall a. a -> [a] -> [a]
: [GroupName ItemKind
ELECTRIC_AMBIENCE, GroupName ItemKind
GENETIC_FLAW_3, GroupName ItemKind
GENETIC_FLAW_10, GroupName ItemKind
GENETIC_FLAW, GroupName ItemKind
BACKSTORY, GroupName ItemKind
BACKSTORY_FLUFF, GroupName ItemKind
BACKSTORY_GOOD, GroupName ItemKind
BACKSTORY_BAD, GroupName ItemKind
BACKSTORY_MIXED, GroupName ItemKind
BACKSTORY_NEUTRAL]

pattern SCAVENGER :: GroupName ItemKind
pattern ALCOHOL :: GroupName ItemKind

pattern ELECTRIC_AMBIENCE, GENETIC_FLAW_3, GENETIC_FLAW_10, GENETIC_FLAW, BACKSTORY, BACKSTORY_FLUFF, BACKSTORY_GOOD, BACKSTORY_BAD, BACKSTORY_MIXED, BACKSTORY_NEUTRAL :: GroupName ItemKind

pattern $bS_FIST :: GroupName ItemKind
$mS_FIST :: forall r. GroupName ItemKind -> (Void# -> r) -> (Void# -> r) -> r
S_FIST = GroupName "fist"
pattern $bS_FOOT :: GroupName ItemKind
$mS_FOOT :: forall r. GroupName ItemKind -> (Void# -> r) -> (Void# -> r) -> r
S_FOOT = GroupName "foot"
pattern $bS_HOOKED_CLAW :: GroupName ItemKind
$mS_HOOKED_CLAW :: forall r. GroupName ItemKind -> (Void# -> r) -> (Void# -> r) -> r
S_HOOKED_CLAW = GroupName "hooked claw"
pattern $bS_SMALL_CLAW :: GroupName ItemKind
$mS_SMALL_CLAW :: forall r. GroupName ItemKind -> (Void# -> r) -> (Void# -> r) -> r
S_SMALL_CLAW = GroupName "small claw"
pattern $bS_SNOUT :: GroupName ItemKind
$mS_SNOUT :: forall r. GroupName ItemKind -> (Void# -> r) -> (Void# -> r) -> r
S_SNOUT = GroupName "snout"
pattern $bS_SMALL_JAW :: GroupName ItemKind
$mS_SMALL_JAW :: forall r. GroupName ItemKind -> (Void# -> r) -> (Void# -> r) -> r
S_SMALL_JAW = GroupName "small jaw"
pattern $bS_JAW :: GroupName ItemKind
$mS_JAW :: forall r. GroupName ItemKind -> (Void# -> r) -> (Void# -> r) -> r
S_JAW = GroupName "jaw"
pattern $bS_LARGE_JAW :: GroupName ItemKind
$mS_LARGE_JAW :: forall r. GroupName ItemKind -> (Void# -> r) -> (Void# -> r) -> r
S_LARGE_JAW = GroupName "large jaw"
pattern $bS_ANTLER :: GroupName ItemKind
$mS_ANTLER :: forall r. GroupName ItemKind -> (Void# -> r) -> (Void# -> r) -> r
S_ANTLER = GroupName "antler"
pattern $bS_HORN :: GroupName ItemKind
$mS_HORN :: forall r. GroupName ItemKind -> (Void# -> r) -> (Void# -> r) -> r
S_HORN = GroupName "horn"
pattern $bS_RHINO_HORN :: GroupName ItemKind
$mS_RHINO_HORN :: forall r. GroupName ItemKind -> (Void# -> r) -> (Void# -> r) -> r
S_RHINO_HORN = GroupName "rhino horn"
pattern $bS_TENTACLE :: GroupName ItemKind
$mS_TENTACLE :: forall r. GroupName ItemKind -> (Void# -> r) -> (Void# -> r) -> r
S_TENTACLE = GroupName "tentacle"
pattern $bS_TIP :: GroupName ItemKind
$mS_TIP :: forall r. GroupName ItemKind -> (Void# -> r) -> (Void# -> r) -> r
S_TIP = GroupName "tip"
pattern $bS_LIP :: GroupName ItemKind
$mS_LIP :: forall r. GroupName ItemKind -> (Void# -> r) -> (Void# -> r) -> r
S_LIP = GroupName "lip"
pattern $bS_THORN :: GroupName ItemKind
$mS_THORN :: forall r. GroupName ItemKind -> (Void# -> r) -> (Void# -> r) -> r
S_THORN = GroupName "thorn"
pattern $bS_BOILING_FISSURE :: GroupName ItemKind
$mS_BOILING_FISSURE :: forall r. GroupName ItemKind -> (Void# -> r) -> (Void# -> r) -> r
S_BOILING_FISSURE = GroupName "boiling fissure"
pattern $bS_BEE_STING :: GroupName ItemKind
$mS_BEE_STING :: forall r. GroupName ItemKind -> (Void# -> r) -> (Void# -> r) -> r
S_BEE_STING = GroupName "bee sting"
pattern $bS_STING :: GroupName ItemKind
$mS_STING :: forall r. GroupName ItemKind -> (Void# -> r) -> (Void# -> r) -> r
S_STING = GroupName "sting"
pattern $bS_VENOM_TOOTH :: GroupName ItemKind
$mS_VENOM_TOOTH :: forall r. GroupName ItemKind -> (Void# -> r) -> (Void# -> r) -> r
S_VENOM_TOOTH = GroupName "venom tooth"
pattern $bS_VENOM_FANG :: GroupName ItemKind
$mS_VENOM_FANG :: forall r. GroupName ItemKind -> (Void# -> r) -> (Void# -> r) -> r
S_VENOM_FANG = GroupName "venom fang"
pattern $bS_SCREECHING_BEAK :: GroupName ItemKind
$mS_SCREECHING_BEAK :: forall r. GroupName ItemKind -> (Void# -> r) -> (Void# -> r) -> r
S_SCREECHING_BEAK = GroupName "screeching beak"
pattern $bS_LARGE_TAIL :: GroupName ItemKind
$mS_LARGE_TAIL :: forall r. GroupName ItemKind -> (Void# -> r) -> (Void# -> r) -> r
S_LARGE_TAIL = GroupName "large tail"
pattern $bS_HUGE_TAIL :: GroupName ItemKind
$mS_HUGE_TAIL :: forall r. GroupName ItemKind -> (Void# -> r) -> (Void# -> r) -> r
S_HUGE_TAIL = GroupName "huge tail"
pattern $bS_ARMORED_SKIN :: GroupName ItemKind
$mS_ARMORED_SKIN :: forall r. GroupName ItemKind -> (Void# -> r) -> (Void# -> r) -> r
S_ARMORED_SKIN = GroupName "armored skin"
pattern $bS_BARK :: GroupName ItemKind
$mS_BARK :: forall r. GroupName ItemKind -> (Void# -> r) -> (Void# -> r) -> r
S_BARK = GroupName "bark"
pattern $bS_NOSTRIL :: GroupName ItemKind
$mS_NOSTRIL :: forall r. GroupName ItemKind -> (Void# -> r) -> (Void# -> r) -> r
S_NOSTRIL = GroupName "nostril"
pattern $bS_RATLLE :: GroupName ItemKind
$mS_RATLLE :: forall r. GroupName ItemKind -> (Void# -> r) -> (Void# -> r) -> r
S_RATLLE = GroupName "rattle"
pattern $bS_INSECT_MORTALITY :: GroupName ItemKind
$mS_INSECT_MORTALITY :: forall r. GroupName ItemKind -> (Void# -> r) -> (Void# -> r) -> r
S_INSECT_MORTALITY = GroupName "insect mortality"
pattern $bS_SAPIENT_BRAIN :: GroupName ItemKind
$mS_SAPIENT_BRAIN :: forall r. GroupName ItemKind -> (Void# -> r) -> (Void# -> r) -> r
S_SAPIENT_BRAIN = GroupName "sapient brain"
pattern $bS_ANIMAL_BRAIN :: GroupName ItemKind
$mS_ANIMAL_BRAIN :: forall r. GroupName ItemKind -> (Void# -> r) -> (Void# -> r) -> r
S_ANIMAL_BRAIN = GroupName "animal brain"
pattern $bS_SCENT_GLAND :: GroupName ItemKind
$mS_SCENT_GLAND :: forall r. GroupName ItemKind -> (Void# -> r) -> (Void# -> r) -> r
S_SCENT_GLAND = GroupName "scent gland"
pattern $bS_BOILING_VENT :: GroupName ItemKind
$mS_BOILING_VENT :: forall r. GroupName ItemKind -> (Void# -> r) -> (Void# -> r) -> r
S_BOILING_VENT = GroupName "boiling vent"
pattern $bS_EYE_3 :: GroupName ItemKind
$mS_EYE_3 :: forall r. GroupName ItemKind -> (Void# -> r) -> (Void# -> r) -> r
S_EYE_3 = GroupName "eye 3"
pattern $bS_EYE_6 :: GroupName ItemKind
$mS_EYE_6 :: forall r. GroupName ItemKind -> (Void# -> r) -> (Void# -> r) -> r
S_EYE_6 = GroupName "eye 6"
pattern $bS_EYE_8 :: GroupName ItemKind
$mS_EYE_8 :: forall r. GroupName ItemKind -> (Void# -> r) -> (Void# -> r) -> r
S_EYE_8 = GroupName "eye 8"
pattern $bS_VISION_6 :: GroupName ItemKind
$mS_VISION_6 :: forall r. GroupName ItemKind -> (Void# -> r) -> (Void# -> r) -> r
S_VISION_6 = GroupName "vision 6"
pattern $bS_VISION_12 :: GroupName ItemKind
$mS_VISION_12 :: forall r. GroupName ItemKind -> (Void# -> r) -> (Void# -> r) -> r
S_VISION_12 = GroupName "vision 12"
pattern $bS_VISION_16 :: GroupName ItemKind
$mS_VISION_16 :: forall r. GroupName ItemKind -> (Void# -> r) -> (Void# -> r) -> r
S_VISION_16 = GroupName "vision 16"
pattern $bS_EAR_3 :: GroupName ItemKind
$mS_EAR_3 :: forall r. GroupName ItemKind -> (Void# -> r) -> (Void# -> r) -> r
S_EAR_3 = GroupName "ear 3"
pattern $bS_EAR_6 :: GroupName ItemKind
$mS_EAR_6 :: forall r. GroupName ItemKind -> (Void# -> r) -> (Void# -> r) -> r
S_EAR_6 = GroupName "ear 6"
pattern $bS_EAR_8 :: GroupName ItemKind
$mS_EAR_8 :: forall r. GroupName ItemKind -> (Void# -> r) -> (Void# -> r) -> r
S_EAR_8 = GroupName "ear 8"
pattern $bS_SPEED_GLAND_5 :: GroupName ItemKind
$mS_SPEED_GLAND_5 :: forall r. GroupName ItemKind -> (Void# -> r) -> (Void# -> r) -> r
S_SPEED_GLAND_5 = GroupName "speed gland 5"
pattern $bS_SPEED_GLAND_10 :: GroupName ItemKind
$mS_SPEED_GLAND_10 :: forall r. GroupName ItemKind -> (Void# -> r) -> (Void# -> r) -> r
S_SPEED_GLAND_10 = GroupName "speed gland 10"

pattern $bSCAVENGER :: GroupName ItemKind
$mSCAVENGER :: forall r. GroupName ItemKind -> (Void# -> r) -> (Void# -> r) -> r
SCAVENGER = GroupName "scavenger"
pattern $bALCOHOL :: GroupName ItemKind
$mALCOHOL :: forall r. GroupName ItemKind -> (Void# -> r) -> (Void# -> r) -> r
ALCOHOL = GroupName "alcohol"

-- ** Allure-specific
pattern $bS_ANIMAL_STOMACH :: GroupName ItemKind
$mS_ANIMAL_STOMACH :: forall r. GroupName ItemKind -> (Void# -> r) -> (Void# -> r) -> r
S_ANIMAL_STOMACH = GroupName "animal stomach"
pattern $bS_HUNGRY :: GroupName ItemKind
$mS_HUNGRY :: forall r. GroupName ItemKind -> (Void# -> r) -> (Void# -> r) -> r
S_HUNGRY = GroupName "hungry"
pattern $bS_RAZOR :: GroupName ItemKind
$mS_RAZOR :: forall r. GroupName ItemKind -> (Void# -> r) -> (Void# -> r) -> r
S_RAZOR = GroupName "razor"
pattern $bS_FLOTATION_BAG :: GroupName ItemKind
$mS_FLOTATION_BAG :: forall r. GroupName ItemKind -> (Void# -> r) -> (Void# -> r) -> r
S_FLOTATION_BAG = GroupName "flotation bag"
pattern $bS_INK_SAC :: GroupName ItemKind
$mS_INK_SAC :: forall r. GroupName ItemKind -> (Void# -> r) -> (Void# -> r) -> r
S_INK_SAC = GroupName "inc sac"
pattern $bS_POWERFUL_HIND_LEGS :: GroupName ItemKind
$mS_POWERFUL_HIND_LEGS :: forall r. GroupName ItemKind -> (Void# -> r) -> (Void# -> r) -> r
S_POWERFUL_HIND_LEGS = GroupName "powerful hind legs"
pattern $bS_COILED_TAIL :: GroupName ItemKind
$mS_COILED_TAIL :: forall r. GroupName ItemKind -> (Void# -> r) -> (Void# -> r) -> r
S_COILED_TAIL = GroupName "coiled tail"
pattern $bS_JET_BOOSTER :: GroupName ItemKind
$mS_JET_BOOSTER :: forall r. GroupName ItemKind -> (Void# -> r) -> (Void# -> r) -> r
S_JET_BOOSTER = GroupName "jet booster"
pattern $bS_RHINO_INERTIA :: GroupName ItemKind
$mS_RHINO_INERTIA :: forall r. GroupName ItemKind -> (Void# -> r) -> (Void# -> r) -> r
S_RHINO_INERTIA = GroupName "rhino inertia"
pattern $bS_SMALL_BEAK :: GroupName ItemKind
$mS_SMALL_BEAK :: forall r. GroupName ItemKind -> (Void# -> r) -> (Void# -> r) -> r
S_SMALL_BEAK = GroupName "small beak"
pattern $bS_LIVE_WIRE :: GroupName ItemKind
$mS_LIVE_WIRE :: forall r. GroupName ItemKind -> (Void# -> r) -> (Void# -> r) -> r
S_LIVE_WIRE = GroupName "live wire"
pattern $bS_COOLING_VENT :: GroupName ItemKind
$mS_COOLING_VENT :: forall r. GroupName ItemKind -> (Void# -> r) -> (Void# -> r) -> r
S_COOLING_VENT = GroupName "cooling vent"
pattern $bS_COOLING_FISSURE :: GroupName ItemKind
$mS_COOLING_FISSURE :: forall r. GroupName ItemKind -> (Void# -> r) -> (Void# -> r) -> r
S_COOLING_FISSURE = GroupName "cooling fissure"
pattern $bS_MEDBOT_VENT :: GroupName ItemKind
$mS_MEDBOT_VENT :: forall r. GroupName ItemKind -> (Void# -> r) -> (Void# -> r) -> r
S_MEDBOT_VENT = GroupName "medbot vent"
pattern $bS_MEDBOT_FISSURE :: GroupName ItemKind
$mS_MEDBOT_FISSURE :: forall r. GroupName ItemKind -> (Void# -> r) -> (Void# -> r) -> r
S_MEDBOT_FISSURE = GroupName "medbot fissure"
pattern $bS_DUST_VENT :: GroupName ItemKind
$mS_DUST_VENT :: forall r. GroupName ItemKind -> (Void# -> r) -> (Void# -> r) -> r
S_DUST_VENT = GroupName "dust vent"
pattern $bS_DUST_FISSURE :: GroupName ItemKind
$mS_DUST_FISSURE :: forall r. GroupName ItemKind -> (Void# -> r) -> (Void# -> r) -> r
S_DUST_FISSURE = GroupName "dust fissure"
pattern $bS_FUEL_VENT :: GroupName ItemKind
$mS_FUEL_VENT :: forall r. GroupName ItemKind -> (Void# -> r) -> (Void# -> r) -> r
S_FUEL_VENT = GroupName "fuel vent"
pattern $bS_FUEL_FISSURE :: GroupName ItemKind
$mS_FUEL_FISSURE :: forall r. GroupName ItemKind -> (Void# -> r) -> (Void# -> r) -> r
S_FUEL_FISSURE = GroupName "fuel fissure"
pattern $bS_ROBOT_BRAIN :: GroupName ItemKind
$mS_ROBOT_BRAIN :: forall r. GroupName ItemKind -> (Void# -> r) -> (Void# -> r) -> r
S_ROBOT_BRAIN = GroupName "robot brain"
pattern $bS_HULL_PLATING :: GroupName ItemKind
$mS_HULL_PLATING :: forall r. GroupName ItemKind -> (Void# -> r) -> (Void# -> r) -> r
S_HULL_PLATING = GroupName "hull plating"
pattern $bS_MOUTH_VENT :: GroupName ItemKind
$mS_MOUTH_VENT :: forall r. GroupName ItemKind -> (Void# -> r) -> (Void# -> r) -> r
S_MOUTH_VENT = GroupName "mouth vent"
pattern $bS_CRUDE_WELD :: GroupName ItemKind
$mS_CRUDE_WELD :: forall r. GroupName ItemKind -> (Void# -> r) -> (Void# -> r) -> r
S_CRUDE_WELD = GroupName "crude weld"

pattern $bELECTRIC_AMBIENCE :: GroupName ItemKind
$mELECTRIC_AMBIENCE :: forall r. GroupName ItemKind -> (Void# -> r) -> (Void# -> r) -> r
ELECTRIC_AMBIENCE = GroupName "electric ambience"
pattern $bGENETIC_FLAW_3 :: GroupName ItemKind
$mGENETIC_FLAW_3 :: forall r. GroupName ItemKind -> (Void# -> r) -> (Void# -> r) -> r
GENETIC_FLAW_3 = GroupName "genetic flaw 3"
pattern $bGENETIC_FLAW_10 :: GroupName ItemKind
$mGENETIC_FLAW_10 :: forall r. GroupName ItemKind -> (Void# -> r) -> (Void# -> r) -> r
GENETIC_FLAW_10 = GroupName "genetic flaw 10"
pattern $bGENETIC_FLAW :: GroupName ItemKind
$mGENETIC_FLAW :: forall r. GroupName ItemKind -> (Void# -> r) -> (Void# -> r) -> r
GENETIC_FLAW = GroupName "genetic flaw"
pattern $bBACKSTORY :: GroupName ItemKind
$mBACKSTORY :: forall r. GroupName ItemKind -> (Void# -> r) -> (Void# -> r) -> r
BACKSTORY = GroupName "backstory"
pattern $bBACKSTORY_FLUFF_UNKNOWN :: GroupName ItemKind
$mBACKSTORY_FLUFF_UNKNOWN :: forall r. GroupName ItemKind -> (Void# -> r) -> (Void# -> r) -> r
BACKSTORY_FLUFF_UNKNOWN = GroupName "fluff backstory unknown"
pattern $bBACKSTORY_FLUFF :: GroupName ItemKind
$mBACKSTORY_FLUFF :: forall r. GroupName ItemKind -> (Void# -> r) -> (Void# -> r) -> r
BACKSTORY_FLUFF = GroupName "fluff backstory"
pattern $bBACKSTORY_GOOD_UNKNOWN :: GroupName ItemKind
$mBACKSTORY_GOOD_UNKNOWN :: forall r. GroupName ItemKind -> (Void# -> r) -> (Void# -> r) -> r
BACKSTORY_GOOD_UNKNOWN = GroupName "good backstory unknown"
pattern $bBACKSTORY_GOOD :: GroupName ItemKind
$mBACKSTORY_GOOD :: forall r. GroupName ItemKind -> (Void# -> r) -> (Void# -> r) -> r
BACKSTORY_GOOD = GroupName "good backstory"
pattern $bBACKSTORY_BAD_UNKNOWN :: GroupName ItemKind
$mBACKSTORY_BAD_UNKNOWN :: forall r. GroupName ItemKind -> (Void# -> r) -> (Void# -> r) -> r
BACKSTORY_BAD_UNKNOWN = GroupName "bad backstory unknown"
pattern $bBACKSTORY_BAD :: GroupName ItemKind
$mBACKSTORY_BAD :: forall r. GroupName ItemKind -> (Void# -> r) -> (Void# -> r) -> r
BACKSTORY_BAD = GroupName "bad backstory"
pattern $bBACKSTORY_MIXED_UNKNOWN :: GroupName ItemKind
$mBACKSTORY_MIXED_UNKNOWN :: forall r. GroupName ItemKind -> (Void# -> r) -> (Void# -> r) -> r
BACKSTORY_MIXED_UNKNOWN = GroupName "mixed backstory unknown"
pattern $bBACKSTORY_MIXED :: GroupName ItemKind
$mBACKSTORY_MIXED :: forall r. GroupName ItemKind -> (Void# -> r) -> (Void# -> r) -> r
BACKSTORY_MIXED = GroupName "mixed backstory"
pattern $bBACKSTORY_NEUTRAL_UNKNOWN :: GroupName ItemKind
$mBACKSTORY_NEUTRAL_UNKNOWN :: forall r. GroupName ItemKind -> (Void# -> r) -> (Void# -> r) -> r
BACKSTORY_NEUTRAL_UNKNOWN = GroupName "neutral backstory unk."
pattern $bBACKSTORY_NEUTRAL :: GroupName ItemKind
$mBACKSTORY_NEUTRAL :: forall r. GroupName ItemKind -> (Void# -> r) -> (Void# -> r) -> r
BACKSTORY_NEUTRAL = GroupName "neutral backstory"

-- * Content

organs :: [ItemKind]
organs :: [ItemKind]
organs =
  [ItemKind
fist, ItemKind
foot, ItemKind
hookedClaw, ItemKind
smallClaw, ItemKind
snout, ItemKind
smallJaw, ItemKind
jaw, ItemKind
largeJaw, ItemKind
antler, ItemKind
horn, ItemKind
rhinoHorn, ItemKind
tentacle, ItemKind
tip, ItemKind
lip, ItemKind
thorn, ItemKind
boilingFissure, ItemKind
arsenicFissure, ItemKind
sulfurFissure, ItemKind
beeSting, ItemKind
sting, ItemKind
venomTooth, ItemKind
venomFang, ItemKind
screechingBeak, ItemKind
largeTail, ItemKind
hugeTail, ItemKind
armoredSkin, ItemKind
bark, ItemKind
eye3, ItemKind
eye6, ItemKind
eye8, ItemKind
vision6, ItemKind
vision12, ItemKind
vision16, ItemKind
nostril, ItemKind
ear3, ItemKind
ear6, ItemKind
ear8, ItemKind
rattleOrgan, ItemKind
insectMortality, ItemKind
sapientBrain, ItemKind
animalBrain, ItemKind
speedGland5, ItemKind
speedGland10, ItemKind
scentGland, ItemKind
boilingVent, ItemKind
arsenicVent, ItemKind
sulfurVent, ItemKind
bonusHP, ItemKind
braced, ItemKind
asleep, ItemKind
impressed]
  -- Allure-specific
  [ItemKind] -> [ItemKind] -> [ItemKind]
forall a. [a] -> [a] -> [a]
++ [ItemKind
animalStomach, ItemKind
hungry, ItemKind
smallBeak, ItemKind
razor, ItemKind
liveWire, ItemKind
flotationBag, ItemKind
inkSac, ItemKind
powerfulHindLegs, ItemKind
coiledTail, ItemKind
jetBooster, ItemKind
rhinoInertia, ItemKind
electricAmbience, ItemKind
electricAmbienceRecharge, ItemKind
robotBrain, ItemKind
hullPlating, ItemKind
mouthVent, ItemKind
dustVent, ItemKind
dustFissure, ItemKind
fuelVent, ItemKind
fuelFissure, ItemKind
geneticFlaw3BadArmorMelee, ItemKind
geneticFlaw3BadArmorRanged, ItemKind
geneticFlaw10BadArmorMelee, ItemKind
geneticFlaw10BadArmorRanged, ItemKind
backstoryFluffTemplate, ItemKind
backstoryFluff1, ItemKind
backstoryGoodTemplate, ItemKind
backstoryGood1, ItemKind
backstoryGood2, ItemKind
backstoryGood3, ItemKind
backstoryBadTemplate, ItemKind
backstoryBad1, ItemKind
backstoryBad2, ItemKind
backstoryBad3, ItemKind
backstoryBad4, ItemKind
backstoryMixedTemplate, ItemKind
backstoryMixed1, ItemKind
backstoryMixed2, ItemKind
backstoryNeutralTemplate, ItemKind
backstoryNeutral1, ItemKind
backstoryNeutral2, ItemKind
backstoryNeutral3]

fist,    foot, hookedClaw, smallClaw, snout, smallJaw, jaw, largeJaw, antler, horn, rhinoHorn, tentacle, tip, lip, thorn, boilingFissure, arsenicFissure, sulfurFissure, beeSting, sting, venomTooth, venomFang, screechingBeak, largeTail, hugeTail, armoredSkin, bark, eye3, eye6, eye8, vision6, vision12, vision16, nostril, ear3, ear6, ear8, rattleOrgan, insectMortality, sapientBrain, animalBrain, speedGland5, speedGland10, scentGland, boilingVent, arsenicVent, sulfurVent, bonusHP, braced, asleep, impressed :: ItemKind
-- Allure-specific
animalStomach,       hungry, smallBeak, razor, liveWire, flotationBag, inkSac, powerfulHindLegs, coiledTail, jetBooster, rhinoInertia, electricAmbience, electricAmbienceRecharge, robotBrain, hullPlating, mouthVent, dustVent, dustFissure, fuelVent, fuelFissure, geneticFlaw3BadArmorMelee, geneticFlaw3BadArmorRanged, geneticFlaw10BadArmorMelee, geneticFlaw10BadArmorRanged, backstoryFluffTemplate, backstoryFluff1, backstoryGoodTemplate, backstoryGood1, backstoryGood2, backstoryGood3, backstoryBadTemplate, backstoryBad1, backstoryBad2, backstoryBad3, backstoryBad4, backstoryMixedTemplate, backstoryMixed1, backstoryMixed2, backstoryNeutralTemplate, backstoryNeutral1, backstoryNeutral2, backstoryNeutral3 :: ItemKind

-- * No-cooldown melee damage organs without effects

thorn :: ItemKind
thorn = ItemKind
fist
  { isymbol :: Char
isymbol  = '-'
  , iname :: Text
iname    = "thorn"
  , ifreq :: Freqs ItemKind
ifreq    = [(GroupName ItemKind
S_THORN, 1)]
  , icount :: Dice
icount   = 2 Dice -> Dice -> Dice
forall a. Num a => a -> a -> a
+ 1 Int -> Int -> Dice
`d` 2  -- unrealistic, but not boring
  , iverbHit :: Text
iverbHit = "puncture"
  , idamage :: Dice
idamage  = 1 Int -> Int -> Dice
`d` 1
  , iaspects :: [Aspect]
iaspects = [Flag -> Aspect
SetFlag Flag
Meleeable]  -- not Durable
  , ieffects :: [Effect]
ieffects = [Text -> Text -> Effect
VerbNoLonger "be not so thorny any more" "."]
  , idesc :: Text
idesc    = "Sharp yet brittle."
  }
tip :: ItemKind
tip = ItemKind
fist
  { iname :: Text
iname    = "tip"
  , ifreq :: Freqs ItemKind
ifreq    = [(GroupName ItemKind
S_TIP, 1)]
  , icount :: Dice
icount   = 1
  , iverbHit :: Text
iverbHit = "poke"
  , idamage :: Dice
idamage  = 1 Int -> Int -> Dice
`d` 1
  , idesc :: Text
idesc    = ""
  }
fist :: ItemKind
fist = $WItemKind :: Char
-> Text
-> Freqs ItemKind
-> [Flavour]
-> Dice
-> Rarity
-> Text
-> Int
-> Dice
-> [Aspect]
-> [Effect]
-> [(GroupName ItemKind, CStore)]
-> Text
-> ItemKind
ItemKind
  { isymbol :: Char
isymbol  = ','
  , iname :: Text
iname    = "fist"
  , ifreq :: Freqs ItemKind
ifreq    = [(GroupName ItemKind
S_FIST, 1)]
  , iflavour :: [Flavour]
iflavour = [Color] -> [Flavour]
zipPlain [Color
Red]
  , icount :: Dice
icount   = 2
  , irarity :: Rarity
irarity  = [(1, 1)]
  , iverbHit :: Text
iverbHit = "punch"
  , iweight :: Int
iweight  = 2000
  , idamage :: Dice
idamage  = 2 Int -> Int -> Dice
`d` 1
  , iaspects :: [Aspect]
iaspects = [Flag -> Aspect
SetFlag Flag
Durable, Flag -> Aspect
SetFlag Flag
Meleeable]
  , ieffects :: [Effect]
ieffects = []
  , idesc :: Text
idesc    = "Simple but effective."
  , ikit :: [(GroupName ItemKind, CStore)]
ikit     = []
  }
foot :: ItemKind
foot = ItemKind
fist
  { iname :: Text
iname    = "foot"
  , ifreq :: Freqs ItemKind
ifreq    = [(GroupName ItemKind
S_FOOT, 1)]
  , iverbHit :: Text
iverbHit = "kick"
  , idamage :: Dice
idamage  = 2 Int -> Int -> Dice
`d` 1
  , idesc :: Text
idesc    = "A weapon you can still use if disarmed."
                 -- great example of tutorial hints inside a flavourful text
  }
smallClaw :: ItemKind
smallClaw = ItemKind
fist
  { iname :: Text
iname    = "small claw"
  , ifreq :: Freqs ItemKind
ifreq    = [(GroupName ItemKind
S_SMALL_CLAW, 1)]
  , iverbHit :: Text
iverbHit = "slash"
  , idamage :: Dice
idamage  = 2 Int -> Int -> Dice
`d` 1
  , idesc :: Text
idesc    = "A pearly spike."
  }
snout :: ItemKind
snout = ItemKind
fist
  { iname :: Text
iname    = "snout"
  , ifreq :: Freqs ItemKind
ifreq    = [(GroupName ItemKind
S_SNOUT, 1)]
  , icount :: Dice
icount   = 1
  , iverbHit :: Text
iverbHit = "nudge"
  , idamage :: Dice
idamage  = 2 Int -> Int -> Dice
`d` 1
  , idesc :: Text
idesc    = "Sensitive and wide-nostrilled."
  }
smallJaw :: ItemKind
smallJaw = ItemKind
fist
  { iname :: Text
iname    = "small jaw"
  , ifreq :: Freqs ItemKind
ifreq    = [(GroupName ItemKind
S_SMALL_JAW, 1)]
  , icount :: Dice
icount   = 1
  , iverbHit :: Text
iverbHit = "rip"
  , idamage :: Dice
idamage  = 3 Int -> Int -> Dice
`d` 1
  , idesc :: Text
idesc    = "Filled with small, even teeth."
  }

-- * Cooldown melee damage organs without effects

tentacle :: ItemKind
tentacle = ItemKind
fist  -- two copies only
  { iname :: Text
iname    = "tentacle"
  , ifreq :: Freqs ItemKind
ifreq    = [(GroupName ItemKind
S_TENTACLE, 1)]
  , iverbHit :: Text
iverbHit = "slap"
  , idamage :: Dice
idamage  = 4 Int -> Int -> Dice
`d` 1
  , iaspects :: [Aspect]
iaspects = Dice -> Aspect
Timeout 3  -- minimal timeout that lets other organs show
               Aspect -> [Aspect] -> [Aspect]
forall a. a -> [a] -> [a]
: ItemKind -> [Aspect]
iaspects ItemKind
fist
  , idesc :: Text
idesc    = "Damp and dextrous."
  }
jaw :: ItemKind
jaw = ItemKind
fist
  { iname :: Text
iname    = "jaw"
  , ifreq :: Freqs ItemKind
ifreq    = [(GroupName ItemKind
S_JAW, 1)]
  , icount :: Dice
icount   = 1
  , iverbHit :: Text
iverbHit = "rip"
  , idamage :: Dice
idamage  = 5 Int -> Int -> Dice
`d` 1
  , iaspects :: [Aspect]
iaspects = Dice -> Aspect
Timeout (2 Dice -> Dice -> Dice
forall a. Num a => a -> a -> a
+ 1 Int -> Int -> Dice
`d` 2)  -- no effect, but limit raw damage
               Aspect -> [Aspect] -> [Aspect]
forall a. a -> [a] -> [a]
: ItemKind -> [Aspect]
iaspects ItemKind
fist
  , idesc :: Text
idesc    = "Delivers a powerful bite."
  }
horn :: ItemKind
horn = ItemKind
fist
  { iname :: Text
iname    = "horn"
  , ifreq :: Freqs ItemKind
ifreq    = [(GroupName ItemKind
S_HORN, 1)]
  , iverbHit :: Text
iverbHit = "impale"
  , idamage :: Dice
idamage  = 5 Int -> Int -> Dice
`d` 1
  , iaspects :: [Aspect]
iaspects = [ Dice -> Aspect
Timeout 7  -- no effect, but limit raw damage; two copies
               , Skill -> Dice -> Aspect
AddSkill Skill
SkArmorMelee 10 ]  -- bonus doubled
               [Aspect] -> [Aspect] -> [Aspect]
forall a. [a] -> [a] -> [a]
++ ItemKind -> [Aspect]
iaspects ItemKind
fist
  , idesc :: Text
idesc    = "Sharp and long, for defence or attack."
  }
largeTail :: ItemKind
largeTail = ItemKind
fist
  { iname :: Text
iname    = "large tail"
  , ifreq :: Freqs ItemKind
ifreq    = [(GroupName ItemKind
S_LARGE_TAIL, 1)]
  , icount :: Dice
icount   = 1
  , iverbHit :: Text
iverbHit = "knock"
  , idamage :: Dice
idamage  = 6 Int -> Int -> Dice
`d` 1  -- not sharp
  , iaspects :: [Aspect]
iaspects = Dice -> Aspect
Timeout (4 Dice -> Dice -> Dice
forall a. Num a => a -> a -> a
+ 1 Int -> Int -> Dice
`d` 2)  -- one copy, so can be low
               Aspect -> [Aspect] -> [Aspect]
forall a. a -> [a] -> [a]
: ItemKind -> [Aspect]
iaspects ItemKind
fist
  , idesc :: Text
idesc    = "Almost as long as the trunk."
  }
largeJaw :: ItemKind
largeJaw = ItemKind
fist  -- organs can't be too weak, because some non-humans also use
                 -- human weapons and then the sudden contrast would be cruel
  { iname :: Text
iname    = "large jaw"
  , ifreq :: Freqs ItemKind
ifreq    = [(GroupName ItemKind
S_LARGE_JAW, 1)]
  , icount :: Dice
icount   = 1
  , iverbHit :: Text
iverbHit = "crush"
  , idamage :: Dice
idamage  = 10 Int -> Int -> Dice
`d` 1  -- tops the best non-crafted, non-unique human weapons
  , iaspects :: [Aspect]
iaspects = Dice -> Aspect
Timeout (8 Dice -> Dice -> Dice
forall a. Num a => a -> a -> a
+ 1 Int -> Int -> Dice
`d` 2)  -- no effect, but limit raw damage
               Aspect -> [Aspect] -> [Aspect]
forall a. a -> [a] -> [a]
: ItemKind -> [Aspect]
iaspects ItemKind
fist
  , idesc :: Text
idesc    = "Enough to swallow anything in a single gulp."
  }

-- * Direct damage organs with effects

beeSting :: ItemKind
beeSting = ItemKind
fist
  { isymbol :: Char
isymbol  = '-'
  , iname :: Text
iname    = "bee sting"
  , ifreq :: Freqs ItemKind
ifreq    = [(GroupName ItemKind
S_BEE_STING, 1)]
  , icount :: Dice
icount   = 1
  , iverbHit :: Text
iverbHit = "sting"
  , idamage :: Dice
idamage  = 0
  , iaspects :: [Aspect]
iaspects = [ Skill -> Dice -> Aspect
AddSkill Skill
SkArmorMelee 200, Skill -> Dice -> Aspect
AddSkill Skill
SkArmorRanged 45
               , Flag -> Aspect
SetFlag Flag
Meleeable ]  -- not Durable
  , ieffects :: [Effect]
ieffects = [Dice -> Effect
Paralyze 10, Int -> Effect
RefillHP 3]  -- low gain; no tragedy if dies early
                 -- no special message when runs out, because it's 1 copy
  , idesc :: Text
idesc    = "Painful, but beneficial."
  }
sting :: ItemKind
sting = ItemKind
fist
  { isymbol :: Char
isymbol  = '-'
  , iname :: Text
iname    = "sting"
  , ifreq :: Freqs ItemKind
ifreq    = [(GroupName ItemKind
S_STING, 1)]
  , icount :: Dice
icount   = 1
  , iverbHit :: Text
iverbHit = "inject"
  , idamage :: Dice
idamage  = 1 Int -> Int -> Dice
`d` 1
  , iaspects :: [Aspect]
iaspects = Dice -> Aspect
Timeout (10 Dice -> Dice -> Dice
forall a. Num a => a -> a -> a
- 1 Int -> Int -> Dice
`dL` 4)
               Aspect -> [Aspect] -> [Aspect]
forall a. a -> [a] -> [a]
: ItemKind -> [Aspect]
iaspects ItemKind
fist
  , ieffects :: [Effect]
ieffects = [GroupName ItemKind -> Dice -> Effect
toOrganBad GroupName ItemKind
S_RETAINING (3 Dice -> Dice -> Dice
forall a. Num a => a -> a -> a
+ 1 Int -> Int -> Dice
`d` 3)]
  , idesc :: Text
idesc    = "Painful, debilitating and harmful."
  }
lip :: ItemKind
lip = ItemKind
fist
  { iname :: Text
iname    = "lip"
  , ifreq :: Freqs ItemKind
ifreq    = [(GroupName ItemKind
S_LIP, 1)]
  , icount :: Dice
icount   = 1
  , iverbHit :: Text
iverbHit = "lap"
  , idamage :: Dice
idamage  = 1 Int -> Int -> Dice
`d` 1
  , iaspects :: [Aspect]
iaspects = Dice -> Aspect
Timeout (3 Dice -> Dice -> Dice
forall a. Num a => a -> a -> a
+ 1 Int -> Int -> Dice
`d` 2)
               Aspect -> [Aspect] -> [Aspect]
forall a. a -> [a] -> [a]
: ItemKind -> [Aspect]
iaspects ItemKind
fist
  , ieffects :: [Effect]
ieffects = [GroupName ItemKind -> Dice -> Effect
toOrganBad GroupName ItemKind
S_WEAKENED (1 Dice -> Dice -> Dice
forall a. Num a => a -> a -> a
+ 1 Int -> Int -> Dice
`dL` 3)]
  , idesc :: Text
idesc    = ""
  }
venomTooth :: ItemKind
venomTooth = ItemKind
fist
  { isymbol :: Char
isymbol  = '-'
  , iname :: Text
iname    = "venom tooth"
  , ifreq :: Freqs ItemKind
ifreq    = [(GroupName ItemKind
S_VENOM_TOOTH, 1)]
  , iverbHit :: Text
iverbHit = "bite"
  , idamage :: Dice
idamage  = 1 Int -> Int -> Dice
`d` 1
  , iaspects :: [Aspect]
iaspects = Dice -> Aspect
Timeout (10 Dice -> Dice -> Dice
forall a. Num a => a -> a -> a
- 1 Int -> Int -> Dice
`dL` 3)
               Aspect -> [Aspect] -> [Aspect]
forall a. a -> [a] -> [a]
: ItemKind -> [Aspect]
iaspects ItemKind
fist
  , ieffects :: [Effect]
ieffects = [GroupName ItemKind -> Dice -> Effect
toOrganBad GroupName ItemKind
S_SLOWED (2 Dice -> Dice -> Dice
forall a. Num a => a -> a -> a
+ 1 Int -> Int -> Dice
`dL` 3)]
  , idesc :: Text
idesc    = "A chilling numbness spreads from its bite."
  }
hookedClaw :: ItemKind
hookedClaw = ItemKind
fist
  { isymbol :: Char
isymbol  = '-'
  , iname :: Text
iname    = "hooked claw"
  , ifreq :: Freqs ItemKind
ifreq    = [(GroupName ItemKind
S_HOOKED_CLAW, 1)]
  , icount :: Dice
icount   = 2  -- even if more, only the fore claws used for fighting
  , iverbHit :: Text
iverbHit = "hook"
  , idamage :: Dice
idamage  = 2 Int -> Int -> Dice
`d` 1
  , iaspects :: [Aspect]
iaspects = Dice -> Aspect
Timeout (12 Dice -> Dice -> Dice
forall a. Num a => a -> a -> a
- 1 Int -> Int -> Dice
`dL` 3)
               Aspect -> [Aspect] -> [Aspect]
forall a. a -> [a] -> [a]
: ItemKind -> [Aspect]
iaspects ItemKind
fist
  , ieffects :: [Effect]
ieffects = [GroupName ItemKind -> Dice -> Effect
toOrganBad GroupName ItemKind
S_SLOWED 2]
  , idesc :: Text
idesc    = "A curved talon."
  }
screechingBeak :: ItemKind
screechingBeak = ItemKind
fist
  { isymbol :: Char
isymbol  = '-'
  , iname :: Text
iname    = "screeching beak"
  , ifreq :: Freqs ItemKind
ifreq    = [(GroupName ItemKind
S_SCREECHING_BEAK, 1)]
  , icount :: Dice
icount   = 1
  , iverbHit :: Text
iverbHit = "peck"
  , idamage :: Dice
idamage  = 3 Int -> Int -> Dice
`d` 1
  , iaspects :: [Aspect]
iaspects = Dice -> Aspect
Timeout (7 Dice -> Dice -> Dice
forall a. Num a => a -> a -> a
- 1 Int -> Int -> Dice
`dL` 3)
               Aspect -> [Aspect] -> [Aspect]
forall a. a -> [a] -> [a]
: ItemKind -> [Aspect]
iaspects ItemKind
fist
  , ieffects :: [Effect]
ieffects = [GroupName ItemKind -> Dice -> Effect
Summon GroupName ItemKind
SCAVENGER (Dice -> Effect) -> Dice -> Effect
forall a b. (a -> b) -> a -> b
$ 1 Int -> Int -> Dice
`dL` 3]
  , idesc :: Text
idesc    = "Both a weapon and a beacon, calling more scavengers to the meal."
  }
antler :: ItemKind
antler = ItemKind
fist
  { isymbol :: Char
isymbol  = '-'
  , iname :: Text
iname    = "antler"
  , ifreq :: Freqs ItemKind
ifreq    = [(GroupName ItemKind
S_ANTLER, 1)]
  , iverbHit :: Text
iverbHit = "ram"
  , idamage :: Dice
idamage  = 4 Int -> Int -> Dice
`d` 1
  , iaspects :: [Aspect]
iaspects = [ Dice -> Aspect
Timeout (Dice -> Aspect) -> Dice -> Aspect
forall a b. (a -> b) -> a -> b
$ 3 Dice -> Dice -> Dice
forall a. Num a => a -> a -> a
+ (1 Int -> Int -> Dice
`d` 3) Dice -> Dice -> Dice
forall a. Num a => a -> a -> a
* 3
               , Skill -> Dice -> Aspect
AddSkill Skill
SkArmorMelee 10 ]  -- bonus doubled
               [Aspect] -> [Aspect] -> [Aspect]
forall a. [a] -> [a] -> [a]
++ ItemKind -> [Aspect]
iaspects ItemKind
fist
  , ieffects :: [Effect]
ieffects = [ThrowMod -> Effect
PushActor (Int -> Int -> Int -> ThrowMod
ThrowMod 100 50 1)]  -- 1 step, slow
  , idesc :: Text
idesc    = ""
  }
rhinoHorn :: ItemKind
rhinoHorn = ItemKind
fist
  { isymbol :: Char
isymbol  = '-'
  , iname :: Text
iname    = "ugly horn"  -- made of keratin, unlike real horns
  , ifreq :: Freqs ItemKind
ifreq    = [(GroupName ItemKind
S_RHINO_HORN, 1)]
  , icount :: Dice
icount   = 1  -- single, unlike real horns
  , iverbHit :: Text
iverbHit = "gore"
  , idamage :: Dice
idamage  = 4 Int -> Int -> Dice
`d` 1
  , iaspects :: [Aspect]
iaspects = Dice -> Aspect
Timeout 5
               Aspect -> [Aspect] -> [Aspect]
forall a. a -> [a] -> [a]
: ItemKind -> [Aspect]
iaspects ItemKind
fist
  , ieffects :: [Effect]
ieffects = [Effect
Impress, Effect
Yell]  -- the owner is a mid-boss, after all
  , idesc :: Text
idesc    = "Very solid, considering it has the same composition as fingernails."
  }
hugeTail :: ItemKind
hugeTail = ItemKind
fist
  { isymbol :: Char
isymbol  = '-'
  , iname :: Text
iname    = "huge tail"
  , ifreq :: Freqs ItemKind
ifreq    = [(GroupName ItemKind
S_HUGE_TAIL, 1)]
  , icount :: Dice
icount   = 1
  , iverbHit :: Text
iverbHit = "upend"
  , idamage :: Dice
idamage  = 7 Int -> Int -> Dice
`d` 1
  , iaspects :: [Aspect]
iaspects = Dice -> Aspect
Timeout (7 Dice -> Dice -> Dice
forall a. Num a => a -> a -> a
+ 1 Int -> Int -> Dice
`d` 2)
               Aspect -> [Aspect] -> [Aspect]
forall a. a -> [a] -> [a]
: ItemKind -> [Aspect]
iaspects ItemKind
fist
                 -- timeout higher, lest they regain push before closing again
  , ieffects :: [Effect]
ieffects = [ThrowMod -> Effect
PushActor (Int -> Int -> Int -> ThrowMod
ThrowMod 200 50 1)]  -- 1 step, fast
      -- 2 steps would be too hard to counteract via second line of heroes
  , idesc :: Text
idesc    = "This immense and muscular tail transfers a huge momentum in a matter of seconds."
  }

-- * Melee weapons without direct damage

venomFang :: ItemKind
venomFang = ItemKind
fist
  { isymbol :: Char
isymbol  = '-'
  , iname :: Text
iname    = "venom fang"
  , ifreq :: Freqs ItemKind
ifreq    = [(GroupName ItemKind
S_VENOM_FANG, 1)]
  , iverbHit :: Text
iverbHit = "bite"
  , idamage :: Dice
idamage  = 0
  , iaspects :: [Aspect]
iaspects = Dice -> Aspect
Timeout (10 Dice -> Dice -> Dice
forall a. Num a => a -> a -> a
- 1 Int -> Int -> Dice
`dL` 5)
               Aspect -> [Aspect] -> [Aspect]
forall a. a -> [a] -> [a]
: ItemKind -> [Aspect]
iaspects ItemKind
fist
  , ieffects :: [Effect]
ieffects = [GroupName ItemKind -> Effect
toOrganNoTimer GroupName ItemKind
S_POISONED]
  , idesc :: Text
idesc    = "Dripping with deadly venom."
  }

-- * Special melee weapons

sulfurFissure :: ItemKind
sulfurFissure = ItemKind
boilingFissure
  { iname :: Text
iname    = "fissure"
  , ifreq :: Freqs ItemKind
ifreq    = [(GroupName ItemKind
S_MEDBOT_FISSURE, 1)]
  , icount :: Dice
icount   = 2 Dice -> Dice -> Dice
forall a. Num a => a -> a -> a
+ 1 Int -> Int -> Dice
`d` 2
  , idamage :: Dice
idamage  = 0  -- heal not via (negative) idamage, for armour would block it
  , iaspects :: [Aspect]
iaspects = Flag -> Aspect
SetFlag Flag
Benign Aspect -> [Aspect] -> [Aspect]
forall a. a -> [a] -> [a]
: ItemKind -> [Aspect]
iaspects ItemKind
boilingFissure
  , ieffects :: [Effect]
ieffects = [ Int -> Effect
RefillHP 5
               , GroupName ItemKind -> Effect
toOrganNoTimer GroupName ItemKind
S_HUNGRY  -- the metabolic price to pay
               , Text -> Text -> Effect
VerbNoLonger "run out of nano medbot liquid" "." ]
  , idesc :: Text
idesc    = ""
  }
boilingFissure :: ItemKind
boilingFissure = ItemKind
fist
  { isymbol :: Char
isymbol  = '-'
  , iname :: Text
iname    = "fissure"
  , ifreq :: Freqs ItemKind
ifreq    = [(GroupName ItemKind
S_BOILING_FISSURE, 1)]
  , icount :: Dice
icount   = 2 Dice -> Dice -> Dice
forall a. Num a => a -> a -> a
+ 1 Int -> Int -> Dice
`d` 2
  , iverbHit :: Text
iverbHit = "hiss at"
  , idamage :: Dice
idamage  = 2 Int -> Int -> Dice
`d` 1  -- can remove hunger, so high price
  , iaspects :: [Aspect]
iaspects = [ Skill -> Dice -> Aspect
AddSkill Skill
SkHurtMelee 20  -- decreasing as count decreases
               , Flag -> Aspect
SetFlag Flag
Meleeable ]  -- not Durable
  , ieffects :: [Effect]
ieffects = [ Int -> Int -> CStore -> GroupName ItemKind -> Effect
DropItem 1 1 CStore
COrgan GroupName ItemKind
CONDITION  -- useful; limited; HP price
               , Text -> Text -> Effect
VerbNoLonger "widen the crack, releasing pressure" "." ]
  , idesc :: Text
idesc    = ""
  }
arsenicFissure :: ItemKind
arsenicFissure = ItemKind
boilingFissure
  { iname :: Text
iname    = "fissure"
  , ifreq :: Freqs ItemKind
ifreq    = [(GroupName ItemKind
S_COOLING_FISSURE, 1)]
  , icount :: Dice
icount   = 3 Dice -> Dice -> Dice
forall a. Num a => a -> a -> a
+ 1 Int -> Int -> Dice
`d` 3
  , idamage :: Dice
idamage  = 2 Int -> Int -> Dice
`d` 1
  , ieffects :: [Effect]
ieffects = [ GroupName ItemKind -> Dice -> Effect
toOrganBad GroupName ItemKind
S_PARSIMONIOUS (5 Dice -> Dice -> Dice
forall a. Num a => a -> a -> a
+ 1 Int -> Int -> Dice
`d` 3)
                   -- weaken/freeze, impacting intellectual abilities first
               , Text -> Text -> Effect
VerbNoLonger "clog with ice" "." ]
  , idesc :: Text
idesc    = ""
  }

-- * Armor organs

armoredSkin :: ItemKind
armoredSkin = $WItemKind :: Char
-> Text
-> Freqs ItemKind
-> [Flavour]
-> Dice
-> Rarity
-> Text
-> Int
-> Dice
-> [Aspect]
-> [Effect]
-> [(GroupName ItemKind, CStore)]
-> Text
-> ItemKind
ItemKind
  { isymbol :: Char
isymbol  = ','
  , iname :: Text
iname    = "armored skin"
  , ifreq :: Freqs ItemKind
ifreq    = [(GroupName ItemKind
S_ARMORED_SKIN, 1)]
  , iflavour :: [Flavour]
iflavour = [Color] -> [Flavour]
zipPlain [Color
Red]
  , icount :: Dice
icount   = 1
  , irarity :: Rarity
irarity  = [(1, 1)]
  , iverbHit :: Text
iverbHit = "bash"
  , iweight :: Int
iweight  = 2000
  , idamage :: Dice
idamage  = 0
  , iaspects :: [Aspect]
iaspects = [ Skill -> Dice -> Aspect
AddSkill Skill
SkArmorMelee 30, Skill -> Dice -> Aspect
AddSkill Skill
SkArmorRanged 15
               , Flag -> Aspect
SetFlag Flag
Durable ]
  , ieffects :: [Effect]
ieffects = []
  , idesc :: Text
idesc    = "Homemade armour is just as good."  -- hmm, it may get confused with leather armor jackets, etc.
  , ikit :: [(GroupName ItemKind, CStore)]
ikit     = []
  }
bark :: ItemKind
bark = ItemKind
armoredSkin
  { iname :: Text
iname    = "bark"
  , ifreq :: Freqs ItemKind
ifreq    = [(GroupName ItemKind
S_BARK, 1)]
  , idesc :: Text
idesc    = ""
  }

-- * Sense organs

eye :: Int -> GroupName ItemKind -> ItemKind
eye :: Int -> GroupName ItemKind -> ItemKind
eye n :: Int
n grp :: GroupName ItemKind
grp = ItemKind
armoredSkin
  { iname :: Text
iname    = "eye"
  , ifreq :: Freqs ItemKind
ifreq    = [(GroupName ItemKind
grp, 1)]
  , icount :: Dice
icount   = 2
  , iverbHit :: Text
iverbHit = "glare at"
  , iaspects :: [Aspect]
iaspects = [ Skill -> Dice -> Aspect
AddSkill Skill
SkSight (Int -> Dice
intToDice Int
n)
               , Flag -> Aspect
SetFlag Flag
Durable ]
  , idesc :: Text
idesc    = "A piercing stare."
  }
eye3 :: ItemKind
eye3 = Int -> GroupName ItemKind -> ItemKind
eye 3 GroupName ItemKind
S_EYE_3
eye6 :: ItemKind
eye6 = Int -> GroupName ItemKind -> ItemKind
eye 6 GroupName ItemKind
S_EYE_6
eye8 :: ItemKind
eye8 = Int -> GroupName ItemKind -> ItemKind
eye 8 GroupName ItemKind
S_EYE_8
vision :: Int -> GroupName ItemKind -> ItemKind
vision :: Int -> GroupName ItemKind -> ItemKind
vision n :: Int
n grp :: GroupName ItemKind
grp = ItemKind
armoredSkin
  { iname :: Text
iname    = "vision"
  , ifreq :: Freqs ItemKind
ifreq    = [(GroupName ItemKind
grp, 1)]
  , iverbHit :: Text
iverbHit = "visualize"
  , iaspects :: [Aspect]
iaspects = [ Skill -> Dice -> Aspect
AddSkill Skill
SkSight (Int -> Dice
intToDice Int
n)
               , Flag -> Aspect
SetFlag Flag
Durable ]
  , idesc :: Text
idesc    = ""
  }
vision6 :: ItemKind
vision6 = Int -> GroupName ItemKind -> ItemKind
vision 6 GroupName ItemKind
S_VISION_6
vision12 :: ItemKind
vision12 = Int -> GroupName ItemKind -> ItemKind
vision 12 GroupName ItemKind
S_VISION_12
vision16 :: ItemKind
vision16 = Int -> GroupName ItemKind -> ItemKind
vision 16 GroupName ItemKind
S_VISION_16
nostril :: ItemKind
nostril = ItemKind
armoredSkin
  { iname :: Text
iname    = "nostril"
  , ifreq :: Freqs ItemKind
ifreq    = [(GroupName ItemKind
S_NOSTRIL, 1)]
  , icount :: Dice
icount   = 2
  , iverbHit :: Text
iverbHit = "snuff"
  , iaspects :: [Aspect]
iaspects = [ Skill -> Dice -> Aspect
AddSkill Skill
SkSmell 1  -- times 2, from icount
               , Flag -> Aspect
SetFlag Flag
Durable ]
  , idesc :: Text
idesc    = ""
  }
ear :: Int -> GroupName ItemKind -> ItemKind
ear :: Int -> GroupName ItemKind -> ItemKind
ear n :: Int
n grp :: GroupName ItemKind
grp = ItemKind
armoredSkin
  { iname :: Text
iname    = "ear"
  , ifreq :: Freqs ItemKind
ifreq    = [(GroupName ItemKind
grp, 1)]
  , icount :: Dice
icount   = 2
  , iverbHit :: Text
iverbHit = "overhear"
  , iaspects :: [Aspect]
iaspects = [ Skill -> Dice -> Aspect
AddSkill Skill
SkHearing (Int -> Dice
intToDice Int
n)
               , Flag -> Aspect
SetFlag Flag
Durable ]
  , idesc :: Text
idesc    = ""
  }
ear3 :: ItemKind
ear3 = Int -> GroupName ItemKind -> ItemKind
ear 3 GroupName ItemKind
S_EAR_3
ear6 :: ItemKind
ear6 = Int -> GroupName ItemKind -> ItemKind
ear 6 GroupName ItemKind
S_EAR_6
ear8 :: ItemKind
ear8 = Int -> GroupName ItemKind -> ItemKind
ear 8 GroupName ItemKind
S_EAR_8

-- * Assorted

rattleOrgan :: ItemKind
rattleOrgan = ItemKind
armoredSkin
  { iname :: Text
iname    = "rattle"
  , ifreq :: Freqs ItemKind
ifreq    = [(GroupName ItemKind
S_RATLLE, 1)]
  , iverbHit :: Text
iverbHit = "announce"
  , iaspects :: [Aspect]
iaspects = [ Dice -> Aspect
Timeout (Dice -> Aspect) -> Dice -> Aspect
forall a b. (a -> b) -> a -> b
$ 10 Dice -> Dice -> Dice
forall a. Num a => a -> a -> a
+ (1 Int -> Int -> Dice
`d` 3) Dice -> Dice -> Dice
forall a. Num a => a -> a -> a
* 10  -- long, to limit spam
               , Flag -> Aspect
SetFlag Flag
Periodic, Flag -> Aspect
SetFlag Flag
Durable ]
  , ieffects :: [Effect]
ieffects = [Effect
Yell, Int -> Effect
RefillCalm 5]
  , idesc :: Text
idesc    = ""
  }
insectMortality :: ItemKind
insectMortality = ItemKind
armoredSkin
  { iname :: Text
iname    = "insect mortality"
  , ifreq :: Freqs ItemKind
ifreq    = [(GroupName ItemKind
S_INSECT_MORTALITY, 1)]
  , iverbHit :: Text
iverbHit = "age"
  , iaspects :: [Aspect]
iaspects = [ Skill -> Dice -> Aspect
AddSkill Skill
SkAggression 2  -- try to attack before you die
               , Dice -> Aspect
Timeout (Dice -> Aspect) -> Dice -> Aspect
forall a b. (a -> b) -> a -> b
$ 30 Dice -> Dice -> Dice
forall a. Num a => a -> a -> a
+ (1 Int -> Int -> Dice
`d` 3) Dice -> Dice -> Dice
forall a. Num a => a -> a -> a
* 10  -- die very slowly
               , Flag -> Aspect
SetFlag Flag
Periodic, Flag -> Aspect
SetFlag Flag
Durable ]
  , ieffects :: [Effect]
ieffects = [Int -> Effect
RefillHP (-1), Effect
Yell]
  , idesc :: Text
idesc    = ""
  }
sapientBrain :: ItemKind
sapientBrain = ItemKind
armoredSkin
  { iname :: Text
iname    = "sapient brain"
  , ifreq :: Freqs ItemKind
ifreq    = [(GroupName ItemKind
S_SAPIENT_BRAIN, 1)]
  , iverbHit :: Text
iverbHit = "outbrain"
  , iaspects :: [Aspect]
iaspects = [Skill -> Dice -> Aspect
AddSkill Skill
sk 1 | Skill
sk <- [Skill
SkMove .. Skill
SkApply]]
               [Aspect] -> [Aspect] -> [Aspect]
forall a. [a] -> [a] -> [a]
++ [Skill -> Dice -> Aspect
AddSkill Skill
SkMove 4]  -- can move at once when waking up
               [Aspect] -> [Aspect] -> [Aspect]
forall a. [a] -> [a] -> [a]
++ [Skill -> Dice -> Aspect
AddSkill Skill
SkAlter 4]  -- can use all stairs; dig rubble, ice
               [Aspect] -> [Aspect] -> [Aspect]
forall a. [a] -> [a] -> [a]
++ [Skill -> Dice -> Aspect
AddSkill Skill
SkWait 2]  -- can brace and sleep
               [Aspect] -> [Aspect] -> [Aspect]
forall a. [a] -> [a] -> [a]
++ [Skill -> Dice -> Aspect
AddSkill Skill
SkApply 1]  -- can use most items, not just foods
               [Aspect] -> [Aspect] -> [Aspect]
forall a. [a] -> [a] -> [a]
++ [Flag -> Aspect
SetFlag Flag
Durable]
  , idesc :: Text
idesc    = ""
  }
animalBrain :: ItemKind
animalBrain = ItemKind
armoredSkin
  { iname :: Text
iname    = "animal brain"
  , ifreq :: Freqs ItemKind
ifreq    = [(GroupName ItemKind
S_ANIMAL_BRAIN, 1)]
  , iverbHit :: Text
iverbHit = "blank"
  , iaspects :: [Aspect]
iaspects = [Skill -> Dice -> Aspect
AddSkill Skill
sk 1 | Skill
sk <- [Skill
SkMove .. Skill
SkApply]]
               [Aspect] -> [Aspect] -> [Aspect]
forall a. [a] -> [a] -> [a]
++ [Skill -> Dice -> Aspect
AddSkill Skill
SkMove 4]  -- can move at once when waking up
               [Aspect] -> [Aspect] -> [Aspect]
forall a. [a] -> [a] -> [a]
++ [Skill -> Dice -> Aspect
AddSkill Skill
SkAlter 2]  -- can use normal stairs; can't dig
               [Aspect] -> [Aspect] -> [Aspect]
forall a. [a] -> [a] -> [a]
++ [Skill -> Dice -> Aspect
AddSkill Skill
SkWait 2]  -- can brace and sleep
               -- No @SkApply@ bonus, so can only apply foods. Note, however,
               -- that AI doesn't risk applying unIded items, so in early
               -- game animals won't eat anything.
               [Aspect] -> [Aspect] -> [Aspect]
forall a. [a] -> [a] -> [a]
++ [Skill -> Dice -> Aspect
AddSkill Skill
SkDisplace (-1)]  -- no melee tactics
               [Aspect] -> [Aspect] -> [Aspect]
forall a. [a] -> [a] -> [a]
++ [Skill -> Dice -> Aspect
AddSkill Skill
SkMoveItem (-1)]  -- no item gathering
               [Aspect] -> [Aspect] -> [Aspect]
forall a. [a] -> [a] -> [a]
++ [Skill -> Dice -> Aspect
AddSkill Skill
SkProject (-1)]  -- nor item flinging
               [Aspect] -> [Aspect] -> [Aspect]
forall a. [a] -> [a] -> [a]
++ [Flag -> Aspect
SetFlag Flag
Durable]
  , idesc :: Text
idesc    = ""
  }
speedGland :: Int -> GroupName ItemKind -> ItemKind
speedGland :: Int -> GroupName ItemKind -> ItemKind
speedGland n :: Int
n grp :: GroupName ItemKind
grp = ItemKind
armoredSkin
  { isymbol :: Char
isymbol  = '-'
  , iname :: Text
iname    = "speed gland"
  , ifreq :: Freqs ItemKind
ifreq    = [(GroupName ItemKind
grp, 1)]
  , iverbHit :: Text
iverbHit = "spit at"
  , iaspects :: [Aspect]
iaspects = [ Dice -> Aspect
Timeout (Dice -> Aspect) -> Dice -> Aspect
forall a b. (a -> b) -> a -> b
$ Int -> Dice
intToDice (100 Int -> Int -> Int
forall a. Integral a => a -> a -> a
`div` Int
n)
               , Skill -> Dice -> Aspect
AddSkill Skill
SkSpeed (Dice -> Aspect) -> Dice -> Aspect
forall a b. (a -> b) -> a -> b
$ Int -> Dice
intToDice Int
n
               , Skill -> Dice -> Aspect
AddSkill Skill
SkArmorMelee (Dice -> Aspect) -> Dice -> Aspect
forall a b. (a -> b) -> a -> b
$ Int -> Dice
intToDice (Int -> Dice) -> Int -> Dice
forall a b. (a -> b) -> a -> b
$ - Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
* 5
               , Flag -> Aspect
SetFlag Flag
Periodic, Flag -> Aspect
SetFlag Flag
Durable ]
  , ieffects :: [Effect]
ieffects = [Int -> Effect
RefillHP 1]
  , idesc :: Text
idesc    = ""
  }
speedGland5 :: ItemKind
speedGland5 = Int -> GroupName ItemKind -> ItemKind
speedGland 5 GroupName ItemKind
S_SPEED_GLAND_5
speedGland10 :: ItemKind
speedGland10 = Int -> GroupName ItemKind -> ItemKind
speedGland 10 GroupName ItemKind
S_SPEED_GLAND_10
scentGland :: ItemKind
scentGland = ItemKind
armoredSkin
  { isymbol :: Char
isymbol  = '-'
  , iname :: Text
iname    = "scent gland"
  , ifreq :: Freqs ItemKind
ifreq    = [(GroupName ItemKind
S_SCENT_GLAND, 1)]
  , icount :: Dice
icount   = 10 Dice -> Dice -> Dice
forall a. Num a => a -> a -> a
+ 1 Int -> Int -> Dice
`d` 3  -- runs out
  , iverbHit :: Text
iverbHit = "spray at"
  , iaspects :: [Aspect]
iaspects = [ Dice -> Aspect
Timeout (Dice -> Aspect) -> Dice -> Aspect
forall a b. (a -> b) -> a -> b
$ (1 Int -> Int -> Dice
`d` 3) Dice -> Dice -> Dice
forall a. Num a => a -> a -> a
* 10
               , Flag -> Aspect
SetFlag Flag
Periodic, Flag -> Aspect
SetFlag Flag
Fragile ]  -- not Durable
  , ieffects :: [Effect]
ieffects = [ Text -> Text -> Effect
VerbNoLonger "look spent" "."
               , Effect
ApplyPerfume
               , GroupName ItemKind -> Effect
Explode GroupName ItemKind
S_DISTRESSING_ODOR ]
                   -- keep explosion at the end to avoid the ambiguity of
                   -- "of ([foo explosion] of [bar])"
  , idesc :: Text
idesc    = ""
  }
sulfurVent :: ItemKind
sulfurVent = ItemKind
armoredSkin
  { isymbol :: Char
isymbol  = 'v'
  , iname :: Text
iname    = "vent"
  , ifreq :: Freqs ItemKind
ifreq    = [(GroupName ItemKind
S_MEDBOT_VENT, 1)]
  , iflavour :: [Flavour]
iflavour = [Color] -> [Flavour]
zipPlain [Color
BrYellow]
  , iverbHit :: Text
iverbHit = "menace"
  , iaspects :: [Aspect]
iaspects = [ Dice -> Aspect
Timeout (Dice -> Aspect) -> Dice -> Aspect
forall a b. (a -> b) -> a -> b
$ (3 Dice -> Dice -> Dice
forall a. Num a => a -> a -> a
+ 1 Int -> Int -> Dice
`d` 3) Dice -> Dice -> Dice
forall a. Num a => a -> a -> a
* 5
               , Flag -> Aspect
SetFlag Flag
Periodic, Flag -> Aspect
SetFlag Flag
Durable ]
  , ieffects :: [Effect]
ieffects = [Int -> Effect
RefillHP 2, GroupName ItemKind -> Effect
Explode GroupName ItemKind
S_MELEE_PROTECTIVE_BALM]
  , idesc :: Text
idesc    = ""
  }
boilingVent :: ItemKind
boilingVent = ItemKind
armoredSkin
  { isymbol :: Char
isymbol  = 'v'
  , iname :: Text
iname    = "vent"
  , ifreq :: Freqs ItemKind
ifreq    = [(GroupName ItemKind
S_BOILING_VENT, 1)]
  , iflavour :: [Flavour]
iflavour = [Color] -> [Flavour]
zipPlain [Color
BrGreen]
  , iverbHit :: Text
iverbHit = "menace"
  , iaspects :: [Aspect]
iaspects = [ Dice -> Aspect
Timeout (Dice -> Aspect) -> Dice -> Aspect
forall a b. (a -> b) -> a -> b
$ (4 Dice -> Dice -> Dice
forall a. Num a => a -> a -> a
+ 1 Int -> Int -> Dice
`d` 3) Dice -> Dice -> Dice
forall a. Num a => a -> a -> a
* 5
               , Flag -> Aspect
SetFlag Flag
Periodic, Flag -> Aspect
SetFlag Flag
Durable ]
  , ieffects :: [Effect]
ieffects = [Int -> Effect
RefillHP 2, GroupName ItemKind -> Effect
Explode GroupName ItemKind
S_BOILING_WATER]
  , idesc :: Text
idesc    = ""
  }
arsenicVent :: ItemKind
arsenicVent = ItemKind
armoredSkin
  { isymbol :: Char
isymbol  = 'v'
  , iname :: Text
iname    = "vent"
  , ifreq :: Freqs ItemKind
ifreq    = [(GroupName ItemKind
S_COOLING_VENT, 1)]
  , iflavour :: [Flavour]
iflavour = [Color] -> [Flavour]
zipPlain [Color
White]
  , iverbHit :: Text
iverbHit = "menace"
  , iaspects :: [Aspect]
iaspects = [ Dice -> Aspect
Timeout (Dice -> Aspect) -> Dice -> Aspect
forall a b. (a -> b) -> a -> b
$ (2 Dice -> Dice -> Dice
forall a. Num a => a -> a -> a
+ 1 Int -> Int -> Dice
`d` 3) Dice -> Dice -> Dice
forall a. Num a => a -> a -> a
* 5
               , Flag -> Aspect
SetFlag Flag
Periodic, Flag -> Aspect
SetFlag Flag
Durable ]
  , ieffects :: [Effect]
ieffects = [Int -> Effect
RefillHP 2, GroupName ItemKind -> Effect
Explode GroupName ItemKind
S_VIOLENT_SLOWNESS_MIST]
  , idesc :: Text
idesc    = ""
  }

-- * Special

bonusHP :: ItemKind
bonusHP = ItemKind
armoredSkin
  { isymbol :: Char
isymbol  = 'H'  -- '+' reserved for conditions
  , iname :: Text
iname    = "bonus HP"
  , ifreq :: Freqs ItemKind
ifreq    = [(GroupName ItemKind
S_BONUS_HP, 1)]
  , iflavour :: [Flavour]
iflavour = [Color] -> [Flavour]
zipPlain [Color
BrBlue]
  , iverbHit :: Text
iverbHit = "intimidate"
  , iweight :: Int
iweight  = 0
  , iaspects :: [Aspect]
iaspects = [Skill -> Dice -> Aspect
AddSkill Skill
SkMaxHP 1]
  , idesc :: Text
idesc    = "Special training and connections in the right places give this adventurer reinforced musculature and augmented internal organs, much more resilient to damage."
  }
braced :: ItemKind
braced = ItemKind
armoredSkin
  { isymbol :: Char
isymbol  = 'B'
  , iname :: Text
iname    = "braced"
  , ifreq :: Freqs ItemKind
ifreq    = [(GroupName ItemKind
S_BRACED, 1)]
  , iflavour :: [Flavour]
iflavour = [Color] -> [Flavour]
zipPlain [Color
BrGreen]
  , iverbHit :: Text
iverbHit = "brace"
  , iweight :: Int
iweight  = 0
  , iaspects :: [Aspect]
iaspects = [ Skill -> Dice -> Aspect
AddSkill Skill
SkArmorMelee 50, Skill -> Dice -> Aspect
AddSkill Skill
SkArmorRanged 25
               , Skill -> Dice -> Aspect
AddSkill Skill
SkHearing 10
               , Flag -> Aspect
SetFlag Flag
Condition ] -- hack: display as condition
  , idesc :: Text
idesc    = "Apart of increased resilience to attacks, being braced protects from displacement by foes and other forms of forced translocation, e.g., pushing or pulling."
  }
asleep :: ItemKind
asleep = ItemKind
armoredSkin
  { isymbol :: Char
isymbol  = 'S'
  , iname :: Text
iname    = "asleep"
  , ifreq :: Freqs ItemKind
ifreq    = [(GroupName ItemKind
S_ASLEEP, 1)]
  , iflavour :: [Flavour]
iflavour = [Color] -> [Flavour]
zipPlain [Color
BrGreen]  -- regenerates HP (very slowly)
  , icount :: Dice
icount   = 5
  , iverbHit :: Text
iverbHit = "slay"
  , iweight :: Int
iweight  = 0
  , iaspects :: [Aspect]
iaspects = [Skill -> Dice -> Aspect
AddSkill Skill
sk (-1) | Skill
sk <- [Skill
SkMove .. Skill
SkApply]]
               [Aspect] -> [Aspect] -> [Aspect]
forall a. [a] -> [a] -> [a]
++ [ Skill -> Dice -> Aspect
AddSkill Skill
SkMelee 1, Skill -> Dice -> Aspect
AddSkill Skill
SkAlter 1, Skill -> Dice -> Aspect
AddSkill Skill
SkWait 1
                  , Skill -> Dice -> Aspect
AddSkill Skill
SkSight (-3), Skill -> Dice -> Aspect
AddSkill Skill
SkArmorMelee (-10)
                  , Flag -> Aspect
SetFlag Flag
Condition ]  -- hack: display as condition
  , idesc :: Text
idesc    = "Sleep helps to regain health, albeit extremely slowly. Being asleep makes you vulnerable, with gradually diminishing effects as the slumber wears off over several turns. Any non-idle action, not only combat but even yawning or stretching removes a sizable portion of the sleepiness."
  }
impressed :: ItemKind
impressed = ItemKind
armoredSkin
  { isymbol :: Char
isymbol  = 'I'
  , iname :: Text
iname    = "impressed"  -- keep the same as in @ifreq@, to simplify code
  , ifreq :: Freqs ItemKind
ifreq    = [(GroupName ItemKind
S_IMPRESSED, 1), (GroupName ItemKind
CONDITION, 1)]
  , iflavour :: [Flavour]
iflavour = [Color] -> [Flavour]
zipPlain [Color
BrRed]
  , iverbHit :: Text
iverbHit = "confuse"
  , iweight :: Int
iweight  = 0
  , iaspects :: [Aspect]
iaspects = [ Skill -> Dice -> Aspect
AddSkill Skill
SkMaxCalm (-1)  -- to help player notice on HUD
                                          -- and to count as bad condition
               , Skill -> Dice -> Aspect
AddSkill Skill
SkArmorMelee (-3)
               , Flag -> Aspect
SetFlag Flag
Fragile  -- to announce "no longer" only when
                                  -- all copies gone
               , Flag -> Aspect
SetFlag Flag
Condition ]  -- this is really a condition,
                                      -- just not a timed condition
  , ieffects :: [Effect]
ieffects = [ Effect -> Effect
OnSmash (Effect -> Effect) -> Effect -> Effect
forall a b. (a -> b) -> a -> b
$ Text -> Effect
verbMsgLess "impressed"
               , Effect -> Effect
OnSmash (Effect -> Effect) -> Effect -> Effect
forall a b. (a -> b) -> a -> b
$ Text -> Effect
verbMsgNoLonger "impressed" ]
                   -- not periodic, so no wear each turn, so only @OnSmash@
  , idesc :: Text
idesc    = "Being impressed by one's adversary sounds like fun, but on battlefield it equals treason. Almost. Throw in depleted battle calm and it leads to mindless desertion outright."
  }

-- * Allure-specific melee weapons

smallBeak :: ItemKind
smallBeak = ItemKind
fist
  { iname :: Text
iname    = "small beak"
  , ifreq :: Freqs ItemKind
ifreq    = [(GroupName ItemKind
S_SMALL_BEAK, 1)]
  , icount :: Dice
icount   = 1
  , iverbHit :: Text
iverbHit = "nom"
  , idamage :: Dice
idamage  = 2 Int -> Int -> Dice
`d` 1
  , idesc :: Text
idesc    = "Cute, but painful."
  }
liveWire :: ItemKind
liveWire = ItemKind
fist
  { isymbol :: Char
isymbol  = '-'
  , iname :: Text
iname    = "live wire"
  , ifreq :: Freqs ItemKind
ifreq    = [(GroupName ItemKind
S_LIVE_WIRE, 1)]
  , icount :: Dice
icount   = 1
  , iverbHit :: Text
iverbHit = "shock"
  , idamage :: Dice
idamage  = 0
  , iaspects :: [Aspect]
iaspects = Dice -> Aspect
Timeout (2 Dice -> Dice -> Dice
forall a. Num a => a -> a -> a
+ 1 Int -> Int -> Dice
`d` 2)
               Aspect -> [Aspect] -> [Aspect]
forall a. a -> [a] -> [a]
: ItemKind -> [Aspect]
iaspects ItemKind
fist
  , ieffects :: [Effect]
ieffects = [ Int -> Dice -> Effect
Discharge 1 (Dice -> Effect) -> Dice -> Effect
forall a b. (a -> b) -> a -> b
$ 80 Dice -> Dice -> Dice
forall a. Num a => a -> a -> a
- 1 Int -> Int -> Dice
`d` 40
               , Int -> Effect
RefillHP (-1) ]
  , idesc :: Text
idesc    = ""
  }
razor :: ItemKind
razor = ItemKind
fist
  { isymbol :: Char
isymbol  = '-'
  , iname :: Text
iname    = "razor edge"
  , ifreq :: Freqs ItemKind
ifreq    = [(GroupName ItemKind
S_RAZOR, 1)]
  , icount :: Dice
icount   = 1 Dice -> Dice -> Dice
forall a. Num a => a -> a -> a
+ 1 Int -> Int -> Dice
`d` 2
  , iverbHit :: Text
iverbHit = "slice"
  , idamage :: Dice
idamage  = 2 Int -> Int -> Dice
`d` 1
  , iaspects :: [Aspect]
iaspects = [ Flag -> Aspect
SetFlag Flag
Meleeable  -- not Durable
               , Dice -> Aspect
Timeout 4 ]  -- but cooldown to use other weapons
  , ieffects :: [Effect]
ieffects = [ GroupName ItemKind -> Dice -> Effect
toOrganBad GroupName ItemKind
S_WEAKENED (2 Dice -> Dice -> Dice
forall a. Num a => a -> a -> a
+ 1 Int -> Int -> Dice
`dL` 3)
               , Text -> Text -> Effect
VerbNoLonger "lose all sharpness" "." ]
                 -- we interpret charges as sharpness of the actor or his razor'
                 -- no pronoun in the message to avoid "you lose its sharpness"
  , idesc :: Text
idesc    = ""
  }
dustFissure :: ItemKind
dustFissure = ItemKind
boilingFissure
  { iname :: Text
iname    = "fissure"
  , ifreq :: Freqs ItemKind
ifreq    = [(GroupName ItemKind
S_DUST_FISSURE, 1)]
  , icount :: Dice
icount   = 3 Dice -> Dice -> Dice
forall a. Num a => a -> a -> a
+ 1 Int -> Int -> Dice
`d` 3
  , idamage :: Dice
idamage  = 1 Int -> Int -> Dice
`d` 1
  , ieffects :: [Effect]
ieffects = [ GroupName ItemKind -> Dice -> Effect
toOrganBad GroupName ItemKind
S_WEAKENED 20
               , Text -> Text -> Effect
VerbNoLonger "cough one last time" "." ]
  , idesc :: Text
idesc    = ""
  }
fuelFissure :: ItemKind
fuelFissure = ItemKind
boilingFissure
  { iname :: Text
iname    = "fissure"
  , ifreq :: Freqs ItemKind
ifreq    = [(GroupName ItemKind
S_FUEL_FISSURE, 1)]
  , icount :: Dice
icount   = 3 Dice -> Dice -> Dice
forall a. Num a => a -> a -> a
+ 1 Int -> Int -> Dice
`d` 3
  , idamage :: Dice
idamage  = 0
  , ieffects :: [Effect]
ieffects = [ Dice -> Effect
Burn 1
               , Text -> Text -> Effect
VerbNoLonger "have its fissures mended by emergency auto-sealants" "." ]
  , idesc :: Text
idesc    = ""
  }

-- * Allure-specific other

animalStomach :: ItemKind
animalStomach = ItemKind
armoredSkin
  { isymbol :: Char
isymbol  = 'u'
  , iname :: Text
iname    = "animal stomach"
  , ifreq :: Freqs ItemKind
ifreq    = [(GroupName ItemKind
S_ANIMAL_STOMACH, 1)]
  , iverbHit :: Text
iverbHit = "burp"
  , iaspects :: [Aspect]
iaspects = [ Dice -> Aspect
Timeout (Dice -> Aspect) -> Dice -> Aspect
forall a b. (a -> b) -> a -> b
$ 500 Dice -> Dice -> Dice
forall a. Num a => a -> a -> a
+ (1 Int -> Int -> Dice
`d` 3) Dice -> Dice -> Dice
forall a. Num a => a -> a -> a
* 50  -- hunger very slowly
               , Flag -> Aspect
SetFlag Flag
Periodic, Flag -> Aspect
SetFlag Flag
Durable ]
  , ieffects :: [Effect]
ieffects = [GroupName ItemKind -> Effect
toOrganNoTimer GroupName ItemKind
S_HUNGRY]
  , idesc :: Text
idesc    = ""
  }
hungry :: ItemKind
hungry = ItemKind
armoredSkin
  { isymbol :: Char
isymbol  = 'U'
  , iname :: Text
iname    = "hungry"  -- keep the same as in @ifreq@, to simplify code
  , ifreq :: Freqs ItemKind
ifreq    = [(GroupName ItemKind
S_HUNGRY, 1), (GroupName ItemKind
CONDITION, 1)]
  , iflavour :: [Flavour]
iflavour = [Color] -> [Flavour]
zipPlain [Color
BrRed]
  , icount :: Dice
icount   = 1
  , iverbHit :: Text
iverbHit = "pang"
  , iweight :: Int
iweight  = 0
  , iaspects :: [Aspect]
iaspects = [ Skill -> Dice -> Aspect
AddSkill Skill
SkMaxHP (-1)
               , Flag -> Aspect
SetFlag Flag
Fragile  -- to announce "no longer" only when
                                  -- all copies gone
               , Flag -> Aspect
SetFlag Flag
Condition ]  -- this is really a condition,
                                      -- just not a timed condition
  , ieffects :: [Effect]
ieffects = [ Effect -> Effect
OnSmash (Effect -> Effect) -> Effect -> Effect
forall a b. (a -> b) -> a -> b
$ Text -> Effect
verbMsgLess "hungry"
               , Effect -> Effect
OnSmash (Effect -> Effect) -> Effect -> Effect
forall a b. (a -> b) -> a -> b
$ Text -> Effect
verbMsgNoLonger "hungry" ]
                   -- not periodic, so no wear each turn, so only @OnSmash@
  , idesc :: Text
idesc    = "Hunger limits physical fitness. In extreme cases, when compounded, it causes such fragility that the slightest stress becomes lethal."
  }
flotationBag :: ItemKind
flotationBag = ItemKind
armoredSkin
  { isymbol :: Char
isymbol  = 'O'
  , iname :: Text
iname    = "flotation bag"
  , ifreq :: Freqs ItemKind
ifreq    = [(GroupName ItemKind
S_FLOTATION_BAG, 1)]
  , iverbHit :: Text
iverbHit = "uplift"
  , iaspects :: [Aspect]
iaspects = [Skill -> Dice -> Aspect
AddSkill Skill
SkArmorRanged (-15), Flag -> Aspect
SetFlag Flag
Durable]
  , ieffects :: [Effect]
ieffects = [Effect -> Effect
OnSmash (Effect -> Effect) -> Effect -> Effect
forall a b. (a -> b) -> a -> b
$ GroupName ItemKind -> Effect
Explode GroupName ItemKind
S_FOCUSED_CONCUSSION]
                  -- if too weak, use S_FOCUSED_FRAGMENTATION that is
                  -- less thematic than CONCUSSION, but more likely to cause
                  -- the chain reaction among peers that we are after
  , idesc :: Text
idesc    = "A large organ that enables effortless flight. It is essentially a hydrogen container with easily regulated internal pressure. It evolved a protection against blunt trauma, but not against puncture."
  }
inkSac :: ItemKind
inkSac = ItemKind
armoredSkin  -- neither melee nor aspects nor periodic, so to be
  { isymbol :: Char
isymbol  = '"'    -- triggered, needs a special symbol
  , iname :: Text
iname    = "ink sac"
  , ifreq :: Freqs ItemKind
ifreq    = [(GroupName ItemKind
S_INK_SAC, 1)]
  , iverbHit :: Text
iverbHit = "squirt"
  , iaspects :: [Aspect]
iaspects = [Dice -> Aspect
Timeout (Dice -> Aspect) -> Dice -> Aspect
forall a b. (a -> b) -> a -> b
$ 3 Dice -> Dice -> Dice
forall a. Num a => a -> a -> a
+ 1 Int -> Int -> Dice
`d` 3, Flag -> Aspect
SetFlag Flag
Durable]
  , ieffects :: [Effect]
ieffects = [ GroupName ItemKind -> Effect
Explode GroupName ItemKind
S_SMOKE  -- weak, but lingers long
               , ThrowMod -> Effect
PullActor (Int -> Int -> Int -> ThrowMod
ThrowMod 200 50 1)  -- 1 step, fast
               , Int -> Effect
RefillCalm 100 ]  -- balance @Explode@ so that AI uses it
  , idesc :: Text
idesc    = ""  -- TODO: https://en.wikipedia.org/wiki/Octopus#Ink_sac
  }
powerfulHindLegs :: ItemKind
powerfulHindLegs = ItemKind
armoredSkin  -- neither melee nor periodic so to trigger
  { isymbol :: Char
isymbol  = '"'              -- needs a special symbol
  , iname :: Text
iname    = "pair"
  , ifreq :: Freqs ItemKind
ifreq    = [(GroupName ItemKind
S_POWERFUL_HIND_LEGS, 1)]
  , iverbHit :: Text
iverbHit = "jump"
  , iaspects :: [Aspect]
iaspects = [ Text -> Aspect
ELabel "of powerful hind legs"
               , Dice -> Aspect
Timeout (Dice -> Aspect) -> Dice -> Aspect
forall a b. (a -> b) -> a -> b
$ 3 Dice -> Dice -> Dice
forall a. Num a => a -> a -> a
+ 1 Int -> Int -> Dice
`d` 3, Flag -> Aspect
SetFlag Flag
Durable ]
  , ieffects :: [Effect]
ieffects = [GroupName ItemKind -> Dice -> Effect
toOrganGood GroupName ItemKind
S_HASTED 1]  -- see comments about jumping pole
  , idesc :: Text
idesc    = "With legs like that, just a moment of preparation is enough to make a rapid succession of huge leaps."  -- no damage, but feet or claws are separate organs and they can be weapons
  }
coiledTail :: ItemKind
coiledTail = ItemKind
powerfulHindLegs
  { iname :: Text
iname    = "coiled tail"
  , ifreq :: Freqs ItemKind
ifreq    = [(GroupName ItemKind
S_COILED_TAIL, 1)]
  , iverbHit :: Text
iverbHit = "spring"
  , iaspects :: [Aspect]
iaspects = [Dice -> Aspect
Timeout (Dice -> Aspect) -> Dice -> Aspect
forall a b. (a -> b) -> a -> b
$ 3 Dice -> Dice -> Dice
forall a. Num a => a -> a -> a
+ 1 Int -> Int -> Dice
`d` 3, Flag -> Aspect
SetFlag Flag
Durable]
  , idesc :: Text
idesc    = "When the coiled tail springs, expect a lurch that leaves you no time to react."
  }
jetBooster :: ItemKind
jetBooster = ItemKind
armoredSkin  -- neither melee nor periodic so to be triggered,
  { isymbol :: Char
isymbol  = '"'        -- needs a special symbol
  , iname :: Text
iname    = "jet booster"
  , ifreq :: Freqs ItemKind
ifreq    = [(GroupName ItemKind
S_JET_BOOSTER, 1)]
  , iverbHit :: Text
iverbHit = "dart"
  , iaspects :: [Aspect]
iaspects = [Dice -> Aspect
Timeout (Dice -> Aspect) -> Dice -> Aspect
forall a b. (a -> b) -> a -> b
$ 4 Dice -> Dice -> Dice
forall a. Num a => a -> a -> a
+ 1 Int -> Int -> Dice
`d` 2, Flag -> Aspect
SetFlag Flag
Durable]
  , ieffects :: [Effect]
ieffects = [ ThrowMod -> Effect
PushActor (Int -> Int -> Int -> ThrowMod
ThrowMod 800 100 1)  -- 8 steps, 2 turns
               , Int -> Effect
RefillCalm 100 ]  -- give AI an incentive to use it
  , idesc :: Text
idesc    = "The throttles are quite erratic with age, but the punch is none the less."
  }
rhinoInertia :: ItemKind
rhinoInertia = ItemKind
jetBooster
  { iname :: Text
iname    = "rhino inertia"
  , ifreq :: Freqs ItemKind
ifreq    = [(GroupName ItemKind
S_RHINO_INERTIA, 1)]
  , iverbHit :: Text
iverbHit = "thunder"
  , idesc :: Text
idesc    = "It's a struggle to move the mass and it's a reinforced concrete wall that stops it."
  }
electricAmbience :: ItemKind
electricAmbience = ItemKind
armoredSkin
  { isymbol :: Char
isymbol  = 'v'
  , iname :: Text
iname    = "static current ambience"
  , ifreq :: Freqs ItemKind
ifreq    = [(GroupName ItemKind
ELECTRIC_AMBIENCE, 1)]
  , iverbHit :: Text
iverbHit = "shortcut"
  , iaspects :: [Aspect]
iaspects = [ Dice -> Aspect
Timeout (Dice -> Aspect) -> Dice -> Aspect
forall a b. (a -> b) -> a -> b
$ (2 Dice -> Dice -> Dice
forall a. Num a => a -> a -> a
+ 1 Int -> Int -> Dice
`d` 3) Dice -> Dice -> Dice
forall a. Num a => a -> a -> a
* 5
               , Flag -> Aspect
SetFlag Flag
Periodic, Flag -> Aspect
SetFlag Flag
Durable ]
  , ieffects :: [Effect]
ieffects = [Int -> Effect
RefillHP 2, GroupName ItemKind -> Effect
Explode GroupName ItemKind
S_CURRENT_DISCHARGE]
  , idesc :: Text
idesc    = ""
  }
electricAmbienceRecharge :: ItemKind
electricAmbienceRecharge = ItemKind
electricAmbience
  { iname :: Text
iname    = "static current ambience"
  , ieffects :: [Effect]
ieffects = [Int -> Effect
RefillHP 1, GroupName ItemKind -> Effect
Explode GroupName ItemKind
S_CURRENT_RECHARGE]
  }
robotBrain :: ItemKind
robotBrain = ItemKind
armoredSkin
  { iname :: Text
iname    = "robot brain"
  , ifreq :: Freqs ItemKind
ifreq    = [(GroupName ItemKind
S_ROBOT_BRAIN, 1)]
  , iverbHit :: Text
iverbHit = "outcompute"
  , iaspects :: [Aspect]
iaspects = [Skill -> Dice -> Aspect
AddSkill Skill
sk 1 | Skill
sk <- [Skill
SkMove .. Skill
SkApply]]
               [Aspect] -> [Aspect] -> [Aspect]
forall a. [a] -> [a] -> [a]
++ [Skill -> Dice -> Aspect
AddSkill Skill
SkMove 4]  -- can move at once when waking up
               [Aspect] -> [Aspect] -> [Aspect]
forall a. [a] -> [a] -> [a]
++ [Skill -> Dice -> Aspect
AddSkill Skill
SkAlter 1]  -- can open doors; only easiest stairs
               [Aspect] -> [Aspect] -> [Aspect]
forall a. [a] -> [a] -> [a]
++ [Skill -> Dice -> Aspect
AddSkill Skill
SkWait 2]  -- can brace and sleep
               -- No @SkAlter@ bonus, so can only use the easiest stairs.
               [Aspect] -> [Aspect] -> [Aspect]
forall a. [a] -> [a] -> [a]
++ [Skill -> Dice -> Aspect
AddSkill Skill
SkApply (-1)]  -- can't even eat food, but can fling
               [Aspect] -> [Aspect] -> [Aspect]
forall a. [a] -> [a] -> [a]
++ [Flag -> Aspect
SetFlag Flag
Durable]
  , idesc :: Text
idesc    = ""
  }
hullPlating :: ItemKind
hullPlating = ItemKind
armoredSkin
  { iname :: Text
iname    = "hull plating"
  , ifreq :: Freqs ItemKind
ifreq    = [(GroupName ItemKind
S_HULL_PLATING, 1)]
  , idesc :: Text
idesc    = ""
  }
mouthVent :: ItemKind
mouthVent = ItemKind
armoredSkin
  { isymbol :: Char
isymbol  = 'v'
  , iname :: Text
iname    = "mouth vent"
  , ifreq :: Freqs ItemKind
ifreq    = [(GroupName ItemKind
S_MOUTH_VENT, 1)]
  , iflavour :: [Flavour]
iflavour = [Color] -> [Flavour]
zipPlain [Color
BrMagenta]
  , iverbHit :: Text
iverbHit = "surprise"
  , iaspects :: [Aspect]
iaspects = [ Dice -> Aspect
Timeout 7
               , Flag -> Aspect
SetFlag Flag
Periodic, Flag -> Aspect
SetFlag Flag
Durable ]
  , ieffects :: [Effect]
ieffects = [[Effect] -> Effect
OneOf ([Effect] -> Effect) -> [Effect] -> Effect
forall a b. (a -> b) -> a -> b
$
      ((Text, Text) -> Effect) -> [(Text, Text)] -> [Effect]
forall a b. (a -> b) -> [a] -> [b]
map (\msg :: (Text, Text)
msg -> Effect -> Effect -> Effect
AndEffect (GroupName ItemKind -> Effect
Explode GroupName ItemKind
S_SMOKE) ((Text -> Text -> Effect) -> (Text, Text) -> Effect
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry Text -> Text -> Effect
VerbMsg (Text, Text)
msg))
          [ ("say: Sir, your luggage has already been collected", ".")
          , ("ask: Would you kindly help me?", "")
          , ("complain: I can't reach you with this tool", "." ) ]
      [Effect] -> [Effect] -> [Effect]
forall a. [a] -> [a] -> [a]
++ (GroupName ItemKind -> Effect) -> [GroupName ItemKind] -> [Effect]
forall a b. (a -> b) -> [a] -> [b]
map GroupName ItemKind -> Effect
Explode
             [ GroupName ItemKind
S_PHEROMONE, GroupName ItemKind
S_RHINO_HOLOGRAM, GroupName ItemKind
S_CURRENT_DISCHARGE
             , GroupName ItemKind -> GroupName ItemKind
blastNoStatOf GroupName ItemKind
S_IMMOBILE, GroupName ItemKind
S_SPARK ]]
  , idesc :: Text
idesc    = ""
  }
dustVent :: ItemKind
dustVent = ItemKind
armoredSkin
  { isymbol :: Char
isymbol  = 'v'
  , iname :: Text
iname    = "vent"
  , ifreq :: Freqs ItemKind
ifreq    = [(GroupName ItemKind
S_DUST_VENT, 1)]
  , iflavour :: [Flavour]
iflavour = [Color] -> [Flavour]
zipPlain [Color
BrCyan]
  , iverbHit :: Text
iverbHit = "menace"
  , iaspects :: [Aspect]
iaspects = [ Dice -> Aspect
Timeout (Dice -> Aspect) -> Dice -> Aspect
forall a b. (a -> b) -> a -> b
$ (5 Dice -> Dice -> Dice
forall a. Num a => a -> a -> a
+ 1 Int -> Int -> Dice
`d` 3) Dice -> Dice -> Dice
forall a. Num a => a -> a -> a
* 5
               , Flag -> Aspect
SetFlag Flag
Periodic, Flag -> Aspect
SetFlag Flag
Durable ]
  , ieffects :: [Effect]
ieffects = [Int -> Effect
RefillHP 2, GroupName ItemKind -> Effect
Explode GroupName ItemKind
S_VIOLENT_FLASH]
  , idesc :: Text
idesc    = ""
  }
fuelVent :: ItemKind
fuelVent = ItemKind
armoredSkin
  { isymbol :: Char
isymbol  = 'v'
  , iname :: Text
iname    = "vent"
  , ifreq :: Freqs ItemKind
ifreq    = [(GroupName ItemKind
S_FUEL_VENT, 1)]
  , iflavour :: [Flavour]
iflavour = [Color] -> [Flavour]
zipPlain [Color
BrRed]
  , iverbHit :: Text
iverbHit = "menace"
  , iaspects :: [Aspect]
iaspects = [ Dice -> Aspect
Timeout (Dice -> Aspect) -> Dice -> Aspect
forall a b. (a -> b) -> a -> b
$ (3 Dice -> Dice -> Dice
forall a. Num a => a -> a -> a
+ 1 Int -> Int -> Dice
`d` 3) Dice -> Dice -> Dice
forall a. Num a => a -> a -> a
* 5
               , Flag -> Aspect
SetFlag Flag
Periodic, Flag -> Aspect
SetFlag Flag
Durable ]
  , ieffects :: [Effect]
ieffects = [Int -> Effect
RefillHP 2, GroupName ItemKind -> Effect
Explode GroupName ItemKind
S_VIOLENT_BURNING_OIL_4]
  , idesc :: Text
idesc    = ""
  }
-- HP change varies due to body size.
--
-- This is destroyed on drop due to being an organ and so it runs
-- the @OnSmash@ effects. Due to being a condition, it's not activated
-- at actor death, avoiding a lot of spam and bringing him back to life.
geneticFlaw :: Int -> Bool -> Int -> GroupName ItemKind -> ItemKind
geneticFlaw :: Int -> Bool -> Int -> GroupName ItemKind -> ItemKind
geneticFlaw fr :: Int
fr badArmorMelee :: Bool
badArmorMelee n :: Int
n grp :: GroupName ItemKind
grp = ItemKind
armoredSkin
  { isymbol :: Char
isymbol  = 'F'
  , iname :: Text
iname    = "genetic flaw"  -- keep the same as in @ifreq@, to simplify code
  , ifreq :: Freqs ItemKind
ifreq    = [(GroupName ItemKind
GENETIC_FLAW, Int
fr), (GroupName ItemKind
grp, 1)]
  , iflavour :: [Flavour]
iflavour = [Color] -> [Flavour]
zipPlain [Color
BrRed]
  , iverbHit :: Text
iverbHit = "flaw"
  , iweight :: Int
iweight  = 0
  , iaspects :: [Aspect]
iaspects = [ Skill -> Dice -> Aspect
AddSkill Skill
SkMaxHP (Int -> Dice
intToDice (Int -> Dice) -> Int -> Dice
forall a b. (a -> b) -> a -> b
$ - Int
n)
               , Flag -> Aspect
SetFlag Flag
MetaGame, Flag -> Aspect
SetFlag Flag
Condition ]
                   -- avoid being blamed in combat messages for bad defence,
                   -- but no CONDITION group, not to be healed too easily
               [Aspect] -> [Aspect] -> [Aspect]
forall a. [a] -> [a] -> [a]
++ [Skill -> Dice -> Aspect
AddSkill Skill
SkWait (-1) | Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= 10]
               [Aspect] -> [Aspect] -> [Aspect]
forall a. [a] -> [a] -> [a]
++ [Skill -> Dice -> Aspect
AddSkill Skill
SkApply (-1) | Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= 10]
               [Aspect] -> [Aspect] -> [Aspect]
forall a. [a] -> [a] -> [a]
++ if Bool
badArmorMelee
                  then [Skill -> Dice -> Aspect
AddSkill Skill
SkArmorMelee (-20)]
                  else [Skill -> Dice -> Aspect
AddSkill Skill
SkArmorRanged (-10)]
  , ieffects :: [Effect]
ieffects = [ Effect -> Effect
OnSmash (Effect -> Effect) -> Effect -> Effect
forall a b. (a -> b) -> a -> b
$ Int -> Int -> CStore -> GroupName ItemKind -> Effect
DropItem Int
forall a. Bounded a => a
maxBound Int
forall a. Bounded a => a
maxBound CStore
COrgan GroupName ItemKind
CONDITION
                   -- key for AI is it eliminates all impression conditions
               , Effect -> Effect
OnSmash (Effect -> Effect) -> Effect -> Effect
forall a b. (a -> b) -> a -> b
$ Int -> Effect
RefillHP Int
n
               , Effect -> Effect
OnSmash (Effect -> Effect) -> Effect -> Effect
forall a b. (a -> b) -> a -> b
$ Text -> Text -> Effect
VerbNoLonger "undergo instant infracellular decontamination" "." ]  -- unlike the civilian version, this one is instant and the attunement is automatic and relatively quick (the usual double cooldown when equipping items again)
  , idesc :: Text
idesc    = "Nobody is perfect. At least without infracellular engineering, which is heavily regulated, insanely expensive and automatically reverted without refund before critical medical interventions. One more reason to be a good citizen, work hard and not die often. But where is the fun in that?"
  }
geneticFlaw3BadArmorMelee :: ItemKind
geneticFlaw3BadArmorMelee = Int -> Bool -> Int -> GroupName ItemKind -> ItemKind
geneticFlaw 1 Bool
True 3 GroupName ItemKind
GENETIC_FLAW_3
geneticFlaw3BadArmorRanged :: ItemKind
geneticFlaw3BadArmorRanged = Int -> Bool -> Int -> GroupName ItemKind -> ItemKind
geneticFlaw 3 Bool
False 3 GroupName ItemKind
GENETIC_FLAW_3
geneticFlaw10BadArmorMelee :: ItemKind
geneticFlaw10BadArmorMelee = Int -> Bool -> Int -> GroupName ItemKind -> ItemKind
geneticFlaw 1 Bool
True 10 GroupName ItemKind
GENETIC_FLAW_10
geneticFlaw10BadArmorRanged :: ItemKind
geneticFlaw10BadArmorRanged = Int -> Bool -> Int -> GroupName ItemKind -> ItemKind
geneticFlaw 3 Bool
False 10 GroupName ItemKind
GENETIC_FLAW_10

-- * Allure-specific backstory items

-- The name and description of each backstory item should add something
-- to the biography or character of the hero or both. However, it should
-- not constrain it so much that it conflicts with any other items.
-- E.g., 'life spent in military' is not acceptable,
-- but a spell in military is fine, just as is life spent doing
-- dangerous tasks, serious missions or giving orders.
-- The idea, in addition to avoiding inconsistency, is to let the player
-- fill in the gaps and, in effect, invent the backstories.
-- OTOH, the player needs something to work with, so a Wikipedia
-- definition of a mild vice or a veiled allusion to in-game mechanics
-- of a virtue are not enough. It's fine if some backstory
-- items are more constraining that others. Variety is good.
--
-- Make sure the effects here that not always fire don't fail with UseId
-- and so reveal the backstory item too early and without the fun.
-- The exception is fluff items, where the effects are marginal by definition.
backstoryFluffTemplate :: ItemKind
backstoryFluffTemplate = $WItemKind :: Char
-> Text
-> Freqs ItemKind
-> [Flavour]
-> Dice
-> Rarity
-> Text
-> Int
-> Dice
-> [Aspect]
-> [Effect]
-> [(GroupName ItemKind, CStore)]
-> Text
-> ItemKind
ItemKind
  { isymbol :: Char
isymbol  = '?'
  , iname :: Text
iname    = "unrevealed rumination"
  , ifreq :: Freqs ItemKind
ifreq    = [(GroupName ItemKind
BACKSTORY_FLUFF_UNKNOWN, 1)]
  , iflavour :: [Flavour]
iflavour = [Color] -> [Flavour]
zipStory [Color
BrBlue, Color
Blue]
  , icount :: Dice
icount   = 1
  , irarity :: Rarity
irarity  = [(1, 1)]
  , iverbHit :: Text
iverbHit = "surprise"
  , iweight :: Int
iweight  = 0
  , idamage :: Dice
idamage  = 0
  , iaspects :: [Aspect]
iaspects = [ GroupName ItemKind -> Aspect
PresentAs GroupName ItemKind
BACKSTORY_FLUFF_UNKNOWN, Flag -> Aspect
SetFlag Flag
MetaGame
               , Flag -> Aspect
SetFlag Flag
Durable
               , Flag -> Aspect
SetFlag Flag
MinorAspects ]
                   -- avoid question marks by weapons in HUD, because,
                   -- unlike necklaces, these won't have stat boosts
  , ieffects :: [Effect]
ieffects = []
  , idesc :: Text
idesc    = "Not all crucial facts about a team member are remembered and revealed as soon as would be most beneficial for the team."
  , ikit :: [(GroupName ItemKind, CStore)]
ikit     = []
  }
backstoryFluff1 :: ItemKind
backstoryFluff1 = ItemKind
backstoryFluffTemplate
  { iname :: Text
iname    = "\"Naughty Kid\""
  , ifreq :: Freqs ItemKind
ifreq    = [(GroupName ItemKind
BACKSTORY_FLUFF, 100), (GroupName ItemKind
BACKSTORY, 1)]
  , iaspects :: [Aspect]
iaspects = [Dice -> Aspect
Timeout 500, Flag -> Aspect
SetFlag Flag
UnderMelee]
               [Aspect] -> [Aspect] -> [Aspect]
forall a. [a] -> [a] -> [a]
++ ItemKind -> [Aspect]
iaspects ItemKind
backstoryFluffTemplate
  , ieffects :: [Effect]
ieffects = [Condition -> Effect -> Effect
When (Int -> Condition
CalmLeq 30) (Effect -> Effect) -> Effect -> Effect
forall a b. (a -> b) -> a -> b
$ [Effect] -> Effect
OneOf ([Effect] -> Effect) -> [Effect] -> Effect
forall a b. (a -> b) -> a -> b
$ ((Text, Text) -> Effect) -> [(Text, Text)] -> [Effect]
forall a b. (a -> b) -> [a] -> [b]
map ((Text -> Text -> Effect) -> (Text, Text) -> Effect
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry Text -> Text -> Effect
VerbMsg)
      [ ("rage, froth-mouthed", ".")
      , ("say: Déjà vu?", "")
      , ("yell: I missed that so", "!")
      , ("hesitate for the briefest moment", ".")
      , ("inquire: in the face? in the face?", "")
      , ("lose it", ".")
      ]]
  , idesc :: Text
idesc    = "Rumination: Bad temper, anguish and uncontrollable fury blot out all other childhood memories."
  }
backstoryGoodTemplate :: ItemKind
backstoryGoodTemplate = ItemKind
backstoryFluffTemplate
  { iname :: Text
iname    = "unrevealed virtue"
  , ifreq :: Freqs ItemKind
ifreq    = [(GroupName ItemKind
BACKSTORY_GOOD_UNKNOWN, 1)]
  , iflavour :: [Flavour]
iflavour = [Color] -> [Flavour]
zipStory [Color
cGoodEvent, Color
cVeryGoodEvent]
  , iaspects :: [Aspect]
iaspects = [ GroupName ItemKind -> Aspect
PresentAs GroupName ItemKind
BACKSTORY_GOOD_UNKNOWN, Flag -> Aspect
SetFlag Flag
MetaGame
               , Flag -> Aspect
SetFlag Flag
Durable, Flag -> Aspect
SetFlag Flag
MinorAspects ]
  }
backstoryGood1 :: ItemKind
backstoryGood1 = ItemKind
backstoryGoodTemplate
  { iname :: Text
iname    = "\"Zero g Champ\""
  , ifreq :: Freqs ItemKind
ifreq    = [(GroupName ItemKind
BACKSTORY_GOOD, 100), (GroupName ItemKind
BACKSTORY, 1)]
  , iaspects :: [Aspect]
iaspects = [Dice -> Aspect
Timeout 1000, Flag -> Aspect
SetFlag Flag
UnderRanged, Flag -> Aspect
SetFlag Flag
Unique]
               [Aspect] -> [Aspect] -> [Aspect]
forall a. [a] -> [a] -> [a]
++ ItemKind -> [Aspect]
iaspects ItemKind
backstoryGoodTemplate
                 -- unique, so that team not overpowered
  , ieffects :: [Effect]
ieffects = [GroupName ItemKind -> Dice -> Effect
toOrganGood GroupName ItemKind
S_RANGED_DEFLECTING 10]
                  -- rare, but long lasting
  , idesc :: Text
idesc    = "Virtue: Years of training for null gravity squash tournaments unexpectedly pay off. At this very distance and speed, trajectory angles are obvious and lounging and feinting comes naturally."
  }
backstoryGood2 :: ItemKind
backstoryGood2 = ItemKind
backstoryGoodTemplate
  { iname :: Text
iname    = "\"Loyalty ritual\""
  , ifreq :: Freqs ItemKind
ifreq    = [(GroupName ItemKind
BACKSTORY_GOOD, 100), (GroupName ItemKind
BACKSTORY, 1)]
  , iaspects :: [Aspect]
iaspects = [Dice -> Aspect
Timeout 200, Flag -> Aspect
SetFlag Flag
Periodic]
               [Aspect] -> [Aspect] -> [Aspect]
forall a. [a] -> [a] -> [a]
++ ItemKind -> [Aspect]
iaspects ItemKind
backstoryGoodTemplate
  , ieffects :: [Effect]
ieffects = [Effect
Impress Effect -> Effect -> Effect
`AndEffect` Text -> Text -> Effect
VerbMsg "mumble repeatedly" "."]
  , idesc :: Text
idesc    = "Virtue: Reciting, every once in a while, the names of all the people your life directly depends on is a proven loyalty-affirming custom. It also lets you pinpoint the moment you start hating a teammate."  -- 'ritual' is exotic enough to add to biography
  }
backstoryGood3 :: ItemKind
backstoryGood3 = ItemKind
backstoryGoodTemplate
  { iname :: Text
iname    = "\"Bravery\""
  , ifreq :: Freqs ItemKind
ifreq    = [(GroupName ItemKind
BACKSTORY_GOOD, 100), (GroupName ItemKind
BACKSTORY, 1)]
  , iaspects :: [Aspect]
iaspects = [Dice -> Aspect
Timeout 1, Flag -> Aspect
SetFlag Flag
UnderMelee]
               [Aspect] -> [Aspect] -> [Aspect]
forall a. [a] -> [a] -> [a]
++ ItemKind -> [Aspect]
iaspects ItemKind
backstoryGoodTemplate
  , ieffects :: [Effect]
ieffects = [Condition -> Effect -> Effect
When (Int -> Condition
CalmLeq 2) (Effect -> Effect) -> Effect -> Effect
forall a b. (a -> b) -> a -> b
$ Condition -> Effect -> Effect
When (ActivationFlag -> Condition
TriggeredBy ActivationFlag
ActivationMeleeable)
                (Effect -> Effect) -> Effect -> Effect
forall a b. (a -> b) -> a -> b
$ [Effect] -> Effect
SeqEffect
                    [ Int -> Dice -> Effect
Recharge 4 20
                    , Int -> Effect
RefillCalm 2
                    ]]
                 -- @TriggeredBy@ condition prevents micro-management
  , idesc :: Text
idesc    = "Virtue: Several years of life threatening events leave either a trauma or a lesson. The lesson is, when fear is the strongest, turn away from yourself and fiercely focus on your mission."
  }
backstoryBadTemplate :: ItemKind
backstoryBadTemplate = ItemKind
backstoryFluffTemplate
  { iname :: Text
iname    = "unrevealed vice"
  , ifreq :: Freqs ItemKind
ifreq    = [(GroupName ItemKind
BACKSTORY_BAD_UNKNOWN, 1)]
  , iflavour :: [Flavour]
iflavour = [Color] -> [Flavour]
zipStory [Color
cBadEvent, Color
cVeryBadEvent]
  , iaspects :: [Aspect]
iaspects = [ GroupName ItemKind -> Aspect
PresentAs GroupName ItemKind
BACKSTORY_BAD_UNKNOWN, Flag -> Aspect
SetFlag Flag
MetaGame
               , Flag -> Aspect
SetFlag Flag
Durable, Flag -> Aspect
SetFlag Flag
MinorAspects ]
  }
backstoryBad1 :: ItemKind
backstoryBad1 = ItemKind
backstoryBadTemplate
  { iname :: Text
iname    = "\"Drug addiction\""
  , ifreq :: Freqs ItemKind
ifreq    = [(GroupName ItemKind
BACKSTORY_BAD, 100), (GroupName ItemKind
BACKSTORY, 1)]
  , iaspects :: [Aspect]
iaspects = [Dice -> Aspect
Timeout 200, Flag -> Aspect
SetFlag Flag
Periodic, Flag -> Aspect
SetFlag Flag
Unique]
               [Aspect] -> [Aspect] -> [Aspect]
forall a. [a] -> [a] -> [a]
++ ItemKind -> [Aspect]
iaspects ItemKind
backstoryBadTemplate
  , ieffects :: [Effect]
ieffects = [Condition -> Effect -> Effect
When (Int -> Condition
CalmLeq 40) (Effect -> Effect) -> Effect -> Effect
forall a b. (a -> b) -> a -> b
$ Condition -> Effect -> Effect
When (Int -> Condition
CalmGeq 20) (Effect -> Effect) -> Effect -> Effect
forall a b. (a -> b) -> a -> b
$ [Effect] -> Effect
SeqEffect
      [ GroupName ItemKind -> Dice -> Effect
toOrganBad GroupName ItemKind
S_SLOWED (3 Dice -> Dice -> Dice
forall a. Num a => a -> a -> a
+ 1 Int -> Int -> Dice
`d` 3)
      , GroupName ItemKind -> Dice -> Effect
toOrganBad GroupName ItemKind
S_FRENZIED (40 Dice -> Dice -> Dice
forall a. Num a => a -> a -> a
+ 1 Int -> Int -> Dice
`d` 10)
      , GroupName ItemKind -> Dice -> Effect
toOrganGood GroupName ItemKind
S_STRENGTHENED (5 Dice -> Dice -> Dice
forall a. Num a => a -> a -> a
+ 1 Int -> Int -> Dice
`d` 5) ]]  -- to short to compensate
  , idesc :: Text
idesc    = "Vice: The small pill that distracts from mild anxiety also distracts from survival and responsibility towards teammates."
  }
backstoryBad2 :: ItemKind
backstoryBad2 = ItemKind
backstoryBadTemplate
  { iname :: Text
iname    = "\"Overconfidence\""
  , ifreq :: Freqs ItemKind
ifreq    = [(GroupName ItemKind
BACKSTORY_BAD, 100), (GroupName ItemKind
BACKSTORY, 1)]
  , iaspects :: [Aspect]
iaspects = [Dice -> Aspect
Timeout 200, Flag -> Aspect
SetFlag Flag
UnderMelee]
               [Aspect] -> [Aspect] -> [Aspect]
forall a. [a] -> [a] -> [a]
++ ItemKind -> [Aspect]
iaspects ItemKind
backstoryBadTemplate
  , ieffects :: [Effect]
ieffects = [Condition -> Effect -> Effect
When (Int -> Condition
CalmGeq 80) (Effect -> Effect) -> Effect -> Effect
forall a b. (a -> b) -> a -> b
$ [Effect] -> Effect
SeqEffect
      [ GroupName ItemKind -> Dice -> Effect
toOrganBad GroupName ItemKind
S_WEAKENED (20 Dice -> Dice -> Dice
forall a. Num a => a -> a -> a
+ 1 Int -> Int -> Dice
`d` 5)
      , GroupName ItemKind -> Dice -> Effect
toOrganBad GroupName ItemKind
S_DEAF (20 Dice -> Dice -> Dice
forall a. Num a => a -> a -> a
+ 1 Int -> Int -> Dice
`d` 5) ]]
  , idesc :: Text
idesc    = "Vice: Never underestimate a maddened, towering abomination, when you only have a stick to fend it off with. Bonus advice: the fact you excelled in school athletics doesn't mean every power in the universe is going to read you body language and cower."
  }
backstoryBad3 :: ItemKind
backstoryBad3 = ItemKind
backstoryBadTemplate
  { iname :: Text
iname    = "\"Arrogance\""
  , ifreq :: Freqs ItemKind
ifreq    = [(GroupName ItemKind
BACKSTORY_BAD, 100), (GroupName ItemKind
BACKSTORY, 1)]
  , iaspects :: [Aspect]
iaspects = [Dice -> Aspect
Timeout 200, Flag -> Aspect
SetFlag Flag
UnderMelee]
               [Aspect] -> [Aspect] -> [Aspect]
forall a. [a] -> [a] -> [a]
++ ItemKind -> [Aspect]
iaspects ItemKind
backstoryBadTemplate
  , ieffects :: [Effect]
ieffects = [Condition -> Effect -> Effect
When (Int -> Condition
CalmGeq 80) (Effect -> Effect) -> Effect -> Effect
forall a b. (a -> b) -> a -> b
$ [Effect] -> Effect
SeqEffect
      [ Int -> Dice -> Effect
Discharge 3 40
      , Effect
Yell
      , [Effect] -> Effect
OneOf ([Effect] -> Effect) -> [Effect] -> Effect
forall a b. (a -> b) -> a -> b
$ ((Text, Text) -> Effect) -> [(Text, Text)] -> [Effect]
forall a b. (a -> b) -> [a] -> [b]
map ((Text -> Text -> Effect) -> (Text, Text) -> Effect
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry Text -> Text -> Effect
VerbMsg)
          [ ("yell: How dare you touch me?", "")
          , ("yell: Do you know who I am?", "")
          , ("yell: Calling my lawyer", "!")
          ] ]]
  , idesc :: Text
idesc    = "Vice: Privilege can be a boon, but if taken for granted, it can be a doom."
  }
backstoryBad4 :: ItemKind
backstoryBad4 = ItemKind
backstoryBadTemplate
  { iname :: Text
iname    = "\"Alcoholism\""
  , ifreq :: Freqs ItemKind
ifreq    = [(GroupName ItemKind
BACKSTORY_BAD, 100), (GroupName ItemKind
BACKSTORY, 1)]
  , iaspects :: [Aspect]
iaspects = [ Dice -> Aspect
Timeout 200, Flag -> Aspect
SetFlag Flag
Periodic
               , Flag -> Aspect
SetFlag Flag
Unique ]  -- a tragic backstory and so unique
               [Aspect] -> [Aspect] -> [Aspect]
forall a. [a] -> [a] -> [a]
++ ItemKind -> [Aspect]
iaspects ItemKind
backstoryBadTemplate
  , ieffects :: [Effect]
ieffects = [[Effect] -> Effect
AtMostOneOf  -- simple but pessimistic probability; not accurate
      [ Int -> Int -> CStore -> GroupName ItemKind -> Effect
DestroyItem 1 1 CStore
CStash GroupName ItemKind
ALCOHOL
          -- this is not drinking, but smashing; say, inner fight, won;
          -- @ConsumeItems [(1, ALCOHOL)] []@ would drink, but not from stash
          -- and only for alcohols that are durable, which is unlikely
        Effect -> Effect -> Effect
`OrEffect`  -- only create if none available
        [Effect] -> Effect
SeqEffect [ Maybe Int -> CStore -> GroupName ItemKind -> TimerDice -> Effect
CreateItem (Int -> Maybe Int
forall a. a -> Maybe a
Just 1) CStore
CStash GroupName ItemKind
ALCOHOL TimerDice
timerNone
                  , Text -> Text -> Effect
VerbMsg "explain: Some moonshine from gathered scraps, just in case" "." ]
      , Effect
NopEffect  -- always fails, no identification
      ]]
  , idesc :: Text
idesc    = "Vice: Adventurers that are abstaining alcoholics are double heroes, even if they too may trip sometimes. That doesn't make alcoholism a virtue, though."
  }
backstoryMixedTemplate :: ItemKind
backstoryMixedTemplate = ItemKind
backstoryFluffTemplate
  { iname :: Text
iname    = "unrevealed twist"
  , ifreq :: Freqs ItemKind
ifreq    = [(GroupName ItemKind
BACKSTORY_MIXED_UNKNOWN, 1)]
  , iflavour :: [Flavour]
iflavour = [Color] -> [Flavour]
zipStory [Color
cRisk, Color
cGraveRisk]
  , iaspects :: [Aspect]
iaspects = [ GroupName ItemKind -> Aspect
PresentAs GroupName ItemKind
BACKSTORY_MIXED_UNKNOWN, Flag -> Aspect
SetFlag Flag
MetaGame
               , Flag -> Aspect
SetFlag Flag
Durable, Flag -> Aspect
SetFlag Flag
MinorAspects ]
  }
backstoryMixed1 :: ItemKind
backstoryMixed1 = ItemKind
backstoryMixedTemplate
  { iname :: Text
iname    = "\"Heavy eyes\""
  , ifreq :: Freqs ItemKind
ifreq    = [(GroupName ItemKind
BACKSTORY_MIXED, 100), (GroupName ItemKind
BACKSTORY, 1)]
  , iaspects :: [Aspect]
iaspects = [Dice -> Aspect
Timeout 100, Flag -> Aspect
SetFlag Flag
Periodic]
               [Aspect] -> [Aspect] -> [Aspect]
forall a. [a] -> [a] -> [a]
++ ItemKind -> [Aspect]
iaspects ItemKind
backstoryMixedTemplate
  , ieffects :: [Effect]
ieffects = [[Effect] -> Effect
AtMostOneOf [ Effect
PutToSleep
                            , Effect
NopEffect
                            , Effect
NopEffect
                            ]]
                  -- mixed, sleep refills Calm fully, but hobbles the actor
  , idesc :: Text
idesc    = "Twist: Can sleep anywhere, any time. The catch: sleeps anywhere, any time."
  }
backstoryMixed2 :: ItemKind
backstoryMixed2 = ItemKind
backstoryMixedTemplate
  { iname :: Text
iname    = "\"Too Young to Die\""
  , ifreq :: Freqs ItemKind
ifreq    = [(GroupName ItemKind
BACKSTORY_MIXED, 100), (GroupName ItemKind
BACKSTORY, 1)]
  , iaspects :: [Aspect]
iaspects = [Dice -> Aspect
Timeout 1, Flag -> Aspect
SetFlag Flag
UnderRanged, Flag -> Aspect
SetFlag Flag
UnderMelee]
               [Aspect] -> [Aspect] -> [Aspect]
forall a. [a] -> [a] -> [a]
++ ItemKind -> [Aspect]
iaspects ItemKind
backstoryMixedTemplate
  , ieffects :: [Effect]
ieffects = [Condition -> Effect -> Effect
When (Int -> Condition
HpLeq 10) (Effect -> Effect) -> Effect -> Effect
forall a b. (a -> b) -> a -> b
$ Condition -> Effect -> Effect
Unless (ActivationFlag -> Condition
TriggeredBy ActivationFlag
ActivationTrigger)
                (Effect -> Effect) -> Effect -> Effect
forall a b. (a -> b) -> a -> b
$ [Effect] -> Effect
SeqEffect
      [Int -> Effect
RefillCalm (-10), GroupName ItemKind -> Dice -> Effect
toOrganGood GroupName ItemKind
S_HASTED 1, Int -> Dice -> Effect
Recharge 1 20]]
        -- mixed: Calm lost but fury helps survive; may fire once per turn
        -- @TriggeredBy@ condition prevents micro-management
  , idesc :: Text
idesc    = "Twist: Despair, fury, denial. Beastly reactions to approaching death. This is unforgivable in space, especially when getting acquainted with dying is so accessible, for a generation already, either via hibernation and nanobot revival or mental exercise culminating in writing a will to be notarized Earth-side."  -- hint that the nanobot revival heroes use all the time may have stemmed from space travel hibernation research; if so, the culture followed, but some youngsters are lazy wimps
  }
backstoryNeutralTemplate :: ItemKind
backstoryNeutralTemplate = ItemKind
backstoryFluffTemplate
  { iname :: Text
iname    = "unrevealed quirk"
  , ifreq :: Freqs ItemKind
ifreq    = [(GroupName ItemKind
BACKSTORY_NEUTRAL_UNKNOWN, 1)]
  , iflavour :: [Flavour]
iflavour = [Color] -> [Flavour]
zipStory [Color
cNeutralEvent, Color
cRareNeutralEvent]
  , iaspects :: [Aspect]
iaspects = [ GroupName ItemKind -> Aspect
PresentAs GroupName ItemKind
BACKSTORY_NEUTRAL_UNKNOWN, Flag -> Aspect
SetFlag Flag
MetaGame
               , Flag -> Aspect
SetFlag Flag
Durable, Flag -> Aspect
SetFlag Flag
MinorAspects ]
  }
backstoryNeutral1 :: ItemKind
backstoryNeutral1 = ItemKind
backstoryNeutralTemplate
  { iname :: Text
iname    = "\"Letting Go\""
  , ifreq :: Freqs ItemKind
ifreq    = [(GroupName ItemKind
BACKSTORY_NEUTRAL, 100), (GroupName ItemKind
BACKSTORY, 1)]
  , ieffects :: [Effect]
ieffects = [ Effect -> Effect
OnSmash (GroupName ItemKind -> Effect
Explode GroupName ItemKind
S_YOUTH_SPRINKLE)  -- may hit foes as well
               , Condition -> Effect -> Effect
Unless (ActivationFlag -> Condition
TriggeredBy ActivationFlag
ActivationTrigger)
                 (Effect -> Effect) -> Effect -> Effect
forall a b. (a -> b) -> a -> b
$ Text -> Text -> Effect
VerbMsg "laugh warmly" "." ]
                   -- never activated, but prevents premature identification
  , idesc :: Text
idesc    = "Quirk: Dying beautifully is an art that takes a lifetime to master and leaves spectators peaceful and uplifted. That's true even for clinical death, potentially reversible with nano medbot treatment back in town."
  }
-- Both can be moved to Mixed if less numerous, even though the effects mild.
backstoryNeutral2 :: ItemKind
backstoryNeutral2 = ItemKind
backstoryNeutralTemplate
  { iname :: Text
iname    = "\"Mood swings\""
  , ifreq :: Freqs ItemKind
ifreq    = [(GroupName ItemKind
BACKSTORY_NEUTRAL, 100), (GroupName ItemKind
BACKSTORY, 1)]
  , iaspects :: [Aspect]
iaspects = [Dice -> Aspect
Timeout 100, Flag -> Aspect
SetFlag Flag
Periodic]
               [Aspect] -> [Aspect] -> [Aspect]
forall a. [a] -> [a] -> [a]
++ ItemKind -> [Aspect]
iaspects ItemKind
backstoryMixedTemplate
  , ieffects :: [Effect]
ieffects = [Condition -> Effect -> Effect
When (Int -> Condition
HpLeq 50) (Effect -> Effect) -> Effect -> Effect
forall a b. (a -> b) -> a -> b
$ [Effect] -> Effect
OneOf [Int -> Effect
RefillCalm 20, Int -> Effect
RefillCalm (-20)]]
  , idesc :: Text
idesc    = "Quirk: Hormonal imbalances make it hard to compensate for natural neural system unsteadiness."
  }
backstoryNeutral3 :: ItemKind
backstoryNeutral3 = ItemKind
backstoryNeutralTemplate
  { iname :: Text
iname    = "\"Cracking under stress\""
  , ifreq :: Freqs ItemKind
ifreq    = [(GroupName ItemKind
BACKSTORY_NEUTRAL, 100), (GroupName ItemKind
BACKSTORY, 1)]
  , iaspects :: [Aspect]
iaspects = [Flag -> Aspect
SetFlag Flag
UnderRanged, Flag -> Aspect
SetFlag Flag
UnderMelee]
               [Aspect] -> [Aspect] -> [Aspect]
forall a. [a] -> [a] -> [a]
++ ItemKind -> [Aspect]
iaspects ItemKind
backstoryMixedTemplate
  , ieffects :: [Effect]
ieffects = [Condition -> Effect -> Effect
When (Int -> Condition
HpLeq 50) (Effect -> Effect) -> Effect -> Effect
forall a b. (a -> b) -> a -> b
$ Condition -> Effect -> Effect
Unless (ActivationFlag -> Condition
TriggeredBy ActivationFlag
ActivationTrigger)
                (Effect -> Effect) -> Effect -> Effect
forall a b. (a -> b) -> a -> b
$ [Effect] -> Effect
OneOf [Int -> Effect
RefillCalm 10, Int -> Effect
RefillCalm (-10)]]
                  -- @TriggeredBy@ condition prevents micro-management
  , idesc :: Text
idesc    = "Quirk: Not everyone needs to be impassive. A brush with death may result in panic today, but in cheering up and rallying the whole team tomorrow. However, if the cost of bad outcomes is prohibitive, exposed posts and front line assignments are better avoided."  -- 'the whole team' is an exaggeration, but it's in-character here
  }