-- | 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_ARSENIC_FISSURE, pattern S_SULFUR_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_ARSENIC_VENT, pattern S_SULFUR_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 S_TOOTH, pattern S_LASH, pattern S_RIGHT_TORSION, pattern S_LEFT_TORSION, pattern S_PUPIL
  , organsGNSingleton, organsGN
  , -- * Content
    organs
  ) where

import Prelude ()

import Game.LambdaHack.Core.Prelude

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

-- * 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_ARSENIC_FISSURE, GroupName ItemKind
S_SULFUR_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_ARSENIC_VENT, GroupName ItemKind
S_SULFUR_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_TOOTH, GroupName ItemKind
S_LASH, GroupName ItemKind
S_RIGHT_TORSION, GroupName ItemKind
S_LEFT_TORSION, GroupName ItemKind
S_PUPIL]

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_ARSENIC_FISSURE, S_SULFUR_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_ARSENIC_VENT, S_SULFUR_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_TOOTH, S_LASH, S_RIGHT_TORSION, S_LEFT_TORSION, S_PUPIL :: GroupName ItemKind

organsGN :: [GroupName ItemKind]
organsGN :: [GroupName ItemKind]
organsGN =
       [GroupName ItemKind
SCAVENGER]

pattern SCAVENGER :: 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_ARSENIC_FISSURE :: GroupName ItemKind
$mS_ARSENIC_FISSURE :: forall r. GroupName ItemKind -> (Void# -> r) -> (Void# -> r) -> r
S_ARSENIC_FISSURE = GroupName "arsenic fissure"
pattern $bS_SULFUR_FISSURE :: GroupName ItemKind
$mS_SULFUR_FISSURE :: forall r. GroupName ItemKind -> (Void# -> r) -> (Void# -> r) -> r
S_SULFUR_FISSURE = GroupName "sulfur 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_ARSENIC_VENT :: GroupName ItemKind
$mS_ARSENIC_VENT :: forall r. GroupName ItemKind -> (Void# -> r) -> (Void# -> r) -> r
S_ARSENIC_VENT = GroupName "arsenic vent"
pattern $bS_SULFUR_VENT :: GroupName ItemKind
$mS_SULFUR_VENT :: forall r. GroupName ItemKind -> (Void# -> r) -> (Void# -> r) -> r
S_SULFUR_VENT = GroupName "sulfur 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"

-- * LH-specific
pattern $bS_TOOTH :: GroupName ItemKind
$mS_TOOTH :: forall r. GroupName ItemKind -> (Void# -> r) -> (Void# -> r) -> r
S_TOOTH = GroupName "tooth"
pattern $bS_LASH :: GroupName ItemKind
$mS_LASH :: forall r. GroupName ItemKind -> (Void# -> r) -> (Void# -> r) -> r
S_LASH = GroupName "lash"
pattern $bS_RIGHT_TORSION :: GroupName ItemKind
$mS_RIGHT_TORSION :: forall r. GroupName ItemKind -> (Void# -> r) -> (Void# -> r) -> r
S_RIGHT_TORSION = GroupName "right torsion"
pattern $bS_LEFT_TORSION :: GroupName ItemKind
$mS_LEFT_TORSION :: forall r. GroupName ItemKind -> (Void# -> r) -> (Void# -> r) -> r
S_LEFT_TORSION = GroupName "left torsion"
pattern $bS_PUPIL :: GroupName ItemKind
$mS_PUPIL :: forall r. GroupName ItemKind -> (Void# -> r) -> (Void# -> r) -> r
S_PUPIL = GroupName "pupil"

-- * 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]
  -- LH-specific
  [ItemKind] -> [ItemKind] -> [ItemKind]
forall a. [a] -> [a] -> [a]
++ [ItemKind
tooth, ItemKind
lash, ItemKind
torsionRight, ItemKind
torsionLeft, ItemKind
pupil]

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
-- LH-specific
tooth, lash, torsionRight, torsionLeft, pupil :: ItemKind

symbolWand :: ContentSymbol ItemKind
symbolWand :: ContentSymbol ItemKind
symbolWand = ItemSymbolsUsedInEngine -> ContentSymbol ItemKind
rsymbolWand (ItemSymbolsUsedInEngine -> ContentSymbol ItemKind)
-> ItemSymbolsUsedInEngine -> ContentSymbol ItemKind
forall a b. (a -> b) -> a -> b
$ RuleContent -> ItemSymbolsUsedInEngine
ritemSymbols RuleContent
standardRules

-- * No-cooldown melee damage organs without effects

thorn :: ItemKind
thorn = ItemKind
fist
  { isymbol :: ContentSymbol ItemKind
isymbol  = ContentSymbol ItemKind
symbolWand
  , iname :: Text
iname    = Text
"thorn"
  , ifreq :: Freqs ItemKind
ifreq    = [(GroupName ItemKind
S_THORN, Int
1)]
  , icount :: Dice
icount   = Dice
2 Dice -> Dice -> Dice
forall a. Num a => a -> a -> a
+ Int
1 Int -> Int -> Dice
`d` Int
2  -- unrealistic, but not boring
  , iverbHit :: Text
iverbHit = Text
"puncture"
  , idamage :: Dice
idamage  = Int
2 Int -> Int -> Dice
`d` Int
1
  , iaspects :: [Aspect]
iaspects = [Flag -> Aspect
SetFlag Flag
Meleeable]  -- not Durable
  , ieffects :: [Effect]
ieffects = [Text -> Text -> Effect
VerbNoLonger Text
"be not so thorny any more" Text
"."]
  , idesc :: Text
idesc    = Text
"Sharp yet brittle."
  }
tip :: ItemKind
tip = ItemKind
fist
  { iname :: Text
iname    = Text
"tip"
  , ifreq :: Freqs ItemKind
ifreq    = [(GroupName ItemKind
S_TIP, Int
1)]
  , icount :: Dice
icount   = Dice
1
  , iverbHit :: Text
iverbHit = Text
"poke"
  , idamage :: Dice
idamage  = Int
2 Int -> Int -> Dice
`d` Int
1
  , idesc :: Text
idesc    = Text
""
  }
fist :: ItemKind
fist = ItemKind :: ContentSymbol ItemKind
-> Text
-> Freqs ItemKind
-> [Flavour]
-> Dice
-> Rarity
-> Text
-> Int
-> Dice
-> [Aspect]
-> [Effect]
-> [(GroupName ItemKind, CStore)]
-> Text
-> ItemKind
ItemKind
  { isymbol :: ContentSymbol ItemKind
isymbol  = ContentSymbol ItemKind -> ContentSymbol ItemKind
forall c. ContentSymbol ItemKind -> ContentSymbol ItemKind
toContentSymbol ContentSymbol ItemKind
','
  , iname :: Text
iname    = Text
"fist"
  , ifreq :: Freqs ItemKind
ifreq    = [(GroupName ItemKind
S_FIST, Int
1)]
  , iflavour :: [Flavour]
iflavour = [Color] -> [Flavour]
zipPlain [Color
Red]
  , icount :: Dice
icount   = Dice
2
  , irarity :: Rarity
irarity  = [(Double
1, Int
1)]
  , iverbHit :: Text
iverbHit = Text
"punch"
  , iweight :: Int
iweight  = Int
2000
  , idamage :: Dice
idamage  = Int
4 Int -> Int -> Dice
`d` Int
1
  , iaspects :: [Aspect]
iaspects = [Flag -> Aspect
SetFlag Flag
Durable, Flag -> Aspect
SetFlag Flag
Meleeable]
  , ieffects :: [Effect]
ieffects = []
  , idesc :: Text
idesc    = Text
"Simple but effective."
  , ikit :: [(GroupName ItemKind, CStore)]
ikit     = []
  }
foot :: ItemKind
foot = ItemKind
fist
  { iname :: Text
iname    = Text
"foot"
  , ifreq :: Freqs ItemKind
ifreq    = [(GroupName ItemKind
S_FOOT, Int
1)]
  , iverbHit :: Text
iverbHit = Text
"kick"
  , idamage :: Dice
idamage  = Int
4 Int -> Int -> Dice
`d` Int
1
  , idesc :: Text
idesc    = Text
"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    = Text
"small claw"
  , ifreq :: Freqs ItemKind
ifreq    = [(GroupName ItemKind
S_SMALL_CLAW, Int
1)]
  , iverbHit :: Text
iverbHit = Text
"slash"
  , idamage :: Dice
idamage  = Int
2 Int -> Int -> Dice
`d` Int
1
  , idesc :: Text
idesc    = Text
"A pearly spike."
  }
snout :: ItemKind
snout = ItemKind
fist
  { iname :: Text
iname    = Text
"snout"
  , ifreq :: Freqs ItemKind
ifreq    = [(GroupName ItemKind
S_SNOUT, Int
1)]
  , icount :: Dice
icount   = Dice
1
  , iverbHit :: Text
iverbHit = Text
"bite"
  , idamage :: Dice
idamage  = Int
2 Int -> Int -> Dice
`d` Int
1
  , idesc :: Text
idesc    = Text
"Sensitive and wide-nostrilled."
  }
smallJaw :: ItemKind
smallJaw = ItemKind
fist
  { iname :: Text
iname    = Text
"small jaw"
  , ifreq :: Freqs ItemKind
ifreq    = [(GroupName ItemKind
S_SMALL_JAW, Int
1)]
  , icount :: Dice
icount   = Dice
1
  , iverbHit :: Text
iverbHit = Text
"rip"
  , idamage :: Dice
idamage  = Int
3 Int -> Int -> Dice
`d` Int
1
  , idesc :: Text
idesc    = Text
"Filled with small, even teeth."
  }

-- * Cooldown melee damage organs without effects

tentacle :: ItemKind
tentacle = ItemKind
fist  -- two copies only
  { iname :: Text
iname    = Text
"tentacle"
  , ifreq :: Freqs ItemKind
ifreq    = [(GroupName ItemKind
S_TENTACLE, Int
1)]
  , iverbHit :: Text
iverbHit = Text
"slap"
  , idamage :: Dice
idamage  = Int
4 Int -> Int -> Dice
`d` Int
1
  , iaspects :: [Aspect]
iaspects = Dice -> Aspect
Timeout Dice
3  -- minimal timeout that lets other organs show
               Aspect -> [Aspect] -> [Aspect]
forall a. a -> [a] -> [a]
: ItemKind -> [Aspect]
iaspects ItemKind
fist
  , idesc :: Text
idesc    = Text
"Damp and dextrous."
  }
jaw :: ItemKind
jaw = ItemKind
fist
  { iname :: Text
iname    = Text
"jaw"
  , ifreq :: Freqs ItemKind
ifreq    = [(GroupName ItemKind
S_JAW, Int
1)]
  , icount :: Dice
icount   = Dice
1
  , iverbHit :: Text
iverbHit = Text
"rip"
  , idamage :: Dice
idamage  = Int
5 Int -> Int -> Dice
`d` Int
1
  , iaspects :: [Aspect]
iaspects = Dice -> Aspect
Timeout (Dice
2 Dice -> Dice -> Dice
forall a. Num a => a -> a -> a
+ Int
1 Int -> Int -> Dice
`d` Int
2)  -- no effect, but limit raw damage
               Aspect -> [Aspect] -> [Aspect]
forall a. a -> [a] -> [a]
: ItemKind -> [Aspect]
iaspects ItemKind
fist
  , idesc :: Text
idesc    = Text
"Delivers a powerful bite."
  }
horn :: ItemKind
horn = ItemKind
fist
  { iname :: Text
iname    = Text
"horn"
  , ifreq :: Freqs ItemKind
ifreq    = [(GroupName ItemKind
S_HORN, Int
1)]
  , iverbHit :: Text
iverbHit = Text
"impale"
  , idamage :: Dice
idamage  = Int
5 Int -> Int -> Dice
`d` Int
1
  , iaspects :: [Aspect]
iaspects = [ Dice -> Aspect
Timeout Dice
7  -- no effect, but limit raw damage; two copies
               , Skill -> Dice -> Aspect
AddSkill Skill
SkArmorMelee Dice
10 ]  -- bonus doubled
               [Aspect] -> [Aspect] -> [Aspect]
forall a. [a] -> [a] -> [a]
++ ItemKind -> [Aspect]
iaspects ItemKind
fist
  , idesc :: Text
idesc    = Text
"Sharp and long, for defence or attack."
  }
largeJaw :: ItemKind
largeJaw = ItemKind
fist
  { iname :: Text
iname    = Text
"large jaw"
  , ifreq :: Freqs ItemKind
ifreq    = [(GroupName ItemKind
S_LARGE_JAW, Int
1)]
  , icount :: Dice
icount   = Dice
1
  , iverbHit :: Text
iverbHit = Text
"crush"
  , idamage :: Dice
idamage  = Int
10 Int -> Int -> Dice
`d` Int
1
  , iaspects :: [Aspect]
iaspects = Dice -> Aspect
Timeout (Dice
2 Dice -> Dice -> Dice
forall a. Num a => a -> a -> a
+ Int
1 Int -> Int -> Dice
`d` Int
2)  -- no effect, but limit raw damage
               Aspect -> [Aspect] -> [Aspect]
forall a. a -> [a] -> [a]
: ItemKind -> [Aspect]
iaspects ItemKind
fist
  , idesc :: Text
idesc    = Text
"Enough to swallow anything in a single gulp."
  }

-- * Direct damage organs with effects

beeSting :: ItemKind
beeSting = ItemKind
fist
  { isymbol :: ContentSymbol ItemKind
isymbol  = ContentSymbol ItemKind
symbolWand
  , iname :: Text
iname    = Text
"bee sting"
  , ifreq :: Freqs ItemKind
ifreq    = [(GroupName ItemKind
S_BEE_STING, Int
1)]
  , icount :: Dice
icount   = Dice
1
  , iverbHit :: Text
iverbHit = Text
"sting"
  , idamage :: Dice
idamage  = Dice
0
  , iaspects :: [Aspect]
iaspects = [ Skill -> Dice -> Aspect
AddSkill Skill
SkArmorMelee Dice
200, Skill -> Dice -> Aspect
AddSkill Skill
SkArmorRanged Dice
45
               , Flag -> Aspect
SetFlag Flag
Meleeable ]  -- not Durable
  , ieffects :: [Effect]
ieffects = [Dice -> Effect
Paralyze Dice
6, Int -> Effect
RefillHP Int
4]
                 -- no special message when runs out, because it's 1 copy
  , idesc :: Text
idesc    = Text
"Painful, but beneficial."
  }
sting :: ItemKind
sting = ItemKind
fist
  { isymbol :: ContentSymbol ItemKind
isymbol  = ContentSymbol ItemKind
symbolWand
  , iname :: Text
iname    = Text
"sting"
  , ifreq :: Freqs ItemKind
ifreq    = [(GroupName ItemKind
S_STING, Int
1)]
  , icount :: Dice
icount   = Dice
1
  , iverbHit :: Text
iverbHit = Text
"inject"
  , idamage :: Dice
idamage  = Int
1 Int -> Int -> Dice
`d` Int
1
  , iaspects :: [Aspect]
iaspects = [Dice -> Aspect
Timeout (Dice -> Aspect) -> Dice -> Aspect
forall a b. (a -> b) -> a -> b
$ Dice
10 Dice -> Dice -> Dice
forall a. Num a => a -> a -> a
- Int
1 Int -> Int -> Dice
`dL` Int
4, Skill -> Dice -> Aspect
AddSkill Skill
SkHurtMelee Dice
40]
               [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 (Dice
3 Dice -> Dice -> Dice
forall a. Num a => a -> a -> a
+ Int
1 Int -> Int -> Dice
`d` Int
3)]
  , idesc :: Text
idesc    = Text
"Painful, debilitating and harmful."
  }
lip :: ItemKind
lip = ItemKind
fist
  { iname :: Text
iname    = Text
"lip"
  , ifreq :: Freqs ItemKind
ifreq    = [(GroupName ItemKind
S_LIP, Int
1)]
  , icount :: Dice
icount   = Dice
1
  , iverbHit :: Text
iverbHit = Text
"lap"
  , idamage :: Dice
idamage  = Int
1 Int -> Int -> Dice
`d` Int
1
  , iaspects :: [Aspect]
iaspects = Dice -> Aspect
Timeout (Dice
3 Dice -> Dice -> Dice
forall a. Num a => a -> a -> a
+ Int
1 Int -> Int -> Dice
`d` Int
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 (Dice
2 Dice -> Dice -> Dice
forall a. Num a => a -> a -> a
+ Int
1 Int -> Int -> Dice
`dL` Int
3)]
  , idesc :: Text
idesc    = Text
""
  }
venomTooth :: ItemKind
venomTooth = ItemKind
fist
  { isymbol :: ContentSymbol ItemKind
isymbol  = ContentSymbol ItemKind
symbolWand
  , iname :: Text
iname    = Text
"venom tooth"
  , ifreq :: Freqs ItemKind
ifreq    = [(GroupName ItemKind
S_VENOM_TOOTH, Int
1)]
  , iverbHit :: Text
iverbHit = Text
"bite"
  , idamage :: Dice
idamage  = Int
1 Int -> Int -> Dice
`d` Int
1
  , iaspects :: [Aspect]
iaspects = Dice -> Aspect
Timeout (Dice
7 Dice -> Dice -> Dice
forall a. Num a => a -> a -> a
- Int
1 Int -> Int -> Dice
`dL` Int
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 (Dice
3 Dice -> Dice -> Dice
forall a. Num a => a -> a -> a
+ Int
1 Int -> Int -> Dice
`d` Int
3)]
  , idesc :: Text
idesc    = Text
"A chilling numbness spreads from its bite."
  }
hookedClaw :: ItemKind
hookedClaw = ItemKind
fist
  { isymbol :: ContentSymbol ItemKind
isymbol  = ContentSymbol ItemKind
symbolWand
  , iname :: Text
iname    = Text
"hooked claw"
  , ifreq :: Freqs ItemKind
ifreq    = [(GroupName ItemKind
S_HOOKED_CLAW, Int
1)]
  , icount :: Dice
icount   = Dice
2  -- even if more, only the fore claws used for fighting
  , iverbHit :: Text
iverbHit = Text
"hook"
  , idamage :: Dice
idamage  = Int
2 Int -> Int -> Dice
`d` Int
1
  , iaspects :: [Aspect]
iaspects = Dice -> Aspect
Timeout (Dice
12 Dice -> Dice -> Dice
forall a. Num a => a -> a -> a
- Int
1 Int -> Int -> Dice
`dL` Int
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 Dice
2]
  , idesc :: Text
idesc    = Text
"A curved talon."
  }
screechingBeak :: ItemKind
screechingBeak = ItemKind
fist
  { isymbol :: ContentSymbol ItemKind
isymbol  = ContentSymbol ItemKind
symbolWand
  , iname :: Text
iname    = Text
"screeching beak"
  , ifreq :: Freqs ItemKind
ifreq    = [(GroupName ItemKind
S_SCREECHING_BEAK, Int
1)]
  , icount :: Dice
icount   = Dice
1
  , iverbHit :: Text
iverbHit = Text
"peck"
  , idamage :: Dice
idamage  = Int
3 Int -> Int -> Dice
`d` Int
1
  , iaspects :: [Aspect]
iaspects = Dice -> Aspect
Timeout (Dice
7 Dice -> Dice -> Dice
forall a. Num a => a -> a -> a
- Int
1 Int -> Int -> Dice
`dL` Int
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
$ Int
1 Int -> Int -> Dice
`dL` Int
3]
  , idesc :: Text
idesc    = Text
"Both a weapon and a beacon, calling more scavengers to the meal."
  }
antler :: ItemKind
antler = ItemKind
fist
  { isymbol :: ContentSymbol ItemKind
isymbol  = ContentSymbol ItemKind
symbolWand
  , iname :: Text
iname    = Text
"antler"
  , ifreq :: Freqs ItemKind
ifreq    = [(GroupName ItemKind
S_ANTLER, Int
1)]
  , iverbHit :: Text
iverbHit = Text
"ram"
  , idamage :: Dice
idamage  = Int
4 Int -> Int -> Dice
`d` Int
1
  , iaspects :: [Aspect]
iaspects = [ Dice -> Aspect
Timeout (Dice -> Aspect) -> Dice -> Aspect
forall a b. (a -> b) -> a -> b
$ Dice
3 Dice -> Dice -> Dice
forall a. Num a => a -> a -> a
+ (Int
1 Int -> Int -> Dice
`d` Int
3) Dice -> Dice -> Dice
forall a. Num a => a -> a -> a
* Dice
3
               , Skill -> Dice -> Aspect
AddSkill Skill
SkArmorMelee Dice
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 Int
100 Int
50 Int
1)]  -- 1 step, slow
  , idesc :: Text
idesc    = Text
""
  }
rhinoHorn :: ItemKind
rhinoHorn = ItemKind
fist
  { isymbol :: ContentSymbol ItemKind
isymbol  = ContentSymbol ItemKind
symbolWand
  , iname :: Text
iname    = Text
"ugly horn"  -- made of keratin, unlike real horns
  , ifreq :: Freqs ItemKind
ifreq    = [(GroupName ItemKind
S_RHINO_HORN, Int
1)]
  , icount :: Dice
icount   = Dice
1  -- single, unlike real horns
  , iverbHit :: Text
iverbHit = Text
"gore"
  , idamage :: Dice
idamage  = Int
5 Int -> Int -> Dice
`d` Int
1
  , iaspects :: [Aspect]
iaspects = [Dice -> Aspect
Timeout Dice
5, Skill -> Dice -> Aspect
AddSkill Skill
SkHurtMelee Dice
20]
               [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    = Text
"Very solid, considering it has the same composition as fingernails."
  }
largeTail :: ItemKind
largeTail = ItemKind
fist
  { isymbol :: ContentSymbol ItemKind
isymbol  = ContentSymbol ItemKind
symbolWand
  , iname :: Text
iname    = Text
"large tail"
  , ifreq :: Freqs ItemKind
ifreq    = [(GroupName ItemKind
S_LARGE_TAIL, Int
1)]
  , icount :: Dice
icount   = Dice
1
  , iverbHit :: Text
iverbHit = Text
"knock"
  , idamage :: Dice
idamage  = Int
7 Int -> Int -> Dice
`d` Int
1
  , iaspects :: [Aspect]
iaspects = [Dice -> Aspect
Timeout (Dice -> Aspect) -> Dice -> Aspect
forall a b. (a -> b) -> a -> b
$ Dice
2 Dice -> Dice -> Dice
forall a. Num a => a -> a -> a
+ Int
1 Int -> Int -> Dice
`d` Int
2, Skill -> Dice -> Aspect
AddSkill Skill
SkHurtMelee Dice
20]
               [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 Int
200 Int
50 Int
1)]  -- 1 step, fast
  , idesc :: Text
idesc    = Text
"Almost as long as the trunk."
  }
hugeTail :: ItemKind
hugeTail = ItemKind
largeTail
  { isymbol :: ContentSymbol ItemKind
isymbol  = ContentSymbol ItemKind
symbolWand
  , iname :: Text
iname    = Text
"huge tail"
  , ifreq :: Freqs ItemKind
ifreq    = [(GroupName ItemKind
S_HUGE_TAIL, Int
1)]
  , iverbHit :: Text
iverbHit = Text
"upend"
  , iaspects :: [Aspect]
iaspects = [Dice -> Aspect
Timeout (Dice -> Aspect) -> Dice -> Aspect
forall a b. (a -> b) -> a -> b
$ Dice
3 Dice -> Dice -> Dice
forall a. Num a => a -> a -> a
+ Int
1 Int -> Int -> Dice
`d` Int
2, Skill -> Dice -> Aspect
AddSkill Skill
SkHurtMelee Dice
20]
               [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 Int
400 Int
50 Int
1)]  -- 2 steps, fast
  , idesc :: Text
idesc    = Text
"Slow but immensely heavy."
  }

-- * Melee weapons without direct damage

venomFang :: ItemKind
venomFang = ItemKind
fist
  { isymbol :: ContentSymbol ItemKind
isymbol  = ContentSymbol ItemKind
symbolWand
  , iname :: Text
iname    = Text
"venom fang"
  , ifreq :: Freqs ItemKind
ifreq    = [(GroupName ItemKind
S_VENOM_FANG, Int
1)]
  , iverbHit :: Text
iverbHit = Text
"bite"
  , idamage :: Dice
idamage  = Dice
0
  , iaspects :: [Aspect]
iaspects = Dice -> Aspect
Timeout (Dice
10 Dice -> Dice -> Dice
forall a. Num a => a -> a -> a
- Int
1 Int -> Int -> Dice
`dL` Int
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    = Text
"Dripping with deadly venom."
  }

-- * Special melee weapons

sulfurFissure :: ItemKind
sulfurFissure = ItemKind
boilingFissure
  { iname :: Text
iname    = Text
"fissure"
  , ifreq :: Freqs ItemKind
ifreq    = [(GroupName ItemKind
S_SULFUR_FISSURE, Int
1)]
  , icount :: Dice
icount   = Dice
2 Dice -> Dice -> Dice
forall a. Num a => a -> a -> a
+ Int
1 Int -> Int -> Dice
`d` Int
2
  , idamage :: Dice
idamage  = Dice
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 Int
5
               , Text -> Text -> Effect
VerbNoLonger Text
"run out of the healing fumes" Text
"."]
  , idesc :: Text
idesc    = Text
""
  }
boilingFissure :: ItemKind
boilingFissure = ItemKind
fist
  { isymbol :: ContentSymbol ItemKind
isymbol  = ContentSymbol ItemKind
symbolWand
  , iname :: Text
iname    = Text
"fissure"
  , ifreq :: Freqs ItemKind
ifreq    = [(GroupName ItemKind
S_BOILING_FISSURE, Int
1)]
  , icount :: Dice
icount   = Dice
5 Dice -> Dice -> Dice
forall a. Num a => a -> a -> a
+ Int
1 Int -> Int -> Dice
`d` Int
5
  , iverbHit :: Text
iverbHit = Text
"hiss at"
  , idamage :: Dice
idamage  = Int
1 Int -> Int -> Dice
`d` Int
1
  , iaspects :: [Aspect]
iaspects = [ Skill -> Dice -> Aspect
AddSkill Skill
SkHurtMelee Dice
20  -- decreasing as count decreases
               , Flag -> Aspect
SetFlag Flag
Meleeable ]  -- not Durable
  , ieffects :: [Effect]
ieffects = [ Int -> Int -> CStore -> GroupName ItemKind -> Effect
DropItem Int
1 Int
1 CStore
COrgan GroupName ItemKind
CONDITION  -- useful; limited
               , Text -> Text -> Effect
VerbNoLonger Text
"widen the crack, releasing pressure" Text
"."]
  , idesc :: Text
idesc    = Text
"A deep crack to the underworld."
  }
arsenicFissure :: ItemKind
arsenicFissure = ItemKind
boilingFissure
  { iname :: Text
iname    = Text
"fissure"
  , ifreq :: Freqs ItemKind
ifreq    = [(GroupName ItemKind
S_ARSENIC_FISSURE, Int
1)]
  , icount :: Dice
icount   = Dice
3 Dice -> Dice -> Dice
forall a. Num a => a -> a -> a
+ Int
1 Int -> Int -> Dice
`d` Int
3
  , idamage :: Dice
idamage  = Int
2 Int -> Int -> Dice
`d` Int
1
  , ieffects :: [Effect]
ieffects = [ GroupName ItemKind -> Dice -> Effect
toOrganBad GroupName ItemKind
S_PARSIMONIOUS (Dice
5 Dice -> Dice -> Dice
forall a. Num a => a -> a -> a
+ Int
1 Int -> Int -> Dice
`d` Int
3)
               -- weaken/poison, impacting intellectual abilities first
               , Text -> Text -> Effect
VerbNoLonger Text
"stop exuding stupefying vapours" Text
"."]
  , idesc :: Text
idesc    = Text
""
  }

-- * Armor organs

armoredSkin :: ItemKind
armoredSkin = ItemKind :: ContentSymbol ItemKind
-> Text
-> Freqs ItemKind
-> [Flavour]
-> Dice
-> Rarity
-> Text
-> Int
-> Dice
-> [Aspect]
-> [Effect]
-> [(GroupName ItemKind, CStore)]
-> Text
-> ItemKind
ItemKind
  { isymbol :: ContentSymbol ItemKind
isymbol  = ContentSymbol ItemKind -> ContentSymbol ItemKind
forall c. ContentSymbol ItemKind -> ContentSymbol ItemKind
toContentSymbol ContentSymbol ItemKind
','
  , iname :: Text
iname    = Text
"armored skin"
  , ifreq :: Freqs ItemKind
ifreq    = [(GroupName ItemKind
S_ARMORED_SKIN, Int
1)]
  , iflavour :: [Flavour]
iflavour = [Color] -> [Flavour]
zipPlain [Color
Red]
  , icount :: Dice
icount   = Dice
1
  , irarity :: Rarity
irarity  = [(Double
1, Int
1)]
  , iverbHit :: Text
iverbHit = Text
"bash"
  , iweight :: Int
iweight  = Int
2000
  , idamage :: Dice
idamage  = Dice
0
  , iaspects :: [Aspect]
iaspects = [ Skill -> Dice -> Aspect
AddSkill Skill
SkArmorMelee Dice
30, Skill -> Dice -> Aspect
AddSkill Skill
SkArmorRanged Dice
15
               , Flag -> Aspect
SetFlag Flag
Durable ]
  , ieffects :: [Effect]
ieffects = []
  , idesc :: Text
idesc    = Text
"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    = Text
"bark"
  , ifreq :: Freqs ItemKind
ifreq    = [(GroupName ItemKind
S_BARK, Int
1)]
  , idesc :: Text
idesc    = Text
""
  }

-- * Sense organs

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

-- * Assorted

rattleOrgan :: ItemKind
rattleOrgan = ItemKind
armoredSkin
  { iname :: Text
iname    = Text
"rattle"
  , ifreq :: Freqs ItemKind
ifreq    = [(GroupName ItemKind
S_RATLLE, Int
1)]
  , iverbHit :: Text
iverbHit = Text
"announce"
  , iaspects :: [Aspect]
iaspects = [ Dice -> Aspect
Timeout (Dice -> Aspect) -> Dice -> Aspect
forall a b. (a -> b) -> a -> b
$ Dice
10 Dice -> Dice -> Dice
forall a. Num a => a -> a -> a
+ (Int
1 Int -> Int -> Dice
`d` Int
3) Dice -> Dice -> Dice
forall a. Num a => a -> a -> a
* Dice
10  -- long, to limit spam
               , Flag -> Aspect
SetFlag Flag
Periodic, Flag -> Aspect
SetFlag Flag
Durable ]
  , ieffects :: [Effect]
ieffects = [Effect
Yell, Int -> Effect
RefillCalm Int
5]
  , idesc :: Text
idesc    = Text
""
  }
insectMortality :: ItemKind
insectMortality = ItemKind
armoredSkin
  { iname :: Text
iname    = Text
"insect mortality"
  , ifreq :: Freqs ItemKind
ifreq    = [(GroupName ItemKind
S_INSECT_MORTALITY, Int
1)]
  , iverbHit :: Text
iverbHit = Text
"age"
  , iaspects :: [Aspect]
iaspects = [ Skill -> Dice -> Aspect
AddSkill Skill
SkAggression Dice
2  -- try to attack before you die
               , Dice -> Aspect
Timeout (Dice -> Aspect) -> Dice -> Aspect
forall a b. (a -> b) -> a -> b
$ Dice
30 Dice -> Dice -> Dice
forall a. Num a => a -> a -> a
+ (Int
1 Int -> Int -> Dice
`d` Int
3) Dice -> Dice -> Dice
forall a. Num a => a -> a -> a
* Dice
10  -- die very slowly
               , Flag -> Aspect
SetFlag Flag
Periodic, Flag -> Aspect
SetFlag Flag
Durable ]
  , ieffects :: [Effect]
ieffects = [Int -> Effect
RefillHP (-Int
1), Effect
Yell]
  , idesc :: Text
idesc    = Text
""
  }
sapientBrain :: ItemKind
sapientBrain = ItemKind
armoredSkin
  { iname :: Text
iname    = Text
"sapient brain"
  , ifreq :: Freqs ItemKind
ifreq    = [(GroupName ItemKind
S_SAPIENT_BRAIN, Int
1)]
  , iverbHit :: Text
iverbHit = Text
"outbrain"
  , iaspects :: [Aspect]
iaspects = [Skill -> Dice -> Aspect
AddSkill Skill
sk Dice
1 | Skill
sk <- [Skill
SkMove .. Skill
SkApply]]
               [Aspect] -> [Aspect] -> [Aspect]
forall a. [a] -> [a] -> [a]
++ [Skill -> Dice -> Aspect
AddSkill Skill
SkMove Dice
4]  -- can move at once when waking up
               [Aspect] -> [Aspect] -> [Aspect]
forall a. [a] -> [a] -> [a]
++ [Skill -> Dice -> Aspect
AddSkill Skill
SkAlter Dice
4]  -- can use all stairs; dig rubble, ice
               [Aspect] -> [Aspect] -> [Aspect]
forall a. [a] -> [a] -> [a]
++ [Skill -> Dice -> Aspect
AddSkill Skill
SkWait Dice
2]  -- can brace and sleep
               [Aspect] -> [Aspect] -> [Aspect]
forall a. [a] -> [a] -> [a]
++ [Skill -> Dice -> Aspect
AddSkill Skill
SkApply Dice
1]  -- can use most items, not just foods
               [Aspect] -> [Aspect] -> [Aspect]
forall a. [a] -> [a] -> [a]
++ [Flag -> Aspect
SetFlag Flag
Durable]
  , idesc :: Text
idesc    = Text
""
  }
animalBrain :: ItemKind
animalBrain = ItemKind
armoredSkin
  { iname :: Text
iname    = Text
"animal brain"
  , ifreq :: Freqs ItemKind
ifreq    = [(GroupName ItemKind
S_ANIMAL_BRAIN, Int
1)]
  , iverbHit :: Text
iverbHit = Text
"blank"
  , iaspects :: [Aspect]
iaspects = [Skill -> Dice -> Aspect
AddSkill Skill
sk Dice
1 | Skill
sk <- [Skill
SkMove .. Skill
SkApply]]
               [Aspect] -> [Aspect] -> [Aspect]
forall a. [a] -> [a] -> [a]
++ [Skill -> Dice -> Aspect
AddSkill Skill
SkMove Dice
4]  -- can move at once when waking up
               [Aspect] -> [Aspect] -> [Aspect]
forall a. [a] -> [a] -> [a]
++ [Skill -> Dice -> Aspect
AddSkill Skill
SkAlter Dice
2]  -- can use normal stairs; can't dig
               [Aspect] -> [Aspect] -> [Aspect]
forall a. [a] -> [a] -> [a]
++ [Skill -> Dice -> Aspect
AddSkill Skill
SkWait Dice
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 (-Dice
1)]  -- no melee tactics
               [Aspect] -> [Aspect] -> [Aspect]
forall a. [a] -> [a] -> [a]
++ [Skill -> Dice -> Aspect
AddSkill Skill
SkMoveItem (-Dice
1)]  -- no item gathering
               [Aspect] -> [Aspect] -> [Aspect]
forall a. [a] -> [a] -> [a]
++ [Skill -> Dice -> Aspect
AddSkill Skill
SkProject (-Dice
1)]  -- nor item flinging
               [Aspect] -> [Aspect] -> [Aspect]
forall a. [a] -> [a] -> [a]
++ [Flag -> Aspect
SetFlag Flag
Durable]
  , idesc :: Text
idesc    = Text
""
  }
speedGland :: Int -> GroupName ItemKind -> ItemKind
speedGland :: Int -> GroupName ItemKind -> ItemKind
speedGland Int
n GroupName ItemKind
grp = ItemKind
armoredSkin
  { isymbol :: ContentSymbol ItemKind
isymbol  = ContentSymbol ItemKind
symbolWand
  , iname :: Text
iname    = Text
"speed gland"
  , ifreq :: Freqs ItemKind
ifreq    = [(GroupName ItemKind
grp, Int
1)]
  , iverbHit :: Text
iverbHit = Text
"spit at"
  , iaspects :: [Aspect]
iaspects = [ Dice -> Aspect
Timeout (Dice -> Aspect) -> Dice -> Aspect
forall a b. (a -> b) -> a -> b
$ Int -> Dice
intToDice (Int
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
               , Flag -> Aspect
SetFlag Flag
Periodic, Flag -> Aspect
SetFlag Flag
Durable ]
  , ieffects :: [Effect]
ieffects = [Int -> Effect
RefillHP Int
1]
  , idesc :: Text
idesc    = Text
""
  }
speedGland5 :: ItemKind
speedGland5 = Int -> GroupName ItemKind -> ItemKind
speedGland Int
5 GroupName ItemKind
S_SPEED_GLAND_5
speedGland10 :: ItemKind
speedGland10 = Int -> GroupName ItemKind -> ItemKind
speedGland Int
10 GroupName ItemKind
S_SPEED_GLAND_10
scentGland :: ItemKind
scentGland = ItemKind
armoredSkin
  { isymbol :: ContentSymbol ItemKind
isymbol  = ContentSymbol ItemKind
symbolWand
  , iname :: Text
iname    = Text
"scent gland"
  , ifreq :: Freqs ItemKind
ifreq    = [(GroupName ItemKind
S_SCENT_GLAND, Int
1)]
  , icount :: Dice
icount   = Dice
10 Dice -> Dice -> Dice
forall a. Num a => a -> a -> a
+ Int
1 Int -> Int -> Dice
`d` Int
3  -- runs out
  , iverbHit :: Text
iverbHit = Text
"spray at"
  , iaspects :: [Aspect]
iaspects = [ Dice -> Aspect
Timeout (Dice -> Aspect) -> Dice -> Aspect
forall a b. (a -> b) -> a -> b
$ (Int
1 Int -> Int -> Dice
`d` Int
3) Dice -> Dice -> Dice
forall a. Num a => a -> a -> a
* Dice
10
               , Flag -> Aspect
SetFlag Flag
Periodic, Flag -> Aspect
SetFlag Flag
Fragile ]  -- not Durable
  , ieffects :: [Effect]
ieffects = [ Text -> Text -> Effect
VerbNoLonger Text
"look spent" Text
"."
               , 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    = Text
""
  }
sulfurVent :: ItemKind
sulfurVent = ItemKind
armoredSkin
  { isymbol :: ContentSymbol ItemKind
isymbol  = ContentSymbol ItemKind -> ContentSymbol ItemKind
forall c. ContentSymbol ItemKind -> ContentSymbol ItemKind
toContentSymbol ContentSymbol ItemKind
'v'
  , iname :: Text
iname    = Text
"vent"
  , ifreq :: Freqs ItemKind
ifreq    = [(GroupName ItemKind
S_SULFUR_VENT, Int
1)]
  , iflavour :: [Flavour]
iflavour = [Color] -> [Flavour]
zipPlain [Color
BrYellow]
  , iverbHit :: Text
iverbHit = Text
"menace"
  , iaspects :: [Aspect]
iaspects = [ Dice -> Aspect
Timeout (Dice -> Aspect) -> Dice -> Aspect
forall a b. (a -> b) -> a -> b
$ (Dice
2 Dice -> Dice -> Dice
forall a. Num a => a -> a -> a
+ Int
1 Int -> Int -> Dice
`d` Int
3) Dice -> Dice -> Dice
forall a. Num a => a -> a -> a
* Dice
5
               , Flag -> Aspect
SetFlag Flag
Periodic, Flag -> Aspect
SetFlag Flag
Durable ]
  , ieffects :: [Effect]
ieffects = [Int -> Effect
RefillHP Int
2, GroupName ItemKind -> Effect
Explode GroupName ItemKind
S_DENSE_SHOWER]
  , idesc :: Text
idesc    = Text
""
  }
boilingVent :: ItemKind
boilingVent = ItemKind
armoredSkin
  { isymbol :: ContentSymbol ItemKind
isymbol  = ContentSymbol ItemKind -> ContentSymbol ItemKind
forall c. ContentSymbol ItemKind -> ContentSymbol ItemKind
toContentSymbol ContentSymbol ItemKind
'v'
  , iname :: Text
iname    = Text
"vent"
  , ifreq :: Freqs ItemKind
ifreq    = [(GroupName ItemKind
S_BOILING_VENT, Int
1)]
  , iflavour :: [Flavour]
iflavour = [Color] -> [Flavour]
zipPlain [Color
Blue]
  , iverbHit :: Text
iverbHit = Text
"menace"
  , iaspects :: [Aspect]
iaspects = [ Dice -> Aspect
Timeout (Dice -> Aspect) -> Dice -> Aspect
forall a b. (a -> b) -> a -> b
$ (Dice
2 Dice -> Dice -> Dice
forall a. Num a => a -> a -> a
+ Int
1 Int -> Int -> Dice
`d` Int
3) Dice -> Dice -> Dice
forall a. Num a => a -> a -> a
* Dice
5
               , Flag -> Aspect
SetFlag Flag
Periodic, Flag -> Aspect
SetFlag Flag
Durable ]
  , ieffects :: [Effect]
ieffects = [Int -> Effect
RefillHP Int
2, GroupName ItemKind -> Effect
Explode GroupName ItemKind
S_BOILING_WATER]
  , idesc :: Text
idesc    = Text
""
  }
arsenicVent :: ItemKind
arsenicVent = ItemKind
armoredSkin
  { isymbol :: ContentSymbol ItemKind
isymbol  = ContentSymbol ItemKind -> ContentSymbol ItemKind
forall c. ContentSymbol ItemKind -> ContentSymbol ItemKind
toContentSymbol ContentSymbol ItemKind
'v'
  , iname :: Text
iname    = Text
"vent"
  , ifreq :: Freqs ItemKind
ifreq    = [(GroupName ItemKind
S_ARSENIC_VENT, Int
1)]
  , iflavour :: [Flavour]
iflavour = [Color] -> [Flavour]
zipPlain [Color
Cyan]
  , iverbHit :: Text
iverbHit = Text
"menace"
  , iaspects :: [Aspect]
iaspects = [ Dice -> Aspect
Timeout (Dice -> Aspect) -> Dice -> Aspect
forall a b. (a -> b) -> a -> b
$ (Dice
2 Dice -> Dice -> Dice
forall a. Num a => a -> a -> a
+ Int
1 Int -> Int -> Dice
`d` Int
3) Dice -> Dice -> Dice
forall a. Num a => a -> a -> a
* Dice
5
               , Flag -> Aspect
SetFlag Flag
Periodic, Flag -> Aspect
SetFlag Flag
Durable ]
  , ieffects :: [Effect]
ieffects = [Int -> Effect
RefillHP Int
2, GroupName ItemKind -> Effect
Explode GroupName ItemKind
S_SPARSE_SHOWER]
  , idesc :: Text
idesc    = Text
""
  }

-- * Special

bonusHP :: ItemKind
bonusHP = ItemKind
armoredSkin
  { isymbol :: ContentSymbol ItemKind
isymbol  = ContentSymbol ItemKind -> ContentSymbol ItemKind
forall c. ContentSymbol ItemKind -> ContentSymbol ItemKind
toContentSymbol ContentSymbol ItemKind
'H'  -- '+' reserved for conditions
  , iname :: Text
iname    = Text
"bonus HP"
  , ifreq :: Freqs ItemKind
ifreq    = [(GroupName ItemKind
S_BONUS_HP, Int
1)]
  , iflavour :: [Flavour]
iflavour = [Color] -> [Flavour]
zipPlain [Color
BrBlue]
  , iverbHit :: Text
iverbHit = Text
"intimidate"
  , iweight :: Int
iweight  = Int
0
  , iaspects :: [Aspect]
iaspects = [Skill -> Dice -> Aspect
AddSkill Skill
SkMaxHP Dice
1]
  , idesc :: Text
idesc    = Text
"Growing up in a privileged background gave you the training and the discrete garment accessories that improve your posture and resilience."
  }
braced :: ItemKind
braced = ItemKind
armoredSkin
  { isymbol :: ContentSymbol ItemKind
isymbol  = ContentSymbol ItemKind -> ContentSymbol ItemKind
forall c. ContentSymbol ItemKind -> ContentSymbol ItemKind
toContentSymbol ContentSymbol ItemKind
'B'
  , iname :: Text
iname    = Text
"braced"
  , ifreq :: Freqs ItemKind
ifreq    = [(GroupName ItemKind
S_BRACED, Int
1)]
  , iflavour :: [Flavour]
iflavour = [Color] -> [Flavour]
zipPlain [Color
BrGreen]
  , iverbHit :: Text
iverbHit = Text
"brace"
  , iweight :: Int
iweight  = Int
0
  , iaspects :: [Aspect]
iaspects = [ Skill -> Dice -> Aspect
AddSkill Skill
SkArmorMelee Dice
50, Skill -> Dice -> Aspect
AddSkill Skill
SkArmorRanged Dice
25
               , Skill -> Dice -> Aspect
AddSkill Skill
SkHearing Dice
10
               , Flag -> Aspect
SetFlag Flag
Condition ] -- hack: display as condition
  , idesc :: Text
idesc    = Text
"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 :: ContentSymbol ItemKind
isymbol  = ContentSymbol ItemKind -> ContentSymbol ItemKind
forall c. ContentSymbol ItemKind -> ContentSymbol ItemKind
toContentSymbol ContentSymbol ItemKind
'S'
  , iname :: Text
iname    = Text
"asleep"
  , ifreq :: Freqs ItemKind
ifreq    = [(GroupName ItemKind
S_ASLEEP, Int
1)]
  , iflavour :: [Flavour]
iflavour = [Color] -> [Flavour]
zipPlain [Color
BrGreen]  -- regenerates HP (very slowly)
  , icount :: Dice
icount   = Dice
5
  , iverbHit :: Text
iverbHit = Text
"slay"
  , iweight :: Int
iweight  = Int
0
  , iaspects :: [Aspect]
iaspects = [Skill -> Dice -> Aspect
AddSkill Skill
sk (-Dice
1) | Skill
sk <- [Skill
SkMove .. Skill
SkApply]]
               [Aspect] -> [Aspect] -> [Aspect]
forall a. [a] -> [a] -> [a]
++ [ Skill -> Dice -> Aspect
AddSkill Skill
SkMelee Dice
1, Skill -> Dice -> Aspect
AddSkill Skill
SkAlter Dice
1, Skill -> Dice -> Aspect
AddSkill Skill
SkWait Dice
1
                  , Skill -> Dice -> Aspect
AddSkill Skill
SkSight (-Dice
3), Skill -> Dice -> Aspect
AddSkill Skill
SkArmorMelee (-Dice
10)
                  , Flag -> Aspect
SetFlag Flag
Condition ]  -- hack: display as condition
  , idesc :: Text
idesc    = Text
"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 :: ContentSymbol ItemKind
isymbol  = ContentSymbol ItemKind -> ContentSymbol ItemKind
forall c. ContentSymbol ItemKind -> ContentSymbol ItemKind
toContentSymbol ContentSymbol ItemKind
'I'
  , iname :: Text
iname    = Text
"impressed"  -- keep the same as in @ifreq@, to simplify code
  , ifreq :: Freqs ItemKind
ifreq    = [(GroupName ItemKind
S_IMPRESSED, Int
1), (GroupName ItemKind
CONDITION, Int
1)]
  , iflavour :: [Flavour]
iflavour = [Color] -> [Flavour]
zipPlain [Color
BrRed]
  , iverbHit :: Text
iverbHit = Text
"confuse"
  , iweight :: Int
iweight  = Int
0
  , iaspects :: [Aspect]
iaspects = [ Skill -> Dice -> Aspect
AddSkill Skill
SkMaxCalm (-Dice
1)  -- to help player notice on HUD
                                          -- and to count as bad condition
               , 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 Text
"impressed"
               , Effect -> Effect
OnSmash (Effect -> Effect) -> Effect -> Effect
forall a b. (a -> b) -> a -> b
$ Text -> Effect
verbMsgNoLonger Text
"impressed" ]
                   -- not periodic, so no wear each turn, so only @OnSmash@
  , idesc :: Text
idesc    = Text
"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."
  }

-- * LH-specific

tooth :: ItemKind
tooth = ItemKind
fist
  { iname :: Text
iname    = Text
"tooth"
  , ifreq :: Freqs ItemKind
ifreq    = [(GroupName ItemKind
S_TOOTH, Int
1)]
  , icount :: Dice
icount   = Dice
3
  , iverbHit :: Text
iverbHit = Text
"nail"
  , idamage :: Dice
idamage  = Int
2 Int -> Int -> Dice
`d` Int
1
  , idesc :: Text
idesc    = Text
""
  }
lash :: ItemKind
lash = ItemKind
fist
  { iname :: Text
iname    = Text
"lash"
  , ifreq :: Freqs ItemKind
ifreq    = [(GroupName ItemKind
S_LASH, Int
1)]
  , icount :: Dice
icount   = Dice
1
  , iverbHit :: Text
iverbHit = Text
"lash"
  , idamage :: Dice
idamage  = Int
3 Int -> Int -> Dice
`d` Int
1
  , idesc :: Text
idesc    = Text
""
  }
torsionRight :: ItemKind
torsionRight = ItemKind
fist
  { iname :: Text
iname    = Text
"right torsion"
  , ifreq :: Freqs ItemKind
ifreq    = [(GroupName ItemKind
S_RIGHT_TORSION, Int
1)]
  , icount :: Dice
icount   = Dice
1
  , iverbHit :: Text
iverbHit = Text
"twist"
  , idamage :: Dice
idamage  = Int
13 Int -> Int -> Dice
`d` Int
1
  , iaspects :: [Aspect]
iaspects = [Dice -> Aspect
Timeout (Dice -> Aspect) -> Dice -> Aspect
forall a b. (a -> b) -> a -> b
$ Dice
5 Dice -> Dice -> Dice
forall a. Num a => a -> a -> a
+ Int
1 Int -> Int -> Dice
`d` Int
5, Skill -> Dice -> Aspect
AddSkill Skill
SkHurtMelee Dice
20]
               [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 (Dice
3 Dice -> Dice -> Dice
forall a. Num a => a -> a -> a
+ Int
1 Int -> Int -> Dice
`d` Int
3)]
  , idesc :: Text
idesc    = Text
""
  }
torsionLeft :: ItemKind
torsionLeft = ItemKind
fist
  { iname :: Text
iname    = Text
"left torsion"
  , ifreq :: Freqs ItemKind
ifreq    = [(GroupName ItemKind
S_LEFT_TORSION, Int
1)]
  , icount :: Dice
icount   = Dice
1
  , iverbHit :: Text
iverbHit = Text
"untwist"
  , idamage :: Dice
idamage  = Int
13 Int -> Int -> Dice
`d` Int
1
  , iaspects :: [Aspect]
iaspects = [Dice -> Aspect
Timeout (Dice -> Aspect) -> Dice -> Aspect
forall a b. (a -> b) -> a -> b
$ Dice
5 Dice -> Dice -> Dice
forall a. Num a => a -> a -> a
+ Int
1 Int -> Int -> Dice
`d` Int
5, Skill -> Dice -> Aspect
AddSkill Skill
SkHurtMelee Dice
20]
               [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 (Dice
3 Dice -> Dice -> Dice
forall a. Num a => a -> a -> a
+ Int
1 Int -> Int -> Dice
`d` Int
3)]
  , idesc :: Text
idesc    = Text
""
  }
pupil :: ItemKind
pupil = ItemKind
fist
  { iname :: Text
iname    = Text
"pupil"
  , ifreq :: Freqs ItemKind
ifreq    = [(GroupName ItemKind
S_PUPIL, Int
1)]
  , icount :: Dice
icount   = Dice
1
  , iverbHit :: Text
iverbHit = Text
"gaze at"
  , idamage :: Dice
idamage  = Int
1 Int -> Int -> Dice
`d` Int
1
  , iaspects :: [Aspect]
iaspects = [Skill -> Dice -> Aspect
AddSkill Skill
SkSight Dice
12, Dice -> Aspect
Timeout Dice
12]
               [Aspect] -> [Aspect] -> [Aspect]
forall a. [a] -> [a] -> [a]
++ ItemKind -> [Aspect]
iaspects ItemKind
fist
  , ieffects :: [Effect]
ieffects = [Int -> Int -> CStore -> GroupName ItemKind -> Effect
DropItem Int
1 Int
forall a. Bounded a => a
maxBound CStore
COrgan GroupName ItemKind
CONDITION, Int -> Effect
RefillCalm (-Int
10)]
                 -- can be useful for the player, but Calm drain is a risk
  , idesc :: Text
idesc    = Text
""
  }