-- Copyright (c) 2008--2011 Andres Loeh
-- Copyright (c) 2010--2021 Mikolaj Konarski and others (see git history)
-- This file is a part of the computer game Allure of the Stars
-- and is released under the terms of the GNU Affero General Public License.
-- For license and copyright information, see the file LICENSE.
--
-- | Item definitions.
module Content.ItemKind
  ( -- * Group name patterns
    pattern HARPOON, pattern ARMOR_LOOSE, pattern CLOTHING_MISC
  , pattern COOKED_PLANT, pattern LIQUID_NITROGEN, pattern GARDENING_TOOL
  , groupNamesSingleton, groupNames
  , -- * Content
    content, items, otherItemContent
  ) where

import Prelude ()

import Game.LambdaHack.Core.Prelude

import Content.ItemKindActor
import Content.ItemKindBlast
import Content.ItemKindEmbed
import Content.ItemKindOrgan
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.Flavour

-- * Group name patterns

groupNamesSingleton :: [GroupName ItemKind]
groupNamesSingleton :: [GroupName ItemKind]
groupNamesSingleton =
       [GroupName ItemKind
S_FRAGRANCE, GroupName ItemKind
S_SINGLE_SPARK, GroupName ItemKind
S_SPARK]
    [GroupName ItemKind]
-> [GroupName ItemKind] -> [GroupName ItemKind]
forall a. [a] -> [a] -> [a]
++ [GroupName ItemKind
FLASK_UNKNOWN, GroupName ItemKind
POTION_UNKNOWN, GroupName ItemKind
EDIBLE_PLANT_UNKNOWN, GroupName ItemKind
SCROLL_UNKNOWN, GroupName ItemKind
NECKLACE_UNKNOWN, GroupName ItemKind
RING_UNKNOWN, GroupName ItemKind
HAMMER_UNKNOWN, GroupName ItemKind
GEM_UNKNOWN, GroupName ItemKind
CURRENCY_UNKNOWN]
    [GroupName ItemKind]
-> [GroupName ItemKind] -> [GroupName ItemKind]
forall a. [a] -> [a] -> [a]
++ [GroupName ItemKind
S_RAG_TANGLE, GroupName ItemKind
S_GRASS_STITCHER, GroupName ItemKind
S_LADIES_FORK, GroupName ItemKind
S_SPADE, GroupName ItemKind
S_HOE]
    [GroupName ItemKind]
-> [GroupName ItemKind] -> [GroupName ItemKind]
forall a. [a] -> [a] -> [a]
++ [GroupName ItemKind
COOKED_PLANT_UNKNOWN]
    [GroupName ItemKind]
-> [GroupName ItemKind] -> [GroupName ItemKind]
forall a. [a] -> [a] -> [a]
++ [GroupName ItemKind]
embedsGNSingleton [GroupName ItemKind]
-> [GroupName ItemKind] -> [GroupName ItemKind]
forall a. [a] -> [a] -> [a]
++ [GroupName ItemKind]
actorsGNSingleton [GroupName ItemKind]
-> [GroupName ItemKind] -> [GroupName ItemKind]
forall a. [a] -> [a] -> [a]
++ [GroupName ItemKind]
organsGNSingleton
    [GroupName ItemKind]
-> [GroupName ItemKind] -> [GroupName ItemKind]
forall a. [a] -> [a] -> [a]
++ [GroupName ItemKind]
blastsGNSingleton [GroupName ItemKind]
-> [GroupName ItemKind] -> [GroupName ItemKind]
forall a. [a] -> [a] -> [a]
++ [GroupName ItemKind]
temporariesGNSingleton

pattern FLASK_UNKNOWN, POTION_UNKNOWN, EDIBLE_PLANT_UNKNOWN, SCROLL_UNKNOWN, NECKLACE_UNKNOWN, RING_UNKNOWN, HAMMER_UNKNOWN, GEM_UNKNOWN, CURRENCY_UNKNOWN :: GroupName ItemKind

pattern S_RAG_TANGLE, S_GRASS_STITCHER, S_LADIES_FORK, S_SPADE, S_HOE :: GroupName ItemKind

pattern COOKED_PLANT_UNKNOWN :: GroupName ItemKind

groupNames :: [GroupName ItemKind]
groupNames :: [GroupName ItemKind]
groupNames =
       [GroupName ItemKind
CRAWL_ITEM, GroupName ItemKind
TREASURE, GroupName ItemKind
ANY_SCROLL, GroupName ItemKind
ANY_GLASS, GroupName ItemKind
ANY_POTION, GroupName ItemKind
ANY_FLASK, GroupName ItemKind
EXPLOSIVE, GroupName ItemKind
ANY_JEWELRY, GroupName ItemKind
VALUABLE, GroupName ItemKind
UNREPORTED_INVENTORY, GroupName ItemKind
AQUATIC]
    [GroupName ItemKind]
-> [GroupName ItemKind] -> [GroupName ItemKind]
forall a. [a] -> [a] -> [a]
++ [GroupName ItemKind
HARPOON, GroupName ItemKind
ARMOR_LOOSE, GroupName ItemKind
CLOTHING_MISC]
    [GroupName ItemKind]
-> [GroupName ItemKind] -> [GroupName ItemKind]
forall a. [a] -> [a] -> [a]
++ [GroupName ItemKind
COOKED_PLANT, GroupName ItemKind
LIQUID_NITROGEN, GroupName ItemKind
GARDENING_TOOL, GroupName ItemKind
TOOL_ONLY]
    [GroupName ItemKind]
-> [GroupName ItemKind] -> [GroupName ItemKind]
forall a. [a] -> [a] -> [a]
++ [GroupName ItemKind]
embedsGN [GroupName ItemKind]
-> [GroupName ItemKind] -> [GroupName ItemKind]
forall a. [a] -> [a] -> [a]
++ [GroupName ItemKind]
actorsGN [GroupName ItemKind]
-> [GroupName ItemKind] -> [GroupName ItemKind]
forall a. [a] -> [a] -> [a]
++ [GroupName ItemKind]
organsGN [GroupName ItemKind]
-> [GroupName ItemKind] -> [GroupName ItemKind]
forall a. [a] -> [a] -> [a]
++ [GroupName ItemKind]
blastsGN

pattern HARPOON, ARMOR_LOOSE, CLOTHING_MISC :: GroupName ItemKind

pattern COOKED_PLANT, LIQUID_NITROGEN, GARDENING_TOOL, TOOL_ONLY :: GroupName ItemKind

-- The @UNKNOWN@ patterns don't need to be exported. Used internally.
-- They also represent singleton groups.
pattern $bFLASK_UNKNOWN :: GroupName ItemKind
$mFLASK_UNKNOWN :: forall r. GroupName ItemKind -> (Void# -> r) -> (Void# -> r) -> r
FLASK_UNKNOWN = GroupName "flask unknown"
pattern $bPOTION_UNKNOWN :: GroupName ItemKind
$mPOTION_UNKNOWN :: forall r. GroupName ItemKind -> (Void# -> r) -> (Void# -> r) -> r
POTION_UNKNOWN = GroupName "potion unknown"
pattern $bEDIBLE_PLANT_UNKNOWN :: GroupName ItemKind
$mEDIBLE_PLANT_UNKNOWN :: forall r. GroupName ItemKind -> (Void# -> r) -> (Void# -> r) -> r
EDIBLE_PLANT_UNKNOWN = GroupName "edible plant unknown"
pattern $bSCROLL_UNKNOWN :: GroupName ItemKind
$mSCROLL_UNKNOWN :: forall r. GroupName ItemKind -> (Void# -> r) -> (Void# -> r) -> r
SCROLL_UNKNOWN = GroupName "scroll unknown"
pattern $bNECKLACE_UNKNOWN :: GroupName ItemKind
$mNECKLACE_UNKNOWN :: forall r. GroupName ItemKind -> (Void# -> r) -> (Void# -> r) -> r
NECKLACE_UNKNOWN = GroupName "necklace unknown"
pattern $bRING_UNKNOWN :: GroupName ItemKind
$mRING_UNKNOWN :: forall r. GroupName ItemKind -> (Void# -> r) -> (Void# -> r) -> r
RING_UNKNOWN = GroupName "ring unknown"
pattern $bHAMMER_UNKNOWN :: GroupName ItemKind
$mHAMMER_UNKNOWN :: forall r. GroupName ItemKind -> (Void# -> r) -> (Void# -> r) -> r
HAMMER_UNKNOWN = GroupName "hammer unknown"
pattern $bGEM_UNKNOWN :: GroupName ItemKind
$mGEM_UNKNOWN :: forall r. GroupName ItemKind -> (Void# -> r) -> (Void# -> r) -> r
GEM_UNKNOWN = GroupName "gem unknown"
pattern $bCURRENCY_UNKNOWN :: GroupName ItemKind
$mCURRENCY_UNKNOWN :: forall r. GroupName ItemKind -> (Void# -> r) -> (Void# -> r) -> r
CURRENCY_UNKNOWN = GroupName "currency unknown"

pattern $bHARPOON :: GroupName ItemKind
$mHARPOON :: forall r. GroupName ItemKind -> (Void# -> r) -> (Void# -> r) -> r
HARPOON = GroupName "harpoon"
pattern $bARMOR_LOOSE :: GroupName ItemKind
$mARMOR_LOOSE :: forall r. GroupName ItemKind -> (Void# -> r) -> (Void# -> r) -> r
ARMOR_LOOSE = GroupName "loose armor"
pattern $bCLOTHING_MISC :: GroupName ItemKind
$mCLOTHING_MISC :: forall r. GroupName ItemKind -> (Void# -> r) -> (Void# -> r) -> r
CLOTHING_MISC = GroupName "miscellaneous clothing"

-- ** Allure-specific

-- Below Allure-specific definitions are interspersed among generic
-- definitions to make managing related definitions easier.

-- The @UNKNOWN@ patterns don't need to be exported. Used internally.
-- They also represent singleton groups.
pattern $bCOOKED_PLANT_UNKNOWN :: GroupName ItemKind
$mCOOKED_PLANT_UNKNOWN :: forall r. GroupName ItemKind -> (Void# -> r) -> (Void# -> r) -> r
COOKED_PLANT_UNKNOWN = GroupName "cooked plant unknown"

pattern $bCOOKED_PLANT :: GroupName ItemKind
$mCOOKED_PLANT :: forall r. GroupName ItemKind -> (Void# -> r) -> (Void# -> r) -> r
COOKED_PLANT = GroupName "cooked plant"
pattern $bLIQUID_NITROGEN :: GroupName ItemKind
$mLIQUID_NITROGEN :: forall r. GroupName ItemKind -> (Void# -> r) -> (Void# -> r) -> r
LIQUID_NITROGEN = GroupName "liquid nitrogen"
pattern $bGARDENING_TOOL :: GroupName ItemKind
$mGARDENING_TOOL :: forall r. GroupName ItemKind -> (Void# -> r) -> (Void# -> r) -> r
GARDENING_TOOL = GroupName "gardening tool"
pattern $bTOOL_ONLY :: GroupName ItemKind
$mTOOL_ONLY :: forall r. GroupName ItemKind -> (Void# -> r) -> (Void# -> r) -> r
TOOL_ONLY = GroupName "tool only"

pattern $bS_RAG_TANGLE :: GroupName ItemKind
$mS_RAG_TANGLE :: forall r. GroupName ItemKind -> (Void# -> r) -> (Void# -> r) -> r
S_RAG_TANGLE = GroupName "rag tangle"
pattern $bS_GRASS_STITCHER :: GroupName ItemKind
$mS_GRASS_STITCHER :: forall r. GroupName ItemKind -> (Void# -> r) -> (Void# -> r) -> r
S_GRASS_STITCHER = GroupName "grass stitcher"
pattern $bS_LADIES_FORK :: GroupName ItemKind
$mS_LADIES_FORK :: forall r. GroupName ItemKind -> (Void# -> r) -> (Void# -> r) -> r
S_LADIES_FORK = GroupName "ladies' fork"
pattern $bS_HOE :: GroupName ItemKind
$mS_HOE :: forall r. GroupName ItemKind -> (Void# -> r) -> (Void# -> r) -> r
S_HOE = GroupName "hoe"
pattern $bS_SPADE :: GroupName ItemKind
$mS_SPADE :: forall r. GroupName ItemKind -> (Void# -> r) -> (Void# -> r) -> r
S_SPADE = GroupName "spade"

-- * Content

content :: [ItemKind]
content :: [ItemKind]
content = [ItemKind]
items [ItemKind] -> [ItemKind] -> [ItemKind]
forall a. [a] -> [a] -> [a]
++ [ItemKind]
otherItemContent

otherItemContent :: [ItemKind]
otherItemContent :: [ItemKind]
otherItemContent = [ItemKind]
embeds [ItemKind] -> [ItemKind] -> [ItemKind]
forall a. [a] -> [a] -> [a]
++ [ItemKind]
actors [ItemKind] -> [ItemKind] -> [ItemKind]
forall a. [a] -> [a] -> [a]
++ [ItemKind]
organs [ItemKind] -> [ItemKind] -> [ItemKind]
forall a. [a] -> [a] -> [a]
++ [ItemKind]
blasts [ItemKind] -> [ItemKind] -> [ItemKind]
forall a. [a] -> [a] -> [a]
++ [ItemKind]
temporaries

items :: [ItemKind]
items :: [ItemKind]
items =
  [ItemKind
sandstoneRock, ItemKind
steelScrap, ItemKind
needle, ItemKind
dart, ItemKind
spike, ItemKind
spike2, ItemKind
slingStone, ItemKind
slingBullet, ItemKind
needleSleep, ItemKind
paralizingProj, ItemKind
harpoon, ItemKind
harpoon2, ItemKind
harpoon3, ItemKind
net, ItemKind
fragmentationBomb, ItemKind
concussionBomb, ItemKind
flashBomb, ItemKind
firecrackerBomb, ItemKind
flaskEmpty, ItemKind
flaskTemplate, ItemKind
flask1, ItemKind
flask2, ItemKind
flask3, ItemKind
flask4, ItemKind
flask5, ItemKind
flask6, ItemKind
flask7, ItemKind
flask8, ItemKind
flask9, ItemKind
flask10, ItemKind
flask11, ItemKind
flask12, ItemKind
flask13, ItemKind
flask14, ItemKind
flask15, ItemKind
flask16, ItemKind
flask17, ItemKind
potionTemplate, ItemKind
potion1, ItemKind
potion2, ItemKind
potion3, ItemKind
potion4, ItemKind
potion5, ItemKind
potion6, ItemKind
potion7, ItemKind
potion8, ItemKind
potion9, ItemKind
potion10, ItemKind
potion11, ItemKind
potion12, ItemKind
potion13, ItemKind
potion14, ItemKind
potion15, ItemKind
potion16, ItemKind
scrollTemplate, ItemKind
scroll1, ItemKind
scroll2, ItemKind
scroll3, ItemKind
scroll4, ItemKind
scroll5, ItemKind
scroll6, ItemKind
scroll7, ItemKind
scroll8, ItemKind
scroll9, ItemKind
scroll10, ItemKind
scroll11, ItemKind
scroll12, ItemKind
scroll13, ItemKind
scroll14, ItemKind
scroll15, ItemKind
scroll16, ItemKind
scrollAd1, ItemKind
rawMeatChunk, ItemKind
roastedMeatChunk, ItemKind
ediblePlantTemplate, ItemKind
ediblePlant1, ItemKind
ediblePlant2, ItemKind
ediblePlant3, ItemKind
ediblePlant4, ItemKind
ediblePlant5, ItemKind
ediblePlant6, ItemKind
ediblePlant7, ItemKind
ediblePlant8, ItemKind
cookedPlantTemplate, ItemKind
cookedPlant1, ItemKind
cookedPlant2, ItemKind
cookedPlant3, ItemKind
cookedPlant4, ItemKind
cookedPlant5, ItemKind
cookedPlant6, ItemKind
cookedPlant7, ItemKind
cookedPlant8, ItemKind
light1, ItemKind
lightDoused1, ItemKind
light2, ItemKind
lightDoused2, ItemKind
light3, ItemKind
blanket, ItemKind
chisel, ItemKind
hacksaw, ItemKind
adjustableSpanner, ItemKind
steelFile, ItemKind
honingSteel, ItemKind
whetstone, ItemKind
diagonalPliers, ItemKind
snips, ItemKind
loppers, ItemKind
boltCutter, ItemKind
solderingIron, ItemKind
duckTape, ItemKind
thickCord, ItemKind
gorget, ItemKind
necklaceTemplate, ItemKind
necklace1, ItemKind
necklace3, ItemKind
necklace4, ItemKind
necklace5, ItemKind
necklace6, ItemKind
necklace7, ItemKind
necklace8, ItemKind
necklace9, ItemKind
necklace10, ItemKind
motionScanner, ItemKind
imageItensifier, ItemKind
sightSharpening, ItemKind
ringTemplate, ItemKind
ring1, ItemKind
ring2, ItemKind
ring3, ItemKind
ring4, ItemKind
ring5, ItemKind
ring6, ItemKind
ring7, ItemKind
ring8, ItemKind
ring9, ItemKind
ring10, ItemKind
armorLeather, ItemKind
armorLeather2, ItemKind
armorMail, ItemKind
meleeEnhancement, ItemKind
spacesuit, ItemKind
spacesuitTorn, ItemKind
gloveFencing, ItemKind
gloveGauntlet, ItemKind
gloveJousting, ItemKind
hatUshanka, ItemKind
capReinforced, ItemKind
helmArmored, ItemKind
heavyBoot, ItemKind
ragTangle, ItemKind
buckler, ItemKind
shield, ItemKind
shield2, ItemKind
shield3, ItemKind
blowtorch, ItemKind
laserSharpener, ItemKind
crowbar, ItemKind
catsPaw, ItemKind
shortClub, ItemKind
longClub, ItemKind
hammerTemplate, ItemKind
hammer1, ItemKind
hammer2, ItemKind
hammer3, ItemKind
hammer4, ItemKind
hammer5, ItemKind
hammerParalyze, ItemKind
hammerSpark, ItemKind
knife, ItemKind
daggerDropBestWeapon, ItemKind
dagger, ItemKind
sword, ItemKind
swordImpress, ItemKind
swordNullify, ItemKind
swordNullifySharp, ItemKind
halberd, ItemKind
oxTongue, ItemKind
halberdPushActor, ItemKind
halberdPushActorSharp, ItemKind
fireAxe, ItemKind
pollaxe, ItemKind
militaryKnife, ItemKind
militaryBaton, ItemKind
cattleProd, ItemKind
grassStitcher, ItemKind
ladiesFork, ItemKind
hoe, ItemKind
spade, ItemKind
treePruner, ItemKind
cleaningPole, ItemKind
staff, ItemKind
pipe, ItemKind
longPole, ItemKind
gemTemplate, ItemKind
gem1, ItemKind
gem2, ItemKind
gem3, ItemKind
gem4, ItemKind
gem5, ItemKind
currencyTemplate, ItemKind
currency, ItemKind
jumpingPole, ItemKind
constructionHooter, ItemKind
wasteContainer, ItemKind
spotlight, ItemKind
seeingItem]

sandstoneRock,    steelScrap, needle, dart, spike, spike2, slingStone, slingBullet, needleSleep, paralizingProj, harpoon, harpoon2, harpoon3, net, fragmentationBomb, concussionBomb, flashBomb, firecrackerBomb, flaskEmpty, flaskTemplate, flask1, flask2, flask3, flask4, flask5, flask6, flask7, flask8, flask9, flask10, flask11, flask12, flask13, flask14, flask15, flask16, flask17, potionTemplate, potion1, potion2, potion3, potion4, potion5, potion6, potion7, potion8, potion9, potion10, potion11, potion12, potion13, potion14, potion15, potion16, scrollTemplate, scroll1, scroll2, scroll3, scroll4, scroll5, scroll6, scroll7, scroll8, scroll9, scroll10, scroll11, scroll12, scroll13, scroll14, scroll15, scroll16, scrollAd1, rawMeatChunk, roastedMeatChunk, ediblePlantTemplate, ediblePlant1, ediblePlant2, ediblePlant3, ediblePlant4, ediblePlant5, ediblePlant6, ediblePlant7, ediblePlant8, cookedPlantTemplate, cookedPlant1, cookedPlant2, cookedPlant3, cookedPlant4, cookedPlant5, cookedPlant6, cookedPlant7, cookedPlant8, light1, lightDoused1, light2, lightDoused2, light3, blanket, chisel, hacksaw, adjustableSpanner, steelFile, honingSteel, whetstone, diagonalPliers, snips, loppers, boltCutter, solderingIron, duckTape, thickCord, gorget, necklaceTemplate, necklace1, necklace3, necklace4, necklace5, necklace6, necklace7, necklace8, necklace9, necklace10, motionScanner, imageItensifier, sightSharpening, ringTemplate, ring1, ring2, ring3, ring4, ring5, ring6, ring7, ring8, ring9, ring10, armorLeather, armorLeather2, armorMail, meleeEnhancement, spacesuit, spacesuitTorn, gloveFencing, gloveGauntlet, gloveJousting, hatUshanka, capReinforced, helmArmored, heavyBoot, ragTangle, buckler, shield, shield2, shield3, blowtorch, laserSharpener, crowbar, catsPaw, shortClub, longClub, hammerTemplate, hammer1, hammer2, hammer3, hammer4, hammer5, hammerParalyze, hammerSpark, knife, daggerDropBestWeapon, dagger, sword, swordImpress, swordNullify, swordNullifySharp, halberd, oxTongue, halberdPushActor, halberdPushActorSharp, fireAxe, pollaxe, militaryKnife, militaryBaton, cattleProd, grassStitcher, ladiesFork, hoe, spade, treePruner, cleaningPole, staff, pipe, longPole, gemTemplate, gem1, gem2, gem3, gem4, gem5, currencyTemplate, currency, jumpingPole, constructionHooter, wasteContainer, spotlight, seeingItem :: ItemKind

-- Keep the dice rolls and sides in aspects small so that not too many
-- distinct items are generated (for display in item lore and for narrative
-- impact ("oh, I found the more powerful of the two variants of the item!",
-- instead of "hmm, I found one of the countless variants, a decent one").
-- In particular, for unique items, unless they inherit aspects from
-- a standard item, permit only a couple possible variants.
-- This is especially important if an item kind has multiple random aspects.
-- Instead multiply dice results, e.g., (1 `d` 3) * 5 instead of 1 `d` 15.
--
-- Beware of non-periodic non-weapon durable items with beneficial effects
-- and low timeout -- AI will starve applying such an item incessantly.

-- * Item group symbols, from Angband and variants

symbolProjectile, _symbolLauncher, symbolLight, symbolTool, symbolSpecial, symbolGold, symbolNecklace, symbolRing, symbolPotion, symbolFlask, symbolScroll, symbolTorsoArmor, symbolMiscArmor, symbolClothes, symbolShield, symbolPolearm, symbolEdged, symbolHafted, symbolWand, _symbolStaff, symbolFood :: Char

symbolProjectile :: Char
symbolProjectile = RuleContent -> Char
rsymbolProjectile RuleContent
standardRules  -- '{'
_symbolLauncher :: Char
_symbolLauncher  = '}'
symbolLight :: Char
symbolLight      = '('
symbolTool :: Char
symbolTool       = ')'
symbolSpecial :: Char
symbolSpecial    = '*'  -- don't overuse, because it clashes with projectiles
symbolGold :: Char
symbolGold       = '$'  -- also gems
symbolNecklace :: Char
symbolNecklace   = '"'
symbolRing :: Char
symbolRing       = '='
symbolPotion :: Char
symbolPotion     = '!'  -- concoction, bottle, jar, vial, canister
symbolFlask :: Char
symbolFlask      = '!'
symbolScroll :: Char
symbolScroll     = '?'  -- book, note, tablet, remote, chip, card
symbolTorsoArmor :: Char
symbolTorsoArmor = '['
symbolMiscArmor :: Char
symbolMiscArmor  = '['
symbolClothes :: Char
symbolClothes    = '['
symbolShield :: Char
symbolShield     = ']'
symbolPolearm :: Char
symbolPolearm    = '/'
symbolEdged :: Char
symbolEdged      = '|'
symbolHafted :: Char
symbolHafted     = '\\'
symbolWand :: Char
symbolWand       = '-'  -- magical rod, transmitter, pistol, rifle, instrument
_symbolStaff :: Char
_symbolStaff     = '_'  -- scanner
symbolFood :: Char
symbolFood       = ','  -- also body part; distinct from floor: not middle dot

-- ** Thrown weapons

sandstoneRock :: ItemKind
sandstoneRock = $WItemKind :: Char
-> Text
-> Freqs ItemKind
-> [Flavour]
-> Dice
-> Rarity
-> Text
-> Int
-> Dice
-> [Aspect]
-> [Effect]
-> [(GroupName ItemKind, CStore)]
-> Text
-> ItemKind
ItemKind
  { isymbol :: Char
isymbol  = Char
symbolProjectile
  , iname :: Text
iname    = "ceramic foam splinter"
  , ifreq :: Freqs ItemKind
ifreq    = [ (GroupName ItemKind
S_SANDSTONE_ROCK, 1)
               , (GroupName ItemKind
UNREPORTED_INVENTORY, 1) ]  -- too weak to spam
  , iflavour :: [Flavour]
iflavour = [Color] -> [Flavour]
zipPlain [Color
Green]
  , icount :: Dice
icount   = 1 Dice -> Dice -> Dice
forall a. Num a => a -> a -> a
+ 1 Int -> Int -> Dice
`d` 2  -- > 1, to let AI ignore sole pieces
  , irarity :: Rarity
irarity  = [(1, 1)]
  , iverbHit :: Text
iverbHit = "swat"
  , iweight :: Int
iweight  = 300
  , idamage :: Dice
idamage  = 1 Int -> Int -> Dice
`d` 1
  , iaspects :: [Aspect]
iaspects = [ Skill -> Dice -> Aspect
AddSkill Skill
SkHurtMelee (Dice -> Aspect) -> Dice -> Aspect
forall a b. (a -> b) -> a -> b
$ -16 Dice -> Dice -> Dice
forall a. Num a => a -> a -> a
* 5
               , Flag -> Aspect
SetFlag Flag
Fragile
               , Int -> Aspect
toVelocity 70 ] -- not dense, irregular
  , ieffects :: [Effect]
ieffects = []
  , idesc :: Text
idesc    = "A light, irregular lump of ceramic foam used in construction."
  , ikit :: [(GroupName ItemKind, CStore)]
ikit     = []
  }
steelScrap :: ItemKind
steelScrap = ItemKind
sandstoneRock
  { iname :: Text
iname    = "steel scrap"
  , ifreq :: Freqs ItemKind
ifreq    = [ (GroupName ItemKind
STEEL_SCRAP, 1)
               , (GroupName ItemKind
UNREPORTED_INVENTORY, 1) ]  -- too weak to spam
  , iflavour :: [Flavour]
iflavour = [Color] -> [Flavour]
zipPlain [Color
Cyan]
  , iverbHit :: Text
iverbHit = "grate"
  , idamage :: Dice
idamage  = 2 Int -> Int -> Dice
`d` 1
  , iweight :: Int
iweight  = 700
  , idesc :: Text
idesc    = " A lump of steel scrap that can be easily bent around and pounded into a wood pole."
  }
needle :: ItemKind
needle = $WItemKind :: Char
-> Text
-> Freqs ItemKind
-> [Flavour]
-> Dice
-> Rarity
-> Text
-> Int
-> Dice
-> [Aspect]
-> [Effect]
-> [(GroupName ItemKind, CStore)]
-> Text
-> ItemKind
ItemKind
  { isymbol :: Char
isymbol  = Char
symbolProjectile
  , iname :: Text
iname    = "needle"
  , ifreq :: Freqs ItemKind
ifreq    = [ (GroupName ItemKind
NEEDLE, 1), (GroupName ItemKind
COMMON_ITEM, 1)
                   -- marked as common to ensure can be polymorphed
               , (GroupName ItemKind
UNREPORTED_INVENTORY, 1) ]  -- too weak to spam
  , iflavour :: [Flavour]
iflavour = [Color] -> [Flavour]
zipPlain [Color
Blue]
  , icount :: Dice
icount   = 1 Dice -> Dice -> Dice
forall a. Num a => a -> a -> a
+ 8 Int -> Int -> Dice
`d` 3
  , irarity :: Rarity
irarity  = [(1, 1)]
  , iverbHit :: Text
iverbHit = "prick"
  , iweight :: Int
iweight  = 3
  , idamage :: Dice
idamage  = 1 Int -> Int -> Dice
`d` 1
  , iaspects :: [Aspect]
iaspects = [ Skill -> Dice -> Aspect
AddSkill Skill
SkHurtMelee (Dice -> Aspect) -> Dice -> Aspect
forall a b. (a -> b) -> a -> b
$ -10 Dice -> Dice -> Dice
forall a. Num a => a -> a -> a
* 5
               , ThrowMod -> Aspect
ToThrow (ThrowMod -> Aspect) -> ThrowMod -> Aspect
forall a b. (a -> b) -> a -> b
$ Int -> Int -> Int -> ThrowMod
ThrowMod 60 100 5  -- piercing; good shape
               , Flag -> Aspect
SetFlag Flag
Fragile ]  -- breaks easily despite being piercing
  , ieffects :: [Effect]
ieffects = []
  , idesc :: Text
idesc    = "A long sturdy hypodermic needle ending in a dried out micro-syringe that is easy to break off. It's too thin to cause great harm, but it passes through flesh easily."
  , ikit :: [(GroupName ItemKind, CStore)]
ikit     = []
  }
dart :: ItemKind
dart = $WItemKind :: Char
-> Text
-> Freqs ItemKind
-> [Flavour]
-> Dice
-> Rarity
-> Text
-> Int
-> Dice
-> [Aspect]
-> [Effect]
-> [(GroupName ItemKind, CStore)]
-> Text
-> ItemKind
ItemKind
  { isymbol :: Char
isymbol  = Char
symbolProjectile
  , iname :: Text
iname    = "billiard ball"
  , ifreq :: Freqs ItemKind
ifreq    = [(GroupName ItemKind
COMMON_ITEM, 100), (GroupName ItemKind
ANY_ARROW, 50), (GroupName ItemKind
WEAK_ARROW, 50)]
  , iflavour :: [Flavour]
iflavour = [Color] -> [Flavour]
zipPlain [Color
White]
  , icount :: Dice
icount   = 1 Dice -> Dice -> Dice
forall a. Num a => a -> a -> a
+ 1 Int -> Int -> Dice
`d` 2 Dice -> Dice -> Dice
forall a. Num a => a -> a -> a
+ 4 Int -> Int -> Dice
`dL` 5
  , irarity :: Rarity
irarity  = [(1, 25)]
  , iverbHit :: Text
iverbHit = "strike"
  , iweight :: Int
iweight  = 170
  , idamage :: Dice
idamage  = 1 Int -> Int -> Dice
`d` 1
  , iaspects :: [Aspect]
iaspects = [Skill -> Dice -> Aspect
AddSkill Skill
SkHurtMelee (Dice -> Aspect) -> Dice -> Aspect
forall a b. (a -> b) -> a -> b
$ (-15 Dice -> Dice -> Dice
forall a. Num a => a -> a -> a
+ 1 Int -> Int -> Dice
`d` 2 Dice -> Dice -> Dice
forall a. Num a => a -> a -> a
+ 1 Int -> Int -> Dice
`dL` 3) Dice -> Dice -> Dice
forall a. Num a => a -> a -> a
* 5]
                 -- only good against leather
  , ieffects :: [Effect]
ieffects = []
  , idesc :: Text
idesc    = "Ideal shape, size and weight for throwing."
  , ikit :: [(GroupName ItemKind, CStore)]
ikit     = []
  }
spike :: ItemKind
spike = $WItemKind :: Char
-> Text
-> Freqs ItemKind
-> [Flavour]
-> Dice
-> Rarity
-> Text
-> Int
-> Dice
-> [Aspect]
-> [Effect]
-> [(GroupName ItemKind, CStore)]
-> Text
-> ItemKind
ItemKind
  { isymbol :: Char
isymbol  = Char
symbolProjectile
  , iname :: Text
iname    = "steak knife"
  , ifreq :: Freqs ItemKind
ifreq    = [(GroupName ItemKind
COMMON_ITEM, 100), (GroupName ItemKind
ANY_ARROW, 50), (GroupName ItemKind
WEAK_ARROW, 50)]
  , iflavour :: [Flavour]
iflavour = [Color] -> [Flavour]
zipPlain [Color
BrCyan]
  , icount :: Dice
icount   = 1 Dice -> Dice -> Dice
forall a. Num a => a -> a -> a
+ 1 Int -> Int -> Dice
`d` 2 Dice -> Dice -> Dice
forall a. Num a => a -> a -> a
+ 3 Int -> Int -> Dice
`dL` 5
  , irarity :: Rarity
irarity  = [(1, 15), (10, 10)]
  , iverbHit :: Text
iverbHit = "nick"
  , iweight :: Int
iweight  = 100
  , idamage :: Dice
idamage  = 2 Int -> Int -> Dice
`d` 1
  , iaspects :: [Aspect]
iaspects = [ Skill -> Dice -> Aspect
AddSkill Skill
SkHurtMelee (Dice -> Aspect) -> Dice -> Aspect
forall a b. (a -> b) -> a -> b
$ (-10 Dice -> Dice -> Dice
forall a. Num a => a -> a -> a
+ 1 Int -> Int -> Dice
`d` 2 Dice -> Dice -> Dice
forall a. Num a => a -> a -> a
+ 1 Int -> Int -> Dice
`dL` 3) Dice -> Dice -> Dice
forall a. Num a => a -> a -> a
* 5
                   -- heavy vs armor
               , Flag -> Aspect
SetFlag Flag
MinorEffects
               , Int -> Aspect
toVelocity 70 ]  -- hitting with tip costs speed
  , ieffects :: [Effect]
ieffects = [ GroupName ItemKind -> Effect
Explode GroupName ItemKind
S_SINGLE_SPARK  -- when hitting enemy
               , Effect -> Effect
OnSmash (GroupName ItemKind -> Effect
Explode GroupName ItemKind
S_SINGLE_SPARK) ]  -- at wall hit
      -- this results in a wordy item synopsis, but it's OK, the spark really
      -- is useful in some situations, not just a flavour
  , idesc :: Text
idesc    = "Not durable nor particularly well balanced, but with a laser-sharpened titanium alloy tip and blade."
  , ikit :: [(GroupName ItemKind, CStore)]
ikit     = []
  }
spike2 :: ItemKind
spike2 = ItemKind
spike
  { iname :: Text
iname    = "heavy steak knife"
  , ifreq :: Freqs ItemKind
ifreq    = [(GroupName ItemKind
COMMON_ITEM, 3), (GroupName ItemKind
ANY_ARROW, 1), (GroupName ItemKind
WEAK_ARROW, 1)]
  , iflavour :: [Flavour]
iflavour = [Color] -> [Flavour]
zipPlain [Color
Cyan]
  , icount :: Dice
icount   = 1 Dice -> Dice -> Dice
forall a. Num a => a -> a -> a
+ 5 Int -> Int -> Dice
`dL` 5
  , iverbHit :: Text
iverbHit = "penetrate"
  , iweight :: Int
iweight  = 150
  , idamage :: Dice
idamage = 4 Int -> Int -> Dice
`d` 1  -- not useful for melee, because hurt skill too low
  , iaspects :: [Aspect]
iaspects = [ Skill -> Dice -> Aspect
AddSkill Skill
SkHurtMelee (Dice -> Aspect) -> Dice -> Aspect
forall a b. (a -> b) -> a -> b
$ (-10 Dice -> Dice -> Dice
forall a. Num a => a -> a -> a
+ 1 Int -> Int -> Dice
`d` 2 Dice -> Dice -> Dice
forall a. Num a => a -> a -> a
+ 1 Int -> Int -> Dice
`dL` 3) Dice -> Dice -> Dice
forall a. Num a => a -> a -> a
* 5
               , Flag -> Aspect
SetFlag Flag
MinorEffects
               , Dice -> [Aspect] -> [Aspect] -> Aspect
Odds (10 Dice -> Dice -> Dice
forall a. Num a => a -> a -> a
* 1 Int -> Int -> Dice
`dL` 10) [] [Int -> Aspect
toVelocity 70] ]
                   -- at deep levels sometimes even don't limit velocity
  , idesc :: Text
idesc    = "Old, slightly discoloured, probably from a genuine steel. A heavy and surprisingly well balanced prop from a posh restaurant. It won't survive any rough treatment, though."  -- the theme of pre-modern things being more solid and intimidating
  }
slingStone :: ItemKind
slingStone = $WItemKind :: Char
-> Text
-> Freqs ItemKind
-> [Flavour]
-> Dice
-> Rarity
-> Text
-> Int
-> Dice
-> [Aspect]
-> [Effect]
-> [(GroupName ItemKind, CStore)]
-> Text
-> ItemKind
ItemKind
  { isymbol :: Char
isymbol  = Char
symbolProjectile
  , iname :: Text
iname    = "steel hex nut"
  , ifreq :: Freqs ItemKind
ifreq    = [(GroupName ItemKind
COMMON_ITEM, 5), (GroupName ItemKind
ANY_ARROW, 100)]
  , iflavour :: [Flavour]
iflavour = [Color] -> [Flavour]
zipPlain [Color
Blue]
  , icount :: Dice
icount   = 1 Dice -> Dice -> Dice
forall a. Num a => a -> a -> a
+ 3 Int -> Int -> Dice
`dL` 4
  , irarity :: Rarity
irarity  = [(8, 25)]
  , iverbHit :: Text
iverbHit = "clobber"
  , iweight :: Int
iweight  = 200
  , idamage :: Dice
idamage  = 1 Int -> Int -> Dice
`d` 1
  , iaspects :: [Aspect]
iaspects = [ Skill -> Dice -> Aspect
AddSkill Skill
SkHurtMelee (Dice -> Aspect) -> Dice -> Aspect
forall a b. (a -> b) -> a -> b
$ (-10 Dice -> Dice -> Dice
forall a. Num a => a -> a -> a
+ 1 Int -> Int -> Dice
`d` 2 Dice -> Dice -> Dice
forall a. Num a => a -> a -> a
+ 1 Int -> Int -> Dice
`dL` 3) Dice -> Dice -> Dice
forall a. Num a => a -> a -> a
* 5
                   -- heavy, to bludgeon through armor
               , Flag -> Aspect
SetFlag Flag
MinorEffects
               , Int -> Aspect
toVelocity 150 ]
  , ieffects :: [Effect]
ieffects = [ GroupName ItemKind -> Effect
Explode GroupName ItemKind
S_SINGLE_SPARK  -- when hitting enemy
               , Effect -> Effect
OnSmash (GroupName ItemKind -> Effect
Explode GroupName ItemKind
S_SINGLE_SPARK) ]  -- at wall hit
  , idesc :: Text
idesc    = "A large hexagonal fastening nut; due to its angular shape, securely lodging in the pouch of a makeshift string and cloth sling."
  , ikit :: [(GroupName ItemKind, CStore)]
ikit     = []
  }
slingBullet :: ItemKind
slingBullet = $WItemKind :: Char
-> Text
-> Freqs ItemKind
-> [Flavour]
-> Dice
-> Rarity
-> Text
-> Int
-> Dice
-> [Aspect]
-> [Effect]
-> [(GroupName ItemKind, CStore)]
-> Text
-> ItemKind
ItemKind
  { isymbol :: Char
isymbol  = Char
symbolProjectile
  , iname :: Text
iname    = "bearing ball"
  , ifreq :: Freqs ItemKind
ifreq    = [(GroupName ItemKind
COMMON_ITEM, 5), (GroupName ItemKind
ANY_ARROW, 100), (GroupName ItemKind
MERCENARY_AMMO, 25)]
  , iflavour :: [Flavour]
iflavour = [Color] -> [Flavour]
zipPlain [Color
BrBlue]
  , icount :: Dice
icount   = 1 Dice -> Dice -> Dice
forall a. Num a => a -> a -> a
+ 6 Int -> Int -> Dice
`dL` 4
  , irarity :: Rarity
irarity  = [(8, 20)]
  , iverbHit :: Text
iverbHit = "slug"
  , iweight :: Int
iweight  = 28
  , idamage :: Dice
idamage  = 1 Int -> Int -> Dice
`d` 1
  , iaspects :: [Aspect]
iaspects = [ Skill -> Dice -> Aspect
AddSkill Skill
SkHurtMelee (Dice -> Aspect) -> Dice -> Aspect
forall a b. (a -> b) -> a -> b
$ (-17 Dice -> Dice -> Dice
forall a. Num a => a -> a -> a
+ 1 Int -> Int -> Dice
`d` 2 Dice -> Dice -> Dice
forall a. Num a => a -> a -> a
+ 1 Int -> Int -> Dice
`dL` 3) Dice -> Dice -> Dice
forall a. Num a => a -> a -> a
* 5
                   -- not too good against armor
               , ThrowMod -> Aspect
ToThrow (ThrowMod -> Aspect) -> ThrowMod -> Aspect
forall a b. (a -> b) -> a -> b
$ Int -> Int -> Int -> ThrowMod
ThrowMod 200 100 2  -- piercing
               , Flag -> Aspect
SetFlag Flag
Fragile ]
                   -- otherwise would rarely break and the player would have
                   -- unlimited resource and would have to pick up constantly
  , ieffects :: [Effect]
ieffects = []
  , idesc :: Text
idesc    = "Small but heavy bearing ball. Thanks to its size and shape, it doesn't snag when released from the makeshift sling's pouch. Minimal friction enables it to pierce through flesh when fast enough initially. Really hard to find once thrown."  -- we lie, it doesn't slow down in our model; but it stops piercing alright
  , ikit :: [(GroupName ItemKind, CStore)]
ikit     = []
  }

-- ** Exotic thrown weapons

needleSleep :: ItemKind
needleSleep = $WItemKind :: Char
-> Text
-> Freqs ItemKind
-> [Flavour]
-> Dice
-> Rarity
-> Text
-> Int
-> Dice
-> [Aspect]
-> [Effect]
-> [(GroupName ItemKind, CStore)]
-> Text
-> ItemKind
ItemKind
  { isymbol :: Char
isymbol  = Char
symbolProjectile
  , iname :: Text
iname    = "tranquillizer dart"
  , ifreq :: Freqs ItemKind
ifreq    = [ (GroupName ItemKind
TRANQUILIZER_DART, 1), (GroupName ItemKind
COMMON_ITEM, 1)
               , (GroupName ItemKind
MERCENARY_AMMO, 25) ]
                   -- marked as common to ensure can be polymorphed
  , iflavour :: [Flavour]
iflavour = [Color] -> [Flavour]
zipPlain [Color
BrBlue]
  , icount :: Dice
icount   = 1 Int -> Int -> Dice
`dL` 3
  , irarity :: Rarity
irarity  = [(1, 1)]
  , iverbHit :: Text
iverbHit = "prick"
  , iweight :: Int
iweight  = 10
  , idamage :: Dice
idamage  = 1 Int -> Int -> Dice
`d` 1
  , iaspects :: [Aspect]
iaspects = [ Skill -> Dice -> Aspect
AddSkill Skill
SkHurtMelee (Dice -> Aspect) -> Dice -> Aspect
forall a b. (a -> b) -> a -> b
$ -10 Dice -> Dice -> Dice
forall a. Num a => a -> a -> a
* 5
               , Flag -> Aspect
SetFlag Flag
Fragile
               , Int -> Aspect
toVelocity 60 ]  -- syringe blocks piercing; slender fins
  , ieffects :: [Effect]
ieffects = [Effect
PutToSleep]
  , idesc :: Text
idesc    = "A long hypodermic needle ending in a micro-syringe with residues of the sleeping agent."
  , ikit :: [(GroupName ItemKind, CStore)]
ikit     = []
  }
-- Identified, because shape (and name) says it all. Detailed aspects id by use.
-- This is an extremely large value for @Paralyze@. Normally for such values
-- we should instead use condition that disables (almost) all stats,
-- except @SkWait@, so that the player can switch leader and not be
-- helpless nor experience instadeath (unless his party is 1-person
-- or the actor is isolated, but that's usually player's fault).
paralizingProj :: ItemKind
paralizingProj = $WItemKind :: Char
-> Text
-> Freqs ItemKind
-> [Flavour]
-> Dice
-> Rarity
-> Text
-> Int
-> Dice
-> [Aspect]
-> [Effect]
-> [(GroupName ItemKind, CStore)]
-> Text
-> ItemKind
ItemKind
  { isymbol :: Char
isymbol  = Char
symbolProjectile
  , iname :: Text
iname    = "can"
  , ifreq :: Freqs ItemKind
ifreq    = [ (GroupName ItemKind
COMMON_ITEM, 100), (GroupName ItemKind
CAN_OF_STICKY_FOAM, 1)
               , (GroupName ItemKind
MERCENARY_AMMO, 25), (GroupName ItemKind
BONDING_TOOL, 1) ]
  , iflavour :: [Flavour]
iflavour = [Color] -> [Flavour]
zipPlain [Color
Magenta]
  , icount :: Dice
icount   = 1 Int -> Int -> Dice
`dL` 4
  , irarity :: Rarity
irarity  = [(5, 5), (10, 20)]
  , iverbHit :: Text
iverbHit = "glue"
  , iweight :: Int
iweight  = 1000
  , idamage :: Dice
idamage  = 1 Int -> Int -> Dice
`d` 1
  , iaspects :: [Aspect]
iaspects = [ Text -> Aspect
ELabel "of sticky foam"
               , Skill -> Dice -> Aspect
AddSkill Skill
SkHurtMelee (Dice -> Aspect) -> Dice -> Aspect
forall a b. (a -> b) -> a -> b
$ -14 Dice -> Dice -> Dice
forall a. Num a => a -> a -> a
* 5
               , Flag -> Aspect
SetFlag Flag
Lobable, Flag -> Aspect
SetFlag Flag
Fragile
               , Int -> Aspect
toVelocity 70 ]  -- unwieldy
  , ieffects :: [Effect]
ieffects = [Dice -> Effect
Paralyze 15, Effect -> Effect
OnSmash (GroupName ItemKind -> Effect
Explode GroupName ItemKind
S_GLUE) ]
  , idesc :: Text
idesc    = "A can of liquid, fast-setting construction foam. Often used as a glue."
  , ikit :: [(GroupName ItemKind, CStore)]
ikit     = []
  }
harpoon :: ItemKind
harpoon = $WItemKind :: Char
-> Text
-> Freqs ItemKind
-> [Flavour]
-> Dice
-> Rarity
-> Text
-> Int
-> Dice
-> [Aspect]
-> [Effect]
-> [(GroupName ItemKind, CStore)]
-> Text
-> ItemKind
ItemKind
  { isymbol :: Char
isymbol  = Char
symbolProjectile
  , iname :: Text
iname    = "harpoon"
  , ifreq :: Freqs ItemKind
ifreq    = [(GroupName ItemKind
COMMON_ITEM, 33), (GroupName ItemKind
HARPOON, 100), (GroupName ItemKind
S_HARPOON_CARGO, 1)]
  , iflavour :: [Flavour]
iflavour = [Color] -> [Flavour]
zipPlain [Color
Brown]
  , icount :: Dice
icount   = 1  -- durable, so one piece lasts long
  , irarity :: Rarity
irarity  = [(1, 17)]
  , iverbHit :: Text
iverbHit = "hook"
  , iweight :: Int
iweight  = 1500  -- high damage and reusable, but one shot less via pulling
  , idamage :: Dice
idamage  = 5 Int -> Int -> Dice
`d` 1
  , iaspects :: [Aspect]
iaspects = [ Dice -> Aspect
Timeout 7
               , Skill -> Dice -> Aspect
AddSkill Skill
SkHurtMelee (Dice -> Aspect) -> Dice -> Aspect
forall a b. (a -> b) -> a -> b
$ (-4 Dice -> Dice -> Dice
forall a. Num a => a -> a -> a
+ 1 Int -> Int -> Dice
`d` 3) Dice -> Dice -> Dice
forall a. Num a => a -> a -> a
* 5
               , Flag -> Aspect
SetFlag Flag
Durable, Flag -> Aspect
SetFlag Flag
Meleeable
               , EqpSlot -> Aspect
EqpSlot EqpSlot
EqpSlotWeaponBig ]  -- AI wields for fun despite stats
  , ieffects :: [Effect]
ieffects = [ThrowMod -> Effect
PullActor (Int -> Int -> Int -> ThrowMod
ThrowMod 200 50 1)]  -- 1 step, fast
  , idesc :: Text
idesc    = "A cargo-hook with a high-tension cord that makes the entangled victim easy to unbalance with a strong pull."
  , ikit :: [(GroupName ItemKind, CStore)]
ikit     = []
  }
harpoon2 :: ItemKind
harpoon2 = ItemKind
harpoon
  { iname :: Text
iname    = "sharp harpoon"
  , ifreq :: Freqs ItemKind
ifreq    = [(GroupName ItemKind
COMMON_ITEM, 1), (GroupName ItemKind
HARPOON, 2), (GroupName ItemKind
S_HARPOON_SHARP, 1)]
  , irarity :: Rarity
irarity  = [(10, 5)]
  , idamage :: Dice
idamage  = 8 Int -> Int -> Dice
`d` 1
  , idesc :: Text
idesc    = "A cord ending in a sharpened cargo-hook that, in addition to entangling the victim, gains purchase biting into the body."
  }
harpoon3 :: ItemKind
harpoon3 = ItemKind
harpoon
  { iname :: Text
iname    = "The Whaling Harpoon"
  , ifreq :: Freqs ItemKind
ifreq    = [(GroupName ItemKind
TREASURE, 15), (GroupName ItemKind
MUSEAL, 50)]
  , iflavour :: [Flavour]
iflavour = [Color] -> [Flavour]
zipFancy [Color
Red]
  , irarity :: Rarity
irarity  = [(8, 4)]
  , idamage :: Dice
idamage  = 7 Int -> Int -> Dice
`d` 1
  , iaspects :: [Aspect]
iaspects = Flag -> Aspect
SetFlag Flag
Unique Aspect -> [Aspect] -> [Aspect]
forall a. a -> [a] -> [a]
: ItemKind -> [Aspect]
iaspects ItemKind
harpoon
  , ieffects :: [Effect]
ieffects = Effect
Yell  -- evoke a cry from pain; brutal
               Effect -> [Effect] -> [Effect]
forall a. a -> [a] -> [a]
: ItemKind -> [Effect]
ieffects ItemKind
harpoon
  , idesc :: Text
idesc    = "A display piece harking back to the Earth's oceanic tourism heyday. Surprising sharp for its age. The cruel, barbed head lodges in its victim so painfully that the weakest tug of the rope sends the victim flying."
  }
net :: ItemKind
net = $WItemKind :: Char
-> Text
-> Freqs ItemKind
-> [Flavour]
-> Dice
-> Rarity
-> Text
-> Int
-> Dice
-> [Aspect]
-> [Effect]
-> [(GroupName ItemKind, CStore)]
-> Text
-> ItemKind
ItemKind
  { isymbol :: Char
isymbol  = Char
symbolProjectile
  , iname :: Text
iname    = "net"
  , ifreq :: Freqs ItemKind
ifreq    = [(GroupName ItemKind
COMMON_ITEM, 100), (GroupName ItemKind
MERCENARY_AMMO, 25)]
  , iflavour :: [Flavour]
iflavour = [Color] -> [Flavour]
zipPlain [Color
BrGreen]
  , icount :: Dice
icount   = 1 Int -> Int -> Dice
`dL` 3
  , irarity :: Rarity
irarity  = [(5, 7), (9, 9)]
  , iverbHit :: Text
iverbHit = "entangle"
  , iweight :: Int
iweight  = 1000
  , idamage :: Dice
idamage  = 2 Int -> Int -> Dice
`d` 1
  , iaspects :: [Aspect]
iaspects = [Skill -> Dice -> Aspect
AddSkill Skill
SkHurtMelee (Dice -> Aspect) -> Dice -> Aspect
forall a b. (a -> b) -> a -> b
$ -14 Dice -> Dice -> Dice
forall a. Num a => a -> a -> a
* 5]
  , ieffects :: [Effect]
ieffects = [ GroupName ItemKind -> Dice -> Effect
toOrganBad GroupName ItemKind
S_SLOWED (3 Dice -> Dice -> Dice
forall a. Num a => a -> a -> a
+ 1 Int -> Int -> Dice
`d` 3)
               , Int -> Int -> CStore -> GroupName ItemKind -> Effect
DropItem Int
forall a. Bounded a => a
maxBound 1 CStore
CEqp GroupName ItemKind
ARMOR_LOOSE
                   -- only one of each kind is dropped, because no rubbish
                   -- in this group and so no risk of exploit
               , ThrowMod -> Effect
SendFlying (Int -> Int -> Int -> ThrowMod
ThrowMod 100 50 1) ]  -- 1 step; painful
  , idesc :: Text
idesc    = "A large synthetic fibre net with weights affixed along the edges. Entangles armor and restricts movement."
  , ikit :: [(GroupName ItemKind, CStore)]
ikit     = []
  }

-- ** Explosives, with the only effect being @Explode@

fragmentationBomb :: ItemKind
fragmentationBomb = $WItemKind :: Char
-> Text
-> Freqs ItemKind
-> [Flavour]
-> Dice
-> Rarity
-> Text
-> Int
-> Dice
-> [Aspect]
-> [Effect]
-> [(GroupName ItemKind, CStore)]
-> Text
-> ItemKind
ItemKind
  { isymbol :: Char
isymbol  = Char
symbolProjectile
  , iname :: Text
iname    = "hand bomb"
      -- improvised bomb filled with iron pellets, nuts, cut nails;
      -- deflagration, not detonation, so large mass and hard container
      -- required not to burn harmlessly; improvised short fuze;
      -- can't be more powerful or would fracture the spaceship's hull
  , ifreq :: Freqs ItemKind
ifreq    = [(GroupName ItemKind
COMMON_ITEM, 100), (GroupName ItemKind
EXPLOSIVE, 300)]
  , iflavour :: [Flavour]
iflavour = [Color] -> [Flavour]
zipPlain [Color
Red]
  , icount :: Dice
icount   = 1 Int -> Int -> Dice
`dL` 5  -- many, because not very intricate
  , irarity :: Rarity
irarity  = [(5, 10), (10, 5)]
  , iverbHit :: Text
iverbHit = "thud"
  , iweight :: Int
iweight  = 3000  -- low velocity due to weight
  , idamage :: Dice
idamage  = 0  -- heavy and hard, but let's not confuse with blast damage
  , iaspects :: [Aspect]
iaspects = [Flag -> Aspect
SetFlag Flag
Lobable, Flag -> Aspect
SetFlag Flag
Fragile]
  , ieffects :: [Effect]
ieffects = [ GroupName ItemKind -> Effect
Explode GroupName ItemKind
S_FOCUSED_FRAGMENTATION
               , Effect -> Effect
OnSmash (GroupName ItemKind -> Effect
Explode GroupName ItemKind
S_VIOLENT_FRAGMENTATION) ]
  , idesc :: Text
idesc    = "Shards of brittle metal packed around an explosive core."
  , ikit :: [(GroupName ItemKind, CStore)]
ikit     = []
  }
concussionBomb :: ItemKind
concussionBomb = ItemKind
fragmentationBomb
  { iname :: Text
iname    = "canister"
      -- slightly stabilized liquid explosive in a soft container, hence
      -- no fragmentation, but huge shock wave despite small size and lack
      -- of strong container to build up pressure; indoors help the shock wave;
      -- unstable enough that no fuze required (or simple electric fuse?);
      -- that's the most potent explosive (a detonating one) to be found
      -- and only in small quantities, due to depressurization hazard
  , iflavour :: [Flavour]
iflavour = [Color] -> [Flavour]
zipPlain [Color
Magenta]
  , iverbHit :: Text
iverbHit = "bonk"
  , iweight :: Int
iweight  = 400
  , iaspects :: [Aspect]
iaspects = [ Flag -> Aspect
SetFlag Flag
Lobable, Flag -> Aspect
SetFlag Flag
Fragile
               , Int -> Aspect
toVelocity 70 ]  -- flappy and so slow
  , ieffects :: [Effect]
ieffects = [ GroupName ItemKind -> Effect
Explode GroupName ItemKind
S_FOCUSED_CONCUSSION
               , Effect -> Effect
OnSmash (GroupName ItemKind -> Effect
Explode GroupName ItemKind
S_VIOLENT_CONCUSSION) ]
  , idesc :: Text
idesc    = "Avoid sudden movements."
  }
-- Not flashbang, because powerful bang without fragmentation is harder
-- to manufacture (requires an oxidizer and steel canister with holes).
-- The bang would also paralyze and/or lower the movement skill
-- (out of balance due to ear trauma).
flashBomb :: ItemKind
flashBomb = ItemKind
fragmentationBomb
  { iname :: Text
iname    = "powder tube"  -- filled with magnesium flash powder
  , iflavour :: [Flavour]
iflavour = [Color] -> [Flavour]
zipPlain [Color
BrYellow]  -- avoid @BrWhite@; looks wrong in dark
  , iverbHit :: Text
iverbHit = "flash"
  , iweight :: Int
iweight  = 400
  , iaspects :: [Aspect]
iaspects = [ Flag -> Aspect
SetFlag Flag
Lobable, Flag -> Aspect
SetFlag Flag
Fragile
               , Int -> Aspect
toVelocity 70 ]  -- bad shape for throwing
  , ieffects :: [Effect]
ieffects = [GroupName ItemKind -> Effect
Explode GroupName ItemKind
S_FOCUSED_FLASH, Effect -> Effect
OnSmash (GroupName ItemKind -> Effect
Explode GroupName ItemKind
S_VIOLENT_FLASH)]
  , idesc :: Text
idesc    = "For dramatic entrances and urgent exits."
  }
firecrackerBomb :: ItemKind
firecrackerBomb = ItemKind
fragmentationBomb
  { iname :: Text
iname = "roll"  -- not fireworks, as they require outdoors
  , iflavour :: [Flavour]
iflavour = [Color] -> [Flavour]
zipPlain [Color
BrMagenta]
  , irarity :: Rarity
irarity  = [(1, 5), (5, 8)]  -- a toy, if harmful
  , iverbHit :: Text
iverbHit = "crack"  -- a pun, matches the verb from "ItemKindBlast"
  , iweight :: Int
iweight  = 1000
  , iaspects :: [Aspect]
iaspects = [Flag -> Aspect
SetFlag Flag
Lobable, Flag -> Aspect
SetFlag Flag
Fragile]
  , ieffects :: [Effect]
ieffects = [GroupName ItemKind -> Effect
Explode GroupName ItemKind
S_FIRECRACKER, Effect -> Effect
OnSmash (GroupName ItemKind -> Effect
Explode GroupName ItemKind
S_FIRECRACKER)]
  , idesc :: Text
idesc    = "String and paper, concealing a deadly surprise."
  }

-- ** Exploding consumables.

-- Not identified, because they are perfect for the id-by-use fun,
-- due to effects. They are fragile and upon hitting the ground explode
-- for effects roughly corresponding to their normal effects.
-- Whether to hit with them or explode them close to the target
-- is intended to be an interesting tactical decision.

-- Flasks are intended to be thrown. They are often not natural: maths, magic,
-- distillery. In fact, they cover all temporary conditions, except those
-- for stats resistance and regeneration. They never heal, directly
-- nor indirectly (regen), so may be thrown without the risk of wasting
-- precious HP.
--
-- There is no flask nor condition that only does Calm or max Calm depletion,
-- because Calm reduced often via combat, etc.

flaskEmpty :: ItemKind
flaskEmpty = ItemKind
flaskTemplate
  { iname :: Text
iname    = "empty flask"
  , ifreq :: Freqs ItemKind
ifreq    = [(GroupName ItemKind
COMMON_ITEM, 100), (GroupName ItemKind
S_EMPTY_FLASK, 1)]
  , iflavour :: [Flavour]
iflavour = [Color] -> [Flavour]
zipGlassPlain [Color
White]
  , icount :: Dice
icount   = 1
  , irarity :: Rarity
irarity  = [(1, 8)]
  , iverbHit :: Text
iverbHit = "bang"
  , iweight :: Int
iweight  = 250
  , iaspects :: [Aspect]
iaspects = [Flag -> Aspect
SetFlag Flag
Lobable, Flag -> Aspect
SetFlag Flag
Fragile, Int -> Aspect
toVelocity 60]
  , idesc :: Text
idesc    = "The only redeeming quality of empty flasks is that they can be filled with any liquid."
  }
flaskTemplate :: ItemKind
flaskTemplate = $WItemKind :: Char
-> Text
-> Freqs ItemKind
-> [Flavour]
-> Dice
-> Rarity
-> Text
-> Int
-> Dice
-> [Aspect]
-> [Effect]
-> [(GroupName ItemKind, CStore)]
-> Text
-> ItemKind
ItemKind
  { isymbol :: Char
isymbol  = Char
symbolFlask
  , iname :: Text
iname    = "flask"
  , ifreq :: Freqs ItemKind
ifreq    = [(GroupName ItemKind
FLASK_UNKNOWN, 1)]
  , iflavour :: [Flavour]
iflavour = [Color] -> [Flavour]
zipGlassPlain [Color]
darkCol [Flavour] -> [Flavour] -> [Flavour]
forall a. [a] -> [a] -> [a]
++ [Color] -> [Flavour]
zipGlassFancy [Color]
darkCol
               [Flavour] -> [Flavour] -> [Flavour]
forall a. [a] -> [a] -> [a]
++ [Color] -> [Flavour]
zipLiquid [Color]
darkCol
  , icount :: Dice
icount   = 1 Int -> Int -> Dice
`d` 2 Dice -> Dice -> Dice
forall a. Num a => a -> a -> a
+ 1 Int -> Int -> Dice
`dL` 3
  , irarity :: Rarity
irarity  = [(1, 5), (10, 3)]
  , iverbHit :: Text
iverbHit = "splash"
  , iweight :: Int
iweight  = 500
  , idamage :: Dice
idamage  = 0
  , iaspects :: [Aspect]
iaspects = [ GroupName ItemKind -> Aspect
PresentAs GroupName ItemKind
FLASK_UNKNOWN, Flag -> Aspect
SetFlag Flag
Lobable, Flag -> Aspect
SetFlag Flag
Fragile
               , Int -> Aspect
toVelocity 60 ]  -- oily, rather bad grip
  , ieffects :: [Effect]
ieffects = []
  , idesc :: Text
idesc    = "A flask of oily liquid of a suspect color. Something seems to be moving inside. Double dose causes twice longer effect. Triple dose is not advisable, since the active substance is never without unhealthy side-effects and often dissolved in large volumes of alcohol."
  , ikit :: [(GroupName ItemKind, CStore)]
ikit     = []
  }
flask1 :: ItemKind
flask1 = ItemKind
flaskTemplate
  { ifreq :: Freqs ItemKind
ifreq    = [ (GroupName ItemKind
COMMON_ITEM, 100), (GroupName ItemKind
ANY_FLASK, 100), (GroupName ItemKind
EXPLOSIVE, 100)
               , (GroupName ItemKind
ANY_GLASS, 100) ]
  , iaspects :: [Aspect]
iaspects = Text -> Aspect
ELabel "of strength brew"
               Aspect -> [Aspect] -> [Aspect]
forall a. a -> [a] -> [a]
: ItemKind -> [Aspect]
iaspects ItemKind
flaskTemplate
  , ieffects :: [Effect]
ieffects = [ GroupName ItemKind -> Dice -> Effect
toOrganGood GroupName ItemKind
S_STRENGTHENED (20 Dice -> Dice -> Dice
forall a. Num a => a -> a -> a
+ 1 Int -> Int -> Dice
`d` 5)
               , Effect -> Effect
OnSmash (GroupName ItemKind -> Effect
Explode GroupName ItemKind
S_DENSE_SHOWER) ]
  }
flask2 :: ItemKind
flask2 = ItemKind
flaskTemplate
  { ifreq :: Freqs ItemKind
ifreq    = [ (GroupName ItemKind
COMMON_ITEM, 100), (GroupName ItemKind
ANY_FLASK, 100), (GroupName ItemKind
EXPLOSIVE, 100)
               , (GroupName ItemKind
ANY_GLASS, 100) ]
  , iaspects :: [Aspect]
iaspects = Text -> Aspect
ELabel "of weakness brew"
               Aspect -> [Aspect] -> [Aspect]
forall a. a -> [a] -> [a]
: ItemKind -> [Aspect]
iaspects ItemKind
flaskTemplate
  , ieffects :: [Effect]
ieffects = [ GroupName ItemKind -> Dice -> Effect
toOrganBad GroupName ItemKind
S_WEAKENED (20 Dice -> Dice -> Dice
forall a. Num a => a -> a -> a
+ 1 Int -> Int -> Dice
`d` 5)
               , Effect -> Effect
OnSmash (GroupName ItemKind -> Effect
Explode GroupName ItemKind
S_SPARSE_SHOWER) ]
  }
flask3 :: ItemKind
flask3 = ItemKind
flaskTemplate
  { ifreq :: Freqs ItemKind
ifreq    = [ (GroupName ItemKind
COMMON_ITEM, 100), (GroupName ItemKind
ANY_FLASK, 100), (GroupName ItemKind
EXPLOSIVE, 100)
               , (GroupName ItemKind
ANY_GLASS, 100), (GroupName ItemKind
OIL_SOURCE, 1) ]
  , iaspects :: [Aspect]
iaspects = Text -> Aspect
ELabel "of melee protective balm"
               Aspect -> [Aspect] -> [Aspect]
forall a. a -> [a] -> [a]
: ItemKind -> [Aspect]
iaspects ItemKind
flaskTemplate
  , ieffects :: [Effect]
ieffects = [ GroupName ItemKind -> Dice -> Effect
toOrganGood GroupName ItemKind
S_PROTECTED_FROM_MELEE (20 Dice -> Dice -> Dice
forall a. Num a => a -> a -> a
+ 1 Int -> Int -> Dice
`d` 5)
               , Effect -> Effect
OnSmash (GroupName ItemKind -> Effect
Explode GroupName ItemKind
S_MELEE_PROTECTIVE_BALM) ]
  , idesc :: Text
idesc    = "A flask of wrestling balm that adheres to the body, but turns into slick oil when hit. Double dose causes twice longer effect."
  }
flask4 :: ItemKind
flask4 = ItemKind
flaskTemplate
  { ifreq :: Freqs ItemKind
ifreq    = [ (GroupName ItemKind
COMMON_ITEM, 100), (GroupName ItemKind
ANY_FLASK, 100), (GroupName ItemKind
EXPLOSIVE, 100)
               , (GroupName ItemKind
ANY_GLASS, 100), (GroupName ItemKind
OIL_SOURCE, 1) ]
  , iaspects :: [Aspect]
iaspects = Text -> Aspect
ELabel "of ranged protective balm"
               Aspect -> [Aspect] -> [Aspect]
forall a. a -> [a] -> [a]
: ItemKind -> [Aspect]
iaspects ItemKind
flaskTemplate
  , ieffects :: [Effect]
ieffects = [ GroupName ItemKind -> Dice -> Effect
toOrganGood GroupName ItemKind
S_PROTECTED_FROM_RANGED (20 Dice -> Dice -> Dice
forall a. Num a => a -> a -> a
+ 1 Int -> Int -> Dice
`d` 5)
               , Effect -> Effect
OnSmash (GroupName ItemKind -> Effect
Explode GroupName ItemKind
S_RANGE_PROTECTIVE_BALM) ]
  , idesc :: Text
idesc    = "A flask of durable body and fabric ointment. Its nanostructure hardens under stress. Double dose causes twice longer effect."
  }
flask5 :: ItemKind
flask5 = ItemKind
flaskTemplate
  { ifreq :: Freqs ItemKind
ifreq    = [ (GroupName ItemKind
COMMON_ITEM, 100), (GroupName ItemKind
ANY_FLASK, 100), (GroupName ItemKind
EXPLOSIVE, 100)
               , (GroupName ItemKind
ANY_GLASS, 100) ]
  , iaspects :: [Aspect]
iaspects = Text -> Aspect
ELabel "of fluorescent paint"
               Aspect -> [Aspect] -> [Aspect]
forall a. a -> [a] -> [a]
: ItemKind -> [Aspect]
iaspects ItemKind
flaskTemplate
  , ieffects :: [Effect]
ieffects = [ GroupName ItemKind -> Dice -> Effect
toOrganBad GroupName ItemKind
S_PAINTED (20 Dice -> Dice -> Dice
forall a. Num a => a -> a -> a
+ 1 Int -> Int -> Dice
`d` 5)
               , Effect -> Effect
OnSmash (GroupName ItemKind -> Effect
Explode GroupName ItemKind
S_PAINT_DROPLET) ]
  }
flask6 :: ItemKind
flask6 = ItemKind
flaskTemplate
  { ifreq :: Freqs ItemKind
ifreq    = [ (GroupName ItemKind
COMMON_ITEM, 100), (GroupName ItemKind
ANY_FLASK, 100), (GroupName ItemKind
EXPLOSIVE, 100)
               , (GroupName ItemKind
ANY_GLASS, 100) ]
  , irarity :: Rarity
irarity  = [(1, 1)]  -- not every playthrough needs one
  , iaspects :: [Aspect]
iaspects = Text -> Aspect
ELabel "of resolution spirit"
               Aspect -> [Aspect] -> [Aspect]
forall a. a -> [a] -> [a]
: ItemKind -> [Aspect]
iaspects ItemKind
flaskTemplate
  , ieffects :: [Effect]
ieffects = [ GroupName ItemKind -> Dice -> Effect
toOrganGood GroupName ItemKind
S_RESOLUTE (500 Dice -> Dice -> Dice
forall a. Num a => a -> a -> a
+ 1 Int -> Int -> Dice
`d` 200)  -- long, for scouting
               , Int -> Effect
RefillCalm 60  -- not to make it a drawback, via @calmEnough@
               , Effect -> Effect
OnSmash (GroupName ItemKind -> Effect
Explode GroupName ItemKind
S_RESOLUTION_DUST) ]
  }
flask7 :: ItemKind
flask7 = ItemKind
flaskTemplate
  { ifreq :: Freqs ItemKind
ifreq    = [ (GroupName ItemKind
COMMON_ITEM, 100), (GroupName ItemKind
ANY_FLASK, 100), (GroupName ItemKind
EXPLOSIVE, 100)
               , (GroupName ItemKind
ANY_GLASS, 100) ]
  , icount :: Dice
icount   = 1 Int -> Int -> Dice
`d` 2  -- too powerful en masse
  , iaspects :: [Aspect]
iaspects = Text -> Aspect
ELabel "of haste brew"
               Aspect -> [Aspect] -> [Aspect]
forall a. a -> [a] -> [a]
: ItemKind -> [Aspect]
iaspects ItemKind
flaskTemplate
  , ieffects :: [Effect]
ieffects = [ GroupName ItemKind -> Dice -> Effect
toOrganGood GroupName ItemKind
S_HASTED (20 Dice -> Dice -> Dice
forall a. Num a => a -> a -> a
+ 1 Int -> Int -> Dice
`d` 5)
               , Effect -> Effect
OnSmash (GroupName ItemKind -> Effect
Explode GroupName ItemKind
S_HASTE_SPRAY) ]
  }
flask8 :: ItemKind
flask8 = ItemKind
flaskTemplate
  { ifreq :: Freqs ItemKind
ifreq    = [ (GroupName ItemKind
COMMON_ITEM, 100), (GroupName ItemKind
ANY_FLASK, 100), (GroupName ItemKind
EXPLOSIVE, 100)
               , (GroupName ItemKind
ANY_GLASS, 100) ]
  , iaspects :: [Aspect]
iaspects = Text -> Aspect
ELabel "of eye drops"
               Aspect -> [Aspect] -> [Aspect]
forall a. a -> [a] -> [a]
: ItemKind -> [Aspect]
iaspects ItemKind
flaskTemplate
  , ieffects :: [Effect]
ieffects = [ GroupName ItemKind -> Dice -> Effect
toOrganGood GroupName ItemKind
S_FAR_SIGHTED (40 Dice -> Dice -> Dice
forall a. Num a => a -> a -> a
+ 1 Int -> Int -> Dice
`d` 10)
               , Effect -> Effect
OnSmash (GroupName ItemKind -> Effect
Explode GroupName ItemKind
S_EYE_DROP) ]
  }
flask9 :: ItemKind
flask9 = ItemKind
flaskTemplate
  { ifreq :: Freqs ItemKind
ifreq    = [ (GroupName ItemKind
COMMON_ITEM, 100), (GroupName ItemKind
ANY_FLASK, 100), (GroupName ItemKind
EXPLOSIVE, 100)
               , (GroupName ItemKind
ANY_GLASS, 100), (GroupName ItemKind
FIRE_FIGHTING_ITEM, 1) ]
  , irarity :: Rarity
irarity  = [(10, 2)]  -- not very useful right now
  , iaspects :: [Aspect]
iaspects = Text -> Aspect
ELabel "of smelly concoction"
               Aspect -> [Aspect] -> [Aspect]
forall a. a -> [a] -> [a]
: ItemKind -> [Aspect]
iaspects ItemKind
flaskTemplate
  , ieffects :: [Effect]
ieffects = [ GroupName ItemKind -> Dice -> Effect
toOrganGood GroupName ItemKind
S_KEEN_SMELLING (40 Dice -> Dice -> Dice
forall a. Num a => a -> a -> a
+ 1 Int -> Int -> Dice
`d` 10)
               , DetectKind -> Int -> Effect
Detect DetectKind
DetectActor 10  -- make it at least slightly useful
               , Effect -> Effect
OnSmash (GroupName ItemKind -> Effect
Explode GroupName ItemKind
S_SMELLY_DROPLET) ]
  }
flask10 :: ItemKind
flask10 = ItemKind
flaskTemplate
  { ifreq :: Freqs ItemKind
ifreq    = [ (GroupName ItemKind
COMMON_ITEM, 100), (GroupName ItemKind
ANY_FLASK, 100), (GroupName ItemKind
EXPLOSIVE, 100)
               , (GroupName ItemKind
ANY_GLASS, 100) ]
  , irarity :: Rarity
irarity  = [(10, 2)]  -- not very useful right now
  , iaspects :: [Aspect]
iaspects = Text -> Aspect
ELabel "of cat tears"
               Aspect -> [Aspect] -> [Aspect]
forall a. a -> [a] -> [a]
: ItemKind -> [Aspect]
iaspects ItemKind
flaskTemplate
  , ieffects :: [Effect]
ieffects = [ GroupName ItemKind -> Dice -> Effect
toOrganGood GroupName ItemKind
S_SHINY_EYED (40 Dice -> Dice -> Dice
forall a. Num a => a -> a -> a
+ 1 Int -> Int -> Dice
`d` 10)
               , Effect -> Effect
OnSmash (GroupName ItemKind -> Effect
Explode GroupName ItemKind
S_EYE_SHINE) ]
  }
flask11 :: ItemKind
flask11 = ItemKind
flaskTemplate
  { iname :: Text
iname    = "bottle"
  , ifreq :: Freqs ItemKind
ifreq    = [ (GroupName ItemKind
COMMON_ITEM, 100), (GroupName ItemKind
ANY_FLASK, 100), (GroupName ItemKind
EXPLOSIVE, 100)
               , (GroupName ItemKind
ANY_GLASS, 100), (GroupName ItemKind
ALCOHOL, 100), (GroupName ItemKind
FIRE_FIGHTING_ITEM, 2) ]
  , icount :: Dice
icount   = 1 Int -> Int -> Dice
`d` 2 Dice -> Dice -> Dice
forall a. Num a => a -> a -> a
+ 1 Int -> Int -> Dice
`d` 3
  , iaspects :: [Aspect]
iaspects = Text -> Aspect
ELabel "of whiskey"
               Aspect -> [Aspect] -> [Aspect]
forall a. a -> [a] -> [a]
: ItemKind -> [Aspect]
iaspects ItemKind
flaskTemplate
  , ieffects :: [Effect]
ieffects = [ GroupName ItemKind -> Dice -> Effect
toOrganGood GroupName ItemKind
S_DRUNK (20 Dice -> Dice -> Dice
forall a. Num a => a -> a -> a
+ 1 Int -> Int -> Dice
`d` 5)
               , Dice -> Effect
Burn 10, Int -> Effect
RefillHP 10, Effect
Yell
               , Effect -> Effect
OnSmash (GroupName ItemKind -> Effect
Explode GroupName ItemKind
S_WHISKEY_SPRAY) ]
  }
flask12 :: ItemKind
flask12 = ItemKind
flaskTemplate
  { ifreq :: Freqs ItemKind
ifreq    = [ (GroupName ItemKind
COMMON_ITEM, 100), (GroupName ItemKind
ANY_FLASK, 100), (GroupName ItemKind
EXPLOSIVE, 100)
               , (GroupName ItemKind
ANY_GLASS, 100), (GroupName ItemKind
WATER_SOURCE, 1) ]
  , iaspects :: [Aspect]
iaspects = Text -> Aspect
ELabel "of bait and switch"
               Aspect -> [Aspect] -> [Aspect]
forall a. a -> [a] -> [a]
: ItemKind -> [Aspect]
iaspects ItemKind
flaskTemplate
  , ieffects :: [Effect]
ieffects = [ GroupName ItemKind -> Dice -> Effect
Summon GroupName ItemKind
MOBILE_ANIMAL 1  -- won't work if no Calm; fun exploit
               , Dice -> Effect
Teleport 7  -- escape sometimes worth the summon
               , Effect -> Effect
OnSmash (GroupName ItemKind -> Dice -> Effect
Summon GroupName ItemKind
MOBILE_ANIMAL 1)
               , Effect -> Effect
OnSmash Effect
Impress  -- mildly useful when thrown
               , Effect -> Effect
OnSmash (GroupName ItemKind -> Effect
Explode GroupName ItemKind
S_WASTE) ]
  }
flask13 :: ItemKind
flask13 = ItemKind
flaskTemplate
  { ifreq :: Freqs ItemKind
ifreq    = [ (GroupName ItemKind
COMMON_ITEM, 100), (GroupName ItemKind
ANY_FLASK, 100), (GroupName ItemKind
EXPLOSIVE, 100)
               , (GroupName ItemKind
ANY_GLASS, 100) ]
  , iaspects :: [Aspect]
iaspects = Text -> Aspect
ELabel "of poison"
               Aspect -> [Aspect] -> [Aspect]
forall a. a -> [a] -> [a]
: ItemKind -> [Aspect]
iaspects ItemKind
flaskTemplate
  , ieffects :: [Effect]
ieffects = [ GroupName ItemKind -> Effect
toOrganNoTimer GroupName ItemKind
S_POISONED, GroupName ItemKind -> Effect
toOrganNoTimer GroupName ItemKind
S_POISONED  -- x2
               , Effect -> Effect
OnSmash (GroupName ItemKind -> Effect
Explode GroupName ItemKind
S_POISON_CLOUD) ]
  }
flask14 :: ItemKind
flask14 = ItemKind
flaskTemplate
  { ifreq :: Freqs ItemKind
ifreq    = [ (GroupName ItemKind
COMMON_ITEM, 100), (GroupName ItemKind
ANY_FLASK, 100), (GroupName ItemKind
EXPLOSIVE, 100)
               , (GroupName ItemKind
ANY_GLASS, 100) ]
  , iaspects :: [Aspect]
iaspects = Text -> Aspect
ELabel "of calamity mixture"
               Aspect -> [Aspect] -> [Aspect]
forall a. a -> [a] -> [a]
: ItemKind -> [Aspect]
iaspects ItemKind
flaskTemplate
  , ieffects :: [Effect]
ieffects = [ GroupName ItemKind -> Effect
toOrganNoTimer GroupName ItemKind
S_POISONED
               , GroupName ItemKind -> Dice -> Effect
toOrganBad GroupName ItemKind
S_WEAKENED (20 Dice -> Dice -> Dice
forall a. Num a => a -> a -> a
+ 1 Int -> Int -> Dice
`d` 5)
               , GroupName ItemKind -> Dice -> Effect
toOrganBad GroupName ItemKind
S_DEFENSELESS (20 Dice -> Dice -> Dice
forall a. Num a => a -> a -> a
+ 1 Int -> Int -> Dice
`d` 5)
               , Effect -> Effect
OnSmash (GroupName ItemKind -> Effect
Explode GroupName ItemKind
S_GLASS_HAIL) ]  -- enough glass to cause that
  }
flask15 :: ItemKind
flask15 = ItemKind
flaskTemplate
  { iname :: Text
iname    = "cartridge"
  , ifreq :: Freqs ItemKind
ifreq    = [ (GroupName ItemKind
COMMON_ITEM, 100), (GroupName ItemKind
ANY_FLASK, 100), (GroupName ItemKind
EXPLOSIVE, 100)
               , (GroupName ItemKind
ANY_GLASS, 100), (GroupName ItemKind
LIQUID_NITROGEN, 1), (GroupName ItemKind
COLD_SOURCE, 1)
               , (GroupName ItemKind
FIRE_FIGHTING_ITEM, 40) ]
  , irarity :: Rarity
irarity  = [(1, 3)]  -- scavenged from walls
  , iaspects :: [Aspect]
iaspects = Text -> Aspect
ELabel "of liquid nitrogen"
               Aspect -> [Aspect] -> [Aspect]
forall a. a -> [a] -> [a]
: ItemKind -> [Aspect]
iaspects ItemKind
flaskTemplate
  , ieffects :: [Effect]
ieffects = [ Dice -> Effect
Burn 1  -- sensory ambiguity between hot and cold
               , GroupName ItemKind -> Dice -> Effect
toOrganBad GroupName ItemKind
S_SLOWED (3 Dice -> Dice -> Dice
forall a. Num a => a -> a -> a
+ 1 Int -> Int -> Dice
`d` 3)
               , Effect -> Effect
OnSmash (GroupName ItemKind -> Effect
Explode GroupName ItemKind
S_FOCUSED_SLOWNESS_MIST) ]
  }
flask16 :: ItemKind
flask16 = ItemKind
flaskTemplate  -- diluted perfume; almost same effects
  { ifreq :: Freqs ItemKind
ifreq    = [ (GroupName ItemKind
COMMON_ITEM, 100), (GroupName ItemKind
S_ROSE_WATER_FLASK, 1)
               , (GroupName ItemKind
ANY_FLASK, 100), (GroupName ItemKind
EXPLOSIVE, 100), (GroupName ItemKind
ANY_GLASS, 100) ]
  , icount :: Dice
icount   = 1
  , irarity :: Rarity
irarity  = [(1, 3)]  -- mostly obtained through crafting
  , iaspects :: [Aspect]
iaspects = Text -> Aspect
ELabel "of rose water"
               Aspect -> [Aspect] -> [Aspect]
forall a. a -> [a] -> [a]
: ItemKind -> [Aspect]
iaspects ItemKind
flaskTemplate
  , ieffects :: [Effect]
ieffects = [ Effect
Impress, GroupName ItemKind -> Dice -> Effect
toOrganGood GroupName ItemKind
S_ROSE_SMELLING (100 Dice -> Dice -> Dice
forall a. Num a => a -> a -> a
+ 1 Int -> Int -> Dice
`d` 20)
               , Effect -> Effect
OnSmash Effect
ApplyPerfume, Effect -> Effect
OnSmash (GroupName ItemKind -> Effect
Explode GroupName ItemKind
S_FRAGRANCE) ]
  }
flask17 :: ItemKind
flask17 = ItemKind
flaskTemplate
  { iname :: Text
iname    = "galon"
      -- TODO: in the future perhaps have different sizes of flasks;
      -- for now, we freely go from flask to galon and back
  , ifreq :: Freqs ItemKind
ifreq    = [ (GroupName ItemKind
COMMON_ITEM, 100), (GroupName ItemKind
S_WATER_FLASK, 1)
               , (GroupName ItemKind
ANY_FLASK, 100), (GroupName ItemKind
ANY_GLASS, 100), (GroupName ItemKind
WATER_SOURCE, 1)
               , (GroupName ItemKind
FIRE_FIGHTING_ITEM, 2) ]
  , icount :: Dice
icount   = 1
  , irarity :: Rarity
irarity  = [(1, 1)]  -- mostly obtained through crafting
  , iaspects :: [Aspect]
iaspects = Text -> Aspect
ELabel "of water"
               Aspect -> [Aspect] -> [Aspect]
forall a. a -> [a] -> [a]
: ItemKind -> [Aspect]
iaspects ItemKind
flaskTemplate
  }

-- Vials are often not intended to be thrown. They are usually natural,
-- including natural stat boosts. They also include the only healing
-- consumables in the game, apart of stimpacks and, to a limited extent, fruits.
-- They appear deeper than most flasks. Various configurations of effects.
-- A different class of effects is on scrolls and mechanical items.
-- Some are shared.

potionTemplate :: ItemKind
potionTemplate = $WItemKind :: Char
-> Text
-> Freqs ItemKind
-> [Flavour]
-> Dice
-> Rarity
-> Text
-> Int
-> Dice
-> [Aspect]
-> [Effect]
-> [(GroupName ItemKind, CStore)]
-> Text
-> ItemKind
ItemKind
  { isymbol :: Char
isymbol  = Char
symbolPotion
  , iname :: Text
iname    = "vial"
  , ifreq :: Freqs ItemKind
ifreq    = [(GroupName ItemKind
POTION_UNKNOWN, 1)]
  , iflavour :: [Flavour]
iflavour = [Color] -> [Flavour]
zipLiquid [Color]
brightCol [Flavour] -> [Flavour] -> [Flavour]
forall a. [a] -> [a] -> [a]
++ [Color] -> [Flavour]
zipPlain [Color]
brightCol [Flavour] -> [Flavour] -> [Flavour]
forall a. [a] -> [a] -> [a]
++ [Color] -> [Flavour]
zipFancy [Color]
brightCol
  , icount :: Dice
icount   = 1 Int -> Int -> Dice
`dL` 3
  , irarity :: Rarity
irarity  = [(1, 10), (10, 6)]
  , iverbHit :: Text
iverbHit = "splash"
  , iweight :: Int
iweight  = 200
  , idamage :: Dice
idamage  = 0
  , iaspects :: [Aspect]
iaspects = [ GroupName ItemKind -> Aspect
PresentAs GroupName ItemKind
POTION_UNKNOWN, Flag -> Aspect
SetFlag Flag
Lobable, Flag -> Aspect
SetFlag Flag
Fragile
               , Int -> Aspect
toVelocity 50 ]  -- oily, small momentum due to small size
  , ieffects :: [Effect]
ieffects = []
  , idesc :: Text
idesc    = "A vial of bright, frothing concoction. The best medicine that nature has to offer for wounds, ailments and mood swings."
  , ikit :: [(GroupName ItemKind, CStore)]
ikit     = []
  }
potion1 :: ItemKind
potion1 = ItemKind
potionTemplate
  { ifreq :: Freqs ItemKind
ifreq    = [ (GroupName ItemKind
COMMON_ITEM, 100), (GroupName ItemKind
S_PERFUME_POTION, 1)
               , (GroupName ItemKind
ANY_POTION, 100), (GroupName ItemKind
ANY_GLASS, 100), (GroupName ItemKind
PERFUME, 1) ]
  , icount :: Dice
icount   = 3 Int -> Int -> Dice
`dL` 1  -- very useful, despite appearances;
                         -- AI heroes can't craft and so die horribly without it
  , iaspects :: [Aspect]
iaspects = Text -> Aspect
ELabel "of perfume"
               Aspect -> [Aspect] -> [Aspect]
forall a. a -> [a] -> [a]
: ItemKind -> [Aspect]
iaspects ItemKind
potionTemplate
  , ieffects :: [Effect]
ieffects = [ Effect
Impress, GroupName ItemKind -> Dice -> Effect
toOrganGood GroupName ItemKind
S_ROSE_SMELLING (50 Dice -> Dice -> Dice
forall a. Num a => a -> a -> a
+ 1 Int -> Int -> Dice
`d` 10)
               , Effect -> Effect
OnSmash Effect
ApplyPerfume, Effect -> Effect
OnSmash (GroupName ItemKind -> Effect
Explode GroupName ItemKind
S_FRAGRANCE) ]
  }
potion2 :: ItemKind
potion2 = ItemKind
potionTemplate
  { iname :: Text
iname    = "the Vial"
  , ifreq :: Freqs ItemKind
ifreq    = [(GroupName ItemKind
CRAWL_ITEM, 100), (GroupName ItemKind
ANY_GLASS, 50)]
  , icount :: Dice
icount   = 1
  , irarity :: Rarity
irarity  = [(5, 6), (10, 2)]
  , iaspects :: [Aspect]
iaspects = [ Flag -> Aspect
SetFlag Flag
Unique, Text -> Aspect
ELabel "of Attraction"
               , Flag -> Aspect
SetFlag Flag
Precious, Flag -> Aspect
SetFlag Flag
Lobable, Flag -> Aspect
SetFlag Flag
Fragile
               , Int -> Aspect
toVelocity 50 ]  -- identified
  , ieffects :: [Effect]
ieffects = [ Effect
Dominate
               , GroupName ItemKind -> Dice -> Effect
toOrganGood GroupName ItemKind
S_HASTED (20 Dice -> Dice -> Dice
forall a. Num a => a -> a -> a
+ 1 Int -> Int -> Dice
`d` 5)
               , Int -> Dice -> Effect
Recharge 20 999
               , Effect -> Effect
OnSmash (GroupName ItemKind -> Effect
Explode GroupName ItemKind
S_PHEROMONE)
               , Effect -> Effect
OnSmash (GroupName ItemKind -> Effect
Explode GroupName ItemKind
S_HASTE_SPRAY) ]
  , idesc :: Text
idesc    = "The liquid fizzes with energy."
  }
potion3 :: ItemKind
potion3 = ItemKind
potionTemplate
  { ifreq :: Freqs ItemKind
ifreq    = [(GroupName ItemKind
COMMON_ITEM, 100), (GroupName ItemKind
ANY_POTION, 100), (GroupName ItemKind
ANY_GLASS, 100)]
  , ieffects :: [Effect]
ieffects = [ Int -> Effect
RefillHP 5, Int -> Int -> CStore -> GroupName ItemKind -> Effect
DropItem 1 Int
forall a. Bounded a => a
maxBound CStore
COrgan GroupName ItemKind
S_POISONED
               , Effect -> Effect
OnSmash (GroupName ItemKind -> Effect
Explode GroupName ItemKind
S_HEALING_MIST) ]
  }
potion4 :: ItemKind
potion4 = ItemKind
potionTemplate
  { ifreq :: Freqs ItemKind
ifreq    = [(GroupName ItemKind
COMMON_ITEM, 100), (GroupName ItemKind
ANY_POTION, 100), (GroupName ItemKind
ANY_GLASS, 100)]
  , irarity :: Rarity
irarity  = [(1, 5), (10, 10)]
  , ieffects :: [Effect]
ieffects = [ Int -> Effect
RefillHP 10
               , Int -> Int -> CStore -> GroupName ItemKind -> Effect
DropItem Int
forall a. Bounded a => a
maxBound Int
forall a. Bounded a => a
maxBound CStore
COrgan GroupName ItemKind
CONDITION
               , Effect -> Effect
OnSmash (GroupName ItemKind -> Effect
Explode GroupName ItemKind
S_HEALING_MIST_2) ]
  }
potion5 :: ItemKind
potion5 = ItemKind
potionTemplate
  { iname :: Text
iname    = "ampoule"  -- filled with semi-stabilized high explosive liquid
  , ifreq :: Freqs ItemKind
ifreq    = [(GroupName ItemKind
COMMON_ITEM, 100), (GroupName ItemKind
ANY_POTION, 100), (GroupName ItemKind
ANY_GLASS, 100)]
  , icount :: Dice
icount   = 3 Int -> Int -> Dice
`dL` 1
  , ieffects :: [Effect]
ieffects = [ Int -> Int -> CStore -> GroupName ItemKind -> Effect
DropItem 1 Int
forall a. Bounded a => a
maxBound CStore
COrgan GroupName ItemKind
CONDITION
               , Effect -> Effect
OnSmash (GroupName ItemKind -> Effect
Explode GroupName ItemKind
S_VIOLENT_CONCUSSION) ]
      -- not fragmentation nor glass hail, because not enough glass
  }
potion6 :: ItemKind
potion6 = ItemKind
potionTemplate
  -- needs to be common to show at least a portion of effects
  { ifreq :: Freqs ItemKind
ifreq    = [(GroupName ItemKind
COMMON_ITEM, 100), (GroupName ItemKind
ANY_POTION, 100), (GroupName ItemKind
ANY_GLASS, 100)]
  , icount :: Dice
icount   = 3 Int -> Int -> Dice
`dL` 1  -- always as many as possible on this level
                         -- without giving away potion identity
  , irarity :: Rarity
irarity  = [(1, 12)]
  , ieffects :: [Effect]
ieffects = [ [Effect] -> Effect
OneOf [ Int -> Effect
RefillHP 10, Int -> Effect
RefillHP 5, Dice -> Effect
Burn 5
                       , Int -> Int -> CStore -> GroupName ItemKind -> Effect
DropItem 1 Int
forall a. Bounded a => a
maxBound CStore
COrgan GroupName ItemKind
S_POISONED
                       , GroupName ItemKind -> Dice -> Effect
toOrganGood GroupName ItemKind
S_STRENGTHENED (20 Dice -> Dice -> Dice
forall a. Num a => a -> a -> a
+ 1 Int -> Int -> Dice
`d` 5) ]
               , Effect -> Effect
OnSmash ([Effect] -> Effect
OneOf [ GroupName ItemKind -> Effect
Explode GroupName ItemKind
S_DENSE_SHOWER
                                , GroupName ItemKind -> Effect
Explode GroupName ItemKind
S_SPARSE_SHOWER
                                , GroupName ItemKind -> Effect
Explode GroupName ItemKind
S_MELEE_PROTECTIVE_BALM
                                , GroupName ItemKind -> Effect
Explode GroupName ItemKind
S_RANGE_PROTECTIVE_BALM
                                , GroupName ItemKind -> Effect
Explode GroupName ItemKind
S_DEFENSELESSNESS_RUNOUT ]) ]
  }
potion7 :: ItemKind
potion7 = ItemKind
potionTemplate
  -- needs to be common to show at least a portion of effects
  { ifreq :: Freqs ItemKind
ifreq    = [(GroupName ItemKind
COMMON_ITEM, 100), (GroupName ItemKind
ANY_POTION, 100), (GroupName ItemKind
ANY_GLASS, 100)]
  , icount :: Dice
icount   = 3 Int -> Int -> Dice
`dL` 1
  , irarity :: Rarity
irarity  = [(10, 12)]
  , ieffects :: [Effect]
ieffects = [ Effect
Impress
               , [Effect] -> Effect
OneOf [ Int -> Effect
RefillHP 20, Int -> Effect
RefillHP 10, Dice -> Effect
Burn 10
                       , Int -> Int -> CStore -> GroupName ItemKind -> Effect
DropItem 1 Int
forall a. Bounded a => a
maxBound CStore
COrgan GroupName ItemKind
S_POISONED
                       , GroupName ItemKind -> Dice -> Effect
toOrganGood GroupName ItemKind
S_HASTED (20 Dice -> Dice -> Dice
forall a. Num a => a -> a -> a
+ 1 Int -> Int -> Dice
`d` 5)
                       , GroupName ItemKind -> Dice -> Effect
toOrganBad GroupName ItemKind
S_IMPATIENT (2 Dice -> Dice -> Dice
forall a. Num a => a -> a -> a
+ 1 Int -> Int -> Dice
`d` 2) ]
               , Effect -> Effect
OnSmash ([Effect] -> Effect
OneOf [ GroupName ItemKind -> Effect
Explode GroupName ItemKind
S_HEALING_MIST_2
                                , GroupName ItemKind -> Effect
Explode GroupName ItemKind
S_WOUNDING_MIST
                                , GroupName ItemKind -> Effect
Explode GroupName ItemKind
S_DISTRESSING_ODOR
                                , GroupName ItemKind -> Effect
Explode (GroupName ItemKind -> Effect) -> GroupName ItemKind -> Effect
forall a b. (a -> b) -> a -> b
$ GroupName ItemKind -> GroupName ItemKind
blastNoStatOf GroupName ItemKind
S_IMPATIENT
                                , GroupName ItemKind -> Effect
Explode GroupName ItemKind
S_HASTE_SPRAY
                                , GroupName ItemKind -> Effect
Explode GroupName ItemKind
S_VIOLENT_SLOWNESS_MIST
                                , GroupName ItemKind -> Effect
Explode GroupName ItemKind
S_FRAGRANCE
                                , GroupName ItemKind -> Effect
Explode GroupName ItemKind
S_VIOLENT_FLASH ]) ]
  }
potion8 :: ItemKind
potion8 = ItemKind
potionTemplate
  { iname :: Text
iname    = "the Vial"
  , ifreq :: Freqs ItemKind
ifreq    = [(GroupName ItemKind
CRAWL_ITEM, 100), (GroupName ItemKind
ANY_GLASS, 50)]
  , icount :: Dice
icount   = 1
  , irarity :: Rarity
irarity  = [(10, 5)]
  , iaspects :: [Aspect]
iaspects = [ Flag -> Aspect
SetFlag Flag
Unique, Text -> Aspect
ELabel "of Love"
               , Flag -> Aspect
SetFlag Flag
Precious, Flag -> Aspect
SetFlag Flag
Lobable, Flag -> Aspect
SetFlag Flag
Fragile
               , Int -> Aspect
toVelocity 50 ]  -- identified
  , ieffects :: [Effect]
ieffects = [ Int -> Effect
RefillHP 60, Int -> Effect
RefillCalm (-60)
               , GroupName ItemKind -> Dice -> Effect
toOrganGood GroupName ItemKind
S_ROSE_SMELLING (80 Dice -> Dice -> Dice
forall a. Num a => a -> a -> a
+ 1 Int -> Int -> Dice
`d` 20)
               , Effect -> Effect
OnSmash (GroupName ItemKind -> Effect
Explode GroupName ItemKind
S_HEALING_MIST_2)
               , Effect -> Effect
OnSmash (GroupName ItemKind -> Effect
Explode GroupName ItemKind
S_DISTRESSING_ODOR) ]
  , idesc :: Text
idesc    = "Perplexing swirls of intense, compelling colour."
  }
potion9 :: ItemKind
potion9 = ItemKind
potionTemplate
  { ifreq :: Freqs ItemKind
ifreq    = [(GroupName ItemKind
COMMON_ITEM, 100), (GroupName ItemKind
ANY_POTION, 100), (GroupName ItemKind
ANY_GLASS, 100)]
  , irarity :: Rarity
irarity  = [(10, 5)]
  , iaspects :: [Aspect]
iaspects = Text -> Aspect
ELabel "of grenadier focus"
               Aspect -> [Aspect] -> [Aspect]
forall a. a -> [a] -> [a]
: ItemKind -> [Aspect]
iaspects ItemKind
potionTemplate
  , ieffects :: [Effect]
ieffects = [ GroupName ItemKind -> Dice -> Effect
toOrganGood GroupName ItemKind
S_MORE_PROJECTING (40 Dice -> Dice -> Dice
forall a. Num a => a -> a -> a
+ 1 Int -> Int -> Dice
`d` 10)
               , GroupName ItemKind -> Dice -> Effect
toOrganBad GroupName ItemKind
S_PACIFIED (5 Dice -> Dice -> Dice
forall a. Num a => a -> a -> a
+ 1 Int -> Int -> Dice
`d` 3)
                   -- the malus has to be weak, or would be too good
                   -- when thrown at foes
               , Effect -> Effect
OnSmash (GroupName ItemKind -> Effect
Explode (GroupName ItemKind -> Effect) -> GroupName ItemKind -> Effect
forall a b. (a -> b) -> a -> b
$ GroupName ItemKind -> GroupName ItemKind
blastBonusStatOf GroupName ItemKind
S_MORE_PROJECTING)
               , Effect -> Effect
OnSmash (GroupName ItemKind -> Effect
Explode (GroupName ItemKind -> Effect) -> GroupName ItemKind -> Effect
forall a b. (a -> b) -> a -> b
$ GroupName ItemKind -> GroupName ItemKind
blastNoStatOf GroupName ItemKind
S_PACIFIED) ]
  , idesc :: Text
idesc    = "Thick, sluggish fluid with violently-bursting bubbles."
  }
potion10 :: ItemKind
potion10 = ItemKind
potionTemplate
  { ifreq :: Freqs ItemKind
ifreq    = [(GroupName ItemKind
COMMON_ITEM, 100), (GroupName ItemKind
ANY_POTION, 100), (GroupName ItemKind
ANY_GLASS, 100)]
  , irarity :: Rarity
irarity  = [(10, 8)]
  , iaspects :: [Aspect]
iaspects = Text -> Aspect
ELabel "of frenzy"
               Aspect -> [Aspect] -> [Aspect]
forall a. a -> [a] -> [a]
: ItemKind -> [Aspect]
iaspects ItemKind
potionTemplate
  , ieffects :: [Effect]
ieffects = [ Effect
Yell
               , GroupName ItemKind -> Dice -> Effect
toOrganGood GroupName ItemKind
S_STRENGTHENED (20 Dice -> Dice -> Dice
forall a. Num a => a -> a -> a
+ 1 Int -> Int -> Dice
`d` 5)
               , GroupName ItemKind -> Dice -> Effect
toOrganBad GroupName ItemKind
S_RETAINING (5 Dice -> Dice -> Dice
forall a. Num a => a -> a -> a
+ 1 Int -> Int -> Dice
`d` 3)
               , GroupName ItemKind -> Dice -> Effect
toOrganBad GroupName ItemKind
S_FRENZIED (40 Dice -> Dice -> Dice
forall a. Num a => a -> a -> a
+ 1 Int -> Int -> Dice
`d` 10)
               , Effect -> Effect
OnSmash (GroupName ItemKind -> Effect
Explode GroupName ItemKind
S_DENSE_SHOWER)
               , Effect -> Effect
OnSmash (GroupName ItemKind -> Effect
Explode (GroupName ItemKind -> Effect) -> GroupName ItemKind -> Effect
forall a b. (a -> b) -> a -> b
$ GroupName ItemKind -> GroupName ItemKind
blastNoStatOf GroupName ItemKind
S_RETAINING)    -- more
               , Effect -> Effect
OnSmash (GroupName ItemKind -> Effect
Explode (GroupName ItemKind -> Effect) -> GroupName ItemKind -> Effect
forall a b. (a -> b) -> a -> b
$ GroupName ItemKind -> GroupName ItemKind
blastNoStatOf GroupName ItemKind
S_RETAINING) ]  -- explosion
  }
potion11 :: ItemKind
potion11 = ItemKind
potionTemplate
  { ifreq :: Freqs ItemKind
ifreq    = [(GroupName ItemKind
COMMON_ITEM, 100), (GroupName ItemKind
ANY_POTION, 100), (GroupName ItemKind
ANY_GLASS, 100)]
  , irarity :: Rarity
irarity  = [(10, 8)]
  , iaspects :: [Aspect]
iaspects = Text -> Aspect
ELabel "of panic"
               Aspect -> [Aspect] -> [Aspect]
forall a. a -> [a] -> [a]
: ItemKind -> [Aspect]
iaspects ItemKind
potionTemplate
  , ieffects :: [Effect]
ieffects = [ Int -> Effect
RefillCalm (-60)
               , GroupName ItemKind -> Dice -> Effect
toOrganGood GroupName ItemKind
S_HASTED (20 Dice -> Dice -> Dice
forall a. Num a => a -> a -> a
+ 1 Int -> Int -> Dice
`d` 5)
               , GroupName ItemKind -> Dice -> Effect
toOrganBad GroupName ItemKind
S_WEAKENED (20 Dice -> Dice -> Dice
forall a. Num a => a -> a -> a
+ 1 Int -> Int -> Dice
`d` 5)
               , GroupName ItemKind -> Dice -> Effect
toOrganBad GroupName ItemKind
S_WITHHOLDING (10 Dice -> Dice -> Dice
forall a. Num a => a -> a -> a
+ 1 Int -> Int -> Dice
`d` 5)
               , Effect -> Effect
OnSmash (GroupName ItemKind -> Effect
Explode GroupName ItemKind
S_HASTE_SPRAY)
               , Effect -> Effect
OnSmash (GroupName ItemKind -> Effect
Explode GroupName ItemKind
S_SPARSE_SHOWER)
               , Effect -> Effect
OnSmash (GroupName ItemKind -> Effect
Explode (GroupName ItemKind -> Effect) -> GroupName ItemKind -> Effect
forall a b. (a -> b) -> a -> b
$ GroupName ItemKind -> GroupName ItemKind
blastNoStatOf GroupName ItemKind
S_WITHHOLDING) ]
  }
potion12 :: ItemKind
potion12 = ItemKind
potionTemplate
  { ifreq :: Freqs ItemKind
ifreq    = [(GroupName ItemKind
COMMON_ITEM, 100), (GroupName ItemKind
ANY_POTION, 100), (GroupName ItemKind
ANY_GLASS, 100)]
  , irarity :: Rarity
irarity  = [(10, 8)]
  , iaspects :: [Aspect]
iaspects = Text -> Aspect
ELabel "of quicksilver"
               Aspect -> [Aspect] -> [Aspect]
forall a. a -> [a] -> [a]
: ItemKind -> [Aspect]
iaspects ItemKind
potionTemplate
  , ieffects :: [Effect]
ieffects = [ GroupName ItemKind -> Dice -> Effect
toOrganGood GroupName ItemKind
S_HASTED (20 Dice -> Dice -> Dice
forall a. Num a => a -> a -> a
+ 1 Int -> Int -> Dice
`d` 5)
               , Int -> Dice -> Effect
Discharge 3 40
               , GroupName ItemKind -> Dice -> Effect
toOrganBad GroupName ItemKind
S_IMMOBILE (5 Dice -> Dice -> Dice
forall a. Num a => a -> a -> a
+ 1 Int -> Int -> Dice
`d` 5)
               , Effect -> Effect
OnSmash (GroupName ItemKind -> Effect
Explode GroupName ItemKind
S_HASTE_SPRAY)
               , Effect -> Effect
OnSmash (GroupName ItemKind -> Effect
Explode GroupName ItemKind
S_IRON_FILING)
               , Effect -> Effect
OnSmash (GroupName ItemKind -> Effect
Explode (GroupName ItemKind -> Effect) -> GroupName ItemKind -> Effect
forall a b. (a -> b) -> a -> b
$ GroupName ItemKind -> GroupName ItemKind
blastNoStatOf GroupName ItemKind
S_IMMOBILE) ]
  }
potion13 :: ItemKind
potion13 = ItemKind
potionTemplate
  { ifreq :: Freqs ItemKind
ifreq    = [(GroupName ItemKind
COMMON_ITEM, 100), (GroupName ItemKind
ANY_POTION, 100), (GroupName ItemKind
ANY_GLASS, 100)]
  , irarity :: Rarity
irarity  = [(10, 7)]
  , iaspects :: [Aspect]
iaspects = Text -> Aspect
ELabel "of slow resistance"
               Aspect -> [Aspect] -> [Aspect]
forall a. a -> [a] -> [a]
: ItemKind -> [Aspect]
iaspects ItemKind
potionTemplate
  , ieffects :: [Effect]
ieffects = [ GroupName ItemKind -> Effect
toOrganNoTimer GroupName ItemKind
S_SLOW_RESISTANT
               , Effect -> Effect
OnSmash (GroupName ItemKind -> Effect
Explode GroupName ItemKind
S_ANTI_SLOW_MIST) ]
  }
potion14 :: ItemKind
potion14 = ItemKind
potionTemplate
  { ifreq :: Freqs ItemKind
ifreq    = [(GroupName ItemKind
COMMON_ITEM, 100), (GroupName ItemKind
ANY_POTION, 100), (GroupName ItemKind
ANY_GLASS, 100)]
  , irarity :: Rarity
irarity  = [(10, 7)]
  , iaspects :: [Aspect]
iaspects = Text -> Aspect
ELabel "of poison resistance"
               Aspect -> [Aspect] -> [Aspect]
forall a. a -> [a] -> [a]
: ItemKind -> [Aspect]
iaspects ItemKind
potionTemplate
  , ieffects :: [Effect]
ieffects = [ GroupName ItemKind -> Effect
toOrganNoTimer GroupName ItemKind
S_POISON_RESISTANT
               , Effect -> Effect
OnSmash (GroupName ItemKind -> Effect
Explode GroupName ItemKind
S_ANTIDOTE_MIST) ]
  }
-- The player has full control over throwing the vial at his party,
-- so he can milk the explosion, so it has to be much weaker, so a weak
-- healing effect is enough. OTOH, throwing a harmful flask at many enemies
-- at once is not easy to arrange, so these explosions can stay powerful.
potion15 :: ItemKind
potion15 = ItemKind
potionTemplate
  { ifreq :: Freqs ItemKind
ifreq    = [(GroupName ItemKind
COMMON_ITEM, 100), (GroupName ItemKind
ANY_POTION, 100), (GroupName ItemKind
ANY_GLASS, 100)]
  , icount :: Dice
icount   = 1 Int -> Int -> Dice
`dL` 5
  , irarity :: Rarity
irarity  = [(1, 2), (10, 12)]
  , iaspects :: [Aspect]
iaspects = Text -> Aspect
ELabel "of regeneration"
               Aspect -> [Aspect] -> [Aspect]
forall a. a -> [a] -> [a]
: ItemKind -> [Aspect]
iaspects ItemKind
potionTemplate
  , ieffects :: [Effect]
ieffects = [ GroupName ItemKind -> Dice -> Effect
toOrganGood GroupName ItemKind
S_ROSE_SMELLING (80 Dice -> Dice -> Dice
forall a. Num a => a -> a -> a
+ 1 Int -> Int -> Dice
`d` 20)
               , GroupName ItemKind -> Effect
toOrganNoTimer GroupName ItemKind
S_REGENERATING
               , GroupName ItemKind -> Effect
toOrganNoTimer GroupName ItemKind
S_REGENERATING  -- x2
               , Effect -> Effect
OnSmash (GroupName ItemKind -> Effect
Explode GroupName ItemKind
S_YOUTH_SPRINKLE) ]
  }
potion16 :: ItemKind
potion16 = ItemKind
potionTemplate
  { ifreq :: Freqs ItemKind
ifreq    = [(GroupName ItemKind
CRAWL_ITEM, 100), (GroupName ItemKind
ANY_POTION, 50)]
  , icount :: Dice
icount   = 1 Int -> Int -> Dice
`dL` 2
  , irarity :: Rarity
irarity  = [(1, 1), (10, 6)]
  , iaspects :: [Aspect]
iaspects = Text -> Aspect
ELabel "of melee deflection"
               Aspect -> [Aspect] -> [Aspect]
forall a. a -> [a] -> [a]
: ItemKind -> [Aspect]
iaspects ItemKind
potionTemplate
  , ieffects :: [Effect]
ieffects = [ GroupName ItemKind -> Dice -> Effect
toOrganGood GroupName ItemKind
S_MELEE_DEFLECTING 2
               , Effect -> Effect
OnSmash (GroupName ItemKind -> Effect
Explode GroupName ItemKind
S_HASTE_SPRAY) ]
                   -- choice of haste instead, e.g., against ranged enemies
  }

-- ** Non-exploding consumables, not specifically designed for throwing

-- Readable or otherwise communicating consumables require high apply skill
-- to be consumed.

scrollTemplate :: ItemKind
scrollTemplate = $WItemKind :: Char
-> Text
-> Freqs ItemKind
-> [Flavour]
-> Dice
-> Rarity
-> Text
-> Int
-> Dice
-> [Aspect]
-> [Effect]
-> [(GroupName ItemKind, CStore)]
-> Text
-> ItemKind
ItemKind
  { isymbol :: Char
isymbol  = Char
symbolScroll
  , iname :: Text
iname    = "chip"
  , ifreq :: Freqs ItemKind
ifreq    = [(GroupName ItemKind
SCROLL_UNKNOWN, 1)]
  , iflavour :: [Flavour]
iflavour = [Color] -> [Flavour]
zipFancy [Color]
stdCol [Flavour] -> [Flavour] -> [Flavour]
forall a. [a] -> [a] -> [a]
++ [Color] -> [Flavour]
zipPlain [Color]
stdCol
  , icount :: Dice
icount   = 1 Int -> Int -> Dice
`dL` 3
  , irarity :: Rarity
irarity  = [(1, 12), (10, 6)]
  , iverbHit :: Text
iverbHit = "thump"
  , iweight :: Int
iweight  = 20
  , idamage :: Dice
idamage  = 0
  , iaspects :: [Aspect]
iaspects = [ GroupName ItemKind -> Aspect
PresentAs GroupName ItemKind
SCROLL_UNKNOWN
               , Int -> Aspect
toVelocity 30 ]  -- too small
  , ieffects :: [Effect]
ieffects = []
  , idesc :: Text
idesc    = "A generic, disposable chip, capable of a one-time holo-display. Some of these also contain a one-time password authorizing a particular spaceship's infrastructure transition. Nobody knows how the infrastructure might respond after so many years."
  , ikit :: [(GroupName ItemKind, CStore)]
ikit     = []
  }
scroll1 :: ItemKind
scroll1 = ItemKind
scrollTemplate
  { iname :: Text
iname    = "the Chip"
  , ifreq :: Freqs ItemKind
ifreq    = [(GroupName ItemKind
CRAWL_ITEM, 100), (GroupName ItemKind
ANY_SCROLL, 75)]
  , icount :: Dice
icount   = 1
  , irarity :: Rarity
irarity  = [(5, 10), (10, 7)]  -- mixed blessing so found early for a unique
  , iaspects :: [Aspect]
iaspects = [Flag -> Aspect
SetFlag Flag
Unique, Text -> Aspect
ELabel "of Reckless Beacon"]
               [Aspect] -> [Aspect] -> [Aspect]
forall a. [a] -> [a] -> [a]
++ ItemKind -> [Aspect]
iaspects ItemKind
scrollTemplate
  , ieffects :: [Effect]
ieffects = [GroupName ItemKind -> Dice -> Effect
Summon GroupName ItemKind
HERO 1, GroupName ItemKind -> Dice -> Effect
Summon GroupName ItemKind
MOBILE_ANIMAL (2 Dice -> Dice -> Dice
forall a. Num a => a -> a -> a
+ 1 Int -> Int -> Dice
`d` 2)]
  , idesc :: Text
idesc    = "This industrial, wide-spectrum alarm broadcaster, if over-amped for a single powerful blast, should be able to cut through the interference and reach any lost crew members, giving them enough positional information to locate us."
  }
scroll2 :: ItemKind
scroll2 = ItemKind
scrollTemplate
  { ifreq :: Freqs ItemKind
ifreq    = [(GroupName ItemKind
CRAWL_ITEM, 100), (GroupName ItemKind
ANY_SCROLL, 100)]
  , irarity :: Rarity
irarity  = [(3, 7)]
  , ieffects :: [Effect]
ieffects = [Bool -> Effect
Ascend Bool
True]
  }
scroll3 :: ItemKind
scroll3 = ItemKind
scrollTemplate
  -- needs to be common to show at least a portion of effects
  { ifreq :: Freqs ItemKind
ifreq    = [(GroupName ItemKind
COMMON_ITEM, 100), (GroupName ItemKind
ANY_SCROLL, 100)]
  , icount :: Dice
icount   = 3 Int -> Int -> Dice
`dL` 1
  , irarity :: Rarity
irarity  = [(1, 15)]
  , ieffects :: [Effect]
ieffects = [[Effect] -> Effect
OneOf [ Dice -> Effect
Paralyze 10, Dice -> Effect
InsertMove 30, Int -> Dice -> Effect
Recharge 5 999
                      , DetectKind -> Int -> Effect
Detect DetectKind
DetectEmbed 20, DetectKind -> Int -> Effect
Detect DetectKind
DetectHidden 20 ]]
  }
scroll4 :: ItemKind
scroll4 = ItemKind
scrollTemplate
  -- needs to be common to show at least a portion of effects
  { ifreq :: Freqs ItemKind
ifreq    = [(GroupName ItemKind
COMMON_ITEM, 100), (GroupName ItemKind
ANY_SCROLL, 100)]
  , icount :: Dice
icount   = 3 Int -> Int -> Dice
`dL` 1
  , irarity :: Rarity
irarity  = [(10, 15)]
  , ieffects :: [Effect]
ieffects = [ Effect
Impress
               , [Effect] -> Effect
OneOf [ Dice -> Effect
Teleport 20, Bool -> Effect
Ascend Bool
False, Bool -> Effect
Ascend Bool
True
                       , [Effect] -> Effect
OneOf [GroupName ItemKind -> Dice -> Effect
Summon GroupName ItemKind
HERO 1, GroupName ItemKind -> Dice -> Effect
Summon GroupName ItemKind
MOBILE_ANIMAL (Dice -> Effect) -> Dice -> Effect
forall a b. (a -> b) -> a -> b
$ 1 Int -> Int -> Dice
`d` 2]
                           -- gaining a hero particularly uncommon
                       , DetectKind -> Int -> Effect
Detect DetectKind
DetectLoot 20  -- the most useful of detections
                       , Maybe Int -> CStore -> GroupName ItemKind -> TimerDice -> Effect
CreateItem Maybe Int
forall a. Maybe a
Nothing CStore
CGround GroupName ItemKind
COMMON_ITEM TimerDice
timerNone ] ]
  }
scroll5 :: ItemKind
scroll5 = ItemKind
scrollTemplate
  { ifreq :: Freqs ItemKind
ifreq    = [(GroupName ItemKind
COMMON_ITEM, 100), (GroupName ItemKind
ANY_SCROLL, 100)]
  , irarity :: Rarity
irarity  = [(1, 6)]  -- powerful, but low counts at the depths it appears on
  , ieffects :: [Effect]
ieffects = [Dice -> Effect
InsertMove (Dice -> Effect) -> Dice -> Effect
forall a b. (a -> b) -> a -> b
$ 20 Dice -> Dice -> Dice
forall a. Num a => a -> a -> a
+ 1 Int -> Int -> Dice
`dL` 20]
  }
scroll6 :: ItemKind
scroll6 = ItemKind
scrollTemplate
  { ifreq :: Freqs ItemKind
ifreq    = [(GroupName ItemKind
COMMON_ITEM, 100), (GroupName ItemKind
ANY_SCROLL, 100)]
  , ieffects :: [Effect]
ieffects = [ThrowMod -> Effect
PullActor (Int -> Int -> Int -> ThrowMod
ThrowMod 800 75 1)]  -- 6 steps, 1.5 turns
  }
scroll7 :: ItemKind
scroll7 = ItemKind
scrollTemplate
  { iname :: Text
iname    = "the Chip"
  , ifreq :: Freqs ItemKind
ifreq    = [(GroupName ItemKind
CRAWL_ITEM, 100), (GroupName ItemKind
ANY_SCROLL, 75)]
  , icount :: Dice
icount   = 1
  , irarity :: Rarity
irarity  = [(10, 5)]
  , iaspects :: [Aspect]
iaspects = [Flag -> Aspect
SetFlag Flag
Unique, Text -> Aspect
ELabel "of Skeleton Key"]
               [Aspect] -> [Aspect] -> [Aspect]
forall a. [a] -> [a] -> [a]
++ ItemKind -> [Aspect]
iaspects ItemKind
scrollTemplate
  , ieffects :: [Effect]
ieffects = [GroupName ItemKind -> Dice -> Effect
Summon GroupName ItemKind
HERO 1]
  , idesc :: Text
idesc    = "This is a security lock chip that opens all doors in the area, including the hatch to a nearby closet, resounding from the blows of, as it turns out, one of our lost crew members."
  }
scroll8 :: ItemKind
scroll8 = ItemKind
scrollTemplate
  { ifreq :: Freqs ItemKind
ifreq    = [(GroupName ItemKind
COMMON_ITEM, 100), (GroupName ItemKind
ANY_SCROLL, 100)]
  , irarity :: Rarity
irarity  = [(10, 12)]  -- powerful, even if not ideal; scares newbies
  , ieffects :: [Effect]
ieffects = [DetectKind -> Int -> Effect
Detect DetectKind
DetectAll 20]
  }
scroll9 :: ItemKind
scroll9 = ItemKind
scrollTemplate
  { ifreq :: Freqs ItemKind
ifreq    = [(GroupName ItemKind
COMMON_ITEM, 100), (GroupName ItemKind
ANY_SCROLL, 100)]
  , iaspects :: [Aspect]
iaspects = Text -> Aspect
ELabel "of cue interpretation"
               Aspect -> [Aspect] -> [Aspect]
forall a. a -> [a] -> [a]
: ItemKind -> [Aspect]
iaspects ItemKind
scrollTemplate
  , ieffects :: [Effect]
ieffects = [DetectKind -> Int -> Effect
Detect DetectKind
DetectActor 20]
  }
scroll10 :: ItemKind
scroll10 = ItemKind
scrollTemplate
  { ifreq :: Freqs ItemKind
ifreq    = [(GroupName ItemKind
COMMON_ITEM, 100), (GroupName ItemKind
ANY_SCROLL, 100)]
  , iaspects :: [Aspect]
iaspects = Text -> Aspect
ELabel "of logistics tracking"
               Aspect -> [Aspect] -> [Aspect]
forall a. a -> [a] -> [a]
: ItemKind -> [Aspect]
iaspects ItemKind
scrollTemplate
  , ieffects :: [Effect]
ieffects = [DetectKind -> Int -> Effect
Detect DetectKind
DetectStash 100]
  }
scroll11 :: ItemKind
scroll11 = ItemKind
scrollTemplate
  { ifreq :: Freqs ItemKind
ifreq    = [(GroupName ItemKind
COMMON_ITEM, 100), (GroupName ItemKind
ANY_SCROLL, 100)]
  , ieffects :: [Effect]
ieffects = [Int -> Dice -> Effect
Discharge 3 40]
  }
scroll12 :: ItemKind
scroll12 = ItemKind
scrollTemplate
  { ifreq :: Freqs ItemKind
ifreq    = [(GroupName ItemKind
COMMON_ITEM, 100), (GroupName ItemKind
ANY_SCROLL, 100)]
  , irarity :: Rarity
irarity  = [(10, 14)]
  , ieffects :: [Effect]
ieffects = [Int -> Dice -> Effect
Recharge 20 999]
  }
scroll13 :: ItemKind
scroll13 = ItemKind
scrollTemplate
  { ifreq :: Freqs ItemKind
ifreq    = [(GroupName ItemKind
COMMON_ITEM, 100), (GroupName ItemKind
ANY_SCROLL, 100)]
  , icount :: Dice
icount   = 3 Int -> Int -> Dice
`dL` 1
  , irarity :: Rarity
irarity  = [(1, 18)]  -- uncommon deep down, where all is known
  , iaspects :: [Aspect]
iaspects = Text -> Aspect
ELabel "of scientific explanation"
               Aspect -> [Aspect] -> [Aspect]
forall a. a -> [a] -> [a]
: ItemKind -> [Aspect]
iaspects ItemKind
scrollTemplate
  , ieffects :: [Effect]
ieffects = [Effect
Identify Effect -> Effect -> Effect
`AndEffect` Int -> Effect
RefillCalm 10]
  , idesc :: Text
idesc    = "The most pressing existential concerns are met with a deeply satisfying scientific answer."
  }
scroll14 :: ItemKind
scroll14 = ItemKind
scrollTemplate
  { ifreq :: Freqs ItemKind
ifreq    = [(GroupName ItemKind
COMMON_ITEM, 100), (GroupName ItemKind
ANY_SCROLL, 100)]
  , irarity :: Rarity
irarity  = [(10, 20)]  -- at gameover a crucial item may be missing
  , iaspects :: [Aspect]
iaspects = Text -> Aspect
ELabel "of molecular reconfiguration"
               Aspect -> [Aspect] -> [Aspect]
forall a. a -> [a] -> [a]
: ItemKind -> [Aspect]
iaspects ItemKind
scrollTemplate
  , ieffects :: [Effect]
ieffects = [Effect
PolyItem Effect -> Effect -> Effect
`AndEffect` GroupName ItemKind -> Effect
Explode GroupName ItemKind
S_FIRECRACKER]
  }
scroll15 :: ItemKind
scroll15 = ItemKind
scrollTemplate
  { ifreq :: Freqs ItemKind
ifreq    = [(GroupName ItemKind
COMMON_ITEM, 100), (GroupName ItemKind
ANY_SCROLL, 100)]
  , irarity :: Rarity
irarity  = [(8, 22)]
  , iaspects :: [Aspect]
iaspects = Text -> Aspect
ELabel "of surface reconfiguration"
               Aspect -> [Aspect] -> [Aspect]
forall a. a -> [a] -> [a]
: ItemKind -> [Aspect]
iaspects ItemKind
scrollTemplate
  , ieffects :: [Effect]
ieffects = [Effect
RerollItem]
  }
scroll16 :: ItemKind
scroll16 = ItemKind
scrollTemplate
  { ifreq :: Freqs ItemKind
ifreq    = [(GroupName ItemKind
COMMON_ITEM, 100), (GroupName ItemKind
ANY_SCROLL, 100)]
  , irarity :: Rarity
irarity  = [(8, 18)]
  , iaspects :: [Aspect]
iaspects = Text -> Aspect
ELabel "of molecular duplication"
               Aspect -> [Aspect] -> [Aspect]
forall a. a -> [a] -> [a]
: ItemKind -> [Aspect]
iaspects ItemKind
scrollTemplate
  , ieffects :: [Effect]
ieffects = [Effect
DupItem]
  }
scrollAd1 :: ItemKind
scrollAd1 = ItemKind
scrollTemplate
  { ifreq :: Freqs ItemKind
ifreq    = [(GroupName ItemKind
COMMON_ITEM, 100), (GroupName ItemKind
ANY_SCROLL, 100)]
  , irarity :: Rarity
irarity  = [(1, 3)]
  , iaspects :: [Aspect]
iaspects = Text -> Aspect
ELabel "of tourist guide"
               Aspect -> [Aspect] -> [Aspect]
forall a. a -> [a] -> [a]
: ItemKind -> [Aspect]
iaspects ItemKind
scrollTemplate
  , ieffects :: [Effect]
ieffects = [ Effect
Impress  -- mostly flavour, but this is useful
               , GroupName ItemKind -> Dice -> Effect
toOrganGood GroupName ItemKind
S_RESOLUTE (500 Dice -> Dice -> Dice
forall a. Num a => a -> a -> a
+ 1 Int -> Int -> Dice
`d` 200)
                   -- a drawback (at least initially) due to @calmEnough@
               , GroupName ItemKind -> Effect
Explode GroupName ItemKind
S_RHINO_HOLOGRAM
               , DetectKind -> Int -> Effect
Detect DetectKind
DetectLoot 5 ]  -- short so useless most of the time
  , idesc :: Text
idesc    = "Biodegradable self-powered mini-projector displaying holographic ads and shopping hints."
  }

-- Foods require only minimal apply skill to consume. Many animals can eat them.

rawMeatChunk :: ItemKind
rawMeatChunk = $WItemKind :: Char
-> Text
-> Freqs ItemKind
-> [Flavour]
-> Dice
-> Rarity
-> Text
-> Int
-> Dice
-> [Aspect]
-> [Effect]
-> [(GroupName ItemKind, CStore)]
-> Text
-> ItemKind
ItemKind
  { isymbol :: Char
isymbol  = Char
symbolFood
  , iname :: Text
iname    = "raw meat chunk"
  , ifreq :: Freqs ItemKind
ifreq    = [ (GroupName ItemKind
RAW_MEAT_CHUNK, 100), (GroupName ItemKind
COMMON_ITEM, 1)
               , (GroupName ItemKind
UNREPORTED_INVENTORY, 1) ]  -- no "fondles a trinket"
  , iflavour :: [Flavour]
iflavour = [Color] -> [Flavour]
zipPlain [Color
Red]
  , icount :: Dice
icount   = 1
  , irarity :: Rarity
irarity  = [(1, 1)]
  , iverbHit :: Text
iverbHit = "slap"
  , iweight :: Int
iweight  = 1000
  , idamage :: Dice
idamage  = 0
  , iaspects :: [Aspect]
iaspects = [Int -> Aspect
toVelocity 50]
  , ieffects :: [Effect]
ieffects = [Int -> Int -> CStore -> GroupName ItemKind -> Effect
DropItem Int
forall a. Bounded a => a
maxBound 1 CStore
COrgan GroupName ItemKind
S_HUNGRY]
  , idesc :: Text
idesc    = "A scrap of edible animal meat. Not very tasty nor nourishing. Cooking would make it more palatable."
  , ikit :: [(GroupName ItemKind, CStore)]
ikit     = []
  }
roastedMeatChunk :: ItemKind
roastedMeatChunk = ItemKind
rawMeatChunk
  { iname :: Text
iname    = "roasted meat chunk"
  , ifreq :: Freqs ItemKind
ifreq    = [ (GroupName ItemKind
ROASTED_MEAT_CHUNK, 100), (GroupName ItemKind
COOKED_FOOD, 60)
               , (GroupName ItemKind
COMMON_ITEM, 1) ]
  , iflavour :: [Flavour]
iflavour = [Color] -> [Flavour]
zipPlain [Color
Brown]
  , ieffects :: [Effect]
ieffects = [Int -> Int -> CStore -> GroupName ItemKind -> Effect
DropItem Int
forall a. Bounded a => a
maxBound 3 CStore
COrgan GroupName ItemKind
S_HUNGRY]
  , idesc :: Text
idesc    = "Delicious and filling chunk of meat. The thermal processing released flavour and made it easier to digest."
  }
ediblePlantTemplate :: ItemKind
ediblePlantTemplate = $WItemKind :: Char
-> Text
-> Freqs ItemKind
-> [Flavour]
-> Dice
-> Rarity
-> Text
-> Int
-> Dice
-> [Aspect]
-> [Effect]
-> [(GroupName ItemKind, CStore)]
-> Text
-> ItemKind
ItemKind
  { isymbol :: Char
isymbol  = Char
symbolFood
  , iname :: Text
iname    = "edible plant"
  , ifreq :: Freqs ItemKind
ifreq    = [(GroupName ItemKind
EDIBLE_PLANT_UNKNOWN, 1)]
  , iflavour :: [Flavour]
iflavour = [Color] -> [Flavour]
zipFancy [Color]
stdCol
  , icount :: Dice
icount   = 1 Int -> Int -> Dice
`dL` 5
  , irarity :: Rarity
irarity  = [(1, 3), (10, 2)]  -- weak, apart of hunger removal
  , iverbHit :: Text
iverbHit = "thump"
  , iweight :: Int
iweight  = 300
  , idamage :: Dice
idamage  = 0
  , iaspects :: [Aspect]
iaspects = [ GroupName ItemKind -> Aspect
PresentAs GroupName ItemKind
EDIBLE_PLANT_UNKNOWN
               , Int -> Aspect
toVelocity 30 ]  -- low density, often falling apart
  , ieffects :: [Effect]
ieffects = []
  , idesc :: Text
idesc    = "Withered but fragrant bits of a colorful plant. Taste tolerably. Doesn't break down that easily in its raw form, without cooking. Only eating may reveal the full effects."
  , ikit :: [(GroupName ItemKind, CStore)]
ikit     = []
  }
ediblePlant1 :: ItemKind
ediblePlant1 = ItemKind
ediblePlantTemplate
  { iname :: Text
iname    = "enhanced berry"
  , ifreq :: Freqs ItemKind
ifreq    = [(GroupName ItemKind
S_ENCHANCED_BERRY, 1), (GroupName ItemKind
COMMON_ITEM, 100), (GroupName ItemKind
EDIBLE_PLANT, 100)]
  , ieffects :: [Effect]
ieffects = [ Int -> Effect
RefillHP 1, GroupName ItemKind -> Dice -> Effect
toOrganBad GroupName ItemKind
S_IMMOBILE (5 Dice -> Dice -> Dice
forall a. Num a => a -> a -> a
+ 1 Int -> Int -> Dice
`d` 5)
               , Int -> Int -> CStore -> GroupName ItemKind -> Effect
DropItem Int
forall a. Bounded a => a
maxBound 1 CStore
COrgan GroupName ItemKind
S_HUNGRY ]
  }
ediblePlant2 :: ItemKind
ediblePlant2 = ItemKind
ediblePlantTemplate
  { iname :: Text
iname    = "frayed fungus"
  , ifreq :: Freqs ItemKind
ifreq    = [(GroupName ItemKind
S_FRAYED_FUNGUS, 1), (GroupName ItemKind
COMMON_ITEM, 100), (GroupName ItemKind
EDIBLE_PLANT, 100)]
  , ieffects :: [Effect]
ieffects = [GroupName ItemKind -> Effect
toOrganNoTimer GroupName ItemKind
S_POISONED]
  }
ediblePlant3 :: ItemKind
ediblePlant3 = ItemKind
ediblePlantTemplate
  { iname :: Text
iname    = "thick leaf"
  , ifreq :: Freqs ItemKind
ifreq    = [(GroupName ItemKind
S_THIC_LEAF, 1), (GroupName ItemKind
COMMON_ITEM, 100), (GroupName ItemKind
EDIBLE_PLANT, 100)]
  , ieffects :: [Effect]
ieffects = [ Int -> Int -> CStore -> GroupName ItemKind -> Effect
DropItem 1 Int
forall a. Bounded a => a
maxBound CStore
COrgan GroupName ItemKind
S_POISONED
               , Int -> Int -> CStore -> GroupName ItemKind -> Effect
DropItem Int
forall a. Bounded a => a
maxBound 2 CStore
COrgan GroupName ItemKind
S_HUNGRY ]
  }
ediblePlant4 :: ItemKind
ediblePlant4 = ItemKind
ediblePlantTemplate
  { iname :: Text
iname    = "reconfigured fruit"
  , ifreq :: Freqs ItemKind
ifreq    = [ (GroupName ItemKind
S_RECONFIGURED_FRUIT, 1), (GroupName ItemKind
COMMON_ITEM, 100)
               , (GroupName ItemKind
EDIBLE_PLANT, 100) ]
  , ieffects :: [Effect]
ieffects = [ GroupName ItemKind -> Dice -> Effect
toOrganBad GroupName ItemKind
S_BLIND (10 Dice -> Dice -> Dice
forall a. Num a => a -> a -> a
+ 1 Int -> Int -> Dice
`d` 10)
               , Int -> Int -> CStore -> GroupName ItemKind -> Effect
DropItem Int
forall a. Bounded a => a
maxBound 3 CStore
COrgan GroupName ItemKind
S_HUNGRY ]
  }
ediblePlant5 :: ItemKind
ediblePlant5 = ItemKind
ediblePlantTemplate
  { iname :: Text
iname    = "fragrant herb"
  , ifreq :: Freqs ItemKind
ifreq    = [(GroupName ItemKind
S_FRAGRANT_HERB, 1), (GroupName ItemKind
COMMON_ITEM, 100), (GroupName ItemKind
EDIBLE_PLANT, 100)]
  , icount :: Dice
icount   = 1 Int -> Int -> Dice
`dL` 9
  , irarity :: Rarity
irarity  = [(1, 3)]  -- powerful; many copies
  , iaspects :: [Aspect]
iaspects = Text -> Aspect
ELabel "of lethargy"
               Aspect -> [Aspect] -> [Aspect]
forall a. a -> [a] -> [a]
: ItemKind -> [Aspect]
iaspects ItemKind
ediblePlantTemplate
  , ieffects :: [Effect]
ieffects = [ GroupName ItemKind -> Dice -> Effect
toOrganBad GroupName ItemKind
S_SLOWED (20 Dice -> Dice -> Dice
forall a. Num a => a -> a -> a
+ 1 Int -> Int -> Dice
`d` 5)
               , GroupName ItemKind -> Effect
toOrganNoTimer GroupName ItemKind
S_REGENERATING
               , GroupName ItemKind -> Effect
toOrganNoTimer GroupName ItemKind
S_REGENERATING  -- x2
               , Int -> Effect
RefillCalm 5 ]  -- too many effects to also add hunger removal
  }
ediblePlant6 :: ItemKind
ediblePlant6 = ItemKind
ediblePlantTemplate
  { iname :: Text
iname    = "dull flower"
  , ifreq :: Freqs ItemKind
ifreq    = [ (GroupName ItemKind
S_DULL_FLOWER, 1), (GroupName ItemKind
COMMON_ITEM, 100), (GroupName ItemKind
EDIBLE_PLANT, 100)
               , (GroupName ItemKind
PERFUME, 1) ]
  , ieffects :: [Effect]
ieffects = [ Effect
PutToSleep
               , Int -> Int -> CStore -> GroupName ItemKind -> Effect
DropItem Int
forall a. Bounded a => a
maxBound 1 CStore
COrgan GroupName ItemKind
S_HUNGRY ]
  }
ediblePlant7 :: ItemKind
ediblePlant7 = ItemKind
ediblePlantTemplate
  { iname :: Text
iname    = "spicy bark"
  , ifreq :: Freqs ItemKind
ifreq    = [(GroupName ItemKind
S_SPICY_BARK, 1), (GroupName ItemKind
COMMON_ITEM, 100), (GroupName ItemKind
EDIBLE_PLANT, 100)]
  , ieffects :: [Effect]
ieffects = [ Dice -> Effect
InsertMove 20, GroupName ItemKind -> Dice -> Effect
toOrganBad GroupName ItemKind
S_FRENZIED (40 Dice -> Dice -> Dice
forall a. Num a => a -> a -> a
+ 1 Int -> Int -> Dice
`d` 10)
               , Int -> Int -> CStore -> GroupName ItemKind -> Effect
DropItem Int
forall a. Bounded a => a
maxBound 1 CStore
COrgan GroupName ItemKind
S_HUNGRY ]
  }
ediblePlant8 :: ItemKind
ediblePlant8 = ItemKind
ediblePlantTemplate
  { iname :: Text
iname    = "pumpkin"
  , ifreq :: Freqs ItemKind
ifreq    = [(GroupName ItemKind
S_PUMPKIN, 1), (GroupName ItemKind
COMMON_ITEM, 100), (GroupName ItemKind
EDIBLE_PLANT, 100)]
  , irarity :: Rarity
irarity  = [(1, 2), (10, 4)]  -- solves the hunger problem, but not too soon
  , iweight :: Int
iweight  = 3000
  , idamage :: Dice
idamage  = 1 Int -> Int -> Dice
`d` 1
  , ieffects :: [Effect]
ieffects = [Int -> Int -> CStore -> GroupName ItemKind -> Effect
DropItem Int
forall a. Bounded a => a
maxBound 1 CStore
COrgan GroupName ItemKind
S_HUNGRY]
  }
cookedPlantTemplate :: ItemKind
cookedPlantTemplate = ItemKind
ediblePlantTemplate
  { iname :: Text
iname    = "cooked plant"
  , ifreq :: Freqs ItemKind
ifreq    = [(GroupName ItemKind
COOKED_PLANT_UNKNOWN, 1)]
  , iflavour :: [Flavour]
iflavour = [Color] -> [Flavour]
zipPlain [Color]
stdCol
  , irarity :: Rarity
irarity  = [(1, 1)]
  , iaspects :: [Aspect]
iaspects = [ GroupName ItemKind -> Aspect
PresentAs GroupName ItemKind
COOKED_PLANT_UNKNOWN
               , Int -> Aspect
toVelocity 20 ]  -- low density, often falling apart
  , idesc :: Text
idesc    = "Withered but fragrant bits of a colorful plant. Taste blandly, but break down easily, releasing all nutrients. Only eating may reveal the full effects."
  }
cookedPlant1 :: ItemKind
cookedPlant1 = ItemKind
cookedPlantTemplate
  { iname :: Text
iname    = "cooked berry"
  , ifreq :: Freqs ItemKind
ifreq    = [(GroupName ItemKind
S_COOKED_BERRY, 1), (GroupName ItemKind
COMMON_ITEM, 1), (GroupName ItemKind
COOKED_PLANT, 100)]
  , ieffects :: [Effect]
ieffects = [ Int -> Effect
RefillHP 1, GroupName ItemKind -> Dice -> Effect
toOrganBad GroupName ItemKind
S_IMMOBILE (5 Dice -> Dice -> Dice
forall a. Num a => a -> a -> a
+ 1 Int -> Int -> Dice
`d` 5)
               , Int -> Int -> CStore -> GroupName ItemKind -> Effect
DropItem Int
forall a. Bounded a => a
maxBound 2 CStore
COrgan GroupName ItemKind
S_HUNGRY ]
  }
cookedPlant2 :: ItemKind
cookedPlant2 = ItemKind
cookedPlantTemplate
  { iname :: Text
iname    = "cooked fungus"
  , ifreq :: Freqs ItemKind
ifreq    = [(GroupName ItemKind
S_COOKED_FUNGUS, 1), (GroupName ItemKind
COMMON_ITEM, 1), (GroupName ItemKind
COOKED_PLANT, 100)]
  , ieffects :: [Effect]
ieffects = ItemKind -> [Effect]
ieffects ItemKind
ediblePlant2
  }
cookedPlant3 :: ItemKind
cookedPlant3 = ItemKind
cookedPlantTemplate
  { iname :: Text
iname    = "cooked leaf"
  , ifreq :: Freqs ItemKind
ifreq    = [ (GroupName ItemKind
S_COOKED_LEAF, 1)
               , (GroupName ItemKind
COMMON_ITEM, 1), (GroupName ItemKind
COOKED_PLANT, 100), (GroupName ItemKind
COOKED_FOOD, 10) ]
  , ieffects :: [Effect]
ieffects = [ Int -> Int -> CStore -> GroupName ItemKind -> Effect
DropItem 1 Int
forall a. Bounded a => a
maxBound CStore
COrgan GroupName ItemKind
S_POISONED
               , Int -> Int -> CStore -> GroupName ItemKind -> Effect
DropItem Int
forall a. Bounded a => a
maxBound 3 CStore
COrgan GroupName ItemKind
S_HUNGRY ]
  }
cookedPlant4 :: ItemKind
cookedPlant4 = ItemKind
cookedPlantTemplate
  { iname :: Text
iname    = "cooked fruit"
  , ifreq :: Freqs ItemKind
ifreq    = [ (GroupName ItemKind
S_COOKED_FRUIT, 1)
               , (GroupName ItemKind
COMMON_ITEM, 1), (GroupName ItemKind
COOKED_PLANT, 100) ]
  , ieffects :: [Effect]
ieffects = [ GroupName ItemKind -> Dice -> Effect
toOrganBad GroupName ItemKind
S_BLIND (10 Dice -> Dice -> Dice
forall a. Num a => a -> a -> a
+ 1 Int -> Int -> Dice
`d` 10)
               , Int -> Int -> CStore -> GroupName ItemKind -> Effect
DropItem Int
forall a. Bounded a => a
maxBound 4 CStore
COrgan GroupName ItemKind
S_HUNGRY ]
  }
cookedPlant5 :: ItemKind
cookedPlant5 = ItemKind
cookedPlantTemplate
  { iname :: Text
iname    = "cooked herb"
  , ifreq :: Freqs ItemKind
ifreq    = [ (GroupName ItemKind
S_COOKED_HERB, 1)
               , (GroupName ItemKind
COMMON_ITEM, 1), (GroupName ItemKind
COOKED_PLANT, 100) ]
  , icount :: Dice
icount   = 1 Int -> Int -> Dice
`dL` 9
  , iaspects :: [Aspect]
iaspects = Text -> Aspect
ELabel "of lethargy"
               Aspect -> [Aspect] -> [Aspect]
forall a. a -> [a] -> [a]
: ItemKind -> [Aspect]
iaspects ItemKind
cookedPlantTemplate
  , ieffects :: [Effect]
ieffects = ItemKind -> [Effect]
ieffects ItemKind
ediblePlant5
  }
cookedPlant6 :: ItemKind
cookedPlant6 = ItemKind
cookedPlantTemplate
  { iname :: Text
iname    = "cooked flower"
  , ifreq :: Freqs ItemKind
ifreq    = [ (GroupName ItemKind
S_COOKED_FLOWER, 1)
               , (GroupName ItemKind
COMMON_ITEM, 1), (GroupName ItemKind
COOKED_PLANT, 100), (GroupName ItemKind
COOKED_FOOD, 10) ]
  , ieffects :: [Effect]
ieffects = [ Effect
PutToSleep
               , Int -> Int -> CStore -> GroupName ItemKind -> Effect
DropItem Int
forall a. Bounded a => a
maxBound 2 CStore
COrgan GroupName ItemKind
S_HUNGRY ]
  }
cookedPlant7 :: ItemKind
cookedPlant7 = ItemKind
cookedPlantTemplate
  { iname :: Text
iname    = "cooked bark"
  , ifreq :: Freqs ItemKind
ifreq    = [ (GroupName ItemKind
S_COOKED_BARK, 1)
               , (GroupName ItemKind
COMMON_ITEM, 1), (GroupName ItemKind
COOKED_PLANT, 100), (GroupName ItemKind
COOKED_FOOD, 10) ]
  , ieffects :: [Effect]
ieffects = [ Dice -> Effect
InsertMove 20, GroupName ItemKind -> Dice -> Effect
toOrganBad GroupName ItemKind
S_FRENZIED (40 Dice -> Dice -> Dice
forall a. Num a => a -> a -> a
+ 1 Int -> Int -> Dice
`d` 10)
               , Int -> Int -> CStore -> GroupName ItemKind -> Effect
DropItem Int
forall a. Bounded a => a
maxBound 2 CStore
COrgan GroupName ItemKind
S_HUNGRY ]
  }
cookedPlant8 :: ItemKind
cookedPlant8 = ItemKind
cookedPlantTemplate
  { iname :: Text
iname    = "cooked pumpkin"
  , ifreq :: Freqs ItemKind
ifreq    = [ (GroupName ItemKind
S_COOKED_PUMPKIN, 1)
               , (GroupName ItemKind
COMMON_ITEM, 1), (GroupName ItemKind
COOKED_PLANT, 100), (GroupName ItemKind
COOKED_FOOD, 10) ]
  , iweight :: Int
iweight  = 3000
  , idamage :: Dice
idamage  = 1 Int -> Int -> Dice
`d` 1
  , ieffects :: [Effect]
ieffects = [Int -> Int -> CStore -> GroupName ItemKind -> Effect
DropItem Int
forall a. Bounded a => a
maxBound 5 CStore
COrgan GroupName ItemKind
S_HUNGRY]
  }

-- ** Lights and related

torchMsg :: Effect
torchMsg :: Effect
torchMsg = Text -> Text -> Effect
VerbMsgFail "feel the torch fracture" "."
torchDestruct :: Effect
torchDestruct :: Effect
torchDestruct =
  Effect -> Effect
OnUser (Effect -> Effect) -> Effect -> Effect
forall a b. (a -> b) -> a -> b
$ [Effect] -> Effect
OneOf ([Effect] -> Effect) -> [Effect] -> Effect
forall a b. (a -> b) -> a -> b
$
    Int -> Int -> CStore -> GroupName ItemKind -> Effect
DestroyItem 1 1 CStore
CEqp GroupName ItemKind
S_WOODEN_TORCH
    Effect -> Effect -> Effect
`AndEffect`
    Maybe Int -> CStore -> GroupName ItemKind -> TimerDice -> Effect
CreateItem Maybe Int
forall a. Maybe a
Nothing CStore
CStash GroupName ItemKind
S_RAG_TANGLE TimerDice
timerNone
      -- staff broken, cord not usable (if a cord was used for crafting);
      -- otherwise rag + staff would produce a cord (bonding tool)
    Effect -> [Effect] -> [Effect]
forall a. a -> [a] -> [a]
: Int -> Int -> CStore -> GroupName ItemKind -> Effect
DestroyItem 1 1 CStore
CEqp GroupName ItemKind
S_WOODEN_TORCH
      Effect -> Effect -> Effect
`AndEffect`
      Maybe Int -> CStore -> GroupName ItemKind -> TimerDice -> Effect
CreateItem Maybe Int
forall a. Maybe a
Nothing CStore
CStash GroupName ItemKind
S_DOUSED_WOODEN_TORCH TimerDice
timerNone
    Effect -> [Effect] -> [Effect]
forall a. a -> [a] -> [a]
: Int -> Effect -> [Effect]
forall a. Int -> a -> [a]
replicate 6 Effect
torchMsg  -- twice more durable than gardening tools
light1 :: ItemKind
light1 = $WItemKind :: Char
-> Text
-> Freqs ItemKind
-> [Flavour]
-> Dice
-> Rarity
-> Text
-> Int
-> Dice
-> [Aspect]
-> [Effect]
-> [(GroupName ItemKind, CStore)]
-> Text
-> ItemKind
ItemKind
  { isymbol :: Char
isymbol  = Char
symbolLight
  , iname :: Text
iname    = "torch"
  , ifreq :: Freqs ItemKind
ifreq    = [ (GroupName ItemKind
COMMON_ITEM, 50), (GroupName ItemKind
LIGHT_ATTENUATOR, 70), (GroupName ItemKind
WEAK_ARROW, 300)
               , (GroupName ItemKind
FIRE_SOURCE, 1), (GroupName ItemKind
S_WOODEN_TORCH, 1) ]
  , iflavour :: [Flavour]
iflavour = [Color] -> [Flavour]
zipPlain [Color
Brown]
  , icount :: Dice
icount   = 1
  , irarity :: Rarity
irarity  = [(3 Double -> Double -> Double
forall a. Num a => a -> a -> a
* 10Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/15, 15), (4 Double -> Double -> Double
forall a. Num a => a -> a -> a
* 10Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/15, 1)]
                 -- crafted, so rare; later taken from aliens
  , iverbHit :: Text
iverbHit = "scorch"
  , iweight :: Int
iweight  = 1000
  , idamage :: Dice
idamage  = 1 Int -> Int -> Dice
`d` 1  -- strong missile, but betrays the flinger
  , iaspects :: [Aspect]
iaspects = [ Skill -> Dice -> Aspect
AddSkill Skill
SkShine 3, Skill -> Dice -> Aspect
AddSkill Skill
SkSight (-2)
                   -- not only flashes, but also sparks,
                   -- so unused by AI due to the mixed blessing
               , Flag -> Aspect
SetFlag Flag
Durable, Flag -> Aspect
SetFlag Flag
Lobable
               , Flag -> Aspect
SetFlag Flag
Meleeable, EqpSlot -> Aspect
EqpSlot EqpSlot
EqpSlotShine ]
                   -- partially durable; reusable flare;
                   -- the staff culled when crafting, so no velocity malus
  , ieffects :: [Effect]
ieffects = [Dice -> Effect
Burn 2, Effect
torchDestruct]  -- no timeout, but destructs
  , idesc :: Text
idesc    = "A puttering torch improvised with rags on a staff, soaked in any lubricant or oil or resin or tar that could be scavenged in a hurry."
  , ikit :: [(GroupName ItemKind, CStore)]
ikit     = []
  }
lightDoused1 :: ItemKind
lightDoused1 = ItemKind
light1
  { iname :: Text
iname    = "doused torch"
  , ifreq :: Freqs ItemKind
ifreq    = [(GroupName ItemKind
S_DOUSED_WOODEN_TORCH, 1) ]
  , iverbHit :: Text
iverbHit = "prod"
  , iaspects :: [Aspect]
iaspects = [Flag -> Aspect
SetFlag Flag
Lobable]  -- not durable, so not OP missile
  , ieffects :: [Effect]
ieffects = []
  , idesc :: Text
idesc    = "A yet unlit torch improvised with rags on a staff, soaked in any lubricant or oil or resin or tar that could be scavenged in a hurry."
  }
light2 :: ItemKind
light2 = $WItemKind :: Char
-> Text
-> Freqs ItemKind
-> [Flavour]
-> Dice
-> Rarity
-> Text
-> Int
-> Dice
-> [Aspect]
-> [Effect]
-> [(GroupName ItemKind, CStore)]
-> Text
-> ItemKind
ItemKind
  { isymbol :: Char
isymbol  = Char
symbolLight
  , iname :: Text
iname    = "oil lamp"
  , ifreq :: Freqs ItemKind
ifreq    = [ (GroupName ItemKind
COMMON_ITEM, 50), (GroupName ItemKind
LIGHT_ATTENUATOR, 70)
               , (GroupName ItemKind
S_OIL_LAMP, 1) ]
  , iflavour :: [Flavour]
iflavour = [Color] -> [Flavour]
zipPlain [Color
BrYellow]
  , icount :: Dice
icount   = 1
  , irarity :: Rarity
irarity  = [(5, 2)]
  , iverbHit :: Text
iverbHit = "burn"
  , iweight :: Int
iweight  = 1600
  , idamage :: Dice
idamage  = 1 Int -> Int -> Dice
`d` 1
  , iaspects :: [Aspect]
iaspects = [ Skill -> Dice -> Aspect
AddSkill Skill
SkShine 3, Skill -> Dice -> Aspect
AddSkill Skill
SkSight (-1)
               , Flag -> Aspect
SetFlag Flag
Lobable, Flag -> Aspect
SetFlag Flag
Fragile, Flag -> Aspect
SetFlag Flag
Equipable
               , EqpSlot -> Aspect
EqpSlot EqpSlot
EqpSlotShine ]
  , ieffects :: [Effect]
ieffects = [ GroupName ItemKind -> Effect
Explode GroupName ItemKind
S_FOCUSED_BURNING_OIL_2
               , Effect -> Effect
OnSmash (GroupName ItemKind -> Effect
Explode GroupName ItemKind
S_VIOLENT_BURNING_OIL_2) ]
  , idesc :: Text
idesc    = "A restaurant table glass lamp filled with plant oil feeding a slender wick. Or a makeshift caricature thereof."
  , ikit :: [(GroupName ItemKind, CStore)]
ikit     = []
  }
lightDoused2 :: ItemKind
lightDoused2 = ItemKind
light2
  { iname :: Text
iname    = "doused oil lamp"
  , ifreq :: Freqs ItemKind
ifreq    = [(GroupName ItemKind
S_DOUSED_OIL_LAMP, 1)]
  , iverbHit :: Text
iverbHit = "bonk"
  , iaspects :: [Aspect]
iaspects = [Flag -> Aspect
SetFlag Flag
Lobable, Flag -> Aspect
SetFlag Flag
Fragile]
  , ieffects :: [Effect]
ieffects = []
  , idesc :: Text
idesc    = "An unlit restaurant table glass lamp filled with plant oil feeding a slender wick. Or a makeshift caricature thereof."
  }
light3 :: ItemKind
light3 = $WItemKind :: Char
-> Text
-> Freqs ItemKind
-> [Flavour]
-> Dice
-> Rarity
-> Text
-> Int
-> Dice
-> [Aspect]
-> [Effect]
-> [(GroupName ItemKind, CStore)]
-> Text
-> ItemKind
ItemKind
  { isymbol :: Char
isymbol  = Char
symbolLight
  , iname :: Text
iname    = "brass lantern"
  , ifreq :: Freqs ItemKind
ifreq    = [(GroupName ItemKind
COMMON_ITEM, 100), (GroupName ItemKind
MUSEAL, 100), (GroupName ItemKind
LIGHT_ATTENUATOR, 5)]
  , iflavour :: [Flavour]
iflavour = [Color] -> [Flavour]
zipPlain [Color
Red]
  , icount :: Dice
icount   = 1
  , irarity :: Rarity
irarity  = [(6, 1), (10, 4)]
  , iverbHit :: Text
iverbHit = "burn"
  , iweight :: Int
iweight  = 3000
  , idamage :: Dice
idamage  = 2 Int -> Int -> Dice
`d` 1
  , iaspects :: [Aspect]
iaspects = [ Skill -> Dice -> Aspect
AddSkill Skill
SkShine 4, Skill -> Dice -> Aspect
AddSkill Skill
SkSight (-1)
               , Flag -> Aspect
SetFlag Flag
Lobable, Flag -> Aspect
SetFlag Flag
Fragile, Flag -> Aspect
SetFlag Flag
Equipable
               , EqpSlot -> Aspect
EqpSlot EqpSlot
EqpSlotShine ]
  , ieffects :: [Effect]
ieffects = [ GroupName ItemKind -> Effect
Explode GroupName ItemKind
S_FOCUSED_BURNING_OIL_4
               , Effect -> Effect
OnSmash (GroupName ItemKind -> Effect
Explode GroupName ItemKind
S_VIOLENT_BURNING_OIL_4) ]
  , idesc :: Text
idesc    = "Very old, very bright and very heavy lantern made of hand-polished brass."
  , ikit :: [(GroupName ItemKind, CStore)]
ikit     = []
  }
blanket :: ItemKind
blanket = $WItemKind :: Char
-> Text
-> Freqs ItemKind
-> [Flavour]
-> Dice
-> Rarity
-> Text
-> Int
-> Dice
-> [Aspect]
-> [Effect]
-> [(GroupName ItemKind, CStore)]
-> Text
-> ItemKind
ItemKind
  { isymbol :: Char
isymbol  = Char
symbolLight
  , iname :: Text
iname    = "mineral fibre blanket"
  , ifreq :: Freqs ItemKind
ifreq    = [ (GroupName ItemKind
COMMON_ITEM, 100), (GroupName ItemKind
LIGHT_ATTENUATOR, 20), (GroupName ItemKind
THICK_CLOTH, 1)
               , (GroupName ItemKind
FIREPROOF_CLOTH, 1), (GroupName ItemKind
FIRE_FIGHTING_ITEM, 100)
               , (GroupName ItemKind
SHARPENING_TOOL, 1) ]
  , iflavour :: [Flavour]
iflavour = [Color] -> [Flavour]
zipPlain [Color
Magenta]
  , icount :: Dice
icount   = 1
  , irarity :: Rarity
irarity  = [(1, 1)]  -- scavenged from walls
  , iverbHit :: Text
iverbHit = "swoosh"
  , iweight :: Int
iweight  = 1000
  , idamage :: Dice
idamage  = 0
  , iaspects :: [Aspect]
iaspects = [ Skill -> Dice -> Aspect
AddSkill Skill
SkShine (-10)
               , Skill -> Dice -> Aspect
AddSkill Skill
SkArmorMelee 3, Skill -> Dice -> Aspect
AddSkill Skill
SkMaxCalm 5
               , Flag -> Aspect
SetFlag Flag
Lobable, Flag -> Aspect
SetFlag Flag
Equipable
               , EqpSlot -> Aspect
EqpSlot EqpSlot
EqpSlotArmorMelee ]
                   -- not Fragile; reusable douse implement;
                   -- douses torch, lamp and lantern in one action,
                   -- both in equipment and when thrown at the floor
  , ieffects :: [Effect]
ieffects = []
  , idesc :: Text
idesc    = "Flame-retardant synthetic fibres. The strong cloth polishes metals really well when soaked, aiding in the final stages of blade sharpening."
  , ikit :: [(GroupName ItemKind, CStore)]
ikit     = []
  }

-- ** Tools used for terrain transformation and crafting, not for wearing

chisel :: ItemKind
chisel = $WItemKind :: Char
-> Text
-> Freqs ItemKind
-> [Flavour]
-> Dice
-> Rarity
-> Text
-> Int
-> Dice
-> [Aspect]
-> [Effect]
-> [(GroupName ItemKind, CStore)]
-> Text
-> ItemKind
ItemKind  -- ignored by AI, but that's fine, others suffice
  { isymbol :: Char
isymbol  = Char
symbolTool
  , iname :: Text
iname    = "chisel"
  , ifreq :: Freqs ItemKind
ifreq    = [(GroupName ItemKind
CRAWL_ITEM, 10), (GroupName ItemKind
BREACHING_TOOL, 1), (GroupName ItemKind
TOOL_ONLY, 1)]
  , iflavour :: [Flavour]
iflavour = [Color] -> [Flavour]
zipPlain [Color
Cyan]
  , icount :: Dice
icount   = 1
  , irarity :: Rarity
irarity  = [(1, 110)]
  , iverbHit :: Text
iverbHit = "dismantle"
  , iweight :: Int
iweight  = 500
  , idamage :: Dice
idamage  = 0  -- not a missile to avoid wasting, before a workshop found
  , iaspects :: [Aspect]
iaspects = []  -- lost after one use; a consumable
  , ieffects :: [Effect]
ieffects = []
  , idesc :: Text
idesc    = "It is a breaching tool that can be used for crafting and terrain modification. There are no junk items in space."  -- TODO: https://en.wikipedia.org/wiki/Chisel
                   -- also say light and cheap, but not durable; one time use
  , ikit :: [(GroupName ItemKind, CStore)]
ikit     = [(GroupName ItemKind
SHARPENING_TOOL, CStore
CGround), (GroupName ItemKind
WIRECUTTING_TOOL, CStore
CGround)]
  }
hacksaw :: ItemKind
hacksaw = ItemKind
chisel
  { iname :: Text
iname    = "hacksaw"
  , idesc :: Text
idesc    = "It is a breaching tool that can be used for crafting and terrain modification. There are no junk items in space."  -- TODO: https://en.wikipedia.org/wiki/Hacksaw
  }
adjustableSpanner :: ItemKind
adjustableSpanner = ItemKind
chisel
  { iname :: Text
iname    = "adjustable spanner"
  , idesc :: Text
idesc    = "It is a breaching tool that can be used for crafting and terrain modification. There are no junk items in space."  -- TODO: https://en.wikipedia.org/wiki/Adjustable_spanner
  , ikit :: [(GroupName ItemKind, CStore)]
ikit     = [ (GroupName ItemKind
SHARPENING_TOOL, CStore
CGround), (GroupName ItemKind
WIRECUTTING_TOOL, CStore
CGround)
               , (GroupName ItemKind
BONDING_TOOL, CStore
CGround) ]
  }
steelFile :: ItemKind
steelFile = ItemKind
chisel
  { iname :: Text
iname    = "steel file"
  , ifreq :: Freqs ItemKind
ifreq    = [ (GroupName ItemKind
CRAWL_ITEM, 20), (GroupName ItemKind
BREACHING_TOOL, 1), (GroupName ItemKind
SHARPENING_TOOL, 1)
               , (GroupName ItemKind
TOOL_ONLY, 1) ]
  , iflavour :: [Flavour]
iflavour = [Color] -> [Flavour]
zipPlain [Color
Red]  -- double purpose, saves one tool sometimes
  , iverbHit :: Text
iverbHit = "grate"
  , idesc :: Text
idesc    = "It is a breaching and sharpening tool that can be used for crafting and terrain modification. There are no junk items in space."  -- TODO: https://en.wikipedia.org/wiki/File_(tool)
  , ikit :: [(GroupName ItemKind, CStore)]
ikit     = []
  }
honingSteel :: ItemKind
honingSteel = ItemKind
chisel
  { iname :: Text
iname    = "honing steel"
  , ifreq :: Freqs ItemKind
ifreq    = [(GroupName ItemKind
CRAWL_ITEM, 10), (GroupName ItemKind
SHARPENING_TOOL, 1), (GroupName ItemKind
TOOL_ONLY, 1)]
  , iflavour :: [Flavour]
iflavour = [Color] -> [Flavour]
zipFancy [Color
Blue]
  , iverbHit :: Text
iverbHit = "hone"
  , idesc :: Text
idesc    = "Originally used for realigning and sharpening dulled edges of kitchen knives in the local restaurants. Now it turns utensils into weapons."
  , ikit :: [(GroupName ItemKind, CStore)]
ikit     = [(GroupName ItemKind
WIRECUTTING_TOOL, CStore
CGround), (GroupName ItemKind
BONDING_TOOL, CStore
CGround)]
  }
whetstone :: ItemKind
whetstone = ItemKind
honingSteel
  { iname :: Text
iname    = "whetstone"
  , iverbHit :: Text
iverbHit = "rub"
  , idesc :: Text
idesc    = "A portable sharpening stone that can transforms a dull piece of scrap into a keen and true blade."
  }
diagonalPliers :: ItemKind
diagonalPliers = ItemKind
chisel
  { iname :: Text
iname    = "pair"
  , ifreq :: Freqs ItemKind
ifreq    = [(GroupName ItemKind
CRAWL_ITEM, 10), (GroupName ItemKind
WIRECUTTING_TOOL, 1), (GroupName ItemKind
TOOL_ONLY, 1)]
  , iflavour :: [Flavour]
iflavour = [Color] -> [Flavour]
zipPlain [Color
Brown]
  , iverbHit :: Text
iverbHit = "cut"
  , iaspects :: [Aspect]
iaspects = [Text -> Aspect
ELabel "of diagonal pliers"]
  , idesc :: Text
idesc    = "It is a wirecutting tool that can be used for crafting and terrain modification. There are no junk items in space."  -- TODO: https://en.wikipedia.org/wiki/Diagonal_pliers
  , ikit :: [(GroupName ItemKind, CStore)]
ikit     = [(GroupName ItemKind
BREACHING_TOOL, CStore
CGround)]
  }
snips :: ItemKind
snips = ItemKind
diagonalPliers
  { iname :: Text
iname    = "pair"
  , iaspects :: [Aspect]
iaspects = [Text -> Aspect
ELabel "of snips"]
  , idesc :: Text
idesc    = "It is a wirecutting tool that can be used for crafting and terrain modification. There are no junk items in space."  -- TODO: https://en.wikipedia.org/wiki/Snips
  }
loppers :: ItemKind
loppers = ItemKind
diagonalPliers
  { iname :: Text
iname    = "pair"
  , iaspects :: [Aspect]
iaspects = [Text -> Aspect
ELabel "of loppers"]
  , idesc :: Text
idesc    = "It is a wirecutting tool that can be used for crafting and terrain modification. There are no junk items in space."  -- TODO: https://en.wikipedia.org/wiki/Loppers
  , ikit :: [(GroupName ItemKind, CStore)]
ikit     = [(GroupName ItemKind
BREACHING_TOOL, CStore
CGround), (GroupName ItemKind
SHARPENING_TOOL, CStore
CGround)]
  }
boltCutter :: ItemKind
boltCutter = ItemKind
loppers
  { iname :: Text
iname    = "bolt cutter"
  , iaspects :: [Aspect]
iaspects = []
  , idesc :: Text
idesc    = "It is a wirecutting tool that can be used for crafting and terrain modification. There are no junk items in space."  -- TODO: https://en.wikipedia.org/wiki/Bolt_cutter
  }
solderingIron :: ItemKind
solderingIron = ItemKind
chisel
  { iname :: Text
iname    = "soldering iron"
  , ifreq :: Freqs ItemKind
ifreq    = [(GroupName ItemKind
CRAWL_ITEM, 5), (GroupName ItemKind
BONDING_TOOL, 20), (GroupName ItemKind
TOOL_ONLY, 1)]
  , iflavour :: [Flavour]
iflavour = [Color] -> [Flavour]
zipPlain [Color
White]
  , iverbHit :: Text
iverbHit = "soldier"
  , idesc :: Text
idesc    = "It is a bonding tool that can be used for crafting and terrain modification. There are no junk items in space."  -- TODO: wikipedia
  , ikit :: [(GroupName ItemKind, CStore)]
ikit     = []
  }
duckTape :: ItemKind
duckTape = ItemKind
solderingIron
  { iname :: Text
iname    = "duck tape"
  , ifreq :: Freqs ItemKind
ifreq    = [(GroupName ItemKind
CRAWL_ITEM, 3), (GroupName ItemKind
BONDING_TOOL, 40), (GroupName ItemKind
TOOL_ONLY, 1)]
  , icount :: Dice
icount   = 1 Int -> Int -> Dice
`d` 4
  , iverbHit :: Text
iverbHit = "catch"
  , idesc :: Text
idesc    = "It is a bonding tool that can be used for crafting and terrain modification. There are no junk items in space."  -- TODO: https://en.wikipedia.org/wiki/Duct_tape
  }
thickCord :: ItemKind
thickCord = ItemKind
solderingIron
  { iname :: Text
iname    = "thick cord"
  , ifreq :: Freqs ItemKind
ifreq    = [ (GroupName ItemKind
CRAWL_ITEM, 7), (GroupName ItemKind
BONDING_TOOL, 30)
               , (GroupName ItemKind
CLOTH_RAG, 1), (GroupName ItemKind
THICK_CLOTH, 1), (GroupName ItemKind
TOOL_ONLY, 1) ]
  , iverbHit :: Text
iverbHit = "tie"
  , idesc :: Text
idesc    = "It is a bonding tool and it soaks fluids."  -- TODO
  }

-- ** Periodic jewelry

-- This looks like a necklace, but is not periodic. Instead, it auto-activates
-- when under melee attack.
gorget :: ItemKind
gorget = ItemKind
necklaceTemplate
  { iname :: Text
iname    = "Old Gorget"
  , ifreq :: Freqs ItemKind
ifreq    = [(GroupName ItemKind
TREASURE, 50), (GroupName ItemKind
MUSEAL, 100)]
  , iflavour :: [Flavour]
iflavour = [Color] -> [Flavour]
zipFancy [Color
BrCyan]  -- looks exactly the same as one of necklaces,
                                  -- but it's OK, it's an artifact
  , iaspects :: [Aspect]
iaspects = [ Flag -> Aspect
SetFlag Flag
Unique
               , Dice -> Aspect
Timeout (Dice -> Aspect) -> Dice -> Aspect
forall a b. (a -> b) -> a -> b
$ 7 Dice -> Dice -> Dice
forall a. Num a => a -> a -> a
- 1 Int -> Int -> Dice
`dL` 4
                   -- the dL dice need to be in negative positions
                   -- for negative stats, such as @Timeout@, so that
                   -- the @RerollItem@ effect makes the item better, not worse
               , Skill -> Dice -> Aspect
AddSkill Skill
SkArmorMelee 3, Skill -> Dice -> Aspect
AddSkill Skill
SkHearing 3
               , Flag -> Aspect
SetFlag Flag
UnderMelee, Flag -> Aspect
SetFlag Flag
Durable ]
               [Aspect] -> [Aspect] -> [Aspect]
forall a. [a] -> [a] -> [a]
++ Aspect -> [Aspect] -> [Aspect]
forall a. Eq a => a -> [a] -> [a]
delete (Flag -> Aspect
SetFlag Flag
Periodic) [Aspect]
iaspects_necklaceTemplate
  , ieffects :: [Effect]
ieffects = [Int -> Effect
RefillCalm 15]
  , idesc :: Text
idesc    = "Worn, cold, large brass medallion on a chain. Unlikely to offer much protection as an armor piece, but when courage is hardest to sustain, the old engraving reassures its wearer."
  }
-- Morally these are the aspects, but we also need to add a fake @Timeout@,
-- to let clients know that the not identified item is periodic jewelry.
iaspects_necklaceTemplate :: [Aspect]
iaspects_necklaceTemplate :: [Aspect]
iaspects_necklaceTemplate =
  [ GroupName ItemKind -> Aspect
PresentAs GroupName ItemKind
NECKLACE_UNKNOWN
  , Flag -> Aspect
SetFlag Flag
Periodic, Flag -> Aspect
SetFlag Flag
Precious, Flag -> Aspect
SetFlag Flag
Equipable
  , Int -> Aspect
toVelocity 50 ]  -- not dense enough
-- Not identified, because id by use, e.g., via periodic activations. Fun.
necklaceTemplate :: ItemKind
necklaceTemplate = $WItemKind :: Char
-> Text
-> Freqs ItemKind
-> [Flavour]
-> Dice
-> Rarity
-> Text
-> Int
-> Dice
-> [Aspect]
-> [Effect]
-> [(GroupName ItemKind, CStore)]
-> Text
-> ItemKind
ItemKind
  { isymbol :: Char
isymbol  = Char
symbolNecklace
  , iname :: Text
iname    = "necklace"
  , ifreq :: Freqs ItemKind
ifreq    = [(GroupName ItemKind
NECKLACE_UNKNOWN, 1)]
  , iflavour :: [Flavour]
iflavour = [Color] -> [Flavour]
zipFancy [Color]
stdCol [Flavour] -> [Flavour] -> [Flavour]
forall a. [a] -> [a] -> [a]
++ [Color] -> [Flavour]
zipPlain [Color]
brightCol
  , icount :: Dice
icount   = 1
  , irarity :: Rarity
irarity  = [(4, 3), (10, 4)]
  , iverbHit :: Text
iverbHit = "whip"
  , iweight :: Int
iweight  = 100
  , idamage :: Dice
idamage  = 0
  , iaspects :: [Aspect]
iaspects = Dice -> Aspect
Timeout 1000000
                 -- fake, needed to display "charging"; the timeout itself
                 -- won't be displayed thanks to periodic; as a side-effect,
                 -- it can't be activated until identified, which is better
                 -- than letting the player try to activate before the real
                 -- cooldown is over and waste turn
               Aspect -> [Aspect] -> [Aspect]
forall a. a -> [a] -> [a]
: [Aspect]
iaspects_necklaceTemplate
  , ieffects :: [Effect]
ieffects = []
  , idesc :: Text
idesc    = "Tingling, rattling chain of flat encrusted links. Eccentric millionaires are known to hide their highly personalized body augmentation packs in bulky jewelry pieces such as these."
  , ikit :: [(GroupName ItemKind, CStore)]
ikit     = []
  }
necklace1 :: ItemKind
necklace1 = ItemKind
necklaceTemplate
  { iname :: Text
iname    = "the Necklace"
  , ifreq :: Freqs ItemKind
ifreq    = [(GroupName ItemKind
CRAWL_ITEM, 50), (GroupName ItemKind
ANY_JEWELRY, 25)]
  , irarity :: Rarity
irarity  = [(3 Double -> Double -> Double
forall a. Num a => a -> a -> a
* 10Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/15, 0), (4 Double -> Double -> Double
forall a. Num a => a -> a -> a
* 10Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/15, 1), (10, 5)]
                 -- prevents camping on lvl 3
  , iaspects :: [Aspect]
iaspects = [ Flag -> Aspect
SetFlag Flag
Unique, Text -> Aspect
ELabel "of Spur Life"
               , Dice -> Aspect
Timeout (Dice -> Aspect) -> Dice -> Aspect
forall a b. (a -> b) -> a -> b
$ (4 Dice -> Dice -> Dice
forall a. Num a => a -> a -> a
- 1 Int -> Int -> Dice
`dL` 3) Dice -> Dice -> Dice
forall a. Num a => a -> a -> a
* 10
                   -- priceless, so worth the long wait and the malus
               , Skill -> Dice -> Aspect
AddSkill Skill
SkArmorMelee (-30)
               , Flag -> Aspect
SetFlag Flag
Durable ]
               [Aspect] -> [Aspect] -> [Aspect]
forall a. [a] -> [a] -> [a]
++ [Aspect]
iaspects_necklaceTemplate
  , ieffects :: [Effect]
ieffects = [ Int -> Effect
RefillCalm (-5)
               , Condition -> Effect -> Effect
When (ActivationFlag -> Condition
TriggeredBy ActivationFlag
ActivationPeriodic) (Effect -> Effect) -> Effect -> Effect
forall a b. (a -> b) -> a -> b
$ Int -> Effect
RefillHP 1 ]
  , idesc :: Text
idesc    = "This awkward chain, when worn on bare skin, frequently emits mild but highly annoying electric shocks, which apparently stimulate tissue regeneration even in distant parts of the body. A part of the surprising effectiveness of this unique artifact may stem from the desperation of the patients to be quickly healed enough to take it off."
  }
-- no necklace2 of Live Bait, wasteContainer too similar
necklace3 :: ItemKind
necklace3 = ItemKind
necklaceTemplate
  { ifreq :: Freqs ItemKind
ifreq    = [(GroupName ItemKind
COMMON_ITEM, 100), (GroupName ItemKind
ANY_JEWELRY, 100)]
  , iaspects :: [Aspect]
iaspects = [ Text -> Aspect
ELabel "of fearful listening"
               , Dice -> Aspect
Timeout 40
                   -- has to be larger than Calm drain or item not removable;
                   -- equal is not enough if enemies drained Calm already
               , Skill -> Dice -> Aspect
AddSkill Skill
SkHearing 6 ]
               [Aspect] -> [Aspect] -> [Aspect]
forall a. [a] -> [a] -> [a]
++ [Aspect]
iaspects_necklaceTemplate
  , ieffects :: [Effect]
ieffects = [ DetectKind -> Int -> Effect
Detect DetectKind
DetectActor 20  -- can be applied; destroys the item
               , Condition -> Effect -> Effect
When (ActivationFlag -> Condition
TriggeredBy ActivationFlag
ActivationPeriodic) (Effect -> Effect) -> Effect -> Effect
forall a b. (a -> b) -> a -> b
$ Int -> Effect
RefillCalm (-30) ]
  }
necklace4 :: ItemKind
necklace4 = ItemKind
necklaceTemplate
  { ifreq :: Freqs ItemKind
ifreq    = [(GroupName ItemKind
COMMON_ITEM, 100), (GroupName ItemKind
ANY_JEWELRY, 100)]
  , iaspects :: [Aspect]
iaspects = [ Text -> Aspect
ELabel "of escape"
               , Dice -> Aspect
Timeout (Dice -> Aspect) -> Dice -> Aspect
forall a b. (a -> b) -> a -> b
$ (7 Dice -> Dice -> Dice
forall a. Num a => a -> a -> a
- 1 Int -> Int -> Dice
`dL` 5) Dice -> Dice -> Dice
forall a. Num a => a -> a -> a
* 10 ]
               [Aspect] -> [Aspect] -> [Aspect]
forall a. [a] -> [a] -> [a]
++ [Aspect]
iaspects_necklaceTemplate
  , ieffects :: [Effect]
ieffects = [ Dice -> Effect
Teleport (Dice -> Effect) -> Dice -> Effect
forall a b. (a -> b) -> a -> b
$ 14 Dice -> Dice -> Dice
forall a. Num a => a -> a -> a
+ 3 Int -> Int -> Dice
`d` 3  -- can be applied; destroys the item
               , DetectKind -> Int -> Effect
Detect DetectKind
DetectExit 20
               , Effect
Yell ]  -- drawback when used for quick exploring
  , idesc :: Text
idesc    = "A supple chain that slips through your fingers."
  }
necklace5 :: ItemKind
necklace5 = ItemKind
necklaceTemplate
  { ifreq :: Freqs ItemKind
ifreq    = [(GroupName ItemKind
COMMON_ITEM, 100), (GroupName ItemKind
ANY_JEWELRY, 100)]
  , iaspects :: [Aspect]
iaspects = [ Text -> Aspect
ELabel "of greed"
               , Dice -> Aspect
Timeout (8 Dice -> Dice -> Dice
forall a. Num a => a -> a -> a
+ 1 Int -> Int -> Dice
`d` 3) ]
               [Aspect] -> [Aspect] -> [Aspect]
forall a. [a] -> [a] -> [a]
++ [Aspect]
iaspects_necklaceTemplate
  , ieffects :: [Effect]
ieffects = [ DetectKind -> Int -> Effect
Detect DetectKind
DetectStash 100
               , GroupName ItemKind -> Dice -> Effect
toOrganBad GroupName ItemKind
S_PARSIMONIOUS (5 Dice -> Dice -> Dice
forall a. Num a => a -> a -> a
+ 1 Int -> Int -> Dice
`d` 3)  -- hard to flee
               , Condition -> Effect -> Effect
When (ActivationFlag -> Condition
TriggeredBy ActivationFlag
ActivationPeriodic) (Effect -> Effect) -> Effect -> Effect
forall a b. (a -> b) -> a -> b
$ Dice -> Effect
Teleport 40 ]  -- risky
  }
necklace6 :: ItemKind
necklace6 = ItemKind
necklaceTemplate
  { ifreq :: Freqs ItemKind
ifreq    = [(GroupName ItemKind
COMMON_ITEM, 100), (GroupName ItemKind
ANY_JEWELRY, 100)]
  , iaspects :: [Aspect]
iaspects = Dice -> Aspect
Timeout ((3 Dice -> Dice -> Dice
forall a. Num a => a -> a -> a
+ 1 Int -> Int -> Dice
`d` 3 Dice -> Dice -> Dice
forall a. Num a => a -> a -> a
- 1 Int -> Int -> Dice
`dL` 3) Dice -> Dice -> Dice
forall a. Num a => a -> a -> a
* 2)
               Aspect -> [Aspect] -> [Aspect]
forall a. a -> [a] -> [a]
: [Aspect]
iaspects_necklaceTemplate  -- OP if Durable; free blink
  , ieffects :: [Effect]
ieffects = [Dice -> Effect
Teleport (Dice -> Effect) -> Dice -> Effect
forall a b. (a -> b) -> a -> b
$ 3 Int -> Int -> Dice
`d` 2]
  }
necklace7 :: ItemKind
necklace7 = ItemKind
necklaceTemplate
  { ifreq :: Freqs ItemKind
ifreq    = [(GroupName ItemKind
COMMON_ITEM, 100), (GroupName ItemKind
ANY_JEWELRY, 100)]
  , iaspects :: [Aspect]
iaspects = Dice -> Aspect
Timeout ((1 Int -> Int -> Dice
`d` 3) Dice -> Dice -> Dice
forall a. Num a => a -> a -> a
* 2)
               Aspect -> [Aspect] -> [Aspect]
forall a. a -> [a] -> [a]
: [Aspect]
iaspects_necklaceTemplate
  , ieffects :: [Effect]
ieffects = [ThrowMod -> Effect
PushActor (Int -> Int -> Int -> ThrowMod
ThrowMod 100 50 1)]  -- 1 step, slow
                  -- the @50@ is only for the case of very light actor, etc.
  }
necklace8 :: ItemKind
necklace8 = ItemKind
necklaceTemplate
  { iname :: Text
iname    = "the Necklace"
  , ifreq :: Freqs ItemKind
ifreq    = [(GroupName ItemKind
CRAWL_ITEM, 50), (GroupName ItemKind
ANY_JEWELRY, 50)]
  , irarity :: Rarity
irarity  = [(10, 5)]  -- powerful and determines tactics for one actor
  , iaspects :: [Aspect]
iaspects = [ Flag -> Aspect
SetFlag Flag
Unique, Text -> Aspect
ELabel "of Overdrive"
               , Dice -> Aspect
Timeout 10
               , Skill -> Dice -> Aspect
AddSkill Skill
SkMaxHP 10  -- good effects vanish when taken off
               , Skill -> Dice -> Aspect
AddSkill Skill
SkSpeed 10
               , Flag -> Aspect
SetFlag Flag
Durable ]
               [Aspect] -> [Aspect] -> [Aspect]
forall a. [a] -> [a] -> [a]
++ [Aspect]
iaspects_necklaceTemplate
  , ieffects :: [Effect]
ieffects = [ Int -> Effect
RefillCalm (-2)  -- don't spam
               , Int -> Dice -> Effect
Discharge 5 80 ]
                   -- discharged again soon after it ends
                 -- Lasting effect lessens temptation to frequently take off
                 -- when engaging in melee, which would lead to micromanagement.
                 -- Quite OOP if worn with the right set of other items, anyway.
  , idesc :: Text
idesc    = "This whirring augmentation pack stimulates its host beyond any medically advisable or, surely, even legally admissible levels. It can be only speculated what kind of activity it was designed for, but clearly the steady handling of melee weapons was not one of them."
  }
necklace9 :: ItemKind
necklace9 = ItemKind
necklaceTemplate
  { iname :: Text
iname    = "coil"
  , ifreq :: Freqs ItemKind
ifreq    = [ (GroupName ItemKind
COMMON_ITEM, 20)  -- crafted, so can be rare
               , (GroupName ItemKind
S_REFRIGERATION_COIL, 1), (GroupName ItemKind
ANY_JEWELRY, 100)
               , (GroupName ItemKind
COLD_SOURCE, 1) ]
  , iaspects :: [Aspect]
iaspects = Text -> Aspect
ELabel "of superconducting refrigeration"
               Aspect -> [Aspect] -> [Aspect]
forall a. a -> [a] -> [a]
: Dice -> Aspect
Timeout ((1 Dice -> Dice -> Dice
forall a. Num a => a -> a -> a
+ 1 Int -> Int -> Dice
`d` 3) Dice -> Dice -> Dice
forall a. Num a => a -> a -> a
* 5)
               Aspect -> [Aspect] -> [Aspect]
forall a. a -> [a] -> [a]
: Aspect -> [Aspect] -> [Aspect]
forall a. Eq a => a -> [a] -> [a]
delete (Flag -> Aspect
SetFlag Flag
Precious) [Aspect]
iaspects_necklaceTemplate
  , ieffects :: [Effect]
ieffects = [GroupName ItemKind -> Effect
Explode GroupName ItemKind
S_CURRENT_DISCHARGE]
  }
necklace10 :: ItemKind
necklace10 = ItemKind
necklaceTemplate
  { ifreq :: Freqs ItemKind
ifreq    = [(GroupName ItemKind
COMMON_ITEM, 100), (GroupName ItemKind
ANY_JEWELRY, 100), (GroupName ItemKind
PERFUME, 1)]
  , iaspects :: [Aspect]
iaspects = Dice -> Aspect
Timeout ((1 Dice -> Dice -> Dice
forall a. Num a => a -> a -> a
+ 1 Int -> Int -> Dice
`d` 3) Dice -> Dice -> Dice
forall a. Num a => a -> a -> a
* 5)
               Aspect -> [Aspect] -> [Aspect]
forall a. a -> [a] -> [a]
: [Aspect]
iaspects_necklaceTemplate
  , ieffects :: [Effect]
ieffects = [GroupName ItemKind -> Effect
Explode GroupName ItemKind
S_FRAGRANCE]
  }
motionScanner :: ItemKind
motionScanner = ItemKind
necklaceTemplate
  { iname :: Text
iname    = "handheld sonar"
  , ifreq :: Freqs ItemKind
ifreq    = [(GroupName ItemKind
COMMON_ITEM, 100), (GroupName ItemKind
ADD_NOCTO_1, 20)]
  , irarity :: Rarity
irarity  = [(5, 3)]
  , iverbHit :: Text
iverbHit = "ping"
  , iweight :: Int
iweight  = 300  -- almost gives it away
  , iaspects :: [Aspect]
iaspects = [ Dice -> Aspect
Timeout (Dice -> Aspect) -> Dice -> Aspect
forall a b. (a -> b) -> a -> b
$ 4 Dice -> Dice -> Dice
forall a. Num a => a -> a -> a
+ 1 Int -> Int -> Dice
`dL` 6
                   -- positive dL dice, since the periodic effect is detrimental
               , Skill -> Dice -> Aspect
AddSkill Skill
SkNocto 1
               , Skill -> Dice -> Aspect
AddSkill Skill
SkArmorMelee (Dice -> Aspect) -> Dice -> Aspect
forall a b. (a -> b) -> a -> b
$ (-4 Dice -> Dice -> Dice
forall a. Num a => a -> a -> a
+ 1 Int -> Int -> Dice
`dL` 3) Dice -> Dice -> Dice
forall a. Num a => a -> a -> a
* 5
               , EqpSlot -> Aspect
EqpSlot EqpSlot
EqpSlotMiscBonus ]
               [Aspect] -> [Aspect] -> [Aspect]
forall a. [a] -> [a] -> [a]
++ [Aspect]
iaspects_necklaceTemplate
  , ieffects :: [Effect]
ieffects = [GroupName ItemKind -> Effect
Explode GroupName ItemKind
S_PING_PLASH]
  , idesc :: Text
idesc    = "Portable underwater echolocator overdriven to scan dark corridors at the cost of emitting occasional loud pings and flashes. Having to track the display hanging from the neck strap is distracting, as well."
  }

-- ** Non-periodic jewelry

imageItensifier :: ItemKind
imageItensifier = $WItemKind :: Char
-> Text
-> Freqs ItemKind
-> [Flavour]
-> Dice
-> Rarity
-> Text
-> Int
-> Dice
-> [Aspect]
-> [Effect]
-> [(GroupName ItemKind, CStore)]
-> Text
-> ItemKind
ItemKind
  { isymbol :: Char
isymbol  = Char
symbolRing
  , iname :: Text
iname    = "noctovisor"
  , ifreq :: Freqs ItemKind
ifreq    = [(GroupName ItemKind
TREASURE, 100), (GroupName ItemKind
ADD_NOCTO_1, 80), (GroupName ItemKind
MUSEAL, 100)]
  , iflavour :: [Flavour]
iflavour = [Color] -> [Flavour]
zipFancy [Color
BrGreen]
  , icount :: Dice
icount   = 1
  , irarity :: Rarity
irarity  = [(5, 2)]
  , iverbHit :: Text
iverbHit = "rattle"
  , iweight :: Int
iweight  = 700
  , idamage :: Dice
idamage  = 0
  , iaspects :: [Aspect]
iaspects = [ Skill -> Dice -> Aspect
AddSkill Skill
SkNocto 1, Skill -> Dice -> Aspect
AddSkill Skill
SkSight (-1)
               , Skill -> Dice -> Aspect
AddSkill Skill
SkArmorMelee (Dice -> Aspect) -> Dice -> Aspect
forall a b. (a -> b) -> a -> b
$ (-6 Dice -> Dice -> Dice
forall a. Num a => a -> a -> a
+ 1 Int -> Int -> Dice
`dL` 3) Dice -> Dice -> Dice
forall a. Num a => a -> a -> a
* 5
               , Flag -> Aspect
SetFlag Flag
Precious, Flag -> Aspect
SetFlag Flag
Equipable
               , EqpSlot -> Aspect
EqpSlot EqpSlot
EqpSlotMiscBonus ]
  , ieffects :: [Effect]
ieffects = []
  , idesc :: Text
idesc    = "Sturdy antique night vision goggles of unknown origin."
  , ikit :: [(GroupName ItemKind, CStore)]
ikit     = []
  }
sightSharpening :: ItemKind
sightSharpening = ItemKind
ringTemplate  -- small and round, so mistaken for a ring
  { iname :: Text
iname    = "Autozoom Contact Lens"
  , ifreq :: Freqs ItemKind
ifreq    = [(GroupName ItemKind
TREASURE, 100), (GroupName ItemKind
ADD_SIGHT, 1)]
      -- it's has to be very rare, because it's powerful and not unique,
      -- and also because it looks exactly as one of necklaces, so it would
      -- be misleading when seen on the map
  , irarity :: Rarity
irarity  = [(7, 1), (10, 10)]  -- low @ifreq@
  , iweight :: Int
iweight  = 50  -- heavier that it looks, due to glass
  , iaspects :: [Aspect]
iaspects = [ Skill -> Dice -> Aspect
AddSkill Skill
SkSight (Dice -> Aspect) -> Dice -> Aspect
forall a b. (a -> b) -> a -> b
$ 1 Dice -> Dice -> Dice
forall a. Num a => a -> a -> a
+ 1 Int -> Int -> Dice
`dL` 2
               , Skill -> Dice -> Aspect
AddSkill Skill
SkHurtMelee (Dice -> Aspect) -> Dice -> Aspect
forall a b. (a -> b) -> a -> b
$ (1 Int -> Int -> Dice
`d` 3) Dice -> Dice -> Dice
forall a. Num a => a -> a -> a
* 3
               , EqpSlot -> Aspect
EqpSlot EqpSlot
EqpSlotSight ]
               [Aspect] -> [Aspect] -> [Aspect]
forall a. [a] -> [a] -> [a]
++ ItemKind -> [Aspect]
iaspects ItemKind
ringTemplate
  , idesc :: Text
idesc    = "Zooms on any movement, distant or close. Requires some getting used to. Never needs to be taken off."
  }
-- Don't add standard effects to rings, because they go in and out
-- of eqp and so activating them would require UI tedium: looking for
-- them in eqp and stash or even activating a wrong item by mistake.
--
-- By general mechanisms, due to not having effects that could identify
-- them by observing the effect, rings are identified on pickup.
-- That's unlike necklaces, which provide the fun of id-by-use, because they
-- have effects and when the effects are triggered, they get identified.
ringTemplate :: ItemKind
ringTemplate = $WItemKind :: Char
-> Text
-> Freqs ItemKind
-> [Flavour]
-> Dice
-> Rarity
-> Text
-> Int
-> Dice
-> [Aspect]
-> [Effect]
-> [(GroupName ItemKind, CStore)]
-> Text
-> ItemKind
ItemKind
  { isymbol :: Char
isymbol  = Char
symbolRing
  , iname :: Text
iname    = "ring"
  , ifreq :: Freqs ItemKind
ifreq    = [(GroupName ItemKind
RING_UNKNOWN, 1)]
  , iflavour :: [Flavour]
iflavour = [Color] -> [Flavour]
zipPlain [Color]
stdCol [Flavour] -> [Flavour] -> [Flavour]
forall a. [a] -> [a] -> [a]
++ [Color] -> [Flavour]
zipFancy [Color]
darkCol
  , icount :: Dice
icount   = 1
  , irarity :: Rarity
irarity  = [(8, 7)]
  , iverbHit :: Text
iverbHit = "knock"
  , iweight :: Int
iweight  = 15
  , idamage :: Dice
idamage  = 0
  , iaspects :: [Aspect]
iaspects = [GroupName ItemKind -> Aspect
PresentAs GroupName ItemKind
RING_UNKNOWN, Flag -> Aspect
SetFlag Flag
Precious, Flag -> Aspect
SetFlag Flag
Equipable]
  , ieffects :: [Effect]
ieffects = []
  , idesc :: Text
idesc    = "A sturdy ring with a softly shining eye. If it contains a body booster unit, beware of the side-effects."
  , ikit :: [(GroupName ItemKind, CStore)]
ikit     = []
  }
ring1 :: ItemKind
ring1 = ItemKind
ringTemplate
  { ifreq :: Freqs ItemKind
ifreq    = [(GroupName ItemKind
COMMON_ITEM, 100), (GroupName ItemKind
ANY_JEWELRY, 100)]
  , irarity :: Rarity
irarity  = [(5, 4)]
  , iaspects :: [Aspect]
iaspects = [ Skill -> Dice -> Aspect
AddSkill Skill
SkSpeed (Dice -> Aspect) -> Dice -> Aspect
forall a b. (a -> b) -> a -> b
$ 1 Int -> Int -> Dice
`dL` 2
               , Skill -> Dice -> Aspect
AddSkill Skill
SkMaxHP (-20)
               , EqpSlot -> Aspect
EqpSlot EqpSlot
EqpSlotSpeed ]
               [Aspect] -> [Aspect] -> [Aspect]
forall a. [a] -> [a] -> [a]
++ ItemKind -> [Aspect]
iaspects ItemKind
ringTemplate
  }
ring2 :: ItemKind
ring2 = ItemKind
ringTemplate
  { ifreq :: Freqs ItemKind
ifreq    = [(GroupName ItemKind
COMMON_ITEM, 100), (GroupName ItemKind
ANY_JEWELRY, 100)]
  , irarity :: Rarity
irarity  = [(8, 4)]
  , iaspects :: [Aspect]
iaspects = [ Skill -> Dice -> Aspect
AddSkill Skill
SkSpeed (Dice -> Aspect) -> Dice -> Aspect
forall a b. (a -> b) -> a -> b
$ 1 Dice -> Dice -> Dice
forall a. Num a => a -> a -> a
+ 1 Int -> Int -> Dice
`dL` 3
               , Skill -> Dice -> Aspect
AddSkill Skill
SkArmorMelee (-40)
               , EqpSlot -> Aspect
EqpSlot EqpSlot
EqpSlotSpeed ]
               [Aspect] -> [Aspect] -> [Aspect]
forall a. [a] -> [a] -> [a]
++ ItemKind -> [Aspect]
iaspects ItemKind
ringTemplate
  }
ring3 :: ItemKind
ring3 = ItemKind
ringTemplate
  { iname :: Text
iname    = "the Ring"
  , ifreq :: Freqs ItemKind
ifreq    = [(GroupName ItemKind
CRAWL_ITEM, 50), (GroupName ItemKind
ANY_JEWELRY, 20)]
  , irarity :: Rarity
irarity  = [(10, 7)]
  , iaspects :: [Aspect]
iaspects = [ Flag -> Aspect
SetFlag Flag
Unique, Text -> Aspect
ELabel "of Rush"
               , Skill -> Dice -> Aspect
AddSkill Skill
SkSpeed (Dice -> Aspect) -> Dice -> Aspect
forall a b. (a -> b) -> a -> b
$ (1 Dice -> Dice -> Dice
forall a. Num a => a -> a -> a
+ 1 Int -> Int -> Dice
`dL` 2) Dice -> Dice -> Dice
forall a. Num a => a -> a -> a
* 2
               , Skill -> Dice -> Aspect
AddSkill Skill
SkMaxHP (-20)
               , Skill -> Dice -> Aspect
AddSkill Skill
SkArmorMelee (-20)
               , Flag -> Aspect
SetFlag Flag
Durable, EqpSlot -> Aspect
EqpSlot EqpSlot
EqpSlotSpeed ]
               [Aspect] -> [Aspect] -> [Aspect]
forall a. [a] -> [a] -> [a]
++ ItemKind -> [Aspect]
iaspects ItemKind
ringTemplate
  , idesc :: Text
idesc    = "The creator of this dangerous artifact didn't find time to document its operation. And now it's too late."
  }
ring4 :: ItemKind
ring4 = ItemKind
ringTemplate
  { ifreq :: Freqs ItemKind
ifreq    = [(GroupName ItemKind
COMMON_ITEM, 100), (GroupName ItemKind
ANY_JEWELRY, 100)]
  , irarity :: Rarity
irarity  = [(5, 5)]
  , iaspects :: [Aspect]
iaspects = [ Skill -> Dice -> Aspect
AddSkill Skill
SkHurtMelee (Dice -> Aspect) -> Dice -> Aspect
forall a b. (a -> b) -> a -> b
$ (2 Dice -> Dice -> Dice
forall a. Num a => a -> a -> a
+ 1 Int -> Int -> Dice
`d` 3 Dice -> Dice -> Dice
forall a. Num a => a -> a -> a
+ (1 Int -> Int -> Dice
`dL` 2) Dice -> Dice -> Dice
forall a. Num a => a -> a -> a
* 2 ) Dice -> Dice -> Dice
forall a. Num a => a -> a -> a
* 3
               , Skill -> Dice -> Aspect
AddSkill Skill
SkMaxHP (-10)
               , EqpSlot -> Aspect
EqpSlot EqpSlot
EqpSlotHurtMelee ]
               [Aspect] -> [Aspect] -> [Aspect]
forall a. [a] -> [a] -> [a]
++ ItemKind -> [Aspect]
iaspects ItemKind
ringTemplate
  }
ring5 :: ItemKind
ring5 = ItemKind
ringTemplate
  { ifreq :: Freqs ItemKind
ifreq    = [(GroupName ItemKind
COMMON_ITEM, 100), (GroupName ItemKind
ANY_JEWELRY, 100)]
  , iaspects :: [Aspect]
iaspects = [ Skill -> Dice -> Aspect
AddSkill Skill
SkHurtMelee (Dice -> Aspect) -> Dice -> Aspect
forall a b. (a -> b) -> a -> b
$ (4 Dice -> Dice -> Dice
forall a. Num a => a -> a -> a
+ 1 Int -> Int -> Dice
`d` 3 Dice -> Dice -> Dice
forall a. Num a => a -> a -> a
+ (1 Int -> Int -> Dice
`dL` 2) Dice -> Dice -> Dice
forall a. Num a => a -> a -> a
* 2 ) Dice -> Dice -> Dice
forall a. Num a => a -> a -> a
* 3
               , Skill -> Dice -> Aspect
AddSkill Skill
SkArmorMelee (-20)
               , EqpSlot -> Aspect
EqpSlot EqpSlot
EqpSlotHurtMelee ]
               [Aspect] -> [Aspect] -> [Aspect]
forall a. [a] -> [a] -> [a]
++ ItemKind -> [Aspect]
iaspects ItemKind
ringTemplate
  }
ring6 :: ItemKind
ring6 = ItemKind
ringTemplate
  { ifreq :: Freqs ItemKind
ifreq    = [(GroupName ItemKind
COMMON_ITEM, 100), (GroupName ItemKind
ANY_JEWELRY, 100)]
  , irarity :: Rarity
irarity  = [(6, 10)]  -- needed, e.g, to buff dominated minions
  , iaspects :: [Aspect]
iaspects = [ Skill -> Dice -> Aspect
AddSkill Skill
SkMaxHP (Dice -> Aspect) -> Dice -> Aspect
forall a b. (a -> b) -> a -> b
$ 5 Dice -> Dice -> Dice
forall a. Num a => a -> a -> a
+ (1 Int -> Int -> Dice
`d` 2 Dice -> Dice -> Dice
forall a. Num a => a -> a -> a
+ 1 Int -> Int -> Dice
`dL` 2) Dice -> Dice -> Dice
forall a. Num a => a -> a -> a
* 5
               , Skill -> Dice -> Aspect
AddSkill Skill
SkMaxCalm (Dice -> Aspect) -> Dice -> Aspect
forall a b. (a -> b) -> a -> b
$ -30 Dice -> Dice -> Dice
forall a. Num a => a -> a -> a
+ (1 Int -> Int -> Dice
`dL` 3) Dice -> Dice -> Dice
forall a. Num a => a -> a -> a
* 5
               , EqpSlot -> Aspect
EqpSlot EqpSlot
EqpSlotMaxHP ]
               [Aspect] -> [Aspect] -> [Aspect]
forall a. [a] -> [a] -> [a]
++ ItemKind -> [Aspect]
iaspects ItemKind
ringTemplate
  }
ring7 :: ItemKind
ring7 = ItemKind
ringTemplate
  { ifreq :: Freqs ItemKind
ifreq    = [(GroupName ItemKind
COMMON_ITEM, 100), (GroupName ItemKind
ANY_JEWELRY, 100), (GroupName ItemKind
MUSEAL, 100)]
  , irarity :: Rarity
irarity  = [(5, 1), (10, 7)]  -- needed after other items drop Calm
  , iaspects :: [Aspect]
iaspects = [ Skill -> Dice -> Aspect
AddSkill Skill
SkMaxCalm (Dice -> Aspect) -> Dice -> Aspect
forall a b. (a -> b) -> a -> b
$ 30 Dice -> Dice -> Dice
forall a. Num a => a -> a -> a
+ (1 Int -> Int -> Dice
`dL` 4) Dice -> Dice -> Dice
forall a. Num a => a -> a -> a
* 5
               , Skill -> Dice -> Aspect
AddSkill Skill
SkHearing 6
               , EqpSlot -> Aspect
EqpSlot EqpSlot
EqpSlotMiscBonus ]
               [Aspect] -> [Aspect] -> [Aspect]
forall a. [a] -> [a] -> [a]
++ ItemKind -> [Aspect]
iaspects ItemKind
ringTemplate
  , idesc :: Text
idesc    = "Cold, solid to the touch, perfectly round, engraved with solemn, strangely comforting, worn out words."
  }
ring8 :: ItemKind
ring8 = ItemKind
ringTemplate  -- weak skill per eqp slot, so can be without drawbacks
  { ifreq :: Freqs ItemKind
ifreq    = [(GroupName ItemKind
COMMON_ITEM, 100), (GroupName ItemKind
ANY_JEWELRY, 100), (GroupName ItemKind
MUSEAL, 50)]
  , irarity :: Rarity
irarity  = [(3, 3)]
  , iaspects :: [Aspect]
iaspects = [ Skill -> Dice -> Aspect
AddSkill Skill
SkShine 1
               , EqpSlot -> Aspect
EqpSlot EqpSlot
EqpSlotShine ]
               [Aspect] -> [Aspect] -> [Aspect]
forall a. [a] -> [a] -> [a]
++ ItemKind -> [Aspect]
iaspects ItemKind
ringTemplate
  , idesc :: Text
idesc    = "A sturdy ring with a large, shining stone."
  }
ring9 :: ItemKind
ring9 = ItemKind
ringTemplate
  { ifreq :: Freqs ItemKind
ifreq    = [(GroupName ItemKind
COMMON_ITEM, 10), (GroupName ItemKind
RING_OF_OPPORTUNITY_SNIPER, 1)]
  , iaspects :: [Aspect]
iaspects = [ Text -> Aspect
ELabel "of opportunity sniper"
               , Skill -> Dice -> Aspect
AddSkill Skill
SkProject 8
               , EqpSlot -> Aspect
EqpSlot EqpSlot
EqpSlotProject ]
               [Aspect] -> [Aspect] -> [Aspect]
forall a. [a] -> [a] -> [a]
++ ItemKind -> [Aspect]
iaspects ItemKind
ringTemplate
  , idesc :: Text
idesc    = "This mil-grade communication equipment feeds the aggregated enemy position information to the wearer, even when he is not the pointman of the team and so the team is not intentionally spotting for him. With proper training this permits ranged attacks, even indirect fire, without neglecting the simultaneous squad doctrine obligation of covering the approach of the pointman."
  }
ring10 :: ItemKind
ring10 = ItemKind
ringTemplate
  { iname :: Text
iname    = "the Ring"
  , ifreq :: Freqs ItemKind
ifreq    = [(GroupName ItemKind
TREASURE, 50), (GroupName ItemKind
ANY_JEWELRY, 50)]
  , irarity :: Rarity
irarity  = [(10, 4)]
  , iaspects :: [Aspect]
iaspects = [ Flag -> Aspect
SetFlag Flag
Unique, Text -> Aspect
ELabel "of Overwatch"
               , Skill -> Dice -> Aspect
AddSkill Skill
SkProject 8  -- TODO: 11, but let player control
                                       -- potion throwing; see capReinforced
               , Skill -> Dice -> Aspect
AddSkill Skill
SkMaxHP (-20)
               , Flag -> Aspect
SetFlag Flag
Durable, EqpSlot -> Aspect
EqpSlot EqpSlot
EqpSlotProject ]
               [Aspect] -> [Aspect] -> [Aspect]
forall a. [a] -> [a] -> [a]
++ ItemKind -> [Aspect]
iaspects ItemKind
ringTemplate
  , idesc :: Text
idesc    = "This exceptional medical contraption constantly transforms and re-injects minuscule amounts of blood serum, synthesizing powerful drugs that greatly enhance spacial awareness and focus, at the cost of weakening bodily resilience and recovery. With this boost, indirect fire becomes possible, even for a non-pointman team member."
  }

-- ** Armor

armorLeather :: ItemKind
armorLeather = $WItemKind :: Char
-> Text
-> Freqs ItemKind
-> [Flavour]
-> Dice
-> Rarity
-> Text
-> Int
-> Dice
-> [Aspect]
-> [Effect]
-> [(GroupName ItemKind, CStore)]
-> Text
-> ItemKind
ItemKind
  { isymbol :: Char
isymbol  = Char
symbolTorsoArmor
  , iname :: Text
iname    = "spacesuit jacket"
  , ifreq :: Freqs ItemKind
ifreq    = [ (GroupName ItemKind
COMMON_ITEM, 100), (GroupName ItemKind
S_SPACESUIT_JACKET, 1)
               , (GroupName ItemKind
SPACESUIT_PART, 1), (GroupName ItemKind
ARMOR_LOOSE, 1), (GroupName ItemKind
STARTING_ARMOR, 100) ]
  , iflavour :: [Flavour]
iflavour = [Color] -> [Flavour]
zipFancy [Color
Blue]
  , icount :: Dice
icount   = 1
  , irarity :: Rarity
irarity  = [(1, 7), (10, 3)]
  , iverbHit :: Text
iverbHit = "thud"
  , iweight :: Int
iweight  = 7000
  , idamage :: Dice
idamage  = 0
  , iaspects :: [Aspect]
iaspects = [ Skill -> Dice -> Aspect
AddSkill Skill
SkHurtMelee (-2)
               , Skill -> Dice -> Aspect
AddSkill Skill
SkArmorMelee (Dice -> Aspect) -> Dice -> Aspect
forall a b. (a -> b) -> a -> b
$ (2 Dice -> Dice -> Dice
forall a. Num a => a -> a -> a
+ 1 Int -> Int -> Dice
`dL` 2) Dice -> Dice -> Dice
forall a. Num a => a -> a -> a
* 5
               , Skill -> Dice -> Aspect
AddSkill Skill
SkArmorRanged (Dice -> Aspect) -> Dice -> Aspect
forall a b. (a -> b) -> a -> b
$ (1 Dice -> Dice -> Dice
forall a. Num a => a -> a -> a
+ 1 Int -> Int -> Dice
`dL` 2) Dice -> Dice -> Dice
forall a. Num a => a -> a -> a
* 3
               , Flag -> Aspect
SetFlag Flag
Durable, Flag -> Aspect
SetFlag Flag
Equipable
               , EqpSlot -> Aspect
EqpSlot EqpSlot
EqpSlotArmorMelee ]
  , ieffects :: [Effect]
ieffects = []
  , idesc :: Text
idesc    = "A hard-shell torso segment of a disposed off spacesuit. Well ventilated through the air tank outlets."
  , ikit :: [(GroupName ItemKind, CStore)]
ikit     = []
  }
armorLeather2 :: ItemKind
armorLeather2 = ItemKind
armorLeather  -- for now, purely flavour, for better messages
  { isymbol :: Char
isymbol  = Char
symbolMiscArmor
  , iname :: Text
iname    = "pair"
  , ifreq :: Freqs ItemKind
ifreq    = [ (GroupName ItemKind
COMMON_ITEM, 100), (GroupName ItemKind
S_SPACESUIT_TROUSERS, 1)
               , (GroupName ItemKind
SPACESUIT_PART, 1), (GroupName ItemKind
STARTING_ARMOR, 100) ]
                 -- no ARMOR_LOOSE; harder to take off than a jacket
  , irarity :: Rarity
irarity  = [(3, 5), (10, 4)]
  , iaspects :: [Aspect]
iaspects = Text -> Aspect
ELabel "of spacesuit trousers" Aspect -> [Aspect] -> [Aspect]
forall a. a -> [a] -> [a]
: ItemKind -> [Aspect]
iaspects ItemKind
armorLeather
  , idesc :: Text
idesc    = "Segmented trousers for open space work, with the hermetically sealed boots cut off. Surprisingly flexible and airy, yet micro-meteorite-proof."
  }
armorMail :: ItemKind
armorMail = ItemKind
armorLeather
  { iname :: Text
iname    = "bulletproof vest"
  , ifreq :: Freqs ItemKind
ifreq    = [ (GroupName ItemKind
COMMON_ITEM, 100), (GroupName ItemKind
ARMOR_LOOSE, 1), (GroupName ItemKind
ARMOR_RANGED, 1)
               , (GroupName ItemKind
S_BULLTEPROOF_VEST, 1), (GroupName ItemKind
STARTING_ARMOR, 50) ]
  , iflavour :: [Flavour]
iflavour = [Color] -> [Flavour]
zipPlain [Color
Cyan]
  , irarity :: Rarity
irarity  = [(4, 3), (7, 12), (10, 3)]
  , iweight :: Int
iweight  = 12000
  , idamage :: Dice
idamage  = 0
  , iaspects :: [Aspect]
iaspects = [ Skill -> Dice -> Aspect
AddSkill Skill
SkHurtMelee (-5)
               , Skill -> Dice -> Aspect
AddSkill Skill
SkArmorMelee (Dice -> Aspect) -> Dice -> Aspect
forall a b. (a -> b) -> a -> b
$ (2 Dice -> Dice -> Dice
forall a. Num a => a -> a -> a
+ 1 Int -> Int -> Dice
`dL` 2) Dice -> Dice -> Dice
forall a. Num a => a -> a -> a
* 5
               , Skill -> Dice -> Aspect
AddSkill Skill
SkArmorRanged (Dice -> Aspect) -> Dice -> Aspect
forall a b. (a -> b) -> a -> b
$ (3 Dice -> Dice -> Dice
forall a. Num a => a -> a -> a
+ 1 Int -> Int -> Dice
`dL` 3) Dice -> Dice -> Dice
forall a. Num a => a -> a -> a
* 3
               , Skill -> Dice -> Aspect
AddSkill Skill
SkOdor 2
               , Flag -> Aspect
SetFlag Flag
Durable, Flag -> Aspect
SetFlag Flag
Equipable
               , EqpSlot -> Aspect
EqpSlot EqpSlot
EqpSlotArmorRanged ]
  , ieffects :: [Effect]
ieffects = []
  , idesc :: Text
idesc    = "A civilian bulletproof vest. Discourages foes from attacking your torso, making it harder for them to land a blow. Really hard to wash due to thickness."
  }
meleeEnhancement :: ItemKind
meleeEnhancement = $WItemKind :: Char
-> Text
-> Freqs ItemKind
-> [Flavour]
-> Dice
-> Rarity
-> Text
-> Int
-> Dice
-> [Aspect]
-> [Effect]
-> [(GroupName ItemKind, CStore)]
-> Text
-> ItemKind
ItemKind
  { isymbol :: Char
isymbol  = Char
symbolTorsoArmor
  , iname :: Text
iname    = "barebones exoskeleton"
  , ifreq :: Freqs ItemKind
ifreq    = [(GroupName ItemKind
COMMON_ITEM, 100)]
  , iflavour :: [Flavour]
iflavour = [Color] -> [Flavour]
zipFancy [Color
Blue]
  , icount :: Dice
icount   = 1
  , irarity :: Rarity
irarity  = [(10, 10)]  -- many, but very varied quality
  , iverbHit :: Text
iverbHit = "zip"
  , iweight :: Int
iweight  = 1000
  , idamage :: Dice
idamage  = 0
  , iaspects :: [Aspect]
iaspects = [ Skill -> Dice -> Aspect
AddSkill Skill
SkHurtMelee (Dice -> Aspect) -> Dice -> Aspect
forall a b. (a -> b) -> a -> b
$ (2 Dice -> Dice -> Dice
forall a. Num a => a -> a -> a
+ 1 Int -> Int -> Dice
`dL` 8) Dice -> Dice -> Dice
forall a. Num a => a -> a -> a
* 3
               , Skill -> Dice -> Aspect
AddSkill Skill
SkArmorMelee 3
               , Flag -> Aspect
SetFlag Flag
Durable, Flag -> Aspect
SetFlag Flag
Equipable
               , EqpSlot -> Aspect
EqpSlot EqpSlot
EqpSlotHurtMelee ]
  , ieffects :: [Effect]
ieffects = []
  , idesc :: Text
idesc    = "A minimal frame from carbon fibre, designed to prevent injuries when lifting and operating heavy construction equipment. Cheap, light, disposable."
  , ikit :: [(GroupName ItemKind, CStore)]
ikit     = []
  }
spacesuit :: ItemKind
spacesuit = $WItemKind :: Char
-> Text
-> Freqs ItemKind
-> [Flavour]
-> Dice
-> Rarity
-> Text
-> Int
-> Dice
-> [Aspect]
-> [Effect]
-> [(GroupName ItemKind, CStore)]
-> Text
-> ItemKind
ItemKind
  { isymbol :: Char
isymbol  = Char
symbolTorsoArmor
  , iname :: Text
iname    = "spacesuit"
  , ifreq :: Freqs ItemKind
ifreq    = [(GroupName ItemKind
S_SPACESUIT, 1)]
  , iflavour :: [Flavour]
iflavour = [Color] -> [Flavour]
zipFancy [Color
BrWhite]
  , icount :: Dice
icount   = 1
  , irarity :: Rarity
irarity  = [(10, 10)]
  , iverbHit :: Text
iverbHit = "hug"
  , iweight :: Int
iweight  = 250000  -- including the fake gravity mass from two boots
  , idamage :: Dice
idamage  = 0
  , iaspects :: [Aspect]
iaspects = [ Skill -> Dice -> Aspect
AddSkill Skill
SkHurtMelee (-30)  -- restricted arm movement
               , Skill -> Dice -> Aspect
AddSkill Skill
SkSight (-1)
               , Skill -> Dice -> Aspect
AddSkill Skill
SkHearing (-3), Skill -> Dice -> Aspect
AddSkill Skill
SkSmell (-99)
               , Skill -> Dice -> Aspect
AddSkill Skill
SkArmorMelee (Dice -> Aspect) -> Dice -> Aspect
forall a b. (a -> b) -> a -> b
$ (8 Dice -> Dice -> Dice
forall a. Num a => a -> a -> a
+ 1 Int -> Int -> Dice
`dL` 2) Dice -> Dice -> Dice
forall a. Num a => a -> a -> a
* 10  -- ~ 95
               , Skill -> Dice -> Aspect
AddSkill Skill
SkArmorRanged (Dice -> Aspect) -> Dice -> Aspect
forall a b. (a -> b) -> a -> b
$ (1 Int -> Int -> Dice
`dL` 3) Dice -> Dice -> Dice
forall a. Num a => a -> a -> a
* 12  -- ~ 25.5
                   -- both armors are sums of the full set, averaged;
                   -- the main advantage is taking only one slot
               , Flag -> Aspect
SetFlag Flag
Durable, Flag -> Aspect
SetFlag Flag
Equipable
               , EqpSlot -> Aspect
EqpSlot EqpSlot
EqpSlotArmorMelee ]
  , ieffects :: [Effect]
ieffects = []
  , idesc :: Text
idesc    = "A heavy spacesuit, with micro-suction machinery build into its boots, but requiring an external air tank for space walking. It heavily restrict arm movement, but not walking, regardless of gravity or lack thereof."
  , ikit :: [(GroupName ItemKind, CStore)]
ikit     = []
  }
spacesuitTorn :: ItemKind
spacesuitTorn = ItemKind
spacesuit
  { iname :: Text
iname    = "torn spacesuit"
  , ifreq :: Freqs ItemKind
ifreq    = [(GroupName ItemKind
CRAWL_ITEM, 100), (GroupName ItemKind
S_SPACESUIT_TORN, 1)]
  , icount :: Dice
icount   = 1 Int -> Int -> Dice
`d` 3
  , irarity :: Rarity
irarity  = [(1, 17), (8 Double -> Double -> Double
forall a. Num a => a -> a -> a
* 10Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/15, 10)]
  , iverbHit :: Text
iverbHit = "entangle"
  , iweight :: Int
iweight  = 10000
  , iaspects :: [Aspect]
iaspects = [ Skill -> Dice -> Aspect
AddSkill Skill
SkHurtMelee (-30)
               , Skill -> Dice -> Aspect
AddSkill Skill
SkSight (-1)  -- obstructed despite the tears
               , Skill -> Dice -> Aspect
AddSkill Skill
SkArmorMelee (Dice -> Aspect) -> Dice -> Aspect
forall a b. (a -> b) -> a -> b
$ (1 Dice -> Dice -> Dice
forall a. Num a => a -> a -> a
+ 1 Int -> Int -> Dice
`d` 3) Dice -> Dice -> Dice
forall a. Num a => a -> a -> a
* 10  -- shallow, no `dL`
               , Skill -> Dice -> Aspect
AddSkill Skill
SkArmorRanged (Dice -> Aspect) -> Dice -> Aspect
forall a b. (a -> b) -> a -> b
$ (1 Int -> Int -> Dice
`d` 2) Dice -> Dice -> Dice
forall a. Num a => a -> a -> a
* 6
               , Flag -> Aspect
SetFlag Flag
Durable, Flag -> Aspect
SetFlag Flag
Equipable
               , EqpSlot -> Aspect
EqpSlot EqpSlot
EqpSlotArmorMelee ]
  , idesc :: Text
idesc    = "A badly torn spacesuit, barely offering any protection any more but still heavily restricting arm movement. Perhaps two decent wearable pieces could be salvaged by extracting, matching and patching components on a suitable workbench using scissors of some kind."
  , ikit :: [(GroupName ItemKind, CStore)]
ikit     = [(GroupName ItemKind
BONDING_TOOL, CStore
CGround)]
  }
gloveFencing :: ItemKind
gloveFencing = $WItemKind :: Char
-> Text
-> Freqs ItemKind
-> [Flavour]
-> Dice
-> Rarity
-> Text
-> Int
-> Dice
-> [Aspect]
-> [Effect]
-> [(GroupName ItemKind, CStore)]
-> Text
-> ItemKind
ItemKind
  { isymbol :: Char
isymbol  = Char
symbolMiscArmor
  , iname :: Text
iname    = "construction glove"
  , ifreq :: Freqs ItemKind
ifreq    = [ (GroupName ItemKind
COMMON_ITEM, 100), (GroupName ItemKind
ARMOR_MISC, 1), (GroupName ItemKind
ARMOR_RANGED, 1)
               , (GroupName ItemKind
STARTING_ARMOR, 50) ]
  , iflavour :: [Flavour]
iflavour = [Color] -> [Flavour]
zipPlain [Color
BrGreen]
  , icount :: Dice
icount   = 1
  , irarity :: Rarity
irarity  = [(6, 9), (10, 5)]
  , iverbHit :: Text
iverbHit = "flap"
  , iweight :: Int
iweight  = 100
  , idamage :: Dice
idamage  = 2 Int -> Int -> Dice
`d` 1
  , iaspects :: [Aspect]
iaspects = [ Skill -> Dice -> Aspect
AddSkill Skill
SkHurtMelee (Dice -> Aspect) -> Dice -> Aspect
forall a b. (a -> b) -> a -> b
$ (2 Dice -> Dice -> Dice
forall a. Num a => a -> a -> a
+ 1 Int -> Int -> Dice
`d` 2 Dice -> Dice -> Dice
forall a. Num a => a -> a -> a
+ 1 Int -> Int -> Dice
`dL` 2) Dice -> Dice -> Dice
forall a. Num a => a -> a -> a
* 3
               , Skill -> Dice -> Aspect
AddSkill Skill
SkArmorRanged (Dice -> Aspect) -> Dice -> Aspect
forall a b. (a -> b) -> a -> b
$ (1 Int -> Int -> Dice
`dL` 2) Dice -> Dice -> Dice
forall a. Num a => a -> a -> a
* 3
               , Flag -> Aspect
SetFlag Flag
Durable, Flag -> Aspect
SetFlag Flag
Meleeable
               , EqpSlot -> Aspect
EqpSlot EqpSlot
EqpSlotHurtMelee
               , Int -> Aspect
toVelocity 40 ]  -- flaps and flutters
  , ieffects :: [Effect]
ieffects = []
  , idesc :: Text
idesc    = "A flexible construction glove from rough leather ensuring a good grip. Also, quite effective in averting or even catching slow projectiles."
  , ikit :: [(GroupName ItemKind, CStore)]
ikit     = []
  }
gloveGauntlet :: ItemKind
gloveGauntlet = ItemKind
gloveFencing
  { iname :: Text
iname    = "spacesuit glove"
  , ifreq :: Freqs ItemKind
ifreq    = [ (GroupName ItemKind
COMMON_ITEM, 100), (GroupName ItemKind
S_SPACESUIT_GLOVE, 1)
               , (GroupName ItemKind
SPACESUIT_PART, 2), (GroupName ItemKind
ARMOR_MISC, 1), (GroupName ItemKind
STARTING_ARMOR, 50) ]
  , iflavour :: [Flavour]
iflavour = [Color] -> [Flavour]
zipFancy [Color
White]
  , irarity :: Rarity
irarity  = [(1, 10), (5 Double -> Double -> Double
forall a. Num a => a -> a -> a
* 10Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/15, 10), (6 Double -> Double -> Double
forall a. Num a => a -> a -> a
* 10Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/15, 1)]
  , iverbHit :: Text
iverbHit = "mow"
  , iweight :: Int
iweight  = 500
  , idamage :: Dice
idamage  = 3 Int -> Int -> Dice
`d` 1
  , iaspects :: [Aspect]
iaspects = [ Skill -> Dice -> Aspect
AddSkill Skill
SkArmorMelee (Dice -> Aspect) -> Dice -> Aspect
forall a b. (a -> b) -> a -> b
$ (1 Int -> Int -> Dice
`d` 3) Dice -> Dice -> Dice
forall a. Num a => a -> a -> a
* 5
               , Flag -> Aspect
SetFlag Flag
Durable, Flag -> Aspect
SetFlag Flag
Meleeable
               , EqpSlot -> Aspect
EqpSlot EqpSlot
EqpSlotWeaponFast  -- no timeout, so worth wielding
               , Int -> Aspect
toVelocity 40 ]  -- flaps and flutters
  , idesc :: Text
idesc    = "A piece of a hull maintenance spacesuit, padded, reinforced with carbon fibre, with extruding titan manipulators."
  }
gloveJousting :: ItemKind
gloveJousting = ItemKind
gloveFencing
  { iname :: Text
iname    = "Welding Handgear"
  , ifreq :: Freqs ItemKind
ifreq    = [(GroupName ItemKind
COMMON_ITEM, 100), (GroupName ItemKind
ARMOR_MISC, 1)]
  , iflavour :: [Flavour]
iflavour = [Color] -> [Flavour]
zipFancy [Color
BrRed]
  , irarity :: Rarity
irarity  = [(1, 6), (10, 3)]
  , iverbHit :: Text
iverbHit = "ram"
  , iweight :: Int
iweight  = 3000
  , idamage :: Dice
idamage  = 5 Int -> Int -> Dice
`d` 1
  , iaspects :: [Aspect]
iaspects = [ Flag -> Aspect
SetFlag Flag
Unique
               , Dice -> Aspect
Timeout 5
               , Skill -> Dice -> Aspect
AddSkill Skill
SkHurtMelee (Dice -> Aspect) -> Dice -> Aspect
forall a b. (a -> b) -> a -> b
$ (-5 Dice -> Dice -> Dice
forall a. Num a => a -> a -> a
+ 1 Int -> Int -> Dice
`dL` 3) Dice -> Dice -> Dice
forall a. Num a => a -> a -> a
* 5
               , Skill -> Dice -> Aspect
AddSkill Skill
SkArmorMelee (Dice -> Aspect) -> Dice -> Aspect
forall a b. (a -> b) -> a -> b
$ (2 Dice -> Dice -> Dice
forall a. Num a => a -> a -> a
+ 1 Int -> Int -> Dice
`d` 2 Dice -> Dice -> Dice
forall a. Num a => a -> a -> a
+ 1 Int -> Int -> Dice
`dL` 3) Dice -> Dice -> Dice
forall a. Num a => a -> a -> a
* 5
               , Skill -> Dice -> Aspect
AddSkill Skill
SkArmorRanged (Dice -> Aspect) -> Dice -> Aspect
forall a b. (a -> b) -> a -> b
$ (1 Dice -> Dice -> Dice
forall a. Num a => a -> a -> a
+ 1 Int -> Int -> Dice
`dL` 3) Dice -> Dice -> Dice
forall a. Num a => a -> a -> a
* 3
                 -- very random on purpose and can even be good on occasion
                 -- or when ItemRerolled enough times
               , Flag -> Aspect
SetFlag Flag
Durable, Flag -> Aspect
SetFlag Flag
Meleeable
               , EqpSlot -> Aspect
EqpSlot EqpSlot
EqpSlotWeaponFast  -- hope to replace with better soon
               , Int -> Aspect
toVelocity 60 ]  -- flaps and flutters
  , idesc :: Text
idesc    = "Rigid, bulky handgear embedding a defunct welding equipment, complete with an affixed small shield and a darkened visor. Awe-inspiring."
  }
hatUshanka :: ItemKind
hatUshanka = $WItemKind :: Char
-> Text
-> Freqs ItemKind
-> [Flavour]
-> Dice
-> Rarity
-> Text
-> Int
-> Dice
-> [Aspect]
-> [Effect]
-> [(GroupName ItemKind, CStore)]
-> Text
-> ItemKind
ItemKind
  { isymbol :: Char
isymbol  = Char
symbolMiscArmor
  , iname :: Text
iname    = "ushanka hat"
  , ifreq :: Freqs ItemKind
ifreq    = [ (GroupName ItemKind
COMMON_ITEM, 100), (GroupName ItemKind
ARMOR_MISC, 1), (GroupName ItemKind
CLOTHING_MISC, 1)
               , (GroupName ItemKind
STARTING_ARMOR, 50) ]
  , iflavour :: [Flavour]
iflavour = [Color] -> [Flavour]
zipPlain [Color
Brown]
  , icount :: Dice
icount   = 1
  , irarity :: Rarity
irarity  = [(3, 7), (10, 4)]
  , iverbHit :: Text
iverbHit = "tickle"
  , iweight :: Int
iweight  = 500
  , idamage :: Dice
idamage  = 0
  , iaspects :: [Aspect]
iaspects = [ Dice -> Aspect
Timeout (Dice -> Aspect) -> Dice -> Aspect
forall a b. (a -> b) -> a -> b
$ (2 Dice -> Dice -> Dice
forall a. Num a => a -> a -> a
+ 1 Int -> Int -> Dice
`d` 2) Dice -> Dice -> Dice
forall a. Num a => a -> a -> a
* 3
               , Skill -> Dice -> Aspect
AddSkill Skill
SkArmorMelee 5, Skill -> Dice -> Aspect
AddSkill Skill
SkHearing (-6)
               , Flag -> Aspect
SetFlag Flag
Periodic, Flag -> Aspect
SetFlag Flag
Durable, Flag -> Aspect
SetFlag Flag
Equipable
               , EqpSlot -> Aspect
EqpSlot EqpSlot
EqpSlotArmorMelee
               , Int -> Aspect
toVelocity 50 ]  -- flaps and flutters
  , ieffects :: [Effect]
ieffects = [Int -> Effect
RefillCalm 1]
  , idesc :: Text
idesc    = "Soft and warm fur. It keeps your ears warm."
  , ikit :: [(GroupName ItemKind, CStore)]
ikit     = []
  }
capReinforced :: ItemKind
capReinforced = $WItemKind :: Char
-> Text
-> Freqs ItemKind
-> [Flavour]
-> Dice
-> Rarity
-> Text
-> Int
-> Dice
-> [Aspect]
-> [Effect]
-> [(GroupName ItemKind, CStore)]
-> Text
-> ItemKind
ItemKind
  { isymbol :: Char
isymbol  = Char
symbolMiscArmor
  , iname :: Text
iname    = "construction cap"
  , ifreq :: Freqs ItemKind
ifreq    = [(GroupName ItemKind
COMMON_ITEM, 100), (GroupName ItemKind
ARMOR_MISC, 1), (GroupName ItemKind
STARTING_ARMOR, 50)]
  , iflavour :: [Flavour]
iflavour = [Color] -> [Flavour]
zipPlain [Color
BrYellow]
  , icount :: Dice
icount   = 1
  , irarity :: Rarity
irarity  = [(6, 9), (10, 3)]
  , iverbHit :: Text
iverbHit = "cut"
  , iweight :: Int
iweight  = 1000
  , idamage :: Dice
idamage  = 0
  , iaspects :: [Aspect]
iaspects = [ Skill -> Dice -> Aspect
AddSkill Skill
SkArmorMelee (Dice -> Aspect) -> Dice -> Aspect
forall a b. (a -> b) -> a -> b
$ (1 Int -> Int -> Dice
`d` 3) Dice -> Dice -> Dice
forall a. Num a => a -> a -> a
* 5
               , Skill -> Dice -> Aspect
AddSkill Skill
SkProject 1
                   -- the brim shields against blinding by light sources, etc.;
                   -- beware of stacking and causing auto-fling of vials
               , Flag -> Aspect
SetFlag Flag
Durable, Flag -> Aspect
SetFlag Flag
Equipable
               , EqpSlot -> Aspect
EqpSlot EqpSlot
EqpSlotProject ]
  , ieffects :: [Effect]
ieffects = []
  , idesc :: Text
idesc    = "A hard plastic shell that might soften a blow."
  , ikit :: [(GroupName ItemKind, CStore)]
ikit     = []
  }
helmArmored :: ItemKind
helmArmored = $WItemKind :: Char
-> Text
-> Freqs ItemKind
-> [Flavour]
-> Dice
-> Rarity
-> Text
-> Int
-> Dice
-> [Aspect]
-> [Effect]
-> [(GroupName ItemKind, CStore)]
-> Text
-> ItemKind
ItemKind
  { isymbol :: Char
isymbol  = Char
symbolMiscArmor
  , iname :: Text
iname    = "spacesuit helmet"
  , ifreq :: Freqs ItemKind
ifreq    = [ (GroupName ItemKind
COMMON_ITEM, 100), (GroupName ItemKind
S_SPACESUIT_HELMET, 1)
               , (GroupName ItemKind
SPACESUIT_PART, 1), (GroupName ItemKind
ARMOR_MISC, 1), (GroupName ItemKind
ARMOR_RANGED, 1)
               , (GroupName ItemKind
STARTING_ARMOR, 50) ]
  , iflavour :: [Flavour]
iflavour = [Color] -> [Flavour]
zipFancy [Color
BrBlue]
  , icount :: Dice
icount   = 1
  , irarity :: Rarity
irarity  = [(1, 11), (4 Double -> Double -> Double
forall a. Num a => a -> a -> a
* 10Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/15, 11), (5 Double -> Double -> Double
forall a. Num a => a -> a -> a
* 10Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/15, 1)]
  , iverbHit :: Text
iverbHit = "headbutt"
  , iweight :: Int
iweight  = 2000
  , idamage :: Dice
idamage  = 4 Int -> Int -> Dice
`d` 1
  , iaspects :: [Aspect]
iaspects = [ Dice -> Aspect
Timeout 4
               , Skill -> Dice -> Aspect
AddSkill Skill
SkArmorMelee (Dice -> Aspect) -> Dice -> Aspect
forall a b. (a -> b) -> a -> b
$ (1 Int -> Int -> Dice
`dL` 3) Dice -> Dice -> Dice
forall a. Num a => a -> a -> a
* 5
               , Skill -> Dice -> Aspect
AddSkill Skill
SkArmorRanged (Dice -> Aspect) -> Dice -> Aspect
forall a b. (a -> b) -> a -> b
$ (2 Dice -> Dice -> Dice
forall a. Num a => a -> a -> a
+ 1 Int -> Int -> Dice
`dL` 2) Dice -> Dice -> Dice
forall a. Num a => a -> a -> a
* 3  -- headshot
               , Skill -> Dice -> Aspect
AddSkill Skill
SkSight (-1)
               , Skill -> Dice -> Aspect
AddSkill Skill
SkHearing (-3), Skill -> Dice -> Aspect
AddSkill Skill
SkSmell (-5)
               , Flag -> Aspect
SetFlag Flag
Durable, Flag -> Aspect
SetFlag Flag
Meleeable
               , EqpSlot -> Aspect
EqpSlot EqpSlot
EqpSlotArmorRanged
               , Int -> Aspect
toVelocity 50 ]  -- unwieldy
  , ieffects :: [Effect]
ieffects = []
  , idesc :: Text
idesc    = "Blocks out everything, including your senses."
  , ikit :: [(GroupName ItemKind, CStore)]
ikit     = []
  }
heavyBoot :: ItemKind
heavyBoot = $WItemKind :: Char
-> Text
-> Freqs ItemKind
-> [Flavour]
-> Dice
-> Rarity
-> Text
-> Int
-> Dice
-> [Aspect]
-> [Effect]
-> [(GroupName ItemKind, CStore)]
-> Text
-> ItemKind
ItemKind
  { isymbol :: Char
isymbol  = Char
symbolMiscArmor
  , iname :: Text
iname    = "spacesuit boot"
  , ifreq :: Freqs ItemKind
ifreq    = [ (GroupName ItemKind
COMMON_ITEM, 100), (GroupName ItemKind
S_SPACESUIT_BOOT, 1)
               , (GroupName ItemKind
SPACESUIT_PART, 2), (GroupName ItemKind
ARMOR_MISC, 1) ]
                 -- no STARTING_ARMOR, because the malus tricky for newbies
  , iflavour :: [Flavour]
iflavour = [Color] -> [Flavour]
zipFancy [Color
Magenta]
  , icount :: Dice
icount   = 1
  , irarity :: Rarity
irarity  = [(1, 12), (3 Double -> Double -> Double
forall a. Num a => a -> a -> a
* 10Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/15, 12), (4 Double -> Double -> Double
forall a. Num a => a -> a -> a
* 10Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/15, 1)]
  , iverbHit :: Text
iverbHit = "sock"
  , iweight :: Int
iweight  = 100000  -- including the fake gravity mass
  , idamage :: Dice
idamage  = 6 Int -> Int -> Dice
`d` 1
  , iaspects :: [Aspect]
iaspects = [ Dice -> Aspect
Timeout 7
               , Skill -> Dice -> Aspect
AddSkill Skill
SkHurtMelee (-10)
               , Skill -> Dice -> Aspect
AddSkill Skill
SkArmorMelee (Dice -> Aspect) -> Dice -> Aspect
forall a b. (a -> b) -> a -> b
$ (1 Dice -> Dice -> Dice
forall a. Num a => a -> a -> a
+ 1 Int -> Int -> Dice
`dL` 3) Dice -> Dice -> Dice
forall a. Num a => a -> a -> a
* 5
               , Flag -> Aspect
SetFlag Flag
Durable, Flag -> Aspect
SetFlag Flag
Meleeable
               , EqpSlot -> Aspect
EqpSlot EqpSlot
EqpSlotWeaponFast  -- hope to replace with better soon
               , Int -> Aspect
toVelocity 500 ]  -- the fake mass not counted for throwing
  , ieffects :: [Effect]
ieffects = []
  , idesc :: Text
idesc    = "An armored boot, cut-off from a spacesuit. The in-built micro-suction machinery for maintaining traction in the absence of gravity gives stability equivalent to an extra 100kg of mass. Kicks get abrupt acceleration millimeters short of the target."
  , ikit :: [(GroupName ItemKind, CStore)]
ikit     = []
  }
ragTangle :: ItemKind
ragTangle = ItemKind
sandstoneRock
  { isymbol :: Char
isymbol  = Char
symbolClothes
  , iname :: Text
iname    = "tangle"
  , ifreq :: Freqs ItemKind
ifreq    = [ (GroupName ItemKind
COMMON_ITEM, 10), (GroupName ItemKind
CLOTH_RAG, 1), (GroupName ItemKind
THICK_CLOTH, 1)
               , (GroupName ItemKind
S_RAG_TANGLE, 1), (GroupName ItemKind
UNREPORTED_INVENTORY, 1) ]
  , iflavour :: [Flavour]
iflavour = [Color] -> [Flavour]
zipPlain [Color
Brown]
  , icount :: Dice
icount   = 1
  , irarity :: Rarity
irarity  = [(1, 10)]  -- crafted, so rare
  , iverbHit :: Text
iverbHit = "touch"
  , iweight :: Int
iweight  = 200
  , idamage :: Dice
idamage  = 0
  , iaspects :: [Aspect]
iaspects = [ Text -> Aspect
ELabel "of rags"
               , Flag -> Aspect
SetFlag Flag
Fragile, Skill -> Dice -> Aspect
AddSkill Skill
SkArmorMelee 2
               , Flag -> Aspect
SetFlag Flag
Equipable, EqpSlot -> Aspect
EqpSlot EqpSlot
EqpSlotArmorMelee ]
  , idesc :: Text
idesc    = "Fashionable --- sometimes. Useful for survival crafting, for example as a wick of a makeshift oil lamp --- always."
  }
-- The biggest power of bucklers and shields is the ranged deflection.
-- There is a risk of micro-management, when the player takes off
-- a buckler or shield just after it activated at ranged attack,
-- regaining the speed for the probably upcoming melee fight.
-- This has the drawback that, while the shield recharges in stash,
-- it looses the charge when equipped again and if it's activated
-- from the stash, the player suffers its full piercing damage.
-- OTOH, if the player has maximized armor, he only suffers 5%
-- of the pierced damage of the shield. But to gain such high armor
-- usually requires keeping a shield equipped.
-- And the speed loss can't be avoided when exploring
-- and an extra slowdown comes from unequipping and equipping again
-- after melee, so it starts to be a meaningful and situational
-- trade-off and not a meaningless micro-management. If players
-- suffer from micro-management anyway, the recharging effect can be
-- limited to hitting in melee only (@ActivationMeleeable@).
-- The push effect is applied to self outside melee, so even less problematic.
buckler :: ItemKind
buckler = $WItemKind :: Char
-> Text
-> Freqs ItemKind
-> [Flavour]
-> Dice
-> Rarity
-> Text
-> Int
-> Dice
-> [Aspect]
-> [Effect]
-> [(GroupName ItemKind, CStore)]
-> Text
-> ItemKind
ItemKind
  { isymbol :: Char
isymbol  = Char
symbolShield
  , iname :: Text
iname    = "buckler"
  , ifreq :: Freqs ItemKind
ifreq    = [(GroupName ItemKind
COMMON_ITEM, 100), (GroupName ItemKind
ARMOR_LOOSE, 1)]
  , iflavour :: [Flavour]
iflavour = [Color] -> [Flavour]
zipPlain [Color
Blue]
  , icount :: Dice
icount   = 1
  , irarity :: Rarity
irarity  = [(4, 7)]
  , iverbHit :: Text
iverbHit = "bash"
  , iweight :: Int
iweight  = 2000
  , idamage :: Dice
idamage  = 2 Int -> Int -> Dice
`d` 1
  , iaspects :: [Aspect]
iaspects = [ Dice -> Aspect
Timeout (Dice -> Aspect) -> Dice -> Aspect
forall a b. (a -> b) -> a -> b
$ (5 Dice -> Dice -> Dice
forall a. Num a => a -> a -> a
+ 1 Int -> Int -> Dice
`d` 2 Dice -> Dice -> Dice
forall a. Num a => a -> a -> a
- 1 Int -> Int -> Dice
`dL` 2) Dice -> Dice -> Dice
forall a. Num a => a -> a -> a
* 2
               , Skill -> Dice -> Aspect
AddSkill Skill
SkArmorMelee 40
               , Skill -> Dice -> Aspect
AddSkill Skill
SkSpeed (-1)  -- the main price to pay
               , Flag -> Aspect
SetFlag Flag
UnderRanged, Flag -> Aspect
SetFlag Flag
Durable, Flag -> Aspect
SetFlag Flag
Meleeable
               , EqpSlot -> Aspect
EqpSlot EqpSlot
EqpSlotArmorMelee
               , Int -> Aspect
toVelocity 50 ]  -- unwieldy to throw
  , ieffects :: [Effect]
ieffects =
      [ Condition -> Effect -> Effect -> Effect
IfThenElse (ActivationFlag -> Condition
TriggeredBy ActivationFlag
ActivationUnderRanged)
                   (Effect
NopEffect Effect -> Effect -> Effect
`OrEffect` GroupName ItemKind -> Dice -> Effect
toOrganGood GroupName ItemKind
S_RANGED_DEFLECTING 1)
                     -- this is particularly useful when exploring
                     -- and getting ambushed; @OrEffect@ is only to help AI
                     -- understand it won't be applied to foes,
                     -- but prevent it from assigning too much value
                     -- and so attacking with buckler too early
                   (Effect -> Effect
OnUser (Int -> Dice -> Effect
Recharge 4 20)) ]
                     -- this is useful during a fight
  , idesc :: Text
idesc    = "An arm protection made from an outer airlock panel. Not too small to deflect projectiles occasionally. Almost harmless when used offensively, but makes room for other weapons."
  , ikit :: [(GroupName ItemKind, CStore)]
ikit     = []
  }
-- In melee, the shield's biggest power is pushing enemies,
-- which however reduces to 1 extra damage point if no clear space behind enemy.
-- So they require keen tactical management.
-- Note that AI will pick them up but never wear and will use them at most
-- as a way to push itself. Despite being @Meleeable@, they will not be used
-- as weapons either. This is OK, using shields smartly is totally beyond AI.
shield :: ItemKind
shield = ItemKind
buckler
  { iname :: Text
iname    = "shield"
  , irarity :: Rarity
irarity  = [(7, 5)]  -- the stronger variants add to total probability
  , iflavour :: [Flavour]
iflavour = [Color] -> [Flavour]
zipPlain [Color
Green]
  , iweight :: Int
iweight  = 4000
  , idamage :: Dice
idamage  = 3 Int -> Int -> Dice
`d` 1
  , iaspects :: [Aspect]
iaspects = [ Dice -> Aspect
Timeout (Dice -> Aspect) -> Dice -> Aspect
forall a b. (a -> b) -> a -> b
$ (7 Dice -> Dice -> Dice
forall a. Num a => a -> a -> a
+ 1 Int -> Int -> Dice
`d` 2 Dice -> Dice -> Dice
forall a. Num a => a -> a -> a
- 1 Int -> Int -> Dice
`dL` 2) Dice -> Dice -> Dice
forall a. Num a => a -> a -> a
* 2
               , Skill -> Dice -> Aspect
AddSkill Skill
SkArmorMelee 60
               , Skill -> Dice -> Aspect
AddSkill Skill
SkSpeed (-1)  -- the main price to pay
               , Skill -> Dice -> Aspect
AddSkill Skill
SkHurtMelee (-25)
               , Flag -> Aspect
SetFlag Flag
UnderRanged, Flag -> Aspect
SetFlag Flag
Durable, Flag -> Aspect
SetFlag Flag
Meleeable
               , EqpSlot -> Aspect
EqpSlot EqpSlot
EqpSlotArmorMelee
               , Int -> Aspect
toVelocity 50 ]  -- unwieldy to throw
  , ieffects :: [Effect]
ieffects =
      [ Condition -> Effect -> Effect -> Effect
IfThenElse (ActivationFlag -> Condition
TriggeredBy ActivationFlag
ActivationUnderRanged)
                   (Effect -> Effect
OnUser (GroupName ItemKind -> Dice -> Effect
toOrganGood GroupName ItemKind
S_RANGED_DEFLECTING 1))
                     -- this is particularly useful when exploring
                     -- and getting ambushed; @OnUser@ is only to help AI
                     -- understand it won't be applied to foes
                   (ThrowMod -> Effect
PushActor (Int -> Int -> Int -> ThrowMod
ThrowMod 200 50 1)) ]  -- 1 step, fast
                     -- this is useful during a fight
  , idesc :: Text
idesc    = "An unwieldy rectangle made of anti-meteorite ceramic sheet. Absorbs a percentage of melee damage, both dealt and sustained. Large enough to shield against projectiles for as long as there is strength to keep it poised. Requires particularly keen positional awareness when used as a weapon."
  }
shield2 :: ItemKind
shield2 = ItemKind
shield
  { ifreq :: Freqs ItemKind
ifreq    = [(GroupName ItemKind
COMMON_ITEM, 20), (GroupName ItemKind
MUSEAL, 100), (GroupName ItemKind
S_SHIELD_BLUNT, 1)]
  , iweight :: Int
iweight  = 6000
  , idamage :: Dice
idamage  = 4 Int -> Int -> Dice
`d` 1
  , ieffects :: [Effect]
ieffects =
      [ Condition -> Effect -> Effect -> Effect
IfThenElse (ActivationFlag -> Condition
TriggeredBy ActivationFlag
ActivationUnderRanged)
                   (Effect -> Effect
OnUser (GroupName ItemKind -> Dice -> Effect
toOrganGood GroupName ItemKind
S_RANGED_DEFLECTING 1))
                   (ThrowMod -> Effect
PushActor (Int -> Int -> Int -> ThrowMod
ThrowMod 400 50 1)) ]  -- 2 steps, fast
  , idesc :: Text
idesc    = "A relic of long-past wars, heavy and with a central spike, which is however misaligned and dull."
  }
shield3 :: ItemKind
shield3 = ItemKind
shield2
  { ifreq :: Freqs ItemKind
ifreq    = [(GroupName ItemKind
COMMON_ITEM, 1), (GroupName ItemKind
MUSEAL, 3), (GroupName ItemKind
S_SHIELD_SHARP, 1)]
  , idamage :: Dice
idamage  = 7 Int -> Int -> Dice
`d` 1
  , idesc :: Text
idesc    = "A relic of long-past wars, heavy and with a sharp central spike."
  }

-- ** Weapons

-- Generally, weapons on long poles have highest damage and defence,
-- but longest timeout. Weapons with handles are middling. Weapons
-- without area weakest, but lowest timeout and highest global melee bonus.
-- Weapons of a given group tend to share the weakest representative's
-- characteristics, even when upgraded. Sharpening of weapons usually
-- just increases their damage.

-- For some weapons the main damage is not edged nor piercing,
-- but wounding trough impact or burns. A portion of such weapons
-- also double as tools for terrain transformation or crafting.

blowtorch :: ItemKind
blowtorch = $WItemKind :: Char
-> Text
-> Freqs ItemKind
-> [Flavour]
-> Dice
-> Rarity
-> Text
-> Int
-> Dice
-> [Aspect]
-> [Effect]
-> [(GroupName ItemKind, CStore)]
-> Text
-> ItemKind
ItemKind
  { isymbol :: Char
isymbol  = Char
symbolTool
  , iname :: Text
iname    = "blowtorch"  -- not unique, but almost never generated on floor
  , ifreq :: Freqs ItemKind
ifreq    = [ (GroupName ItemKind
BLOWTORCH, 1), (GroupName ItemKind
VALUABLE, 20)  -- make AI afraid to hog
               , (GroupName ItemKind
CRAWL_ITEM, 1)  -- @PolyItem@ doesn't work on it
               , (GroupName ItemKind
BREACHING_TOOL, 1), (GroupName ItemKind
FIRE_SOURCE, 1) ]
                 -- infinite use, but harmful
  , iflavour :: [Flavour]
iflavour = [Color] -> [Flavour]
zipPlain [Color
BrRed]
  , icount :: Dice
icount   = 1
  , irarity :: Rarity
irarity  = [(1, 1)]
  , iverbHit :: Text
iverbHit = "scorch"
  , iweight :: Int
iweight  = 2000
  , idamage :: Dice
idamage  = 0
  , iaspects :: [Aspect]
iaspects = [ Dice -> Aspect
Timeout 4
               , Skill -> Dice -> Aspect
AddSkill Skill
SkAlter 2
               , Skill -> Dice -> Aspect
AddSkill Skill
SkWait (-2)
                   -- patience thin in the heat; prevents sleep, to let
                   -- AI use @SkAlter@ to get to level 4
               , Flag -> Aspect
SetFlag Flag
Durable, Flag -> Aspect
SetFlag Flag
Meleeable
               , EqpSlot -> Aspect
EqpSlot EqpSlot
EqpSlotAlter
               , Int -> Aspect
toVelocity 0 ]  -- @Burn@ not effective when thrown
  , ieffects :: [Effect]
ieffects = [ Dice -> Effect
Burn 3  -- ensure heroes wear initially, so they reach lvl 4
               , Effect
Impress ]
      -- is used for melee in precedence to fists, but not to cleavers;
      -- so if player wants to hit with it, it's enough to pack other gear;
      -- is also the low bar for self-inflicted damage from durable breaching
      -- tool and fire source use so that other tool-weapons need only
      -- do that many non-armor affected damage to dissuade the player
      -- from using them without careful thought
  , idesc :: Text
idesc    = "A sturdy old-fashioned portable blowtorch for fine cutting or welding of metals. Unfocused and inaccurate, but does not require access codes to high current power outlets. If you can patiently suffer the heat, it can be used as a clumsy breaching tool for stuck, locked and welded containers and doors."  -- for some reason I don't feel like being more obvious here about the use for the welded staircase; maybe that's because the torch can be used long after the first puzzle of the game is forgotten and so the in-you-face hints should be on items and actors that get forgotten together with the puzzle
  , ikit :: [(GroupName ItemKind, CStore)]
ikit     = []
  }
laserSharpener :: ItemKind
laserSharpener = $WItemKind :: Char
-> Text
-> Freqs ItemKind
-> [Flavour]
-> Dice
-> Rarity
-> Text
-> Int
-> Dice
-> [Aspect]
-> [Effect]
-> [(GroupName ItemKind, CStore)]
-> Text
-> ItemKind
ItemKind
  { isymbol :: Char
isymbol  = Char
symbolTool
  , iname :: Text
iname    = "Laser Sharpener"
  , ifreq :: Freqs ItemKind
ifreq    = [(GroupName ItemKind
CRAWL_ITEM, 50), (GroupName ItemKind
SHARPENING_TOOL, 1)]
  , iflavour :: [Flavour]
iflavour = [Color] -> [Flavour]
zipFancy [Color
BrBlue]
  , icount :: Dice
icount   = 1
  , irarity :: Rarity
irarity  = [(5, 25)]  -- comes bundled with other tools
  , iverbHit :: Text
iverbHit = "paint"
  , iweight :: Int
iweight  = 2000
  , idamage :: Dice
idamage  = 0
  , iaspects :: [Aspect]
iaspects = [ Flag -> Aspect
SetFlag Flag
Unique, Dice -> Aspect
Timeout 5
               , Flag -> Aspect
SetFlag Flag
Durable, Flag -> Aspect
SetFlag Flag
Meleeable, EqpSlot -> Aspect
EqpSlot EqpSlot
EqpSlotWeaponBig
               , Int -> Aspect
toVelocity 0 ]  -- @Burn@ not effective when thrown
  , ieffects :: [Effect]
ieffects = [Dice -> Effect
Burn 4]  -- really harmful when used as a sharpener; intended
  , idesc :: Text
idesc    = "Laser ablation is the safest and most accurate of sharpening method. Misaligned optics with broken shielding, however, change the situation dramatically, enabling stray laser pulses to escape at unpredictable angles."  -- hence short range and so melee weapon; TODO: long range weapon with instant projectiles and no risk of hull breach
  , ikit :: [(GroupName ItemKind, CStore)]
ikit     = []
  }
crowbar :: ItemKind
crowbar = $WItemKind :: Char
-> Text
-> Freqs ItemKind
-> [Flavour]
-> Dice
-> Rarity
-> Text
-> Int
-> Dice
-> [Aspect]
-> [Effect]
-> [(GroupName ItemKind, CStore)]
-> Text
-> ItemKind
ItemKind
  { isymbol :: Char
isymbol  = Char
symbolTool
  , iname :: Text
iname    = "crowbar"
  , ifreq :: Freqs ItemKind
ifreq    = [ (GroupName ItemKind
COMMON_ITEM, 100), (GroupName ItemKind
BREACHING_TOOL, 1), (GroupName ItemKind
S_CROWBAR, 1)
               , (GroupName ItemKind
STARTING_WEAPON, 30) ]
  , iflavour :: [Flavour]
iflavour = [Color] -> [Flavour]
zipPlain [Color
BrCyan]
  , icount :: Dice
icount   = 1
  , iweight :: Int
iweight  = 1000
  , irarity :: Rarity
irarity  = [(1, 5), (3 Double -> Double -> Double
forall a. Num a => a -> a -> a
* 10Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/15, 5), (4 Double -> Double -> Double
forall a. Num a => a -> a -> a
* 10Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/15, 1)]
  , iverbHit :: Text
iverbHit = "gouge"
  , idamage :: Dice
idamage  = 2 Int -> Int -> Dice
`d` 1
  , iaspects :: [Aspect]
iaspects = [ Dice -> Aspect
Timeout (Dice -> Aspect) -> Dice -> Aspect
forall a b. (a -> b) -> a -> b
$ 2 Dice -> Dice -> Dice
forall a. Num a => a -> a -> a
+ 1 Int -> Int -> Dice
`d` 3
               , Flag -> Aspect
SetFlag Flag
Durable, Flag -> Aspect
SetFlag Flag
Meleeable
               , EqpSlot -> Aspect
EqpSlot EqpSlot
EqpSlotWeaponFast
               , Int -> Aspect
toVelocity 0 ]  -- totally unbalanced
  , ieffects :: [Effect]
ieffects = [Int -> Effect
RefillHP (-3)]
                 -- @RefillHP@ to avoid a no-brainer of durable tool use;
                 -- (idamage ignored to avoid the exploit of tool use in armor)
  , idesc :: Text
idesc    = "This is a heavy and pointy piece of steel that can be employed as an improvised melee weapon. It is also usable as a breaching tool, though rather injurious."  -- TODO: https://en.wikipedia.org/wiki/Crowbar_(tool)
  , ikit :: [(GroupName ItemKind, CStore)]
ikit     = []
  }
catsPaw :: ItemKind
catsPaw = $WItemKind :: Char
-> Text
-> Freqs ItemKind
-> [Flavour]
-> Dice
-> Rarity
-> Text
-> Int
-> Dice
-> [Aspect]
-> [Effect]
-> [(GroupName ItemKind, CStore)]
-> Text
-> ItemKind
ItemKind
  { isymbol :: Char
isymbol  = Char
symbolTool
  , iname :: Text
iname    = "cat's paw"
  , ifreq :: Freqs ItemKind
ifreq    = [ (GroupName ItemKind
COMMON_ITEM, 100), (GroupName ItemKind
BREACHING_TOOL, 1)
               , (GroupName ItemKind
STARTING_WEAPON, 15) ]
  , iflavour :: [Flavour]
iflavour = [Color] -> [Flavour]
zipPlain [Color
Cyan]
  , icount :: Dice
icount   = 1
  , iweight :: Int
iweight  = 500
  , irarity :: Rarity
irarity  = [(1, 12), (3 Double -> Double -> Double
forall a. Num a => a -> a -> a
* 10Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/15, 12), (4 Double -> Double -> Double
forall a. Num a => a -> a -> a
* 10Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/15, 1)]
  , iverbHit :: Text
iverbHit = "paw"
  , idamage :: Dice
idamage  = 1 Int -> Int -> Dice
`d` 1
  , iaspects :: [Aspect]
iaspects = [ Dice -> Aspect
Timeout (Dice -> Aspect) -> Dice -> Aspect
forall a b. (a -> b) -> a -> b
$ 1 Dice -> Dice -> Dice
forall a. Num a => a -> a -> a
+ 1 Int -> Int -> Dice
`d` 2
               , Flag -> Aspect
SetFlag Flag
Durable, Flag -> Aspect
SetFlag Flag
Meleeable
               , EqpSlot -> Aspect
EqpSlot EqpSlot
EqpSlotWeaponFast
               , Int -> Aspect
toVelocity 0 ]  -- totally unbalanced
  , ieffects :: [Effect]
ieffects = [Int -> Effect
RefillHP (-2)]
                 -- @RefillHP@ to avoid a no-brainer of durable tool use;
                 -- also quite attractive as a ranged weapon
  , idesc :: Text
idesc    = "This is a sturdy and pointy piece of steel that can be employed as an improvised melee weapon. It is also usable as a breaching tool, though not a particularly safe one."  -- TODO: https://en.wikipedia.org/wiki/Cat%27s_paw_(nail_puller)
  , ikit :: [(GroupName ItemKind, CStore)]
ikit     = []
  }
shortClub :: ItemKind
shortClub = $WItemKind :: Char
-> Text
-> Freqs ItemKind
-> [Flavour]
-> Dice
-> Rarity
-> Text
-> Int
-> Dice
-> [Aspect]
-> [Effect]
-> [(GroupName ItemKind, CStore)]
-> Text
-> ItemKind
ItemKind
  { isymbol :: Char
isymbol  = Char
symbolHafted
  , iname :: Text
iname    = "short club"
  , ifreq :: Freqs ItemKind
ifreq    = [(GroupName ItemKind
S_SHORT_CLUB, 1), (GroupName ItemKind
STARTING_WEAPON, 700)]
  , iflavour :: [Flavour]
iflavour = [Color] -> [Flavour]
zipPlain [Color
BrBlue]
  , icount :: Dice
icount   = 1
  , irarity :: Rarity
irarity  = [(1, 1)]  -- only crafted
  , iverbHit :: Text
iverbHit = "club"
  , iweight :: Int
iweight  = 2500
  , idamage :: Dice
idamage  = 2 Int -> Int -> Dice
`d` 1
  , iaspects :: [Aspect]
iaspects = [ Flag -> Aspect
SetFlag Flag
Durable, Flag -> Aspect
SetFlag Flag
Meleeable, EqpSlot -> Aspect
EqpSlot EqpSlot
EqpSlotWeaponFast
               , Int -> Aspect
toVelocity 60 ]
  , ieffects :: [Effect]
ieffects = [Int -> Effect
RefillHP (-1)]
  , idesc :: Text
idesc    = "Simplicity."
  , ikit :: [(GroupName ItemKind, CStore)]
ikit     = []
  }
longClub :: ItemKind
longClub = ItemKind
shortClub
  { iname :: Text
iname    = "long club"
  , ifreq :: Freqs ItemKind
ifreq    = [(GroupName ItemKind
S_LONG_CLUB, 1), (GroupName ItemKind
STARTING_WEAPON, 500)]
  , iflavour :: [Flavour]
iflavour = [Color] -> [Flavour]
zipPlain [Color
Magenta]
  , iweight :: Int
iweight  = 3500
  , idamage :: Dice
idamage  = 3 Int -> Int -> Dice
`d` 1  -- from two scraps
  , iaspects :: [Aspect]
iaspects = [ Dice -> Aspect
Timeout (Dice -> Aspect) -> Dice -> Aspect
forall a b. (a -> b) -> a -> b
$ 2 Dice -> Dice -> Dice
forall a. Num a => a -> a -> a
+ 1 Int -> Int -> Dice
`d` 2
               , Flag -> Aspect
SetFlag Flag
Durable, Flag -> Aspect
SetFlag Flag
Meleeable, EqpSlot -> Aspect
EqpSlot EqpSlot
EqpSlotWeaponFast
               , Int -> Aspect
toVelocity 0 ]  -- totally unbalanced
  , ieffects :: [Effect]
ieffects = [Int -> Effect
RefillHP (-2)]
  , idesc :: Text
idesc    = "Simplicity, long version."
  }
hammerTemplate :: ItemKind
hammerTemplate = $WItemKind :: Char
-> Text
-> Freqs ItemKind
-> [Flavour]
-> Dice
-> Rarity
-> Text
-> Int
-> Dice
-> [Aspect]
-> [Effect]
-> [(GroupName ItemKind, CStore)]
-> Text
-> ItemKind
ItemKind  -- properly hafted *and* glued to handle/pole
  { isymbol :: Char
isymbol  = Char
symbolHafted
  , iname :: Text
iname    = "sledgehammer"  -- "demolition hammer" is Br. Eng. for jackhammer
  , ifreq :: Freqs ItemKind
ifreq    = [(GroupName ItemKind
HAMMER_UNKNOWN, 1)]
                 -- not @BREACHING_TOOL@, because it trigger traps
                 -- and destroys treasure, instead of opening; generally
                 -- a very aggressive weapon, bad for defense even when long
  , iflavour :: [Flavour]
iflavour = [Color] -> [Flavour]
zipFancy [Color
BrMagenta]  -- avoid "pink"
  , icount :: Dice
icount   = 1
  , irarity :: Rarity
irarity  = [(1, 2), (3, 2), (7, 25), (9, 1)]
                 -- not too common up to lvl 3, where one is guaranteed
                 -- and deep down, when crafting done already
  , iverbHit :: Text
iverbHit = "club"
  , iweight :: Int
iweight  = 4000
  , idamage :: Dice
idamage  = 0  -- all damage independent of melee skill; this also helps
                  -- not to lie about damage of unidentified items
  , iaspects :: [Aspect]
iaspects = [ GroupName ItemKind -> Aspect
PresentAs GroupName ItemKind
HAMMER_UNKNOWN
               , Flag -> Aspect
SetFlag Flag
Durable, Flag -> Aspect
SetFlag Flag
Meleeable, EqpSlot -> Aspect
EqpSlot EqpSlot
EqpSlotWeaponBig
               , Int -> Aspect
toVelocity 0 ]  -- totally unbalanced
  , ieffects :: [Effect]
ieffects = []
  , idesc :: Text
idesc    = "One of many kinds of hammers employed in construction work. The usual ones with blunt heads don't cause grave wounds, but enough weight on a long handle can shake and bruise even most armored foes. However, larger hammers require more time to recover after a swing."  -- replaced with one of the descriptions below at identification time
  , ikit :: [(GroupName ItemKind, CStore)]
ikit     = []
  }
hammer1 :: ItemKind
hammer1 = ItemKind
hammerTemplate  -- 1m handle, blunt
  { ifreq :: Freqs ItemKind
ifreq    = [ (GroupName ItemKind
COMMON_ITEM, 100)
               , (GroupName ItemKind
STARTING_WEAPON, 50), (GroupName ItemKind
STARTING_HAMMER, 80)
               , (GroupName ItemKind
S_SHORT_BLUNT_HAMMER, 1) ]
  , iaspects :: [Aspect]
iaspects = Dice -> Aspect
Timeout 6
               Aspect -> [Aspect] -> [Aspect]
forall a. a -> [a] -> [a]
: ItemKind -> [Aspect]
iaspects ItemKind
hammerTemplate
  , ieffects :: [Effect]
ieffects = [Int -> Effect
RefillHP (-5)]  -- weak, but meant to be sharpened ASAP
  , idesc :: Text
idesc    = "One of many kinds of hammers employed in construction work. This is the usual one, with a blunt head and a short handle that, with a vice, may be pushed out and replaced with a longer pole."
  }
hammer2 :: ItemKind
hammer2 = ItemKind
hammerTemplate  -- 0.75m handle, sharp
  { ifreq :: Freqs ItemKind
ifreq    = [ (GroupName ItemKind
COMMON_ITEM, 10)
               , (GroupName ItemKind
STARTING_WEAPON, 5), (GroupName ItemKind
STARTING_HAMMER, 5)
               , (GroupName ItemKind
BONDING_TOOL, 1) ]
  , irarity :: Rarity
irarity  = [(1, 4), (3, 4), (7, 40)]
                 -- common early, since not a guaranteed drop;
                 -- common also late, because not crafted
  , iverbHit :: Text
iverbHit = "puncture"
  , idamage :: Dice
idamage  = 3 Int -> Int -> Dice
`d` 1
  , iaspects :: [Aspect]
iaspects = [Dice -> Aspect
Timeout 3, EqpSlot -> Aspect
EqpSlot EqpSlot
EqpSlotWeaponFast]
               [Aspect] -> [Aspect] -> [Aspect]
forall a. [a] -> [a] -> [a]
++ (ItemKind -> [Aspect]
iaspects ItemKind
hammerTemplate [Aspect] -> [Aspect] -> [Aspect]
forall a. Eq a => [a] -> [a] -> [a]
\\ [EqpSlot -> Aspect
EqpSlot EqpSlot
EqpSlotWeaponBig])
  , ieffects :: [Effect]
ieffects = [Int -> Effect
RefillHP (-3)]
  , idesc :: Text
idesc    = "Upon closer inspection, this hammer, or pick, turns out particularly well balanced. The profiled handle seamlessly joins the head, which focuses the blow at a sharp point, compensating for the tool's modest size. This makes it capable of permanently smashing objects together, though any fumble results in hands smashed as well."
  }
hammer3 :: ItemKind
hammer3 = ItemKind
hammerTemplate  -- 2m pole, blunt
  { ifreq :: Freqs ItemKind
ifreq    = [ (GroupName ItemKind
COMMON_ITEM, 4), (GroupName ItemKind
STARTING_WEAPON, 2)
               , (GroupName ItemKind
S_LONG_BLUNT_HAMMER, 1) ]
  , iweight :: Int
iweight  = 6000  -- pole weight almost gives it away
  , iaspects :: [Aspect]
iaspects = [ Dice -> Aspect
Timeout 12
               , Skill -> Dice -> Aspect
AddSkill Skill
SkHurtMelee (Dice -> Aspect) -> Dice -> Aspect
forall a b. (a -> b) -> a -> b
$ (-6 Dice -> Dice -> Dice
forall a. Num a => a -> a -> a
+ 1 Int -> Int -> Dice
`d` 4) Dice -> Dice -> Dice
forall a. Num a => a -> a -> a
* 3 ]
                   -- the malus not so important, hence easy to get the best
               [Aspect] -> [Aspect] -> [Aspect]
forall a. [a] -> [a] -> [a]
++ ItemKind -> [Aspect]
iaspects ItemKind
hammerTemplate
  , ieffects :: [Effect]
ieffects = [Int -> Effect
RefillHP (-8)]
  , idesc :: Text
idesc    = "This maul sports a particularly long pole that increases the momentum of the blunt head's swing, at the cost of long recovery."
  }
hammer4 :: ItemKind
hammer4 = ItemKind
hammer1  -- 1m handle, sharp
  { ifreq :: Freqs ItemKind
ifreq    = [ (GroupName ItemKind
COMMON_ITEM, 4), (GroupName ItemKind
STARTING_WEAPON, 2)
               , (GroupName ItemKind
S_SHORT_SHARP_HAMMER, 1) ]
  , iverbHit :: Text
iverbHit = "cleave"
  , idamage :: Dice
idamage  = 3 Int -> Int -> Dice
`d` 1
  , idesc :: Text
idesc    = "This hammer's head has it's protruding edges sharpened. Otherwise, it's pretty ordinary, with a short handle."
 }
hammer5 :: ItemKind
hammer5 = ItemKind
hammer3  -- 2m pole, sharp
  { ifreq :: Freqs ItemKind
ifreq    = [(GroupName ItemKind
COMMON_ITEM, 1), (GroupName ItemKind
S_LONG_SHARP_HAMMER, 1)]
  , iverbHit :: Text
iverbHit = "cleave"
  , idamage :: Dice
idamage  = 3 Int -> Int -> Dice
`d` 1
  , idesc :: Text
idesc    = "This maul features a head with the edge of the narrow end sharpened for cutting. Such long-hafted hammers require more time to recover after a swing, but the momentum alone can shake and bruise even armored foes that can't be harmed by sharp edges."
  }
hammerParalyze :: ItemKind
hammerParalyze = ItemKind
hammerTemplate
  { iname :: Text
iname    = "The Concussion Hammer"
  , ifreq :: Freqs ItemKind
ifreq    = [(GroupName ItemKind
TREASURE, 40), (GroupName ItemKind
STARTING_HAMMER, 5)]
  , irarity :: Rarity
irarity  = [(5, 1), (8, 6)]
  , idamage :: Dice
idamage  = 3 Int -> Int -> Dice
`d` 1
  , iaspects :: [Aspect]
iaspects = [ Flag -> Aspect
SetFlag Flag
Unique
               , Dice -> Aspect
Timeout 10 ]  -- 2m, but light head and pole
               [Aspect] -> [Aspect] -> [Aspect]
forall a. [a] -> [a] -> [a]
++ ItemKind -> [Aspect]
iaspects ItemKind
hammerTemplate
  , ieffects :: [Effect]
ieffects = [Int -> Effect
RefillHP (-8), Dice -> Effect
Paralyze 10]
  , idesc :: Text
idesc    = "This exquisite demolition hammer with a titanium head and exceptionally long synthetic handle leaves no wall and no body standing."
  }
hammerSpark :: ItemKind
hammerSpark = ItemKind
hammerTemplate  -- the only hammer with significantly heavier head
  { iname :: Text
iname    = "The Grand Smithhammer"
  , ifreq :: Freqs ItemKind
ifreq    = [(GroupName ItemKind
TREASURE, 40), (GroupName ItemKind
BONDING_TOOL, 1), (GroupName ItemKind
MUSEAL, 100)]
  , irarity :: Rarity
irarity  = [(5, 1), (8, 6)]
  , iweight :: Int
iweight  = 5000  -- weight and shape/damage gives it away; always identified
  , iaspects :: [Aspect]
iaspects = [ Flag -> Aspect
SetFlag Flag
Unique
               , Dice -> Aspect
Timeout 8  -- 1.5m handle and heavy, but unique
               , Skill -> Dice -> Aspect
AddSkill Skill
SkHurtMelee (Dice -> Aspect) -> Dice -> Aspect
forall a b. (a -> b) -> a -> b
$ (-20 Dice -> Dice -> Dice
forall a. Num a => a -> a -> a
+ 1 Int -> Int -> Dice
`dL` 10) Dice -> Dice -> Dice
forall a. Num a => a -> a -> a
* 5  -- 50--95
               , EqpSlot -> Aspect
EqpSlot EqpSlot
EqpSlotWeaponBig
               , Flag -> Aspect
SetFlag Flag
Durable, Flag -> Aspect
SetFlag Flag
Meleeable
               , Int -> Aspect
toVelocity 0 ]  -- totally unbalanced
  , ieffects :: [Effect]
ieffects = [ GroupName ItemKind -> Effect
Explode GroupName ItemKind
S_SPARK
                   -- we can't use a focused explosion, because it would harm
                   -- the hammer wielder as well, unlike this one; it's already
                   -- risky, since it may alert other factions; can reveal
                   -- other enemies rarely, though
               , Int -> Effect
RefillHP (-15) ]  -- hammer tanks prefer consistent damage
                                   -- over 1-shot kills, so this is not OP
  , idesc :: Text
idesc    = "High carbon steel of this heavy old hammer doesn't yield even to the newest alloys and produces fountains of sparks in defiance. Whatever it forge-welds together, stays together. Don't try to use it without training, however."
  }

-- The standard melee weapons do most of their damage as kinetic edged
-- or piercing, affected by armor and hurt skill.

knife :: ItemKind
knife = $WItemKind :: Char
-> Text
-> Freqs ItemKind
-> [Flavour]
-> Dice
-> Rarity
-> Text
-> Int
-> Dice
-> [Aspect]
-> [Effect]
-> [(GroupName ItemKind, CStore)]
-> Text
-> ItemKind
ItemKind
  { isymbol :: Char
isymbol  = Char
symbolEdged
  , iname :: Text
iname    = "cleaver"
  , ifreq :: Freqs ItemKind
ifreq    = [(GroupName ItemKind
COMMON_ITEM, 100), (GroupName ItemKind
STARTING_WEAPON, 100), (GroupName ItemKind
S_CLEAVER, 1)]
  , iflavour :: [Flavour]
iflavour = [Color] -> [Flavour]
zipPlain [Color
BrCyan]
  , icount :: Dice
icount   = 1
  , irarity :: Rarity
irarity  = [(1, 3), (3, 3), (5, 40), (9, 1)]
                 -- useful initially and for crafting mid-game
  , iverbHit :: Text
iverbHit = "cut"
  , iweight :: Int
iweight  = 1000
  , idamage :: Dice
idamage  = 5 Int -> Int -> Dice
`d` 1
  , iaspects :: [Aspect]
iaspects = [ Dice -> Aspect
Timeout 3
               , Skill -> Dice -> Aspect
AddSkill Skill
SkHurtMelee (Dice -> Aspect) -> Dice -> Aspect
forall a b. (a -> b) -> a -> b
$ (1 Int -> Int -> Dice
`d` 2 Dice -> Dice -> Dice
forall a. Num a => a -> a -> a
+ 1 Int -> Int -> Dice
`dL` 3) Dice -> Dice -> Dice
forall a. Num a => a -> a -> a
* 3
                   -- very common, so don't make too random nor too good
               , Flag -> Aspect
SetFlag Flag
Durable, Flag -> Aspect
SetFlag Flag
Meleeable
               , EqpSlot -> Aspect
EqpSlot EqpSlot
EqpSlotWeaponFast
               , Int -> Aspect
toVelocity 40 ]  -- ensuring it hits with the tip costs speed
  , ieffects :: [Effect]
ieffects = []
  , idesc :: Text
idesc    = "A heavy professional kitchen blade. Will do fine cutting any kind of meat, bone and an occasional metal can. Does not penetrate deeply, but is quick to move and hard to block. Especially useful in conjunction with a larger weapon."
  , ikit :: [(GroupName ItemKind, CStore)]
ikit     = []
  }
daggerDropBestWeapon :: ItemKind
daggerDropBestWeapon = ItemKind
knife
  { iname :: Text
iname    = "The Double Dagger"
  , ifreq :: Freqs ItemKind
ifreq    = [(GroupName ItemKind
TREASURE, 40), (GroupName ItemKind
MUSEAL, 100)]
  , irarity :: Rarity
irarity  = [(1, 3), (10, 2)]
  , iaspects :: [Aspect]
iaspects = Flag -> Aspect
SetFlag Flag
Unique
               Aspect -> [Aspect] -> [Aspect]
forall a. a -> [a] -> [a]
: ItemKind -> [Aspect]
iaspects ItemKind
knife
  , ieffects :: [Effect]
ieffects = [Int -> Dice -> Effect
Discharge 1 50, Effect
Yell]  -- powerful and low timeout, but noisy
                                       -- and no effect if no weapons charged
  , idesc :: Text
idesc    = "An antique double dagger that a focused fencer can use to catch and twist away an opponent's blade."
  }
dagger :: ItemKind
dagger = ItemKind
knife
  { iname :: Text
iname    = "dagger"
  , ifreq :: Freqs ItemKind
ifreq    = [(GroupName ItemKind
COMMON_ITEM, 4), (GroupName ItemKind
S_DAGGER, 1), (GroupName ItemKind
STARTING_WEAPON, 4)]
  , iverbHit :: Text
iverbHit = "open"
  , irarity :: Rarity
irarity  = [(7, 20)]  -- like hammer, not knife, to prevent excess
  , idamage :: Dice
idamage  = 7 Int -> Int -> Dice
`d` 1
  , idesc :: Text
idesc    = "A double-edged knife with a sharp tip that penetrates the smallest defence gaps, making it especially useful in conjunction with a larger but less nimble weapon."
  }
sword :: ItemKind
sword = $WItemKind :: Char
-> Text
-> Freqs ItemKind
-> [Flavour]
-> Dice
-> Rarity
-> Text
-> Int
-> Dice
-> [Aspect]
-> [Effect]
-> [(GroupName ItemKind, CStore)]
-> Text
-> ItemKind
ItemKind  -- dead end, but can be crafted with just one file tool
  { isymbol :: Char
isymbol  = Char
symbolPolearm
  , iname :: Text
iname    = "sharpened pipe"
  , ifreq :: Freqs ItemKind
ifreq    = [ (GroupName ItemKind
COMMON_ITEM, 4), (GroupName ItemKind
STARTING_WEAPON, 30)
               , (GroupName ItemKind
S_SHARPENED_PIPE, 1) ]
  , iflavour :: [Flavour]
iflavour = [Color] -> [Flavour]
zipFancy [Color
BrCyan]
  , icount :: Dice
icount   = 1
  , irarity :: Rarity
irarity  = [(3, 1), (6, 15)]
  , iverbHit :: Text
iverbHit = "stab"
  , iweight :: Int
iweight  = 2000
  , idamage :: Dice
idamage  = 10 Int -> Int -> Dice
`d` 1  -- with high melee bonus, better than a good hammer
  , iaspects :: [Aspect]
iaspects = [ Dice -> Aspect
Timeout 7  -- unique in that there's no randomness
               , EqpSlot -> Aspect
EqpSlot EqpSlot
EqpSlotWeaponBig
               , Flag -> Aspect
SetFlag Flag
Durable, Flag -> Aspect
SetFlag Flag
Meleeable
               , Int -> Aspect
toVelocity 40 ]  -- ensuring it hits with the tip costs speed
  , ieffects :: [Effect]
ieffects = []
  , idesc :: Text
idesc    = "A makeshift weapon of simple design, but great potential."
  , ikit :: [(GroupName ItemKind, CStore)]
ikit     = []
  }
swordImpress :: ItemKind
swordImpress = ItemKind
sword
  { isymbol :: Char
isymbol  = Char
symbolEdged
  , iname :: Text
iname    = "The Master's Sword"
  , ifreq :: Freqs ItemKind
ifreq    = [(GroupName ItemKind
TREASURE, 40), (GroupName ItemKind
MUSEAL, 100)]
  , irarity :: Rarity
irarity  = [(5, 1), (8, 6)]
  , iverbHit :: Text
iverbHit = "slash"
  , iaspects :: [Aspect]
iaspects = Flag -> Aspect
SetFlag Flag
Unique
               Aspect -> [Aspect] -> [Aspect]
forall a. a -> [a] -> [a]
: ItemKind -> [Aspect]
iaspects ItemKind
sword
  , ieffects :: [Effect]
ieffects = [Effect
Impress]
  , idesc :: Text
idesc    = "A particularly well-balanced museum piece. It has a history and in the right hands lends itself to impressive shows of fencing skill."
  }
swordNullify :: ItemKind
swordNullify = ItemKind
sword
  { isymbol :: Char
isymbol  = Char
symbolEdged
  , iname :: Text
iname    = "The Blunt Rapier"
  , ifreq :: Freqs ItemKind
ifreq    = [(GroupName ItemKind
TREASURE, 50), (GroupName ItemKind
S_RAPIER_BLUNT, 1)]
  , iverbHit :: Text
iverbHit = "pierce"
  , irarity :: Rarity
irarity  = [(5, 1), (8, 6)]
  , idamage :: Dice
idamage  = 7 Int -> Int -> Dice
`d` 1  -- as dagger, but upgradeable and no skill bonus
  , iaspects :: [Aspect]
iaspects = [ Flag -> Aspect
SetFlag Flag
Unique, Dice -> Aspect
Timeout 3, EqpSlot -> Aspect
EqpSlot EqpSlot
EqpSlotWeaponFast
               , Flag -> Aspect
SetFlag Flag
Durable, Flag -> Aspect
SetFlag Flag
Meleeable
               , Int -> Aspect
toVelocity 40 ]  -- ensuring it hits with the tip costs speed
  , ieffects :: [Effect]
ieffects = []
  , idesc :: Text
idesc    = "An exuberant hand-forged roasting implement, intentionally and wisely kept blunt."
  }
swordNullifySharp :: ItemKind
swordNullifySharp = ItemKind
swordNullify
  { iname :: Text
iname    = "The Roasting Rapier"
  , ifreq :: Freqs ItemKind
ifreq    = [(GroupName ItemKind
S_RAPIER_SHARP, 1)]
  , idamage :: Dice
idamage  = 10 Int -> Int -> Dice
`d` 1
  , ieffects :: [Effect]
ieffects = [ Int -> Int -> CStore -> GroupName ItemKind -> Effect
DropItem 1 Int
forall a. Bounded a => a
maxBound CStore
COrgan GroupName ItemKind
CONDITION
               , Int -> Effect
RefillCalm (-10)
               , Effect
Yell ]
  , idesc :: Text
idesc    = "A thin, acutely sharp steel blade that pierces deeply and sends its victim into abrupt, sobering shock. Originally, an exuberant hand-forged roasting implement, intentionally and wisely kept blunt."
  }
halberd :: ItemKind
halberd = $WItemKind :: Char
-> Text
-> Freqs ItemKind
-> [Flavour]
-> Dice
-> Rarity
-> Text
-> Int
-> Dice
-> [Aspect]
-> [Effect]
-> [(GroupName ItemKind, CStore)]
-> Text
-> ItemKind
ItemKind  -- long pole
  { isymbol :: Char
isymbol  = Char
symbolPolearm
  , iname :: Text
iname    = "pole cleaver"
  , ifreq :: Freqs ItemKind
ifreq    = [(GroupName ItemKind
COMMON_ITEM, 3), (GroupName ItemKind
STARTING_WEAPON, 70), (GroupName ItemKind
S_POLE_CLEAVER, 1)]
  , iflavour :: [Flavour]
iflavour = [Color] -> [Flavour]
zipPlain [Color
BrYellow]
  , icount :: Dice
icount   = 1
  , irarity :: Rarity
irarity  = [(5, 1), (10, 3)]
  , iverbHit :: Text
iverbHit = "slice"
  , iweight :: Int
iweight  = 3500
  , idamage :: Dice
idamage  = 11 Int -> Int -> Dice
`d` 1  -- bad, until sharpened
  , iaspects :: [Aspect]
iaspects = [ Dice -> Aspect
Timeout 10
               , Skill -> Dice -> Aspect
AddSkill Skill
SkHurtMelee (Dice -> Aspect) -> Dice -> Aspect
forall a b. (a -> b) -> a -> b
$ (-12 Dice -> Dice -> Dice
forall a. Num a => a -> a -> a
+ 1 Int -> Int -> Dice
`d` 4 Dice -> Dice -> Dice
forall a. Num a => a -> a -> a
+ 1 Int -> Int -> Dice
`dL` 5) Dice -> Dice -> Dice
forall a. Num a => a -> a -> a
* 3
                   -- weak against armor at game start with no hurt bonus;
                   -- variety to spice up crafting
               , Skill -> Dice -> Aspect
AddSkill Skill
SkArmorMelee 20
               , Flag -> Aspect
SetFlag Flag
Durable, Flag -> Aspect
SetFlag Flag
Meleeable
               , EqpSlot -> Aspect
EqpSlot EqpSlot
EqpSlotWeaponBig
               , Int -> Aspect
toVelocity 20 ]  -- not balanced
  , ieffects :: [Effect]
ieffects = []
  , idesc :: Text
idesc    = "An improvised but deadly weapon made of a long kitchen cleaver glued and bound to a long pole. Not often one succeeds in making enough space to swing it freely, but even when stuck between terrain obstacles it blocks approaches effectively and makes using other weapons difficult, both by friends and foes."
  , ikit :: [(GroupName ItemKind, CStore)]
ikit     = []
  }
oxTongue :: ItemKind
oxTongue = ItemKind
halberd  -- long pole, because glued 1m handle worse than nothing
  { iname :: Text
iname    = "long spear"
  , ifreq :: Freqs ItemKind
ifreq    = [(GroupName ItemKind
COMMON_ITEM, 1), (GroupName ItemKind
S_LONG_SPEAR, 1)]
  , iverbHit :: Text
iverbHit = "impale"
  , idamage :: Dice
idamage  = 13 Int -> Int -> Dice
`d` 1
  , idesc :: Text
idesc    = "An improvised but deadly weapon made of a long, sharp dagger glued and bound to a long pole. Not often one succeeds in making enough space to thrust it freely, but even when stuck between terrain obstacles it blocks approaches effectively and makes using other weapons difficult, both by friends and foes."
  }
halberdPushActor :: ItemKind
halberdPushActor = ItemKind
halberd
  { iname :: Text
iname    = "The Blunt Swiss Halberd"
  , ifreq :: Freqs ItemKind
ifreq    = [(GroupName ItemKind
CRAWL_ITEM, 30), (GroupName ItemKind
S_HALBERD_BLUNT, 1)]
                 -- not in a museum; reenactors' gear
  , irarity :: Rarity
irarity  = [(7, 0), (9, 8)]
  , iaspects :: [Aspect]
iaspects = Flag -> Aspect
SetFlag Flag
Unique
               Aspect -> [Aspect] -> [Aspect]
forall a. a -> [a] -> [a]
: ItemKind -> [Aspect]
iaspects ItemKind
halberd
  , ieffects :: [Effect]
ieffects = [ThrowMod -> Effect
PushActor (Int -> Int -> Int -> ThrowMod
ThrowMod 200 100 1)]  -- 2 steps, slow
  , idesc :: Text
idesc    = "A perfect replica made for a reenactor troupe, hardened, but missing any sharpening. Versatile, with great reach and leverage. Foes are held at a distance."
  }
halberdPushActorSharp :: ItemKind
halberdPushActorSharp = ItemKind
halberdPushActor
  { iname :: Text
iname    = "The Swiss Halberd"
  , ifreq :: Freqs ItemKind
ifreq    = [(GroupName ItemKind
S_HALBERD_SHARP, 1)]
  , idamage :: Dice
idamage  = 13 Int -> Int -> Dice
`d` 1
  , idesc :: Text
idesc    = "A perfect replica made for a reenactor troupe, hardened, sharpened. Versatile, with great reach and leverage. Foes are held at a distance."
  }
fireAxe :: ItemKind
fireAxe = $WItemKind :: Char
-> Text
-> Freqs ItemKind
-> [Flavour]
-> Dice
-> Rarity
-> Text
-> Int
-> Dice
-> [Aspect]
-> [Effect]
-> [(GroupName ItemKind, CStore)]
-> Text
-> ItemKind
ItemKind
  { isymbol :: Char
isymbol  = Char
symbolHafted
  , iname :: Text
iname    = "fire axe"
  , ifreq :: Freqs ItemKind
ifreq    = [(GroupName ItemKind
TREASURE, 20), (GroupName ItemKind
S_FIRE_AXE, 1), (GroupName ItemKind
FIRE_FIGHTING_ITEM, 5)]
                 -- not @BREACHING_TOOL@, because it trigger traps
                 -- and destroys treasure, instead of opening
  , iflavour :: [Flavour]
iflavour = [Color] -> [Flavour]
zipPlain [Color
BrRed]
  , icount :: Dice
icount   = 1
  , irarity :: Rarity
irarity  = [(1, 1)]  -- from fire cabinets
  , iverbHit :: Text
iverbHit = "gouge"
  , iweight :: Int
iweight  = 1600
  , idamage :: Dice
idamage  = 9 Int -> Int -> Dice
`d` 1  -- worse than sharpened pipe, but upgradable
  , iaspects :: [Aspect]
iaspects = [ Dice -> Aspect
Timeout 7
               , Flag -> Aspect
SetFlag Flag
Durable, Flag -> Aspect
SetFlag Flag
Meleeable
               , EqpSlot -> Aspect
EqpSlot EqpSlot
EqpSlotWeaponBig  -- 1m handle
               , Int -> Aspect
toVelocity 40 ]  -- ensuring it hits with the blade costs speed
  , ieffects :: [Effect]
ieffects = []
  , idesc :: Text
idesc    = "An axe with a spike: once used for fire fighting, now turned to a bloodier purpose."
  , ikit :: [(GroupName ItemKind, CStore)]
ikit     = []
  }
pollaxe :: ItemKind
pollaxe = ItemKind
fireAxe
  { iname :: Text
iname    = "pollaxe"
  , ifreq :: Freqs ItemKind
ifreq    = [(GroupName ItemKind
TREASURE, 2), (GroupName ItemKind
S_POLL_AXE, 1)]
  , iflavour :: [Flavour]
iflavour = [Color] -> [Flavour]
zipPlain [Color
BrRed]
  , iverbHit :: Text
iverbHit = "carve"
  , iweight :: Int
iweight  = 4500
  , idamage :: Dice
idamage  = 15 Int -> Int -> Dice
`d` 1
  , iaspects :: [Aspect]
iaspects = [ Dice -> Aspect
Timeout (Dice -> Aspect) -> Dice -> Aspect
forall a b. (a -> b) -> a -> b
$ 15 Dice -> Dice -> Dice
forall a. Num a => a -> a -> a
- 1 Int -> Int -> Dice
`dL` 5  -- variety to spice up crafting
               , Skill -> Dice -> Aspect
AddSkill Skill
SkArmorMelee 20
               , Flag -> Aspect
SetFlag Flag
Durable, Flag -> Aspect
SetFlag Flag
Meleeable
               , EqpSlot -> Aspect
EqpSlot EqpSlot
EqpSlotWeaponBig
               , Int -> Aspect
toVelocity 20 ]  -- not balanced
  , ieffects :: [Effect]
ieffects = [Effect -> Effect
OnUser (Int -> Dice -> Effect
Discharge 5 50)]
  , idesc :: Text
idesc    = "A long-hafted spiked axe: great reach and momentum, but so unbalanced that fighters swinging it can't control their combat stance."
  }
militaryKnife :: ItemKind
militaryKnife = ItemKind
knife
  { iname :: Text
iname    = "military knife"
  , ifreq :: Freqs ItemKind
ifreq    = [ (GroupName ItemKind
TREASURE, 1), (GroupName ItemKind
WIRECUTTING_TOOL, 2), (GroupName ItemKind
MERCENARY_WEAPON, 70)
               , (GroupName ItemKind
STARTING_WEAPON, 3) ]
  , iflavour :: [Flavour]
iflavour = [Color] -> [Flavour]
zipFancy [Color
Green]
  , irarity :: Rarity
irarity  = [(10, 15)]  -- in crawl, comes bundled with tools
  , iweight :: Int
iweight  = 500  -- too small to attach to a pole
  , idamage :: Dice
idamage  = 7 Int -> Int -> Dice
`d` 1
  , iaspects :: [Aspect]
iaspects = [ Dice -> Aspect
Timeout 2
               , Skill -> Dice -> Aspect
AddSkill Skill
SkHurtMelee (Dice -> Aspect) -> Dice -> Aspect
forall a b. (a -> b) -> a -> b
$ (-1 Dice -> Dice -> Dice
forall a. Num a => a -> a -> a
+ 1 Int -> Int -> Dice
`d` 3 Dice -> Dice -> Dice
forall a. Num a => a -> a -> a
+ 1 Int -> Int -> Dice
`dL` 2) Dice -> Dice -> Dice
forall a. Num a => a -> a -> a
* 3
               , Flag -> Aspect
SetFlag Flag
Durable, Flag -> Aspect
SetFlag Flag
Meleeable
               , EqpSlot -> Aspect
EqpSlot EqpSlot
EqpSlotWeaponFast
               , Int -> Aspect
toVelocity 50 ]  -- designed also for throwing
  , ieffects :: [Effect]
ieffects = [ Int -> Effect
RefillHP (-1)
                   -- @RefillHP@ to avoid a no-brainer of durable tool use
               , Int -> Int -> CStore -> GroupName ItemKind -> Effect
DropItem 1 Int
forall a. Bounded a => a
maxBound CStore
COrgan GroupName ItemKind
CONDITION ]
                   -- useful for AI who is the main user of this weapon
  , idesc :: Text
idesc    = "Military design laser-sharpened alloy blade able to cleanly open an artery at the lightest touch through layers of fabric. Despite its modest size, it defeats barbed wire in one slice."
  }
militaryBaton :: ItemKind
militaryBaton = $WItemKind :: Char
-> Text
-> Freqs ItemKind
-> [Flavour]
-> Dice
-> Rarity
-> Text
-> Int
-> Dice
-> [Aspect]
-> [Effect]
-> [(GroupName ItemKind, CStore)]
-> Text
-> ItemKind
ItemKind
  { isymbol :: Char
isymbol  = Char
symbolHafted
  , iname :: Text
iname    = "military stun gun"
  , ifreq :: Freqs ItemKind
ifreq    = [(GroupName ItemKind
TREASURE, 1), (GroupName ItemKind
MERCENARY_WEAPON, 30)]
  , iflavour :: [Flavour]
iflavour = [Color] -> [Flavour]
zipFancy [Color
Green]
  , icount :: Dice
icount   = 1
  , irarity :: Rarity
irarity  = [(10, 10)]
  , iverbHit :: Text
iverbHit = "prod"
  , iweight :: Int
iweight  = 1000
  , idamage :: Dice
idamage  = 6 Int -> Int -> Dice
`d` 1
  , iaspects :: [Aspect]
iaspects = [ Dice -> Aspect
Timeout 7
               , Flag -> Aspect
SetFlag Flag
Durable, Flag -> Aspect
SetFlag Flag
Meleeable
               , EqpSlot -> Aspect
EqpSlot EqpSlot
EqpSlotWeaponBig
               , Int -> Aspect
toVelocity 40 ]
  , ieffects :: [Effect]
ieffects = [Int -> Dice -> Effect
Discharge 1 100, Int -> Effect
RefillCalm (-50)]
      -- don't overdo discharging or unequipping becomes beneficial
  , idesc :: Text
idesc    = "A direct contact electroshock weapon with unlimited and fast recharging. Ideal for close quarter fights inside space habitats, where preserving the integrity of the outer hull is paramount."
  , ikit :: [(GroupName ItemKind, CStore)]
ikit     = []
  }
cattleProd :: ItemKind
cattleProd = ItemKind
militaryBaton
  { iname :: Text
iname    = "electric cattle prod"
  , ifreq :: Freqs ItemKind
ifreq    = [(GroupName ItemKind
COMMON_ITEM, 100)]
  , iflavour :: [Flavour]
iflavour = [Color] -> [Flavour]
zipPlain [Color
Brown]
  , irarity :: Rarity
irarity  = [(8, 5)]
  , idamage :: Dice
idamage  = 5 Int -> Int -> Dice
`d` 1
  , ieffects :: [Effect]
ieffects = [Int -> Dice -> Effect
Discharge 1 60, Int -> Effect
RefillCalm (-30)]
      -- The Calm effect helps to place it as one of the first weapons.
  , idesc :: Text
idesc    = "Used for subduing unruly zoo animals."
  }

-- The combat value of the following class of weapons is very limited,
-- but they or their components can be used for crafting.

gardenMsg :: Effect
gardenMsg :: Effect
gardenMsg = Text -> Text -> Effect
VerbMsgFail "feel the gardening tool fracture" "."
gardenDestruct :: GroupName ItemKind -> Effect
gardenDestruct :: GroupName ItemKind -> Effect
gardenDestruct grp :: GroupName ItemKind
grp =
  Effect -> Effect
OnUser (Effect -> Effect) -> Effect -> Effect
forall a b. (a -> b) -> a -> b
$ [Effect] -> Effect
OneOf ([Effect] -> Effect) -> [Effect] -> Effect
forall a b. (a -> b) -> a -> b
$
    Int -> Int -> CStore -> GroupName ItemKind -> Effect
DestroyItem 1 1 CStore
CEqp GroupName ItemKind
grp
    Effect -> Effect -> Effect
`AndEffect`
    [Effect] -> Effect
SeqEffect [ Maybe Int -> CStore -> GroupName ItemKind -> TimerDice -> Effect
CreateItem Maybe Int
forall a. Maybe a
Nothing CStore
CStash GroupName ItemKind
HANDLE TimerDice
timerNone
              , Maybe Int -> CStore -> GroupName ItemKind -> TimerDice -> Effect
CreateItem Maybe Int
forall a. Maybe a
Nothing CStore
CStash GroupName ItemKind
STEEL_SCRAP TimerDice
timerNone ]
    Effect -> [Effect] -> [Effect]
forall a. a -> [a] -> [a]
: Int -> Effect -> [Effect]
forall a. Int -> a -> [a]
replicate 3 Effect
gardenMsg
grassStitcher :: ItemKind
grassStitcher = $WItemKind :: Char
-> Text
-> Freqs ItemKind
-> [Flavour]
-> Dice
-> Rarity
-> Text
-> Int
-> Dice
-> [Aspect]
-> [Effect]
-> [(GroupName ItemKind, CStore)]
-> Text
-> ItemKind
ItemKind
  { isymbol :: Char
isymbol  = Char
symbolPolearm
  , iname :: Text
iname    = "grass stitcher"
  , ifreq :: Freqs ItemKind
ifreq    = [ (GroupName ItemKind
COMMON_ITEM, 10), (GroupName ItemKind
HANDLE_AND_STEEL, 1)
               , (GroupName ItemKind
GARDENING_TOOL, 100), (GroupName ItemKind
S_GRASS_STITCHER, 1) ]
  , iflavour :: [Flavour]
iflavour = [Color] -> [Flavour]
zipPlain [Color
Green]
  , icount :: Dice
icount   = 1
  , irarity :: Rarity
irarity  = [(1, 1)] -- beyond level 3 they mostly appear with treePruner
  , iverbHit :: Text
iverbHit = "stab"
  , iweight :: Int
iweight  = 500
  , idamage :: Dice
idamage  = 5 Int -> Int -> Dice
`d` 1
  , iaspects :: [Aspect]
iaspects = [ Dice -> Aspect
Timeout 3  -- light and can hit with any side
               , Flag -> Aspect
SetFlag Flag
Durable, Flag -> Aspect
SetFlag Flag
Meleeable
               , EqpSlot -> Aspect
EqpSlot EqpSlot
EqpSlotWeaponFast
               , Int -> Aspect
toVelocity 30 ]
  , ieffects :: [Effect]
ieffects = [GroupName ItemKind -> Effect
gardenDestruct GroupName ItemKind
S_GRASS_STITCHER]
  , idesc :: Text
idesc    = ""  -- TODO: https://en.wikipedia.org/wiki/Grass_Stitcher
  , ikit :: [(GroupName ItemKind, CStore)]
ikit     = [(GroupName ItemKind
GARDENING_TOOL, CStore
CGround), (GroupName ItemKind
GARDENING_TOOL, CStore
CGround)]
  }
ladiesFork :: ItemKind
ladiesFork = ItemKind
grassStitcher
  { iname :: Text
iname    = "ladies' fork"
  , ifreq :: Freqs ItemKind
ifreq    = [ (GroupName ItemKind
COMMON_ITEM, 10), (GroupName ItemKind
HANDLE_AND_STEEL, 1)
               , (GroupName ItemKind
GARDENING_TOOL, 100), (GroupName ItemKind
S_LADIES_FORK, 1) ]
  , iflavour :: [Flavour]
iflavour = [Color] -> [Flavour]
zipFancy [Color
Green]
  , iweight :: Int
iweight  = 1000
  , idamage :: Dice
idamage  = 6 Int -> Int -> Dice
`d` 1
  , iaspects :: [Aspect]
iaspects = [ Dice -> Aspect
Timeout 5
               , Flag -> Aspect
SetFlag Flag
Durable, Flag -> Aspect
SetFlag Flag
Meleeable
               , EqpSlot -> Aspect
EqpSlot EqpSlot
EqpSlotWeaponBig
               , Int -> Aspect
toVelocity 40 ]
  , ieffects :: [Effect]
ieffects = [GroupName ItemKind -> Effect
gardenDestruct GroupName ItemKind
S_LADIES_FORK]
  , idesc :: Text
idesc    = ""  -- TODO: https://en.wikipedia.org/wiki/Garden_fork
  , ikit :: [(GroupName ItemKind, CStore)]
ikit     = [(GroupName ItemKind
GARDENING_TOOL, CStore
CGround)]
  }
hoe :: ItemKind
hoe = ItemKind
grassStitcher
  { isymbol :: Char
isymbol  = Char
symbolHafted
  , iname :: Text
iname    = "hoe"
  , ifreq :: Freqs ItemKind
ifreq    = [ (GroupName ItemKind
COMMON_ITEM, 10), (GroupName ItemKind
HANDLE_AND_STEEL, 1)
               , (GroupName ItemKind
GARDENING_TOOL, 100), (GroupName ItemKind
S_HOE, 1) ]
  , iflavour :: [Flavour]
iflavour = [Color] -> [Flavour]
zipFancy [Color
Cyan]
  , iverbHit :: Text
iverbHit = "hack"
  , iweight :: Int
iweight  = 1000
  , idamage :: Dice
idamage  = 7 Int -> Int -> Dice
`d` 1  -- neither sharp nor heavy
  , iaspects :: [Aspect]
iaspects = [ Dice -> Aspect
Timeout 7
               , Flag -> Aspect
SetFlag Flag
Durable, Flag -> Aspect
SetFlag Flag
Meleeable
               , EqpSlot -> Aspect
EqpSlot EqpSlot
EqpSlotWeaponBig
               , Int -> Aspect
toVelocity 40 ]
  , ieffects :: [Effect]
ieffects = [GroupName ItemKind -> Effect
gardenDestruct GroupName ItemKind
S_HOE]
  , idesc :: Text
idesc    = ""  -- TODO: https://en.wikipedia.org/wiki/Hoe_(tool)
  , ikit :: [(GroupName ItemKind, CStore)]
ikit     = [(GroupName ItemKind
GARDENING_TOOL, CStore
CGround)]
  }
spade :: ItemKind
spade = ItemKind
grassStitcher
  { isymbol :: Char
isymbol  = Char
symbolHafted  -- swinging much more deadly than gouging
  , iname :: Text
iname    = "spade"
  , ifreq :: Freqs ItemKind
ifreq    = [ (GroupName ItemKind
COMMON_ITEM, 10), (GroupName ItemKind
HANDLE_AND_STEEL, 1)
               , (GroupName ItemKind
GARDENING_TOOL, 100), (GroupName ItemKind
S_SPADE, 1) ]
  , iflavour :: [Flavour]
iflavour = [Color] -> [Flavour]
zipPlain [Color
Cyan]
  , iverbHit :: Text
iverbHit = "cut"
  , iweight :: Int
iweight  = 2000
  , idamage :: Dice
idamage  = 8 Int -> Int -> Dice
`d` 1
  , iaspects :: [Aspect]
iaspects = [ Dice -> Aspect
Timeout 9
               , Flag -> Aspect
SetFlag Flag
Durable, Flag -> Aspect
SetFlag Flag
Meleeable
               , EqpSlot -> Aspect
EqpSlot EqpSlot
EqpSlotWeaponBig
               , Int -> Aspect
toVelocity 50 ]
  , ieffects :: [Effect]
ieffects = [GroupName ItemKind -> Effect
gardenDestruct GroupName ItemKind
S_SPADE]
  , idesc :: Text
idesc    = ""  -- TODO: https://en.wikipedia.org/wiki/Spade
  , ikit :: [(GroupName ItemKind, CStore)]
ikit     = []  -- most powerful, most likely to come alone
  }
treePruner :: ItemKind
treePruner = ItemKind
grassStitcher
  { iname :: Text
iname    = "long reach tree pruner"
  , ifreq :: Freqs ItemKind
ifreq    = [(GroupName ItemKind
COMMON_ITEM, 100), (GroupName ItemKind
POLE_AND_STEEL, 1)]
  , iflavour :: [Flavour]
iflavour = [Color] -> [Flavour]
zipFancy [Color
BrRed]
  , irarity :: Rarity
irarity  = [(1, 12)]  -- early, while the weapon is still useful
  , iweight :: Int
iweight  = 4500
  , idamage :: Dice
idamage  = 3 Int -> Int -> Dice
`d` 1
  , iaspects :: [Aspect]
iaspects = [ Dice -> Aspect
Timeout 7
               , Skill -> Dice -> Aspect
AddSkill Skill
SkArmorMelee 20  -- sharp
               , Flag -> Aspect
SetFlag Flag
Durable, Flag -> Aspect
SetFlag Flag
Meleeable
               , EqpSlot -> Aspect
EqpSlot EqpSlot
EqpSlotArmorMelee
               , Int -> Aspect
toVelocity 50 ]
  , ieffects :: [Effect]
ieffects = []
  , idesc :: Text
idesc    = "A heavy tree lopper on a sturdy long pole."
  , ikit :: [(GroupName ItemKind, CStore)]
ikit     = [(GroupName ItemKind
GARDENING_TOOL, CStore
CGround)]
  }
cleaningPole :: ItemKind
cleaningPole = ItemKind
grassStitcher
  { iname :: Text
iname    = "window cleaning pole"
  , ifreq :: Freqs ItemKind
ifreq    = [(GroupName ItemKind
COMMON_ITEM, 100), (GroupName ItemKind
POLE_AND_STEEL, 1)]
  , iflavour :: [Flavour]
iflavour = [Color] -> [Flavour]
zipPlain [Color
Blue]
  , irarity :: Rarity
irarity  = [(10, 6)]  -- last chance of a long pole
  , iweight :: Int
iweight  = 3500
  , idamage :: Dice
idamage  = 2 Int -> Int -> Dice
`d` 1
  , iaspects :: [Aspect]
iaspects = [ Skill -> Dice -> Aspect
AddSkill Skill
SkArmorMelee 10  -- not sharp, so weaker
               , Flag -> Aspect
SetFlag Flag
Durable, Flag -> Aspect
SetFlag Flag
Meleeable  -- a fence may melee with
               , EqpSlot -> Aspect
EqpSlot EqpSlot
EqpSlotArmorMelee
               , Int -> Aspect
toVelocity 40 ]
  , ieffects :: [Effect]
ieffects = []
  , idesc :: Text
idesc    = "A cleaning contraption for glass surfaces, mounted on a long synthetic pole."
  , ikit :: [(GroupName ItemKind, CStore)]
ikit     = []
  }
staff :: ItemKind
staff = ItemKind
grassStitcher
  { isymbol :: Char
isymbol  = Char
symbolHafted
  , iname :: Text
iname    = "wooden staff"
  , ifreq :: Freqs ItemKind
ifreq    = [(GroupName ItemKind
HANDLE, 70), (GroupName ItemKind
POLE_OR_HANDLE, 55), (GroupName ItemKind
S_STAFF, 1)]
  , iflavour :: [Flavour]
iflavour = [Color] -> [Flavour]
zipPlain [Color
Brown]
  , iverbHit :: Text
iverbHit = "prod"
  , iweight :: Int
iweight  = 1000
  , idamage :: Dice
idamage  = 1 Int -> Int -> Dice
`d` 1
  , iaspects :: [Aspect]
iaspects = [ Flag -> Aspect
SetFlag Flag
Durable  -- prevent AI wield; boring, often too weak
               , Int -> Aspect
toVelocity 30 ]  -- a weak missile and that's all
  , ieffects :: [Effect]
ieffects = []
  , idesc :: Text
idesc    = "A handle of a make-shift tool to be crafted."
  , ikit :: [(GroupName ItemKind, CStore)]
ikit     = []
  }
pipe :: ItemKind
pipe = ItemKind
staff
  { iname :: Text
iname    = "metal pipe"
  , ifreq :: Freqs ItemKind
ifreq    = [(GroupName ItemKind
HANDLE, 30), (GroupName ItemKind
POLE_OR_HANDLE, 15), (GroupName ItemKind
S_PIPE, 1)]
  , iflavour :: [Flavour]
iflavour = [Color] -> [Flavour]
zipFancy [Color
BrBlue]
  , idamage :: Dice
idamage  = 2 Int -> Int -> Dice
`d` 1
  , idesc :: Text
idesc    = "Around a meter long, light, strong and hard alloy pipe. With one or both ends cut diagonally and sharpened, this would become a formidable weapon."
  }
longPole :: ItemKind
longPole = ItemKind
staff
  { iname :: Text
iname    = "long pole"
  , ifreq :: Freqs ItemKind
ifreq    = [(GroupName ItemKind
POLE, 90), (GroupName ItemKind
POLE_OR_HANDLE, 30)]
  , iflavour :: [Flavour]
iflavour = [Color] -> [Flavour]
zipPlain [Color
BrYellow]
  , iweight :: Int
iweight  = 3000
  , idamage :: Dice
idamage  = 2 Int -> Int -> Dice
`d` 1
  , iaspects :: [Aspect]
iaspects = [ Skill -> Dice -> Aspect
AddSkill Skill
SkArmorMelee 10  -- not sharp, so weaker
               , Flag -> Aspect
SetFlag Flag
Durable, Flag -> Aspect
SetFlag Flag
Meleeable
               , EqpSlot -> Aspect
EqpSlot EqpSlot
EqpSlotArmorMelee
               , Int -> Aspect
toVelocity 20 ]
  , idesc :: Text
idesc    = "Over two meters long, strong and light pole."
  }

-- ** Treasure

gemTemplate :: ItemKind
gemTemplate = $WItemKind :: Char
-> Text
-> Freqs ItemKind
-> [Flavour]
-> Dice
-> Rarity
-> Text
-> Int
-> Dice
-> [Aspect]
-> [Effect]
-> [(GroupName ItemKind, CStore)]
-> Text
-> ItemKind
ItemKind
  { isymbol :: Char
isymbol  = Char
symbolGold
  , iname :: Text
iname    = "gem"
  , ifreq :: Freqs ItemKind
ifreq    = [(GroupName ItemKind
GEM_UNKNOWN, 1), (GroupName ItemKind
VALUABLE, 100)]
  , iflavour :: [Flavour]
iflavour = [Color] -> [Flavour]
zipPlain ([Color] -> [Flavour]) -> [Color] -> [Flavour]
forall a b. (a -> b) -> a -> b
$ Color -> [Color] -> [Color]
forall a. Eq a => a -> [a] -> [a]
delete Color
BrYellow [Color]
brightCol  -- natural, so not fancy
  , icount :: Dice
icount   = 1
  , irarity :: Rarity
irarity  = []
  , iverbHit :: Text
iverbHit = "tap"
  , iweight :: Int
iweight  = 50
  , idamage :: Dice
idamage  = 0
  , iaspects :: [Aspect]
iaspects = [GroupName ItemKind -> Aspect
PresentAs GroupName ItemKind
GEM_UNKNOWN, Flag -> Aspect
SetFlag Flag
Precious]
  , ieffects :: [Effect]
ieffects = []
  , idesc :: Text
idesc    = "Precious, though useless. Worth around 100 gold grains."
  , ikit :: [(GroupName ItemKind, CStore)]
ikit     = []
  }
gem1 :: ItemKind
gem1 = ItemKind
gemTemplate
  { ifreq :: Freqs ItemKind
ifreq    = [ (GroupName ItemKind
TREASURE, 100), (GroupName ItemKind
GEM, 100), (GroupName ItemKind
ANY_JEWELRY, 10)
               , (GroupName ItemKind
VALUABLE, 100) ]
  , irarity :: Rarity
irarity  = [(3, 0), (6, 12), (10, 8)]
  , iaspects :: [Aspect]
iaspects = [Skill -> Dice -> Aspect
AddSkill Skill
SkShine 1, Skill -> Dice -> Aspect
AddSkill Skill
SkSpeed (-1)]
                 -- reflects strongly, distracts; so it glows in the dark,
                 -- is visible on dark floor, but not too tempting to wear
               [Aspect] -> [Aspect] -> [Aspect]
forall a. [a] -> [a] -> [a]
++ ItemKind -> [Aspect]
iaspects ItemKind
gemTemplate
  }
gem2 :: ItemKind
gem2 = ItemKind
gem1
  { ifreq :: Freqs ItemKind
ifreq    = [ (GroupName ItemKind
TREASURE, 150), (GroupName ItemKind
GEM, 100), (GroupName ItemKind
ANY_JEWELRY, 10)
               , (GroupName ItemKind
VALUABLE, 100) ]
  , irarity :: Rarity
irarity  = [(5, 0), (7, 25), (10, 8)]
  }
gem3 :: ItemKind
gem3 = ItemKind
gem1
  { ifreq :: Freqs ItemKind
ifreq    = [ (GroupName ItemKind
TREASURE, 150), (GroupName ItemKind
GEM, 100), (GroupName ItemKind
ANY_JEWELRY, 10)
               , (GroupName ItemKind
VALUABLE, 100) ]
  , irarity :: Rarity
irarity  = [(7, 0), (8, 30), (10, 8)]
  }
gem4 :: ItemKind
gem4 = ItemKind
gem1
  { ifreq :: Freqs ItemKind
ifreq    = [ (GroupName ItemKind
TREASURE, 150), (GroupName ItemKind
GEM, 100), (GroupName ItemKind
ANY_JEWELRY, 30)
               , (GroupName ItemKind
VALUABLE, 100) ]
  , irarity :: Rarity
irarity  = [(9, 0), (10, 40)]
  }
gem5 :: ItemKind
gem5 = ItemKind
gem1
  { isymbol :: Char
isymbol  = Char
symbolSpecial
  , iname :: Text
iname    = "stimpack"
  , ifreq :: Freqs ItemKind
ifreq    = [ (GroupName ItemKind
TREASURE, 200), (GroupName ItemKind
GEM, 25), (GroupName ItemKind
ANY_JEWELRY, 10)
               , (GroupName ItemKind
VALUABLE, 100) ]
  , iflavour :: [Flavour]
iflavour = [Color] -> [Flavour]
zipPlain [Color
BrYellow]
  , irarity :: Rarity
irarity  = [(1, 40), (10, 10)]
  , iaspects :: [Aspect]
iaspects = [ Text -> Aspect
ELabel "of youth", Flag -> Aspect
SetFlag Flag
Precious  -- not hidden
               , Skill -> Dice -> Aspect
AddSkill Skill
SkOdor (-1) ]
  , ieffects :: [Effect]
ieffects = [Int -> Effect
RefillCalm 10, Int -> Effect
RefillHP 40]
  , idesc :: Text
idesc    = "Calms, heals, invigorates, rejuvenates and smells nice. No side-effects. As valuable as precious gems, at 100 gold grains each."
  }
currencyTemplate :: ItemKind
currencyTemplate = $WItemKind :: Char
-> Text
-> Freqs ItemKind
-> [Flavour]
-> Dice
-> Rarity
-> Text
-> Int
-> Dice
-> [Aspect]
-> [Effect]
-> [(GroupName ItemKind, CStore)]
-> Text
-> ItemKind
ItemKind
  { isymbol :: Char
isymbol  = Char
symbolGold
  , iname :: Text
iname    = "gold grain"
  , ifreq :: Freqs ItemKind
ifreq    = [(GroupName ItemKind
CURRENCY_UNKNOWN, 1), (GroupName ItemKind
VALUABLE, 1)]
  , iflavour :: [Flavour]
iflavour = [Color] -> [Flavour]
zipPlain [Color
BrYellow]
  , icount :: Dice
icount   = 10 Dice -> Dice -> Dice
forall a. Num a => a -> a -> a
+ 1 Int -> Int -> Dice
`d` 20 Dice -> Dice -> Dice
forall a. Num a => a -> a -> a
+ 1 Int -> Int -> Dice
`dL` 20
  , irarity :: Rarity
irarity  = [(1, 25), (10, 10)]
  , iverbHit :: Text
iverbHit = "tap"
  , iweight :: Int
iweight  = 1
  , idamage :: Dice
idamage  = 0
  , iaspects :: [Aspect]
iaspects = [GroupName ItemKind -> Aspect
PresentAs GroupName ItemKind
CURRENCY_UNKNOWN, Flag -> Aspect
SetFlag Flag
Precious]
  , ieffects :: [Effect]
ieffects = []
  , idesc :: Text
idesc    = "Reliably valuable in every civilized place."
  , ikit :: [(GroupName ItemKind, CStore)]
ikit     = []
  }
currency :: ItemKind
currency = ItemKind
currencyTemplate
  { ifreq :: Freqs ItemKind
ifreq    = [(GroupName ItemKind
TREASURE, 100), (GroupName ItemKind
S_CURRENCY, 100), (GroupName ItemKind
VALUABLE, 1)]
  , iaspects :: [Aspect]
iaspects = [Skill -> Dice -> Aspect
AddSkill Skill
SkShine 1, Skill -> Dice -> Aspect
AddSkill Skill
SkSpeed (-1)]
               [Aspect] -> [Aspect] -> [Aspect]
forall a. [a] -> [a] -> [a]
++ ItemKind -> [Aspect]
iaspects ItemKind
currencyTemplate
  }

-- ** Tools to be actively used, but not worn

jumpingPole :: ItemKind
jumpingPole = $WItemKind :: Char
-> Text
-> Freqs ItemKind
-> [Flavour]
-> Dice
-> Rarity
-> Text
-> Int
-> Dice
-> [Aspect]
-> [Effect]
-> [(GroupName ItemKind, CStore)]
-> Text
-> ItemKind
ItemKind
  { isymbol :: Char
isymbol  = Char
symbolWand
  , iname :: Text
iname    = "jumping pole"
  , ifreq :: Freqs ItemKind
ifreq    = [(GroupName ItemKind
COMMON_ITEM, 100), (GroupName ItemKind
POLE, 10)]
  , iflavour :: [Flavour]
iflavour = [Color] -> [Flavour]
zipFancy [Color
White]
  , icount :: Dice
icount   = 1
  , irarity :: Rarity
irarity  = [(6, 14)]  -- effect useful early, but too many poles early
  , iverbHit :: Text
iverbHit = "prod"
  , iweight :: Int
iweight  = 4000
  , idamage :: Dice
idamage  = 0
  , iaspects :: [Aspect]
iaspects = [ Dice -> Aspect
Timeout (Dice -> Aspect) -> Dice -> Aspect
forall a b. (a -> b) -> a -> b
$ (4 Dice -> Dice -> Dice
forall a. Num a => a -> a -> a
+ 1 Int -> Int -> Dice
`d` 2 Dice -> Dice -> Dice
forall a. Num a => a -> a -> a
- 1 Int -> Int -> Dice
`dL` 2) Dice -> Dice -> Dice
forall a. Num a => a -> a -> a
* 5
               , Flag -> Aspect
SetFlag Flag
Durable ]
  , ieffects :: [Effect]
ieffects = [GroupName ItemKind -> Dice -> Effect
toOrganGood GroupName ItemKind
S_HASTED 1]
                 -- This works and doesn't cause AI loops. @InsertMove@
                 -- would produce an activation that doesn't change game state.
                 -- Hasting for an absolute number of turns would cause
                 -- an explosion of time when several poles are accumulated.
                 -- Here it speeds AI up for exactly the turn spent activating,
                 -- so when AI applies it repeatedly, it gets its time back and
                 -- is not stuck. In total, the exploration speed is unchanged,
                 -- but it's useful when fleeing in the dark to make distance
                 -- and when initiating combat, so it's OK that AI uses it.
                 -- Timeout is rather high, because for factions with leaders
                 -- some time is often gained, so this could be useful
                 -- even during melee, which would be tiresome to employ.
  , idesc :: Text
idesc    = "Makes you vulnerable at take-off, but then you are free like a bird."
  , ikit :: [(GroupName ItemKind, CStore)]
ikit     = []
  }

-- ** Detachable and usable, in various ways, robot body parts

constructionHooter :: ItemKind
constructionHooter = ItemKind
necklaceTemplate
  { iname :: Text
iname    = "construction hooter"
  , ifreq :: Freqs ItemKind
ifreq    = [(GroupName ItemKind
CONSTRUCTION_HOOTER, 1), (GroupName ItemKind
COMMON_ITEM, 1), (GroupName ItemKind
ARMOR_LOOSE, 1)]
                   -- extremely rare, but dropped by decontamination chambers
  , iflavour :: [Flavour]
iflavour = [Color] -> [Flavour]
zipPlain [Color
BrRed]
  , irarity :: Rarity
irarity  = [(1, 1)]
  , iweight :: Int
iweight  = 1000
  , iaspects :: [Aspect]
iaspects = [ Skill -> Dice -> Aspect
AddSkill Skill
SkArmorMelee 2
               , Flag -> Aspect
SetFlag Flag
Durable, Int -> Aspect
toVelocity 50
               , Flag -> Aspect
SetFlag Flag
Equipable, EqpSlot -> Aspect
EqpSlot EqpSlot
EqpSlotArmorMelee]
  , ieffects :: [Effect]
ieffects = [Effect
Yell, GroupName ItemKind -> Dice -> Effect
Summon GroupName ItemKind
CONSTRUCTION_ROBOT 1]
  , idesc :: Text
idesc    = "An emergency hooter for alarming human personnel in case their life is in danger. Worn by construction robots around their \"neck\", where it's least exposed, but even there it needs to be heavily armored and running on its own power supply."
  }
wasteContainer :: ItemKind
wasteContainer = $WItemKind :: Char
-> Text
-> Freqs ItemKind
-> [Flavour]
-> Dice
-> Rarity
-> Text
-> Int
-> Dice
-> [Aspect]
-> [Effect]
-> [(GroupName ItemKind, CStore)]
-> Text
-> ItemKind
ItemKind
  { isymbol :: Char
isymbol  = Char
symbolTool
  , iname :: Text
iname    = "waste container"
  , ifreq :: Freqs ItemKind
ifreq    = [(GroupName ItemKind
WASTE_CONTAINER, 1), (GroupName ItemKind
WATER_SOURCE, 1), (GroupName ItemKind
ARMOR_LOOSE, 1)]
  , iflavour :: [Flavour]
iflavour = [Color] -> [Flavour]
zipLiquid [Color
Green]
  , icount :: Dice
icount   = 1
  , irarity :: Rarity
irarity  = [(1, 1)]
  , iverbHit :: Text
iverbHit = "spill over"
  , iweight :: Int
iweight  = 30000
  , idamage :: Dice
idamage  = 0
  , iaspects :: [Aspect]
iaspects = [ Dice -> Aspect
Timeout (Dice -> Aspect) -> Dice -> Aspect
forall a b. (a -> b) -> a -> b
$ (1 Int -> Int -> Dice
`d` 2) Dice -> Dice -> Dice
forall a. Num a => a -> a -> a
* 30  -- robots should not summon too often
               , Skill -> Dice -> Aspect
AddSkill Skill
SkArmorMelee 20  -- tempting
               , Skill -> Dice -> Aspect
AddSkill Skill
SkMaxCalm (-30)  -- punishes excessive stacking
               , Flag -> Aspect
SetFlag Flag
Periodic, Flag -> Aspect
SetFlag Flag
Equipable
               , EqpSlot -> Aspect
EqpSlot EqpSlot
EqpSlotArmorMelee ]
  , ieffects :: [Effect]
ieffects = [ DetectKind -> Int -> Effect
Detect DetectKind
DetectLoot 20
               , Condition -> Effect -> Effect
When (ActivationFlag -> Condition
TriggeredBy ActivationFlag
ActivationPeriodic) (Effect -> Effect) -> Effect -> Effect
forall a b. (a -> b) -> a -> b
$ [Effect] -> Effect
SeqEffect
                   [ GroupName ItemKind -> Dice -> Effect
Summon GroupName ItemKind
MOBILE_ANIMAL (Dice -> Effect) -> Dice -> Effect
forall a b. (a -> b) -> a -> b
$ 1 Int -> Int -> Dice
`dL` 2
                   , GroupName ItemKind -> Effect
Explode GroupName ItemKind
S_WASTE ] ]
  , idesc :: Text
idesc    = "Waste recognition and utilization subsystem. Detects any stray item not registered as a passenger's cargo. Leaks a little. But one man's trash is another man's treasure and so this item has many beneficial uses."
  , ikit :: [(GroupName ItemKind, CStore)]
ikit     = []
  }
spotlight :: ItemKind
spotlight = $WItemKind :: Char
-> Text
-> Freqs ItemKind
-> [Flavour]
-> Dice
-> Rarity
-> Text
-> Int
-> Dice
-> [Aspect]
-> [Effect]
-> [(GroupName ItemKind, CStore)]
-> Text
-> ItemKind
ItemKind
  { isymbol :: Char
isymbol  = Char
symbolLight
  , iname :: Text
iname    = "spotlight"
  , ifreq :: Freqs ItemKind
ifreq    = [(GroupName ItemKind
SPOTLIGHT, 1)]
  , iflavour :: [Flavour]
iflavour = [Color] -> [Flavour]
zipPlain [Color
White]
  , icount :: Dice
icount   = 1
  , irarity :: Rarity
irarity  = [(1, 1)]
  , iverbHit :: Text
iverbHit = "illuminate"
  , iweight :: Int
iweight  = 3000
  , idamage :: Dice
idamage  = 0
  , iaspects :: [Aspect]
iaspects = [ Skill -> Dice -> Aspect
AddSkill Skill
SkShine 3
               , Skill -> Dice -> Aspect
AddSkill Skill
SkHurtMelee (-2)  -- heavy and unwieldy
               , Flag -> Aspect
SetFlag Flag
Equipable, EqpSlot -> Aspect
EqpSlot EqpSlot
EqpSlotShine ]
  , ieffects :: [Effect]
ieffects = [DetectKind -> Int -> Effect
Detect DetectKind
DetectHidden 10]
  , idesc :: Text
idesc    = "Powerful wide-beam spotlight in an unwieldy rack-mounted package. On full power, it can shine through thin construction surfaces, underlying fault lines."
  , ikit :: [(GroupName ItemKind, CStore)]
ikit     = []
  }
seeingItem :: ItemKind
seeingItem = $WItemKind :: Char
-> Text
-> Freqs ItemKind
-> [Flavour]
-> Dice
-> Rarity
-> Text
-> Int
-> Dice
-> [Aspect]
-> [Effect]
-> [(GroupName ItemKind, CStore)]
-> Text
-> ItemKind
ItemKind
  { isymbol :: Char
isymbol  = Char
symbolRing
  , iname :: Text
iname    = "visual sensor"
  , ifreq :: Freqs ItemKind
ifreq    = [(GroupName ItemKind
COMMON_ITEM, 100)]
  , iflavour :: [Flavour]
iflavour = [Color] -> [Flavour]
zipPlain [Color
BrBlue]
  , icount :: Dice
icount   = 1
  , irarity :: Rarity
irarity  = [(1, 2)]
  , iverbHit :: Text
iverbHit = "gaze at"
  , iweight :: Int
iweight  = 500
  , idamage :: Dice
idamage  = 0
  , iaspects :: [Aspect]
iaspects = [ Dice -> Aspect
Timeout 3
               , Skill -> Dice -> Aspect
AddSkill Skill
SkSight 10  -- a spyglass for quick wields
               , Skill -> Dice -> Aspect
AddSkill Skill
SkMaxCalm 30  -- to diminish clipping sight by Calm
               , Skill -> Dice -> Aspect
AddSkill Skill
SkShine 2  -- to lit corridors when flying
               , Skill -> Dice -> Aspect
AddSkill Skill
SkMaxHP (-30)  -- prevent excessive stacking
               , Flag -> Aspect
SetFlag Flag
Periodic ]
  , ieffects :: [Effect]
ieffects = [ DetectKind -> Int -> Effect
Detect DetectKind
DetectActor 20  -- rare enough that one-time is not OP
               , Condition -> Effect -> Effect
When (ActivationFlag -> Condition
TriggeredBy ActivationFlag
ActivationPeriodic) (Effect -> Effect) -> Effect -> Effect
forall a b. (a -> b) -> a -> b
$ [Effect] -> Effect
SeqEffect
                   [ GroupName ItemKind -> Effect
Explode GroupName ItemKind
S_SINGLE_SPARK
                   , GroupName ItemKind -> Effect
toOrganNoTimer GroupName ItemKind
S_POISONED  -- really can't be worn
                   , GroupName ItemKind -> Dice -> Effect
Summon GroupName ItemKind
MOBILE_ROBOT 1 ] ]
  , idesc :: Text
idesc    = "An oversize visual sensor freshly torn out of some unfortunate robot. It still sends a clear picture to unidentified receivers, even though the coolant liquid seeps from the seized servos and many internal contacts spark loose."
  , ikit :: [(GroupName ItemKind, CStore)]
ikit     = []
  }