-- | 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 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

import Content.ItemKindBlast
import Content.ItemKindTemporary
import Content.RuleKind

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

pattern $mSCAVENGER :: forall {r}. GroupName ItemKind -> ((# #) -> r) -> ((# #) -> r) -> r
$bSCAVENGER :: GroupName ItemKind
SCAVENGER = GroupName "scavenger"

-- * LH-specific
pattern $mS_TOOTH :: forall {r}. GroupName ItemKind -> ((# #) -> r) -> ((# #) -> r) -> r
$bS_TOOTH :: GroupName ItemKind
S_TOOTH = GroupName "tooth"
pattern $mS_LASH :: forall {r}. GroupName ItemKind -> ((# #) -> r) -> ((# #) -> r) -> r
$bS_LASH :: GroupName ItemKind
S_LASH = GroupName "lash"
pattern $mS_RIGHT_TORSION :: forall {r}. GroupName ItemKind -> ((# #) -> r) -> ((# #) -> r) -> r
$bS_RIGHT_TORSION :: GroupName ItemKind
S_RIGHT_TORSION = GroupName "right torsion"
pattern $mS_LEFT_TORSION :: forall {r}. GroupName ItemKind -> ((# #) -> r) -> ((# #) -> r) -> r
$bS_LEFT_TORSION :: GroupName ItemKind
S_LEFT_TORSION = GroupName "left torsion"
pattern $mS_PUPIL :: forall {r}. GroupName ItemKind -> ((# #) -> r) -> ((# #) -> r) -> r
$bS_PUPIL :: GroupName ItemKind
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  = symbolWand
  , iname    = "thorn"
  , ifreq    = [(S_THORN, 1)]
  , icount   = 2 + 1 `d` 2  -- unrealistic, but not boring
  , iverbHit = "puncture"
  , idamage  = 2 `d` 1
  , iaspects = [SetFlag Meleeable]  -- not Durable
  , ieffects = [VerbNoLonger "be not so thorny any more" "."]
  , idesc    = "Sharp yet brittle."
  }
tip :: ItemKind
tip = ItemKind
fist
  { iname    = "tip"
  , ifreq    = [(S_TIP, 1)]
  , icount   = 1
  , iverbHit = "poke"
  , idamage  = 2 `d` 1
  , idesc    = ""
  }
fist :: ItemKind
fist = ItemKind
  { isymbol :: ContentSymbol ItemKind
isymbol  = ContentSymbol ItemKind -> ContentSymbol ItemKind
forall c. ContentSymbol ItemKind -> ContentSymbol ItemKind
toContentSymbol ContentSymbol ItemKind
','
  , iname :: Text
iname    = Text
"fist"
  , ifreq :: [(GroupName ItemKind, Int)]
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    = "foot"
  , ifreq    = [(S_FOOT, 1)]
  , iverbHit = "kick"
  , idamage  = 4 `d` 1
  , idesc    = "A weapon you can still use if disarmed."
                 -- great example of tutorial hints inside a flavourful text
  }
smallClaw :: ItemKind
smallClaw = ItemKind
fist
  { iname    = "small claw"
  , ifreq    = [(S_SMALL_CLAW, 1)]
  , iverbHit = "slash"
  , idamage  = 2 `d` 1
  , idesc    = "A pearly spike."
  }
snout :: ItemKind
snout = ItemKind
fist
  { iname    = "snout"
  , ifreq    = [(S_SNOUT, 1)]
  , icount   = 1
  , iverbHit = "bite"
  , idamage  = 2 `d` 1
  , idesc    = "Sensitive and wide-nostrilled."
  }
smallJaw :: ItemKind
smallJaw = ItemKind
fist
  { iname    = "small jaw"
  , ifreq    = [(S_SMALL_JAW, 1)]
  , icount   = 1
  , iverbHit = "rip"
  , idamage  = 3 `d` 1
  , idesc    = "Filled with small, even teeth."
  }

-- * Cooldown melee damage organs without effects

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

-- * Direct damage organs with effects

beeSting :: ItemKind
beeSting = ItemKind
fist
  { isymbol  = symbolWand
  , iname    = "bee sting"
  , ifreq    = [(S_BEE_STING, 1)]
  , icount   = 1
  , iverbHit = "sting"
  , idamage  = 0
  , iaspects = [ AddSkill SkArmorMelee 200, AddSkill SkArmorRanged 45
               , SetFlag Meleeable ]  -- not Durable
  , ieffects = [Paralyze 6, RefillHP 4]
                 -- no special message when runs out, because it's 1 copy
  , idesc    = "Painful, but beneficial."
  }
sting :: ItemKind
sting = ItemKind
fist
  { isymbol  = symbolWand
  , iname    = "sting"
  , ifreq    = [(S_STING, 1)]
  , icount   = 1
  , iverbHit = "inject"
  , idamage  = 1 `d` 1
  , iaspects = [Timeout $ 10 - 1 `dL` 4, AddSkill SkHurtMelee 40]
               ++ iaspects fist
  , ieffects = [toOrganBad S_RETAINING (3 + 1 `d` 3)]
  , idesc    = "Painful, debilitating and harmful."
  }
lip :: ItemKind
lip = ItemKind
fist
  { iname    = "lip"
  , ifreq    = [(S_LIP, 1)]
  , icount   = 1
  , iverbHit = "lap"
  , idamage  = 1 `d` 1
  , iaspects = Timeout (3 + 1 `d` 2)
               : iaspects fist
  , ieffects = [toOrganBad S_WEAKENED (2 + 1 `dL` 3)]
  , idesc    = ""
  }
venomTooth :: ItemKind
venomTooth = ItemKind
fist
  { isymbol  = symbolWand
  , iname    = "venom tooth"
  , ifreq    = [(S_VENOM_TOOTH, 1)]
  , iverbHit = "bite"
  , idamage  = 1 `d` 1
  , iaspects = Timeout (7 - 1 `dL` 3)
               : iaspects fist
  , ieffects = [toOrganBad S_SLOWED (3 + 1 `d` 3)]
  , idesc    = "A chilling numbness spreads from its bite."
  }
hookedClaw :: ItemKind
hookedClaw = ItemKind
fist
  { isymbol  = symbolWand
  , iname    = "hooked claw"
  , ifreq    = [(S_HOOKED_CLAW, 1)]
  , icount   = 2  -- even if more, only the fore claws used for fighting
  , iverbHit = "hook"
  , idamage  = 2 `d` 1
  , iaspects = Timeout (12 - 1 `dL` 3)
               : iaspects fist
  , ieffects = [toOrganBad S_SLOWED 2]
  , idesc    = "A curved talon."
  }
screechingBeak :: ItemKind
screechingBeak = ItemKind
fist
  { isymbol  = symbolWand
  , iname    = "screeching beak"
  , ifreq    = [(S_SCREECHING_BEAK, 1)]
  , icount   = 1
  , iverbHit = "peck"
  , idamage  = 3 `d` 1
  , iaspects = Timeout (7 - 1 `dL` 3)
               : iaspects fist
  , ieffects = [Summon SCAVENGER $ 1 `dL` 3]
  , idesc    = "Both a weapon and a beacon, calling more scavengers to the meal."
  }
antler :: ItemKind
antler = ItemKind
fist
  { isymbol  = symbolWand
  , iname    = "antler"
  , ifreq    = [(S_ANTLER, 1)]
  , iverbHit = "ram"
  , idamage  = 4 `d` 1
  , iaspects = [ Timeout $ 3 + (1 `d` 3) * 3
               , AddSkill SkArmorMelee 10 ]  -- bonus doubled
               ++ iaspects fist
  , ieffects = [PushActor (ThrowMod 100 50 1)]  -- 1 step, slow
  , idesc    = ""
  }
rhinoHorn :: ItemKind
rhinoHorn = ItemKind
fist
  { isymbol  = symbolWand
  , iname    = "ugly horn"  -- made of keratin, unlike real horns
  , ifreq    = [(S_RHINO_HORN, 1)]
  , icount   = 1  -- single, unlike real horns
  , iverbHit = "gore"
  , idamage  = 5 `d` 1
  , iaspects = [Timeout 5, AddSkill SkHurtMelee 20]
               ++ iaspects fist
  , ieffects = [Impress, Yell]  -- the owner is a mid-boss, after all
  , idesc    = "Very solid, considering it has the same composition as fingernails."
  }
largeTail :: ItemKind
largeTail = ItemKind
fist
  { isymbol  = symbolWand
  , iname    = "large tail"
  , ifreq    = [(S_LARGE_TAIL, 1)]
  , icount   = 1
  , iverbHit = "knock"
  , idamage  = 7 `d` 1
  , iaspects = [Timeout $ 2 + 1 `d` 2, AddSkill SkHurtMelee 20]
               ++ iaspects fist
                 -- timeout higher, lest they regain push before closing again
  , ieffects = [PushActor (ThrowMod 200 50 1)]  -- 1 step, fast
  , idesc    = "Almost as long as the trunk."
  }
hugeTail :: ItemKind
hugeTail = ItemKind
largeTail
  { isymbol  = symbolWand
  , iname    = "huge tail"
  , ifreq    = [(S_HUGE_TAIL, 1)]
  , iverbHit = "upend"
  , iaspects = [Timeout $ 3 + 1 `d` 2, AddSkill SkHurtMelee 20]
               ++ iaspects fist
                 -- timeout higher, lest they regain push before closing again
  , ieffects = [PushActor (ThrowMod 400 50 1)]  -- 2 steps, fast
  , idesc    = "Slow but immensely heavy."
  }

-- * Melee weapons without direct damage

venomFang :: ItemKind
venomFang = ItemKind
fist
  { isymbol  = symbolWand
  , iname    = "venom fang"
  , ifreq    = [(S_VENOM_FANG, 1)]
  , iverbHit = "bite"
  , idamage  = 0
  , iaspects = Timeout (10 - 1 `dL` 5)
               : iaspects fist
  , ieffects = [toOrganNoTimer S_POISONED]
  , idesc    = "Dripping with deadly venom."
  }

-- * Special melee weapons

sulfurFissure :: ItemKind
sulfurFissure = ItemKind
boilingFissure
  { iname    = "fissure"
  , ifreq    = [(S_SULFUR_FISSURE, 1)]
  , icount   = 2 + 1 `d` 2
  , idamage  = 0  -- heal not via (negative) idamage, for armour would block it
  , iaspects = SetFlag Benign : iaspects boilingFissure
  , ieffects = [ RefillHP 5
               , VerbNoLonger "run out of the healing fumes" "."]
  , idesc    = ""
  }
boilingFissure :: ItemKind
boilingFissure = ItemKind
fist
  { isymbol  = symbolWand
  , iname    = "fissure"
  , ifreq    = [(S_BOILING_FISSURE, 1)]
  , icount   = 5 + 1 `d` 5
  , iverbHit = "hiss at"
  , idamage  = 1 `d` 1
  , iaspects = [ AddSkill SkHurtMelee 20  -- decreasing as count decreases
               , SetFlag Meleeable ]  -- not Durable
  , ieffects = [ DropItem 1 1 COrgan CONDITION  -- useful; limited
               , VerbNoLonger "widen the crack, releasing pressure" "."]
  , idesc    = "A deep crack to the underworld."
  }
arsenicFissure :: ItemKind
arsenicFissure = ItemKind
boilingFissure
  { iname    = "fissure"
  , ifreq    = [(S_ARSENIC_FISSURE, 1)]
  , icount   = 3 + 1 `d` 3
  , idamage  = 2 `d` 1
  , ieffects = [ toOrganBad S_PARSIMONIOUS (5 + 1 `d` 3)
               -- weaken/poison, impacting intellectual abilities first
               , VerbNoLonger "stop exuding stupefying vapours" "."]
  , idesc    = ""
  }

-- * Armor organs

armoredSkin :: ItemKind
armoredSkin = 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 :: [(GroupName ItemKind, Int)]
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    = "bark"
  , ifreq    = [(S_BARK, 1)]
  , idesc    = ""
  }

-- * Sense organs

eye :: Int -> GroupName ItemKind -> ItemKind
eye :: Int -> GroupName ItemKind -> ItemKind
eye Int
n GroupName ItemKind
grp = ItemKind
armoredSkin
  { iname    = "eye"
  , ifreq    = [(grp, 1)]
  , icount   = 2
  , iverbHit = "glare at"
  , iaspects = [ AddSkill SkSight (intToDice n)
               , SetFlag Durable ]
  , idesc    = "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    = "vision"
  , ifreq    = [(grp, 1)]
  , iverbHit = "visualize"
  , iaspects = [ AddSkill SkSight (intToDice n)
               , SetFlag Durable ]
  , idesc    = ""
  }
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    = "nostril"
  , ifreq    = [(S_NOSTRIL, 1)]
  , icount   = 2
  , iverbHit = "snuff"
  , iaspects = [ AddSkill SkSmell 1  -- times 2, from icount
               , SetFlag Durable ]
  , idesc    = ""
  }
ear :: Int -> GroupName ItemKind -> ItemKind
ear :: Int -> GroupName ItemKind -> ItemKind
ear Int
n GroupName ItemKind
grp = ItemKind
armoredSkin
  { iname    = "ear"
  , ifreq    = [(grp, 1)]
  , icount   = 2
  , iverbHit = "overhear"
  , iaspects = [ AddSkill SkHearing (intToDice n)
               , SetFlag Durable ]
  , idesc    = ""
  }
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    = "rattle"
  , ifreq    = [(S_RATLLE, 1)]
  , iverbHit = "announce"
  , iaspects = [ Timeout $ 10 + (1 `d` 3) * 10  -- long, to limit spam
               , SetFlag Periodic, SetFlag Durable ]
  , ieffects = [Yell, RefillCalm 5]
  , idesc    = ""
  }
insectMortality :: ItemKind
insectMortality = ItemKind
armoredSkin
  { iname    = "insect mortality"
  , ifreq    = [(S_INSECT_MORTALITY, 1)]
  , iverbHit = "age"
  , iaspects = [ AddSkill SkAggression 2  -- try to attack before you die
               , Timeout $ 30 + (1 `d` 3) * 10  -- die very slowly
               , SetFlag Periodic, SetFlag Durable ]
  , ieffects = [RefillHP (-1), Yell]
  , idesc    = ""
  }
sapientBrain :: ItemKind
sapientBrain = ItemKind
armoredSkin
  { iname    = "sapient brain"
  , ifreq    = [(S_SAPIENT_BRAIN, 1)]
  , iverbHit = "outbrain"
  , iaspects = [AddSkill sk 1 | sk <- [SkMove .. SkApply]]
               ++ [AddSkill SkMove 4]  -- can move at once when waking up
               ++ [AddSkill SkAlter 4]  -- can use all stairs; dig rubble, ice
               ++ [AddSkill SkWait 2]  -- can brace and sleep
               ++ [AddSkill SkApply 1]  -- can use most items, not just foods
               ++ [SetFlag Durable]
  , idesc    = ""
  }
animalBrain :: ItemKind
animalBrain = ItemKind
armoredSkin
  { iname    = "animal brain"
  , ifreq    = [(S_ANIMAL_BRAIN, 1)]
  , iverbHit = "blank"
  , iaspects = [AddSkill sk 1 | sk <- [SkMove .. SkApply]]
               ++ [AddSkill SkMove 4]  -- can move at once when waking up
               ++ [AddSkill SkAlter 2]  -- can use normal stairs; can't dig
               ++ [AddSkill 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.
               ++ [AddSkill SkDisplace (-1)]  -- no melee tactics
               ++ [AddSkill SkMoveItem (-1)]  -- no item gathering
               ++ [AddSkill SkProject (-1)]  -- nor item flinging
               ++ [SetFlag Durable]
  , idesc    = ""
  }
speedGland :: Int -> GroupName ItemKind -> ItemKind
speedGland :: Int -> GroupName ItemKind -> ItemKind
speedGland Int
n GroupName ItemKind
grp = ItemKind
armoredSkin
  { isymbol  = symbolWand
  , iname    = "speed gland"
  , ifreq    = [(grp, 1)]
  , iverbHit = "spit at"
  , iaspects = [ Timeout $ intToDice (100 `div` n)
               , AddSkill SkSpeed $ intToDice n
               , SetFlag Periodic, SetFlag Durable ]
  , ieffects = [RefillHP 1]
  , idesc    = ""
  }
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  = symbolWand
  , iname    = "scent gland"
  , ifreq    = [(S_SCENT_GLAND, 1)]
  , icount   = 10 + 1 `d` 3  -- runs out
  , iverbHit = "spray at"
  , iaspects = [ Timeout $ (1 `d` 3) * 10
               , SetFlag Periodic, SetFlag Fragile ]  -- not Durable
  , ieffects = [ VerbNoLonger "look spent" "."
               , ApplyPerfume
               , Explode S_DISTRESSING_ODOR ]
                   -- keep explosion at the end to avoid the ambiguity of
                   -- "of ([foo explosion] of [bar])"
  , idesc    = ""
  }
sulfurVent :: ItemKind
sulfurVent = ItemKind
armoredSkin
  { isymbol  = toContentSymbol 'v'
  , iname    = "vent"
  , ifreq    = [(S_SULFUR_VENT, 1)]
  , iflavour = zipPlain [BrYellow]
  , iverbHit = "menace"
  , iaspects = [ Timeout $ (2 + 1 `d` 3) * 5
               , SetFlag Periodic, SetFlag Durable ]
  , ieffects = [RefillHP 2, Explode S_DENSE_SHOWER]
  , idesc    = ""
  }
boilingVent :: ItemKind
boilingVent = ItemKind
armoredSkin
  { isymbol  = toContentSymbol 'v'
  , iname    = "vent"
  , ifreq    = [(S_BOILING_VENT, 1)]
  , iflavour = zipPlain [Blue]
  , iverbHit = "menace"
  , iaspects = [ Timeout $ (2 + 1 `d` 3) * 5
               , SetFlag Periodic, SetFlag Durable ]
  , ieffects = [RefillHP 2, Explode S_BOILING_WATER]
  , idesc    = ""
  }
arsenicVent :: ItemKind
arsenicVent = ItemKind
armoredSkin
  { isymbol  = toContentSymbol 'v'
  , iname    = "vent"
  , ifreq    = [(S_ARSENIC_VENT, 1)]
  , iflavour = zipPlain [Cyan]
  , iverbHit = "menace"
  , iaspects = [ Timeout $ (2 + 1 `d` 3) * 5
               , SetFlag Periodic, SetFlag Durable ]
  , ieffects = [RefillHP 2, Explode S_SPARSE_SHOWER]
  , idesc    = ""
  }

-- * Special

bonusHP :: ItemKind
bonusHP = ItemKind
armoredSkin
  { isymbol  = toContentSymbol 'H'  -- '+' reserved for conditions
  , iname    = "extra HP"
  , ifreq    = [(S_BONUS_HP, 1)]
  , iflavour = zipPlain [BrBlue]
  , iverbHit = "intimidate"
  , iweight  = 0
  , iaspects = [AddSkill SkMaxHP 1]
  , idesc    = "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  = toContentSymbol 'B'
  , iname    = "braced"
  , ifreq    = [(S_BRACED, 1)]
  , iflavour = zipPlain [BrGreen]
  , iverbHit = "brace"
  , iweight  = 0
  , iaspects = [ AddSkill SkArmorMelee 50, AddSkill SkArmorRanged 25
               , AddSkill SkHearing 10
               , SetFlag Condition ] -- hack: display as condition
  , 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  = toContentSymbol 'S'
  , iname    = "asleep"
  , ifreq    = [(S_ASLEEP, 1)]
  , iflavour = zipPlain [BrGreen]  -- regenerates HP (very slowly)
  , icount   = 5
  , iverbHit = "slay"
  , iweight  = 0
  , iaspects = [AddSkill sk (-1) | sk <- [SkMove .. SkApply]]
               ++ [ AddSkill SkMelee 1, AddSkill SkAlter 1, AddSkill SkWait 1
                  , AddSkill SkSight (-3), AddSkill SkArmorMelee (-10)
                  , SetFlag Condition ]  -- hack: display as condition
  , 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  = toContentSymbol 'I'
  , iname    = "impressed"  -- keep the same as in @ifreq@, to simplify code
  , ifreq    = [(S_IMPRESSED, 1), (CONDITION, 1)]
  , iflavour = zipPlain [BrRed]
  , iverbHit = "confuse"
  , iweight  = 0
  , iaspects = [ AddSkill SkMaxCalm (-1)  -- to help player notice on HUD
                                          -- and to count as bad condition
               , SetFlag Fragile  -- to announce "no longer" only when
                                  -- all copies gone
               , SetFlag Condition ]  -- this is really a condition,
                                      -- just not a timed condition
  , ieffects = [ OnSmash $ verbMsgLess "impressed"
               , OnSmash $ verbMsgNoLonger "impressed" ]
                   -- not periodic, so no wear each turn, so only @OnSmash@
  , 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."
  }

-- * LH-specific

tooth :: ItemKind
tooth = ItemKind
fist
  { iname    = "tooth"
  , ifreq    = [(S_TOOTH, 1)]
  , icount   = 3
  , iverbHit = "nail"
  , idamage  = 2 `d` 1
  , idesc    = ""
  }
lash :: ItemKind
lash = ItemKind
fist
  { iname    = "lash"
  , ifreq    = [(S_LASH, 1)]
  , icount   = 1
  , iverbHit = "lash"
  , idamage  = 3 `d` 1
  , idesc    = ""
  }
torsionRight :: ItemKind
torsionRight = ItemKind
fist
  { iname    = "right torsion"
  , ifreq    = [(S_RIGHT_TORSION, 1)]
  , icount   = 1
  , iverbHit = "twist"
  , idamage  = 13 `d` 1
  , iaspects = [Timeout $ 5 + 1 `d` 5, AddSkill SkHurtMelee 20]
               ++ iaspects fist
  , ieffects = [toOrganBad S_SLOWED (3 + 1 `d` 3)]
  , idesc    = ""
  }
torsionLeft :: ItemKind
torsionLeft = ItemKind
fist
  { iname    = "left torsion"
  , ifreq    = [(S_LEFT_TORSION, 1)]
  , icount   = 1
  , iverbHit = "untwist"
  , idamage  = 13 `d` 1
  , iaspects = [Timeout $ 5 + 1 `d` 5, AddSkill SkHurtMelee 20]
               ++ iaspects fist
  , ieffects = [toOrganBad S_WEAKENED (3 + 1 `d` 3)]
  , idesc    = ""
  }
pupil :: ItemKind
pupil = ItemKind
fist
  { iname    = "pupil"
  , ifreq    = [(S_PUPIL, 1)]
  , icount   = 1
  , iverbHit = "gaze at"
  , idamage  = 1 `d` 1
  , iaspects = [AddSkill SkSight 12, Timeout 12]
               ++ iaspects fist
  , ieffects = [DropItem 1 maxBound COrgan CONDITION, RefillCalm (-10)]
                 -- can be useful for the player, but Calm drain is a risk
  , idesc    = ""
  }