-- | Actor (or rather actor body trunk) definitions.
module Content.ItemKindActor
  ( -- * Group name patterns
    pattern S_WOODEN_TORCH, pattern S_SANDSTONE_ROCK
  , pattern HERO, pattern SCOUT_HERO, pattern RANGER_HERO, pattern ESCAPIST_HERO, pattern AMBUSHER_HERO, pattern BRAWLER_HERO, pattern SOLDIER_HERO, pattern CIVILIAN, pattern MONSTER, pattern MOBILE_MONSTER, pattern SCOUT_MONSTER, pattern ANIMAL, pattern MOBILE_ANIMAL, pattern IMMOBILE_ANIMAL, pattern INSECT, pattern GEOPHENOMENON
  , pattern ADD_SIGHT, pattern ARMOR_RANGED, pattern ADD_NOCTO_1, pattern WEAK_ARROW, pattern LIGHT_ATTENUATOR, pattern FIREPROOF_CLOTH, pattern RING_OF_OPPORTUNITY_SNIPER, pattern ANY_ARROW, pattern STARTING_ARMOR, pattern STARTING_WEAPON, pattern GEM
  , actorsGN, actorsGNSingleton
  , -- * Content
    actors
  ) where

import Prelude ()

import Game.LambdaHack.Core.Prelude

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

import Content.ItemKindOrgan

-- * Group name patterns

actorsGNSingleton :: [GroupName ItemKind]
actorsGNSingleton :: [GroupName ItemKind]
actorsGNSingleton =
       [GroupName ItemKind
S_WOODEN_TORCH, GroupName ItemKind
S_SANDSTONE_ROCK]

pattern S_WOODEN_TORCH, S_SANDSTONE_ROCK :: GroupName ItemKind

actorsGN :: [GroupName ItemKind]
actorsGN :: [GroupName ItemKind]
actorsGN =
       [GroupName ItemKind
HERO, GroupName ItemKind
SCOUT_HERO, GroupName ItemKind
RANGER_HERO, GroupName ItemKind
ESCAPIST_HERO, GroupName ItemKind
AMBUSHER_HERO, GroupName ItemKind
BRAWLER_HERO, GroupName ItemKind
SOLDIER_HERO, GroupName ItemKind
CIVILIAN, GroupName ItemKind
MONSTER, GroupName ItemKind
MOBILE_MONSTER, GroupName ItemKind
SCOUT_MONSTER, GroupName ItemKind
ANIMAL, GroupName ItemKind
MOBILE_ANIMAL, GroupName ItemKind
IMMOBILE_ANIMAL, GroupName ItemKind
INSECT, GroupName ItemKind
GEOPHENOMENON]
    [GroupName ItemKind]
-> [GroupName ItemKind] -> [GroupName ItemKind]
forall a. [a] -> [a] -> [a]
++ [GroupName ItemKind
ADD_SIGHT, GroupName ItemKind
ARMOR_RANGED, GroupName ItemKind
ADD_NOCTO_1, GroupName ItemKind
WEAK_ARROW, GroupName ItemKind
LIGHT_ATTENUATOR, GroupName ItemKind
FIREPROOF_CLOTH, GroupName ItemKind
RING_OF_OPPORTUNITY_SNIPER, GroupName ItemKind
ANY_ARROW, GroupName ItemKind
STARTING_ARMOR, GroupName ItemKind
STARTING_WEAPON, GroupName ItemKind
GEM]

pattern HERO, SCOUT_HERO, RANGER_HERO, ESCAPIST_HERO, AMBUSHER_HERO, BRAWLER_HERO, SOLDIER_HERO, CIVILIAN, MONSTER, MOBILE_MONSTER, SCOUT_MONSTER, ANIMAL, MOBILE_ANIMAL, IMMOBILE_ANIMAL, INSECT, GEOPHENOMENON :: GroupName ItemKind

pattern ADD_SIGHT, ARMOR_RANGED, ADD_NOCTO_1, WEAK_ARROW, LIGHT_ATTENUATOR, FIREPROOF_CLOTH, RING_OF_OPPORTUNITY_SNIPER, ANY_ARROW, STARTING_ARMOR, STARTING_WEAPON, GEM :: GroupName ItemKind

pattern $bHERO :: GroupName ItemKind
$mHERO :: forall r. GroupName ItemKind -> (Void# -> r) -> (Void# -> r) -> r
HERO = GroupName "adventurer"
pattern $bSCOUT_HERO :: GroupName ItemKind
$mSCOUT_HERO :: forall r. GroupName ItemKind -> (Void# -> r) -> (Void# -> r) -> r
SCOUT_HERO = GroupName "scout"
pattern $bRANGER_HERO :: GroupName ItemKind
$mRANGER_HERO :: forall r. GroupName ItemKind -> (Void# -> r) -> (Void# -> r) -> r
RANGER_HERO = GroupName "ranger"
pattern $bESCAPIST_HERO :: GroupName ItemKind
$mESCAPIST_HERO :: forall r. GroupName ItemKind -> (Void# -> r) -> (Void# -> r) -> r
ESCAPIST_HERO = GroupName "escapist"
pattern $bAMBUSHER_HERO :: GroupName ItemKind
$mAMBUSHER_HERO :: forall r. GroupName ItemKind -> (Void# -> r) -> (Void# -> r) -> r
AMBUSHER_HERO = GroupName "ambusher"
pattern $bBRAWLER_HERO :: GroupName ItemKind
$mBRAWLER_HERO :: forall r. GroupName ItemKind -> (Void# -> r) -> (Void# -> r) -> r
BRAWLER_HERO = GroupName "brawler"
pattern $bSOLDIER_HERO :: GroupName ItemKind
$mSOLDIER_HERO :: forall r. GroupName ItemKind -> (Void# -> r) -> (Void# -> r) -> r
SOLDIER_HERO = GroupName "soldier"
pattern $bCIVILIAN :: GroupName ItemKind
$mCIVILIAN :: forall r. GroupName ItemKind -> (Void# -> r) -> (Void# -> r) -> r
CIVILIAN = GroupName "civilian"
pattern $bMONSTER :: GroupName ItemKind
$mMONSTER :: forall r. GroupName ItemKind -> (Void# -> r) -> (Void# -> r) -> r
MONSTER = GroupName "monstrosity"
pattern $bMOBILE_MONSTER :: GroupName ItemKind
$mMOBILE_MONSTER :: forall r. GroupName ItemKind -> (Void# -> r) -> (Void# -> r) -> r
MOBILE_MONSTER = GroupName "mobile monstrosity"
pattern $bSCOUT_MONSTER :: GroupName ItemKind
$mSCOUT_MONSTER :: forall r. GroupName ItemKind -> (Void# -> r) -> (Void# -> r) -> r
SCOUT_MONSTER = GroupName "scout monstrosity"
pattern $bANIMAL :: GroupName ItemKind
$mANIMAL :: forall r. GroupName ItemKind -> (Void# -> r) -> (Void# -> r) -> r
ANIMAL = GroupName "animal"
pattern $bMOBILE_ANIMAL :: GroupName ItemKind
$mMOBILE_ANIMAL :: forall r. GroupName ItemKind -> (Void# -> r) -> (Void# -> r) -> r
MOBILE_ANIMAL = GroupName "mobile animal"
pattern $bIMMOBILE_ANIMAL :: GroupName ItemKind
$mIMMOBILE_ANIMAL :: forall r. GroupName ItemKind -> (Void# -> r) -> (Void# -> r) -> r
IMMOBILE_ANIMAL = GroupName "immobile animal"
pattern $bINSECT :: GroupName ItemKind
$mINSECT :: forall r. GroupName ItemKind -> (Void# -> r) -> (Void# -> r) -> r
INSECT = GroupName "insect"
pattern $bGEOPHENOMENON :: GroupName ItemKind
$mGEOPHENOMENON :: forall r. GroupName ItemKind -> (Void# -> r) -> (Void# -> r) -> r
GEOPHENOMENON = GroupName "geological phenomenon"

pattern $bS_WOODEN_TORCH :: GroupName ItemKind
$mS_WOODEN_TORCH :: forall r. GroupName ItemKind -> (Void# -> r) -> (Void# -> r) -> r
S_WOODEN_TORCH = GroupName "wooden torch"
pattern $bS_SANDSTONE_ROCK :: GroupName ItemKind
$mS_SANDSTONE_ROCK :: forall r. GroupName ItemKind -> (Void# -> r) -> (Void# -> r) -> r
S_SANDSTONE_ROCK = GroupName "sandstone rock"

pattern $bADD_SIGHT :: GroupName ItemKind
$mADD_SIGHT :: forall r. GroupName ItemKind -> (Void# -> r) -> (Void# -> r) -> r
ADD_SIGHT = GroupName "sight improvement"
pattern $bARMOR_RANGED :: GroupName ItemKind
$mARMOR_RANGED :: forall r. GroupName ItemKind -> (Void# -> r) -> (Void# -> r) -> r
ARMOR_RANGED = GroupName "ranged armor"
pattern $bADD_NOCTO_1 :: GroupName ItemKind
$mADD_NOCTO_1 :: forall r. GroupName ItemKind -> (Void# -> r) -> (Void# -> r) -> r
ADD_NOCTO_1 = GroupName "noctovision improvement"
pattern $bWEAK_ARROW :: GroupName ItemKind
$mWEAK_ARROW :: forall r. GroupName ItemKind -> (Void# -> r) -> (Void# -> r) -> r
WEAK_ARROW = GroupName "weak arrow"
pattern $bLIGHT_ATTENUATOR :: GroupName ItemKind
$mLIGHT_ATTENUATOR :: forall r. GroupName ItemKind -> (Void# -> r) -> (Void# -> r) -> r
LIGHT_ATTENUATOR = GroupName "light attenuator"
pattern $bFIREPROOF_CLOTH :: GroupName ItemKind
$mFIREPROOF_CLOTH :: forall r. GroupName ItemKind -> (Void# -> r) -> (Void# -> r) -> r
FIREPROOF_CLOTH = GroupName "fireproof cloth"
pattern $bRING_OF_OPPORTUNITY_SNIPER :: GroupName ItemKind
$mRING_OF_OPPORTUNITY_SNIPER :: forall r. GroupName ItemKind -> (Void# -> r) -> (Void# -> r) -> r
RING_OF_OPPORTUNITY_SNIPER = GroupName "ring of sniper"
pattern $bANY_ARROW :: GroupName ItemKind
$mANY_ARROW :: forall r. GroupName ItemKind -> (Void# -> r) -> (Void# -> r) -> r
ANY_ARROW = GroupName "arrow"
pattern $bSTARTING_ARMOR :: GroupName ItemKind
$mSTARTING_ARMOR :: forall r. GroupName ItemKind -> (Void# -> r) -> (Void# -> r) -> r
STARTING_ARMOR = GroupName "starting armor"
pattern $bSTARTING_WEAPON :: GroupName ItemKind
$mSTARTING_WEAPON :: forall r. GroupName ItemKind -> (Void# -> r) -> (Void# -> r) -> r
STARTING_WEAPON = GroupName "starting weapon"
pattern $bGEM :: GroupName ItemKind
$mGEM :: forall r. GroupName ItemKind -> (Void# -> r) -> (Void# -> r) -> r
GEM = GroupName "gem"

-- * Content

actors :: [ItemKind]
actors :: [ItemKind]
actors =
  [ItemKind
warrior, ItemKind
warrior2, ItemKind
warrior3, ItemKind
warrior4, ItemKind
warrior5, ItemKind
scout, ItemKind
ranger, ItemKind
escapist, ItemKind
ambusher, ItemKind
brawler, ItemKind
soldier, ItemKind
civilian, ItemKind
civilian2, ItemKind
civilian3, ItemKind
civilian4, ItemKind
civilian5, ItemKind
eye, ItemKind
fastEye, ItemKind
nose, ItemKind
elbow, ItemKind
torsor, ItemKind
goldenJackal, ItemKind
griffonVulture, ItemKind
skunk, ItemKind
armadillo, ItemKind
gilaMonster, ItemKind
rattlesnake, ItemKind
hyena, ItemKind
komodoDragon, ItemKind
alligator, ItemKind
rhinoceros, ItemKind
beeSwarm, ItemKind
hornetSwarm, ItemKind
thornbush]
  -- LH-specific
  [ItemKind] -> [ItemKind] -> [ItemKind]
forall a. [a] -> [a] -> [a]
++ [ItemKind
geyserBoiling, ItemKind
geyserArsenic, ItemKind
geyserSulfur]

warrior,    warrior2, warrior3, warrior4, warrior5, scout, ranger, escapist, ambusher, brawler, soldier, civilian, civilian2, civilian3, civilian4, civilian5, eye, fastEye, nose, elbow, torsor, goldenJackal, griffonVulture, skunk, armadillo, gilaMonster, rattlesnake, hyena, komodoDragon, alligator, rhinoceros, beeSwarm, hornetSwarm, thornbush :: ItemKind
-- LH-specific
geyserBoiling, geyserArsenic, geyserSulfur :: ItemKind

-- Note that the actors that appear in the crawl scenario should
-- be generated with at most ordinary ammo. Otherwise, farming them
-- may be rational though boring endeavour. Any exceptions to that
-- should be well thought of. E.g., unique guaranteed items on bosses
-- are safe, just as restricted kinds of weak items.

-- * Hunams

-- TODO: bring back S_EAR_3 when character progression permits hearing boosts.
humanOrgans :: [(GroupName ItemKind, CStore)]
humanOrgans :: [(GroupName ItemKind, CStore)]
humanOrgans = [ (GroupName ItemKind
S_FIST, CStore
COrgan), (GroupName ItemKind
S_FOOT, CStore
COrgan)
              , (GroupName ItemKind
S_EYE_6, CStore
COrgan), (GroupName ItemKind
S_EAR_6, CStore
COrgan)
              , (GroupName ItemKind
S_SAPIENT_BRAIN, CStore
COrgan) ]
warrior :: ItemKind
warrior = ItemKind :: ContentSymbol ItemKind
-> Text
-> Freqs ItemKind
-> [Flavour]
-> Dice
-> Rarity
-> Text
-> Int
-> Dice
-> [Aspect]
-> [Effect]
-> [(GroupName ItemKind, CStore)]
-> Text
-> ItemKind
ItemKind
  { isymbol :: ContentSymbol ItemKind
isymbol  = ContentSymbol ItemKind -> ContentSymbol ItemKind
forall c. ContentSymbol ItemKind -> ContentSymbol ItemKind
toContentSymbol ContentSymbol ItemKind
'@'
  , iname :: Text
iname    = Text
"adventurer"  -- modified if initial actors in hero faction
  , ifreq :: Freqs ItemKind
ifreq    = [(GroupName ItemKind
HERO, Int
100), (GroupName ItemKind
MOBILE, Int
1)]
  , iflavour :: [Flavour]
iflavour = [Color] -> [Flavour]
zipPlain [Color
BrWhite]
  , icount :: Dice
icount   = Dice
1
  , irarity :: Rarity
irarity  = [(Double
1, Int
5)]
  , iverbHit :: Text
iverbHit = Text
"thud"
  , iweight :: Int
iweight  = Int
80000
  , idamage :: Dice
idamage  = Dice
0
  , iaspects :: [Aspect]
iaspects = [ Skill -> Dice -> Aspect
AddSkill Skill
SkMaxHP Dice
80  -- partially from clothes and first aid
               , Skill -> Dice -> Aspect
AddSkill Skill
SkMaxCalm Dice
70
               , Skill -> Dice -> Aspect
AddSkill Skill
SkSpeed Dice
20
               , Skill -> Dice -> Aspect
AddSkill Skill
SkNocto Dice
2
               , Skill -> Dice -> Aspect
AddSkill Skill
SkWait Dice
1  -- can lurk
               , Skill -> Dice -> Aspect
AddSkill Skill
SkProject Dice
2  -- can lob
               , Skill -> Dice -> Aspect
AddSkill Skill
SkApply Dice
2  -- can even apply periodic items
               , Skill -> Dice -> Aspect
AddSkill Skill
SkOdor Dice
1
               , Flag -> Aspect
SetFlag Flag
Durable ]
  , ieffects :: [Effect]
ieffects = []
  , ikit :: [(GroupName ItemKind, CStore)]
ikit     = [(GroupName ItemKind, CStore)]
humanOrgans
               [(GroupName ItemKind, CStore)]
-> [(GroupName ItemKind, CStore)] -> [(GroupName ItemKind, CStore)]
forall a. [a] -> [a] -> [a]
++ [(GroupName ItemKind
S_SANDSTONE_ROCK, CStore
CStash)]
  , idesc :: Text
idesc    = Text
""  -- "A hardened veteran of combat."
  }
warrior2 :: ItemKind
warrior2 = ItemKind
warrior
  { iname :: Text
iname    = Text
"warrior"
  , ikit :: [(GroupName ItemKind, CStore)]
ikit     = [(GroupName ItemKind, CStore)]
humanOrgans
               [(GroupName ItemKind, CStore)]
-> [(GroupName ItemKind, CStore)] -> [(GroupName ItemKind, CStore)]
forall a. [a] -> [a] -> [a]
++ [(GroupName ItemKind
COMMON_ITEM, CStore
CStash)]
  -- , idesc    = ""
  }
warrior3 :: ItemKind
warrior3 = ItemKind
warrior
  { iname :: Text
iname    = Text
"blacksmith"
  -- , idesc    = ""
  }
warrior4 :: ItemKind
warrior4 = ItemKind
warrior
  { iname :: Text
iname    = Text
"forester"
  -- , idesc    = ""
  }
warrior5 :: ItemKind
warrior5 = ItemKind
warrior
  { iname :: Text
iname    = Text
"scientist"
  -- , idesc    = ""
  }

scout :: ItemKind
scout = ItemKind
warrior
  { ifreq :: Freqs ItemKind
ifreq    = [(GroupName ItemKind
SCOUT_HERO, Int
100), (GroupName ItemKind
MOBILE, Int
1)]
  , ikit :: [(GroupName ItemKind, CStore)]
ikit     = [(GroupName ItemKind, CStore)]
humanOrgans
               [(GroupName ItemKind, CStore)]
-> [(GroupName ItemKind, CStore)] -> [(GroupName ItemKind, CStore)]
forall a. [a] -> [a] -> [a]
++ [ (GroupName ItemKind
ADD_SIGHT, CStore
CEqp)
                  , (GroupName ItemKind
ARMOR_RANGED, CStore
CEqp)
                  , (GroupName ItemKind
ADD_NOCTO_1, CStore
CStash) ]
  -- , idesc    = ""
  }
ranger :: ItemKind
ranger = ItemKind
warrior
  { ifreq :: Freqs ItemKind
ifreq    = [(GroupName ItemKind
RANGER_HERO, Int
100), (GroupName ItemKind
MOBILE, Int
1)]
  , ikit :: [(GroupName ItemKind, CStore)]
ikit     = [(GroupName ItemKind, CStore)]
humanOrgans
               [(GroupName ItemKind, CStore)]
-> [(GroupName ItemKind, CStore)] -> [(GroupName ItemKind, CStore)]
forall a. [a] -> [a] -> [a]
++ [ (GroupName ItemKind
ARMOR_RANGED, CStore
CEqp)
                  , (GroupName ItemKind
WEAK_ARROW, CStore
CStash) ]
  -- , idesc    = ""
  }
escapist :: ItemKind
escapist = ItemKind
warrior
  { ifreq :: Freqs ItemKind
ifreq    = [(GroupName ItemKind
ESCAPIST_HERO, Int
100), (GroupName ItemKind
MOBILE, Int
1)]
  , ikit :: [(GroupName ItemKind, CStore)]
ikit     = [(GroupName ItemKind, CStore)]
humanOrgans
               [(GroupName ItemKind, CStore)]
-> [(GroupName ItemKind, CStore)] -> [(GroupName ItemKind, CStore)]
forall a. [a] -> [a] -> [a]
++ [ (GroupName ItemKind
ADD_SIGHT, CStore
CEqp)
                  , (GroupName ItemKind
STARTING_ARMOR, CStore
CEqp)
                  , (GroupName ItemKind
WEAK_ARROW, CStore
CStash)  -- mostly for probing
                  , (GroupName ItemKind
LIGHT_ATTENUATOR, CStore
CStash)
                  , (GroupName ItemKind
S_WOODEN_TORCH, CStore
CStash)
                  , (GroupName ItemKind
FIREPROOF_CLOTH, CStore
CStash) ]
  -- , idesc    = ""
  }
ambusher :: ItemKind
ambusher = ItemKind
warrior
  { ifreq :: Freqs ItemKind
ifreq    = [(GroupName ItemKind
AMBUSHER_HERO, Int
100), (GroupName ItemKind
MOBILE, Int
1)]
  , ikit :: [(GroupName ItemKind, CStore)]
ikit     = [(GroupName ItemKind, CStore)]
humanOrgans  -- dark and numerous, so more kit without exploring
               [(GroupName ItemKind, CStore)]
-> [(GroupName ItemKind, CStore)] -> [(GroupName ItemKind, CStore)]
forall a. [a] -> [a] -> [a]
++ [ (GroupName ItemKind
RING_OF_OPPORTUNITY_SNIPER, CStore
CEqp)
                  , (GroupName ItemKind
ANY_ARROW, CStore
CStash), (GroupName ItemKind
ANY_ARROW, CStore
CStash)
                  , (GroupName ItemKind
WEAK_ARROW, CStore
CStash)
                  , (GroupName ItemKind
EXPLOSIVE, CStore
CStash)
                  , (GroupName ItemKind
LIGHT_ATTENUATOR, CStore
CEqp)
                  , (GroupName ItemKind
S_WOODEN_TORCH, CStore
CStash) ]
  -- , idesc    = ""
  }
brawler :: ItemKind
brawler = ItemKind
warrior
  { ifreq :: Freqs ItemKind
ifreq    = [(GroupName ItemKind
BRAWLER_HERO, Int
100), (GroupName ItemKind
MOBILE, Int
1)]
  , ikit :: [(GroupName ItemKind, CStore)]
ikit     = [(GroupName ItemKind, CStore)]
humanOrgans
               [(GroupName ItemKind, CStore)]
-> [(GroupName ItemKind, CStore)] -> [(GroupName ItemKind, CStore)]
forall a. [a] -> [a] -> [a]
++ [ (GroupName ItemKind
STARTING_WEAPON, CStore
CEqp)
                  , (GroupName ItemKind
ANY_POTION, CStore
CStash) ]
  -- , idesc    = ""
  }
soldier :: ItemKind
soldier = ItemKind
brawler
  { ifreq :: Freqs ItemKind
ifreq    = [(GroupName ItemKind
SOLDIER_HERO, Int
100), (GroupName ItemKind
MOBILE, Int
1)]
  , ikit :: [(GroupName ItemKind, CStore)]
ikit     = ItemKind -> [(GroupName ItemKind, CStore)]
ikit ItemKind
brawler
               [(GroupName ItemKind, CStore)]
-> [(GroupName ItemKind, CStore)] -> [(GroupName ItemKind, CStore)]
forall a. [a] -> [a] -> [a]
++ [(GroupName ItemKind
EXPLOSIVE, CStore
CStash)]
  -- , idesc    = ""
  }

civilian :: ItemKind
civilian = ItemKind
warrior
  { iname :: Text
iname    = Text
"clerk"
  , ifreq :: Freqs ItemKind
ifreq    = [(GroupName ItemKind
CIVILIAN, Int
100), (GroupName ItemKind
MOBILE, Int
1)]
  , iflavour :: [Flavour]
iflavour = [Color] -> [Flavour]
zipPlain [Color
BrBlack]
  -- , idesc    = ""
  }
civilian2 :: ItemKind
civilian2 = ItemKind
civilian
  { iname :: Text
iname    = Text
"hairdresser"
  -- , idesc    = ""
  }
civilian3 :: ItemKind
civilian3 = ItemKind
civilian
  { iname :: Text
iname    = Text
"lawyer"
  -- , idesc    = ""
  }
civilian4 :: ItemKind
civilian4 = ItemKind
civilian
  { iname :: Text
iname    = Text
"peddler"
  -- , idesc    = ""
  }
civilian5 :: ItemKind
civilian5 = ItemKind
civilian
  { iname :: Text
iname    = Text
"tax collector"
  -- , idesc    = ""
  }

-- * Monsters

-- They have bright colours, because they are not natural.

eye :: ItemKind
eye = ItemKind :: ContentSymbol ItemKind
-> Text
-> Freqs ItemKind
-> [Flavour]
-> Dice
-> Rarity
-> Text
-> Int
-> Dice
-> [Aspect]
-> [Effect]
-> [(GroupName ItemKind, CStore)]
-> Text
-> ItemKind
ItemKind
  { isymbol :: ContentSymbol ItemKind
isymbol  = ContentSymbol ItemKind -> ContentSymbol ItemKind
forall c. ContentSymbol ItemKind -> ContentSymbol ItemKind
toContentSymbol ContentSymbol ItemKind
'e'
  , iname :: Text
iname    = Text
"reducible eye"
  , ifreq :: Freqs ItemKind
ifreq    = [ (GroupName ItemKind
MONSTER, Int
100), (GroupName ItemKind
MOBILE, Int
1)
               , (GroupName ItemKind
MOBILE_MONSTER, Int
100), (GroupName ItemKind
SCOUT_MONSTER, Int
10) ]
  , iflavour :: [Flavour]
iflavour = [Color] -> [Flavour]
zipFancy [Color
BrRed]
  , icount :: Dice
icount   = Dice
1
  , irarity :: Rarity
irarity  = [(Double
3, Int
0), (Double
4, Int
10), (Double
10, Int
8)]
  , iverbHit :: Text
iverbHit = Text
"thud"
  , iweight :: Int
iweight  = Int
80000
  , idamage :: Dice
idamage  = Dice
0
  , iaspects :: [Aspect]
iaspects = [ Skill -> Dice -> Aspect
AddSkill Skill
SkMaxHP Dice
16, Skill -> Dice -> Aspect
AddSkill Skill
SkMaxCalm Dice
70
               , Skill -> Dice -> Aspect
AddSkill Skill
SkSpeed Dice
20, Skill -> Dice -> Aspect
AddSkill Skill
SkNocto Dice
2
               , Skill -> Dice -> Aspect
AddSkill Skill
SkAggression Dice
1
               , Skill -> Dice -> Aspect
AddSkill Skill
SkProject Dice
2  -- can lob
               , Skill -> Dice -> Aspect
AddSkill Skill
SkApply Dice
1  -- can use even cultural artifacts
               , Flag -> Aspect
SetFlag Flag
Durable ]
  , ieffects :: [Effect]
ieffects = []
  , idesc :: Text
idesc    = Text
"Under your stare, it reduces to the bits that define its essence. Under introspection, the bits slow down and solidify into an arbitrary form again. It must be huge inside, for holographic principle to manifest so overtly."  -- holographic principle is an anachronism for XIX or most of XX century, but "the cosmological scale effects" is too weak
  , ikit :: [(GroupName ItemKind, CStore)]
ikit     = [ (GroupName ItemKind
S_LASH, CStore
COrgan), (GroupName ItemKind
S_PUPIL, CStore
COrgan)  -- at least one non-timed
               , (GroupName ItemKind
S_SAPIENT_BRAIN, CStore
COrgan) ]  -- no hearing, it's all eyes
  }
fastEye :: ItemKind
fastEye = ItemKind :: ContentSymbol ItemKind
-> Text
-> Freqs ItemKind
-> [Flavour]
-> Dice
-> Rarity
-> Text
-> Int
-> Dice
-> [Aspect]
-> [Effect]
-> [(GroupName ItemKind, CStore)]
-> Text
-> ItemKind
ItemKind
  { isymbol :: ContentSymbol ItemKind
isymbol  = ContentSymbol ItemKind -> ContentSymbol ItemKind
forall c. ContentSymbol ItemKind -> ContentSymbol ItemKind
toContentSymbol ContentSymbol ItemKind
'j'
  , iname :: Text
iname    = Text
"injective jaw"
  , ifreq :: Freqs ItemKind
ifreq    = [ (GroupName ItemKind
MONSTER, Int
100), (GroupName ItemKind
MOBILE, Int
1)
               , (GroupName ItemKind
MOBILE_MONSTER, Int
100), (GroupName ItemKind
SCOUT_MONSTER, Int
60) ]
  , iflavour :: [Flavour]
iflavour = [Color] -> [Flavour]
zipFancy [Color
BrBlue]
  , icount :: Dice
icount   = Dice
1
  , irarity :: Rarity
irarity  = [(Double
3, Int
0), (Double
4, Int
6), (Double
10, Int
12)]
  , iverbHit :: Text
iverbHit = Text
"thud"
  , iweight :: Int
iweight  = Int
80000
  , idamage :: Dice
idamage  = Dice
0
  , iaspects :: [Aspect]
iaspects = [ Skill -> Dice -> Aspect
AddSkill Skill
SkMaxHP Dice
5, Skill -> Dice -> Aspect
AddSkill Skill
SkMaxCalm Dice
70
               , Skill -> Dice -> Aspect
AddSkill Skill
SkSpeed Dice
30, Skill -> Dice -> Aspect
AddSkill Skill
SkNocto Dice
2
               , Skill -> Dice -> Aspect
AddSkill Skill
SkAggression Dice
1
               , Flag -> Aspect
SetFlag Flag
Durable ]
  , ieffects :: [Effect]
ieffects = []
  , idesc :: Text
idesc    = Text
"Hungers but never eats. Bites but never swallows. Burrows its own image through, but never carries anything back."  -- rather weak: not about injective objects, but puny, concrete, injective functions  --- where's the madness in that?
  , ikit :: [(GroupName ItemKind, CStore)]
ikit     = [ (GroupName ItemKind
S_TOOTH, CStore
COrgan), (GroupName ItemKind
S_LIP, CStore
COrgan)  -- at least one non-timed
               , (GroupName ItemKind
S_SPEED_GLAND_10, CStore
COrgan)
               , (GroupName ItemKind
S_VISION_6, CStore
COrgan), (GroupName ItemKind
S_EAR_3, CStore
COrgan)
               , (GroupName ItemKind
S_SAPIENT_BRAIN, CStore
COrgan) ]
  }
nose :: ItemKind
nose = ItemKind :: ContentSymbol ItemKind
-> Text
-> Freqs ItemKind
-> [Flavour]
-> Dice
-> Rarity
-> Text
-> Int
-> Dice
-> [Aspect]
-> [Effect]
-> [(GroupName ItemKind, CStore)]
-> Text
-> ItemKind
ItemKind  -- depends solely on smell
  { isymbol :: ContentSymbol ItemKind
isymbol  = ContentSymbol ItemKind -> ContentSymbol ItemKind
forall c. ContentSymbol ItemKind -> ContentSymbol ItemKind
toContentSymbol ContentSymbol ItemKind
'n'
  , iname :: Text
iname    = Text
"point-free nose"
  , ifreq :: Freqs ItemKind
ifreq    = [(GroupName ItemKind
MONSTER, Int
100), (GroupName ItemKind
MOBILE, Int
1), (GroupName ItemKind
MOBILE_MONSTER, Int
100)]
  , iflavour :: [Flavour]
iflavour = [Color] -> [Flavour]
zipFancy [Color
BrGreen]
  , icount :: Dice
icount   = Dice
1
  , irarity :: Rarity
irarity  = [(Double
3, Int
0), (Double
4, Int
5), (Double
10, Int
7)]
  , iverbHit :: Text
iverbHit = Text
"thud"
  , iweight :: Int
iweight  = Int
80000
  , idamage :: Dice
idamage  = Dice
0
  , iaspects :: [Aspect]
iaspects = [ Skill -> Dice -> Aspect
AddSkill Skill
SkMaxHP Dice
30, Skill -> Dice -> Aspect
AddSkill Skill
SkMaxCalm Dice
30
               , Skill -> Dice -> Aspect
AddSkill Skill
SkSpeed Dice
18, Skill -> Dice -> Aspect
AddSkill Skill
SkNocto Dice
2
               , Skill -> Dice -> Aspect
AddSkill Skill
SkAggression Dice
1
               , Skill -> Dice -> Aspect
AddSkill Skill
SkProject (-Dice
1)  -- can't project
               , Flag -> Aspect
SetFlag Flag
Durable ]
  , ieffects :: [Effect]
ieffects = []
  , idesc :: Text
idesc    = Text
"No mouth, yet it devours everything around, constantly sniffing itself inward; pure movement structure, no constant point to focus one's maddened gaze on."
  , ikit :: [(GroupName ItemKind, CStore)]
ikit     = [ (GroupName ItemKind
S_TIP, CStore
COrgan), (GroupName ItemKind
S_LIP, CStore
COrgan)  -- at least one non-timed
               , (GroupName ItemKind
S_NOSTRIL, CStore
COrgan)
               , (GroupName ItemKind
S_SAPIENT_BRAIN, CStore
COrgan) ]  -- no sight nor hearing
  }
elbow :: ItemKind
elbow = ItemKind :: ContentSymbol ItemKind
-> Text
-> Freqs ItemKind
-> [Flavour]
-> Dice
-> Rarity
-> Text
-> Int
-> Dice
-> [Aspect]
-> [Effect]
-> [(GroupName ItemKind, CStore)]
-> Text
-> ItemKind
ItemKind
  { isymbol :: ContentSymbol ItemKind
isymbol  = ContentSymbol ItemKind -> ContentSymbol ItemKind
forall c. ContentSymbol ItemKind -> ContentSymbol ItemKind
toContentSymbol ContentSymbol ItemKind
'e'
  , iname :: Text
iname    = Text
"commutative elbow"
  , ifreq :: Freqs ItemKind
ifreq    = [ (GroupName ItemKind
MONSTER, Int
100), (GroupName ItemKind
MOBILE, Int
1)
               , (GroupName ItemKind
MOBILE_MONSTER, Int
100), (GroupName ItemKind
SCOUT_MONSTER, Int
30) ]
  , iflavour :: [Flavour]
iflavour = [Color] -> [Flavour]
zipFancy [Color
BrMagenta]
  , icount :: Dice
icount   = Dice
1
  , irarity :: Rarity
irarity  = [(Double
3, Int
0), (Double
4, Int
1), (Double
10, Int
12)]
  , iverbHit :: Text
iverbHit = Text
"thud"
  , iweight :: Int
iweight  = Int
80000
  , idamage :: Dice
idamage  = Dice
0
  , iaspects :: [Aspect]
iaspects = [ Skill -> Dice -> Aspect
AddSkill Skill
SkMaxHP Dice
8, Skill -> Dice -> Aspect
AddSkill Skill
SkMaxCalm Dice
80
               , Skill -> Dice -> Aspect
AddSkill Skill
SkSpeed Dice
20, Skill -> Dice -> Aspect
AddSkill Skill
SkNocto Dice
2
               , Skill -> Dice -> Aspect
AddSkill Skill
SkProject Dice
2  -- can lob
               , Skill -> Dice -> Aspect
AddSkill Skill
SkApply Dice
1  -- can even use cultural artifacts
               , Skill -> Dice -> Aspect
AddSkill Skill
SkMelee (-Dice
1)
               , Flag -> Aspect
SetFlag Flag
Durable ]
  , ieffects :: [Effect]
ieffects = []
  , idesc :: Text
idesc    = Text
"An arm strung like a bow. A few edges, but none keen enough. A few points, but none piercing. Deadly objects zip out of the void."
  , ikit :: [(GroupName ItemKind, CStore)]
ikit     = [ (GroupName ItemKind
S_SPEED_GLAND_5, CStore
COrgan), (GroupName ItemKind
S_BARK, CStore
COrgan)
               , (GroupName ItemKind
S_VISION_12, CStore
COrgan), (GroupName ItemKind
S_EAR_8, CStore
COrgan)
                   -- too powerful to get stronger sight
               , (GroupName ItemKind
S_SAPIENT_BRAIN, CStore
COrgan)
               , (GroupName ItemKind
ANY_ARROW, CStore
CStash), (GroupName ItemKind
ANY_ARROW, CStore
CStash)
               , (GroupName ItemKind
WEAK_ARROW, CStore
CStash), (GroupName ItemKind
WEAK_ARROW, CStore
CStash) ]
  }
torsor :: ItemKind
torsor = ItemKind :: ContentSymbol ItemKind
-> Text
-> Freqs ItemKind
-> [Flavour]
-> Dice
-> Rarity
-> Text
-> Int
-> Dice
-> [Aspect]
-> [Effect]
-> [(GroupName ItemKind, CStore)]
-> Text
-> ItemKind
ItemKind
  { isymbol :: ContentSymbol ItemKind
isymbol  = ContentSymbol ItemKind -> ContentSymbol ItemKind
forall c. ContentSymbol ItemKind -> ContentSymbol ItemKind
toContentSymbol ContentSymbol ItemKind
'T'
  , iname :: Text
iname    = Text
"The Forgetful Torsor"
  , ifreq :: Freqs ItemKind
ifreq    = [(GroupName ItemKind
MONSTER, Int
100), (GroupName ItemKind
MOBILE, Int
1)]
  , iflavour :: [Flavour]
iflavour = [Color] -> [Flavour]
zipFancy [Color
BrCyan]
  , icount :: Dice
icount   = Dice
1
  , irarity :: Rarity
irarity  = [(Double
9, Int
0), (Double
10, Int
1000)]  -- unique
  , iverbHit :: Text
iverbHit = Text
"thud"
  , iweight :: Int
iweight  = Int
80000
  , idamage :: Dice
idamage  = Dice
0
  , iaspects :: [Aspect]
iaspects = [ Flag -> Aspect
SetFlag Flag
Unique
               , Skill -> Dice -> Aspect
AddSkill Skill
SkMaxHP Dice
300, Skill -> Dice -> Aspect
AddSkill Skill
SkMaxCalm Dice
100
               , Skill -> Dice -> Aspect
AddSkill Skill
SkSpeed Dice
15, Skill -> Dice -> Aspect
AddSkill Skill
SkNocto Dice
2
               , Skill -> Dice -> Aspect
AddSkill Skill
SkAggression Dice
3
               , Skill -> Dice -> Aspect
AddSkill Skill
SkProject Dice
2  -- can lob
               , Skill -> Dice -> Aspect
AddSkill Skill
SkApply Dice
1  -- can even use cultural artifacts
               , Skill -> Dice -> Aspect
AddSkill Skill
SkAlter (-Dice
1)  -- can't exit the gated level; a boss,
                                        -- but can dig rubble, ice
               , Flag -> Aspect
SetFlag Flag
Durable ]
  , ieffects :: [Effect]
ieffects = []
  , idesc :: Text
idesc    = Text
"A principal homogeneous manifold, that acts freely and with enormous force, but whose stabilizers are trivial, making it rather helpless without a support group."
  , ikit :: [(GroupName ItemKind, CStore)]
ikit     = [ (GroupName ItemKind
S_RIGHT_TORSION, CStore
COrgan), (GroupName ItemKind
S_LEFT_TORSION, CStore
COrgan)
               , (GroupName ItemKind
S_PUPIL, CStore
COrgan)
               , (GroupName ItemKind
S_TENTACLE, CStore
COrgan)  -- low timeout, so rarely a stall
               , (GroupName ItemKind
S_EAR_8, CStore
COrgan)
               , (GroupName ItemKind
S_SAPIENT_BRAIN, CStore
COrgan)
               , (GroupName ItemKind
GEM, CStore
CStash), (GroupName ItemKind
GEM, CStore
CStash)
               , (GroupName ItemKind
GEM, CStore
CStash), (GroupName ItemKind
GEM, CStore
CStash) ]
  }
-- "ground x" --- for immovable monster that can only tele or prob travel
-- pullback
-- skeletal

-- * Animals

-- They need rather strong melee, because they don't use items.
-- They have dull colors, except for yellow, because there is no dull variant.

goldenJackal :: ItemKind
goldenJackal = ItemKind :: ContentSymbol ItemKind
-> Text
-> Freqs ItemKind
-> [Flavour]
-> Dice
-> Rarity
-> Text
-> Int
-> Dice
-> [Aspect]
-> [Effect]
-> [(GroupName ItemKind, CStore)]
-> Text
-> ItemKind
ItemKind  -- basically a much smaller, slower and nosy hyena
  { isymbol :: ContentSymbol ItemKind
isymbol  = ContentSymbol ItemKind -> ContentSymbol ItemKind
forall c. ContentSymbol ItemKind -> ContentSymbol ItemKind
toContentSymbol ContentSymbol ItemKind
'j'
  , iname :: Text
iname    = Text
"golden jackal"
  , ifreq :: Freqs ItemKind
ifreq    = [ (GroupName ItemKind
ANIMAL, Int
100), (GroupName ItemKind
MOBILE, Int
1), (GroupName ItemKind
MOBILE_ANIMAL, Int
100)
               , (GroupName ItemKind
SCAVENGER, Int
50) ]
  , iflavour :: [Flavour]
iflavour = [Color] -> [Flavour]
zipPlain [Color
BrYellow]
  , icount :: Dice
icount   = Dice
1
  , irarity :: Rarity
irarity  = [(Double
1, Int
4), (Double
10, Int
2)]
  , iverbHit :: Text
iverbHit = Text
"thud"
  , iweight :: Int
iweight  = Int
13000
  , idamage :: Dice
idamage  = Dice
0
  , iaspects :: [Aspect]
iaspects = [ Skill -> Dice -> Aspect
AddSkill Skill
SkMaxHP Dice
15, Skill -> Dice -> Aspect
AddSkill Skill
SkMaxCalm Dice
70
               , Skill -> Dice -> Aspect
AddSkill Skill
SkSpeed Dice
24, Skill -> Dice -> Aspect
AddSkill Skill
SkNocto Dice
2
               , Skill -> Dice -> Aspect
AddSkill Skill
SkAggression Dice
2  -- scout
               , Skill -> Dice -> Aspect
AddSkill Skill
SkDisplace Dice
1  -- scout
               , Flag -> Aspect
SetFlag Flag
Durable ]
  , ieffects :: [Effect]
ieffects = []
  , idesc :: Text
idesc    = Text
"An opportunistic predator, feeding on carrion and the weak."
  , ikit :: [(GroupName ItemKind, CStore)]
ikit     = [ (GroupName ItemKind
S_SMALL_JAW, CStore
COrgan)
               , (GroupName ItemKind
S_EYE_6, CStore
COrgan), (GroupName ItemKind
S_NOSTRIL, CStore
COrgan), (GroupName ItemKind
S_EAR_8, CStore
COrgan)
               , (GroupName ItemKind
S_ANIMAL_BRAIN, CStore
COrgan) ]
  }
griffonVulture :: ItemKind
griffonVulture = ItemKind :: ContentSymbol ItemKind
-> Text
-> Freqs ItemKind
-> [Flavour]
-> Dice
-> Rarity
-> Text
-> Int
-> Dice
-> [Aspect]
-> [Effect]
-> [(GroupName ItemKind, CStore)]
-> Text
-> ItemKind
ItemKind  -- keep it boring and weak, because it summons
  { isymbol :: ContentSymbol ItemKind
isymbol  = ContentSymbol ItemKind -> ContentSymbol ItemKind
forall c. ContentSymbol ItemKind -> ContentSymbol ItemKind
toContentSymbol ContentSymbol ItemKind
'v'
  , iname :: Text
iname    = Text
"griffon vulture"
  , ifreq :: Freqs ItemKind
ifreq    = [ (GroupName ItemKind
ANIMAL, Int
100), (GroupName ItemKind
MOBILE, Int
1), (GroupName ItemKind
MOBILE_ANIMAL, Int
100)
               , (GroupName ItemKind
SCAVENGER, Int
30) ]
  , iflavour :: [Flavour]
iflavour = [Color] -> [Flavour]
zipPlain [Color
BrYellow]
  , icount :: Dice
icount   = Dice
1
  , irarity :: Rarity
irarity  = [(Double
1, Int
3), (Double
10, Int
3)]
  , iverbHit :: Text
iverbHit = Text
"thud"
  , iweight :: Int
iweight  = Int
13000
  , idamage :: Dice
idamage  = Dice
0
  , iaspects :: [Aspect]
iaspects = [ Skill -> Dice -> Aspect
AddSkill Skill
SkMaxHP Dice
15, Skill -> Dice -> Aspect
AddSkill Skill
SkMaxCalm Dice
80
                   -- enough Calm to summon twice only if not attacked at all;
                   -- loses a lot of sight after summoning
               , Skill -> Dice -> Aspect
AddSkill Skill
SkSpeed Dice
22, Skill -> Dice -> Aspect
AddSkill Skill
SkNocto Dice
2
               , Skill -> Dice -> Aspect
AddSkill Skill
SkAlter (-Dice
2)  -- can't use hard stairs nor doors
               , Skill -> Dice -> Aspect
AddSkill Skill
SkFlying Dice
10  -- flies slowly, but far
               , Flag -> Aspect
SetFlag Flag
Durable ]
      -- Animals don't have leader, usually, so even if only one on level,
      -- it pays the communication overhead, so the speed is higher to get
      -- them on par with human leaders moving solo.
  , ieffects :: [Effect]
ieffects = []
  , idesc :: Text
idesc    = Text
"It soars high above, searching for vulnerable prey."
  , ikit :: [(GroupName ItemKind, CStore)]
ikit     = [ (GroupName ItemKind
S_SCREECHING_BEAK, CStore
COrgan)  -- in reality it grunts and hisses
               , (GroupName ItemKind
S_SMALL_CLAW, CStore
COrgan)
               , (GroupName ItemKind
S_EYE_8, CStore
COrgan), (GroupName ItemKind
S_EAR_8, CStore
COrgan)
                   -- can't shoot, so strong sight is OK
               , (GroupName ItemKind
S_ANIMAL_BRAIN, CStore
COrgan) ]
  }
skunk :: ItemKind
skunk = ItemKind :: ContentSymbol ItemKind
-> Text
-> Freqs ItemKind
-> [Flavour]
-> Dice
-> Rarity
-> Text
-> Int
-> Dice
-> [Aspect]
-> [Effect]
-> [(GroupName ItemKind, CStore)]
-> Text
-> ItemKind
ItemKind
  { isymbol :: ContentSymbol ItemKind
isymbol  = ContentSymbol ItemKind -> ContentSymbol ItemKind
forall c. ContentSymbol ItemKind -> ContentSymbol ItemKind
toContentSymbol ContentSymbol ItemKind
's'
  , iname :: Text
iname    = Text
"hog-nosed skunk"
  , ifreq :: Freqs ItemKind
ifreq    = [(GroupName ItemKind
ANIMAL, Int
100), (GroupName ItemKind
MOBILE, Int
1), (GroupName ItemKind
MOBILE_ANIMAL, Int
100)]
  , iflavour :: [Flavour]
iflavour = [Color] -> [Flavour]
zipPlain [Color
White]
  , icount :: Dice
icount   = Dice
1
  , irarity :: Rarity
irarity  = [(Double
1, Int
8), (Double
5, Int
1)]
  , iverbHit :: Text
iverbHit = Text
"thud"
  , iweight :: Int
iweight  = Int
4000
  , idamage :: Dice
idamage  = Dice
0
  , iaspects :: [Aspect]
iaspects = [ Skill -> Dice -> Aspect
AddSkill Skill
SkMaxHP Dice
13, Skill -> Dice -> Aspect
AddSkill Skill
SkMaxCalm Dice
30
               , Skill -> Dice -> Aspect
AddSkill Skill
SkSpeed Dice
22, Skill -> Dice -> Aspect
AddSkill Skill
SkNocto Dice
2
               , Skill -> Dice -> Aspect
AddSkill Skill
SkAlter (-Dice
2)  -- can't use hard stairs nor doors
               , Skill -> Dice -> Aspect
AddSkill Skill
SkOdor Dice
5  -- and no smell skill, to let it leave smell
               , Flag -> Aspect
SetFlag Flag
Durable ]
  , ieffects :: [Effect]
ieffects = []
  , idesc :: Text
idesc    = Text
"Its only defence is the terrible stench."
  , ikit :: [(GroupName ItemKind, CStore)]
ikit     = [ (GroupName ItemKind
S_SCENT_GLAND, CStore
COrgan)
               , (GroupName ItemKind
S_SMALL_CLAW, CStore
COrgan), (GroupName ItemKind
S_SNOUT, CStore
COrgan)
               , (GroupName ItemKind
S_EYE_3, CStore
COrgan), (GroupName ItemKind
S_EAR_6, CStore
COrgan)
               , (GroupName ItemKind
S_ANIMAL_BRAIN, CStore
COrgan) ]
  }
armadillo :: ItemKind
armadillo = ItemKind :: ContentSymbol ItemKind
-> Text
-> Freqs ItemKind
-> [Flavour]
-> Dice
-> Rarity
-> Text
-> Int
-> Dice
-> [Aspect]
-> [Effect]
-> [(GroupName ItemKind, CStore)]
-> Text
-> ItemKind
ItemKind
  { isymbol :: ContentSymbol ItemKind
isymbol  = ContentSymbol ItemKind -> ContentSymbol ItemKind
forall c. ContentSymbol ItemKind -> ContentSymbol ItemKind
toContentSymbol ContentSymbol ItemKind
'a'
  , iname :: Text
iname    = Text
"giant armadillo"
  , ifreq :: Freqs ItemKind
ifreq    = [(GroupName ItemKind
ANIMAL, Int
100), (GroupName ItemKind
MOBILE, Int
1), (GroupName ItemKind
MOBILE_ANIMAL, Int
100)]
  , iflavour :: [Flavour]
iflavour = [Color] -> [Flavour]
zipPlain [Color
Brown]
  , icount :: Dice
icount   = Dice
1
  , irarity :: Rarity
irarity  = [(Double
1, Int
7)]
  , iverbHit :: Text
iverbHit = Text
"thud"
  , iweight :: Int
iweight  = Int
54000
  , idamage :: Dice
idamage  = Dice
0
  , iaspects :: [Aspect]
iaspects = [ Skill -> Dice -> Aspect
AddSkill Skill
SkMaxHP Dice
25, Skill -> Dice -> Aspect
AddSkill Skill
SkMaxCalm Dice
30
               , Skill -> Dice -> Aspect
AddSkill Skill
SkSpeed Dice
20, Skill -> Dice -> Aspect
AddSkill Skill
SkNocto Dice
2
               , Skill -> Dice -> Aspect
AddSkill Skill
SkHurtMelee (-Dice
70)  -- quite harmless rolled in a ball
               , Skill -> Dice -> Aspect
AddSkill Skill
SkAlter (-Dice
2)  -- can't use hard stairs nor doors
               , Flag -> Aspect
SetFlag Flag
Durable ]
  , ieffects :: [Effect]
ieffects = []
  , idesc :: Text
idesc    = Text
"When threatened, it rolls into a ball."
  , ikit :: [(GroupName ItemKind, CStore)]
ikit     = [ (GroupName ItemKind
S_HOOKED_CLAW, CStore
COrgan), (GroupName ItemKind
S_SNOUT, CStore
COrgan)
               , (GroupName ItemKind
S_ARMORED_SKIN, CStore
COrgan), (GroupName ItemKind
S_ARMORED_SKIN, CStore
COrgan)
               , (GroupName ItemKind
S_EYE_3, CStore
COrgan), (GroupName ItemKind
S_NOSTRIL, CStore
COrgan), (GroupName ItemKind
S_EAR_6, CStore
COrgan)
               , (GroupName ItemKind
S_ANIMAL_BRAIN, CStore
COrgan) ]
  }
gilaMonster :: ItemKind
gilaMonster = ItemKind :: ContentSymbol ItemKind
-> Text
-> Freqs ItemKind
-> [Flavour]
-> Dice
-> Rarity
-> Text
-> Int
-> Dice
-> [Aspect]
-> [Effect]
-> [(GroupName ItemKind, CStore)]
-> Text
-> ItemKind
ItemKind
  { isymbol :: ContentSymbol ItemKind
isymbol  = ContentSymbol ItemKind -> ContentSymbol ItemKind
forall c. ContentSymbol ItemKind -> ContentSymbol ItemKind
toContentSymbol ContentSymbol ItemKind
'g'
  , iname :: Text
iname    = Text
"Gila monster"
  , ifreq :: Freqs ItemKind
ifreq    = [(GroupName ItemKind
ANIMAL, Int
100), (GroupName ItemKind
MOBILE, Int
1), (GroupName ItemKind
MOBILE_ANIMAL, Int
100)]
  , iflavour :: [Flavour]
iflavour = [Color] -> [Flavour]
zipPlain [Color
Magenta]
  , icount :: Dice
icount   = Dice
1
  , irarity :: Rarity
irarity  = [(Double
2, Int
5), (Double
10, Int
2)]
  , iverbHit :: Text
iverbHit = Text
"thud"
  , iweight :: Int
iweight  = Int
80000
  , idamage :: Dice
idamage  = Dice
0
  , iaspects :: [Aspect]
iaspects = [ Skill -> Dice -> Aspect
AddSkill Skill
SkMaxHP Dice
15, Skill -> Dice -> Aspect
AddSkill Skill
SkMaxCalm Dice
50
               , Skill -> Dice -> Aspect
AddSkill Skill
SkSpeed Dice
18, Skill -> Dice -> Aspect
AddSkill Skill
SkNocto Dice
2
               , Skill -> Dice -> Aspect
AddSkill Skill
SkAlter (-Dice
2)  -- can't use hard stairs nor doors
               , Flag -> Aspect
SetFlag Flag
Durable ]
  , ieffects :: [Effect]
ieffects = []
  , idesc :: Text
idesc    = Text
"Numbing venom ensures that even the fastest prey has no escape."
  , ikit :: [(GroupName ItemKind, CStore)]
ikit     = [ (GroupName ItemKind
S_VENOM_TOOTH, CStore
COrgan), (GroupName ItemKind
S_SMALL_CLAW, CStore
COrgan)
               , (GroupName ItemKind
S_EYE_3, CStore
COrgan), (GroupName ItemKind
S_NOSTRIL, CStore
COrgan), (GroupName ItemKind
S_EAR_6, CStore
COrgan)
               , (GroupName ItemKind
S_ANIMAL_BRAIN, CStore
COrgan) ]
  }
rattlesnake :: ItemKind
rattlesnake = ItemKind :: ContentSymbol ItemKind
-> Text
-> Freqs ItemKind
-> [Flavour]
-> Dice
-> Rarity
-> Text
-> Int
-> Dice
-> [Aspect]
-> [Effect]
-> [(GroupName ItemKind, CStore)]
-> Text
-> ItemKind
ItemKind
  { isymbol :: ContentSymbol ItemKind
isymbol  = ContentSymbol ItemKind -> ContentSymbol ItemKind
forall c. ContentSymbol ItemKind -> ContentSymbol ItemKind
toContentSymbol ContentSymbol ItemKind
's'
  , iname :: Text
iname    = Text
"rattlesnake"
  , ifreq :: Freqs ItemKind
ifreq    = [(GroupName ItemKind
ANIMAL, Int
100), (GroupName ItemKind
MOBILE, Int
1), (GroupName ItemKind
MOBILE_ANIMAL, Int
100)]
  , iflavour :: [Flavour]
iflavour = [Color] -> [Flavour]
zipPlain [Color
Brown]
  , icount :: Dice
icount   = Dice
1
  , irarity :: Rarity
irarity  = [(Double
5, Int
1), (Double
10, Int
7), (Double
20, Int
10)]  -- common among late spawns
  , iverbHit :: Text
iverbHit = Text
"thud"
  , iweight :: Int
iweight  = Int
80000
  , idamage :: Dice
idamage  = Dice
0
  , iaspects :: [Aspect]
iaspects = [ Skill -> Dice -> Aspect
AddSkill Skill
SkMaxHP Dice
28, Skill -> Dice -> Aspect
AddSkill Skill
SkMaxCalm Dice
60
               , Skill -> Dice -> Aspect
AddSkill Skill
SkSpeed Dice
16, Skill -> Dice -> Aspect
AddSkill Skill
SkNocto Dice
2
               , Skill -> Dice -> Aspect
AddSkill Skill
SkAggression Dice
2  -- often discharged. so flees anyway
               , Skill -> Dice -> Aspect
AddSkill Skill
SkAlter (-Dice
2)  -- can't use hard stairs nor doors
               , Flag -> Aspect
SetFlag Flag
Durable ]
  , ieffects :: [Effect]
ieffects = []
  , idesc :: Text
idesc    = Text
"Beware its rattle - it serves as a warning of an agonising death."
  , ikit :: [(GroupName ItemKind, CStore)]
ikit     = [ (GroupName ItemKind
S_VENOM_FANG, CStore
COrgan)  -- when discharged, it's weaponless
               , (GroupName ItemKind
S_RATLLE, CStore
COrgan)
               , (GroupName ItemKind
S_EYE_3, CStore
COrgan), (GroupName ItemKind
S_NOSTRIL, CStore
COrgan), (GroupName ItemKind
S_EAR_6, CStore
COrgan)
               , (GroupName ItemKind
S_ANIMAL_BRAIN, CStore
COrgan) ]
  }
hyena :: ItemKind
hyena = ItemKind :: ContentSymbol ItemKind
-> Text
-> Freqs ItemKind
-> [Flavour]
-> Dice
-> Rarity
-> Text
-> Int
-> Dice
-> [Aspect]
-> [Effect]
-> [(GroupName ItemKind, CStore)]
-> Text
-> ItemKind
ItemKind
  { isymbol :: ContentSymbol ItemKind
isymbol  = ContentSymbol ItemKind -> ContentSymbol ItemKind
forall c. ContentSymbol ItemKind -> ContentSymbol ItemKind
toContentSymbol ContentSymbol ItemKind
'h'
  , iname :: Text
iname    = Text
"spotted hyena"
  , ifreq :: Freqs ItemKind
ifreq    = [ (GroupName ItemKind
ANIMAL, Int
100), (GroupName ItemKind
MOBILE, Int
1), (GroupName ItemKind
MOBILE_ANIMAL, Int
100)
               , (GroupName ItemKind
SCAVENGER, Int
20) ]
  , iflavour :: [Flavour]
iflavour = [Color] -> [Flavour]
zipPlain [Color
BrYellow]
  , icount :: Dice
icount   = Dice
1
  , irarity :: Rarity
irarity  = [(Double
4, Int
1), (Double
10, Int
5), (Double
20, Int
10)]
      -- gets summoned often, so low base rarity, except among late spawns
  , iverbHit :: Text
iverbHit = Text
"thud"
  , iweight :: Int
iweight  = Int
60000
  , idamage :: Dice
idamage  = Dice
0
  , iaspects :: [Aspect]
iaspects = [ Skill -> Dice -> Aspect
AddSkill Skill
SkMaxHP Dice
23, Skill -> Dice -> Aspect
AddSkill Skill
SkMaxCalm Dice
70
               , Skill -> Dice -> Aspect
AddSkill Skill
SkSpeed Dice
32, Skill -> Dice -> Aspect
AddSkill Skill
SkNocto Dice
2
               , Flag -> Aspect
SetFlag Flag
Durable ]
  , ieffects :: [Effect]
ieffects = []
  , idesc :: Text
idesc    = Text
"Skulking in the shadows, waiting for easy prey."
  , ikit :: [(GroupName ItemKind, CStore)]
ikit     = [ (GroupName ItemKind
S_JAW, CStore
COrgan), (GroupName ItemKind
S_SMALL_CLAW, CStore
COrgan)
               , (GroupName ItemKind
S_EYE_6, CStore
COrgan), (GroupName ItemKind
S_NOSTRIL, CStore
COrgan), (GroupName ItemKind
S_EAR_8, CStore
COrgan)
               , (GroupName ItemKind
S_ANIMAL_BRAIN, CStore
COrgan) ]
  }
komodoDragon :: ItemKind
komodoDragon = ItemKind :: ContentSymbol ItemKind
-> Text
-> Freqs ItemKind
-> [Flavour]
-> Dice
-> Rarity
-> Text
-> Int
-> Dice
-> [Aspect]
-> [Effect]
-> [(GroupName ItemKind, CStore)]
-> Text
-> ItemKind
ItemKind
  { isymbol :: ContentSymbol ItemKind
isymbol  = ContentSymbol ItemKind -> ContentSymbol ItemKind
forall c. ContentSymbol ItemKind -> ContentSymbol ItemKind
toContentSymbol ContentSymbol ItemKind
'k'
  , iname :: Text
iname    = Text
"Komodo dragon"
  , ifreq :: Freqs ItemKind
ifreq    = [(GroupName ItemKind
ANIMAL, Int
100), (GroupName ItemKind
MOBILE, Int
1), (GroupName ItemKind
MOBILE_ANIMAL, Int
100)]
  , iflavour :: [Flavour]
iflavour = [Color] -> [Flavour]
zipPlain [Color
BrRed]  -- speedy, so bright red
  , icount :: Dice
icount   = Dice
1
  , irarity :: Rarity
irarity  = [(Double
9, Int
0), (Double
10, Int
11), (Double
20, Int
20)]
  , iverbHit :: Text
iverbHit = Text
"thud"
  , iweight :: Int
iweight  = Int
80000
  , idamage :: Dice
idamage  = Dice
0
  , iaspects :: [Aspect]
iaspects = [ Skill -> Dice -> Aspect
AddSkill Skill
SkMaxHP Dice
40, Skill -> Dice -> Aspect
AddSkill Skill
SkMaxCalm Dice
60  -- regens
               , Skill -> Dice -> Aspect
AddSkill Skill
SkSpeed Dice
17, Skill -> Dice -> Aspect
AddSkill Skill
SkNocto Dice
2
               , Skill -> Dice -> Aspect
AddSkill Skill
SkHurtMelee Dice
60  -- great fighter with low cooldowns
               , Skill -> Dice -> Aspect
AddSkill Skill
SkAggression Dice
1  -- match the description
               , Flag -> Aspect
SetFlag Flag
Durable ]
  , ieffects :: [Effect]
ieffects = []
  , idesc :: Text
idesc    = Text
"Larger and more aggressive than any other lizard, but as easily recovering from wounds as its lesser cousins."
  , ikit :: [(GroupName ItemKind, CStore)]
ikit     = [ (GroupName ItemKind
S_LARGE_TAIL, CStore
COrgan), (GroupName ItemKind
S_JAW, CStore
COrgan)
               , (GroupName ItemKind
S_LIP, CStore
COrgan), (GroupName ItemKind
S_FOOT, CStore
COrgan)
               , (GroupName ItemKind
S_SPEED_GLAND_5, CStore
COrgan), (GroupName ItemKind
S_ARMORED_SKIN, CStore
COrgan)
               , (GroupName ItemKind
S_EYE_3, CStore
COrgan), (GroupName ItemKind
S_NOSTRIL, CStore
COrgan), (GroupName ItemKind
S_EAR_3, CStore
COrgan)
               , (GroupName ItemKind
S_ANIMAL_BRAIN, CStore
COrgan) ]
  }
alligator :: ItemKind
alligator = ItemKind :: ContentSymbol ItemKind
-> Text
-> Freqs ItemKind
-> [Flavour]
-> Dice
-> Rarity
-> Text
-> Int
-> Dice
-> [Aspect]
-> [Effect]
-> [(GroupName ItemKind, CStore)]
-> Text
-> ItemKind
ItemKind  -- late, slow, deadly semi-tank with some armor;
                      -- too deadly to get more HP; bombs the only recourse
  { isymbol :: ContentSymbol ItemKind
isymbol  = ContentSymbol ItemKind -> ContentSymbol ItemKind
forall c. ContentSymbol ItemKind -> ContentSymbol ItemKind
toContentSymbol ContentSymbol ItemKind
'a'
  , iname :: Text
iname    = Text
"alligator"
  , ifreq :: Freqs ItemKind
ifreq    = [(GroupName ItemKind
ANIMAL, Int
100), (GroupName ItemKind
MOBILE, Int
1), (GroupName ItemKind
MOBILE_ANIMAL, Int
100)]
  , iflavour :: [Flavour]
iflavour = [Color] -> [Flavour]
zipPlain [Color
Blue]
  , icount :: Dice
icount   = Dice
1
  , irarity :: Rarity
irarity  = [(Double
9, Int
0), (Double
10, Int
12), (Double
20, Int
10), (Double
40, Int
40)]
  , iverbHit :: Text
iverbHit = Text
"thud"
  , iweight :: Int
iweight  = Int
80000
  , idamage :: Dice
idamage  = Dice
0
  , iaspects :: [Aspect]
iaspects = [ Skill -> Dice -> Aspect
AddSkill Skill
SkMaxHP Dice
55, Skill -> Dice -> Aspect
AddSkill Skill
SkMaxCalm Dice
70
               , Skill -> Dice -> Aspect
AddSkill Skill
SkSpeed Dice
18, Skill -> Dice -> Aspect
AddSkill Skill
SkNocto Dice
2
               , Skill -> Dice -> Aspect
AddSkill Skill
SkSwimming Dice
100  -- swims better than walks
               , Flag -> Aspect
SetFlag Flag
Durable ]
  , ieffects :: [Effect]
ieffects = []
  , idesc :: Text
idesc    = Text
"An armored predator from the dawn of time. You better not get within its reach."
  , ikit :: [(GroupName ItemKind, CStore)]
ikit     = [ (GroupName ItemKind
S_HUGE_TAIL, CStore
COrgan)  -- the special trick, breaking frontline
               , (GroupName ItemKind
S_LARGE_JAW, CStore
COrgan)
               , (GroupName ItemKind
S_SMALL_CLAW, CStore
COrgan)
               , (GroupName ItemKind
S_ARMORED_SKIN, CStore
COrgan)
               , (GroupName ItemKind
S_EYE_6, CStore
COrgan), (GroupName ItemKind
S_EAR_8, CStore
COrgan)
               , (GroupName ItemKind
S_ANIMAL_BRAIN, CStore
COrgan) ]
  }
rhinoceros :: ItemKind
rhinoceros = ItemKind :: ContentSymbol ItemKind
-> Text
-> Freqs ItemKind
-> [Flavour]
-> Dice
-> Rarity
-> Text
-> Int
-> Dice
-> [Aspect]
-> [Effect]
-> [(GroupName ItemKind, CStore)]
-> Text
-> ItemKind
ItemKind
  { isymbol :: ContentSymbol ItemKind
isymbol  = ContentSymbol ItemKind -> ContentSymbol ItemKind
forall c. ContentSymbol ItemKind -> ContentSymbol ItemKind
toContentSymbol ContentSymbol ItemKind
'R'
  , iname :: Text
iname    = Text
"The Maddened Rhinoceros"
  , ifreq :: Freqs ItemKind
ifreq    = [(GroupName ItemKind
ANIMAL, Int
100), (GroupName ItemKind
MOBILE, Int
1)]
  , iflavour :: [Flavour]
iflavour = [Color] -> [Flavour]
zipPlain [Color
Brown]
  , icount :: Dice
icount   = Dice
1
  , irarity :: Rarity
irarity  = [(Double
2, Int
0), (Double
3, Int
1000), (Double
4, Int
0)]  -- an early unique
  , iverbHit :: Text
iverbHit = Text
"thud"
  , iweight :: Int
iweight  = Int
80000
  , idamage :: Dice
idamage  = Dice
0
  , iaspects :: [Aspect]
iaspects = [ Flag -> Aspect
SetFlag Flag
Unique
               , Skill -> Dice -> Aspect
AddSkill Skill
SkMaxHP Dice
90, Skill -> Dice -> Aspect
AddSkill Skill
SkMaxCalm Dice
60
               , Skill -> Dice -> Aspect
AddSkill Skill
SkSpeed Dice
27, Skill -> Dice -> Aspect
AddSkill Skill
SkNocto Dice
2
               , Skill -> Dice -> Aspect
AddSkill Skill
SkAggression Dice
2
               , Skill -> Dice -> Aspect
AddSkill Skill
SkAlter (-Dice
1)  -- can't use hard stairs nor dig;
                                        -- a weak miniboss
               , Flag -> Aspect
SetFlag Flag
Durable ]
  , ieffects :: [Effect]
ieffects = []
  , idesc :: Text
idesc    = Text
"The last of its kind. Blind with rage. Charges at deadly speed."
  , ikit :: [(GroupName ItemKind, CStore)]
ikit     = [ (GroupName ItemKind
S_RHINO_HORN, CStore
COrgan), (GroupName ItemKind
S_SNOUT, CStore
COrgan)
               , (GroupName ItemKind
S_ARMORED_SKIN, CStore
COrgan)
               , (GroupName ItemKind
S_EYE_3, CStore
COrgan), (GroupName ItemKind
S_EAR_8, CStore
COrgan)
               , (GroupName ItemKind
S_ANIMAL_BRAIN, CStore
COrgan) ]
  }

-- * Non-animal animals

beeSwarm :: ItemKind
beeSwarm = ItemKind :: ContentSymbol ItemKind
-> Text
-> Freqs ItemKind
-> [Flavour]
-> Dice
-> Rarity
-> Text
-> Int
-> Dice
-> [Aspect]
-> [Effect]
-> [(GroupName ItemKind, CStore)]
-> Text
-> ItemKind
ItemKind
  { isymbol :: ContentSymbol ItemKind
isymbol  = ContentSymbol ItemKind -> ContentSymbol ItemKind
forall c. ContentSymbol ItemKind -> ContentSymbol ItemKind
toContentSymbol ContentSymbol ItemKind
'b'
  , iname :: Text
iname    = Text
"bee swarm"
  , ifreq :: Freqs ItemKind
ifreq    = [(GroupName ItemKind
ANIMAL, Int
100), (GroupName ItemKind
INSECT, Int
50), (GroupName ItemKind
MOBILE, Int
1)]
  , iflavour :: [Flavour]
iflavour = [Color] -> [Flavour]
zipPlain [Color
Brown]
  , icount :: Dice
icount   = Dice
1
  , irarity :: Rarity
irarity  = [(Double
1, Int
3), (Double
10, Int
4)]
  , iverbHit :: Text
iverbHit = Text
"buzz"
  , iweight :: Int
iweight  = Int
1000
  , idamage :: Dice
idamage  = Dice
0
  , iaspects :: [Aspect]
iaspects = [ Skill -> Dice -> Aspect
AddSkill Skill
SkMaxHP Dice
10, Skill -> Dice -> Aspect
AddSkill Skill
SkMaxCalm Dice
60
               , Skill -> Dice -> Aspect
AddSkill Skill
SkSpeed Dice
30, Skill -> Dice -> Aspect
AddSkill Skill
SkNocto Dice
2  -- armor in sting
               , Skill -> Dice -> Aspect
AddSkill Skill
SkAlter (-Dice
2)  -- can't use hard stairs nor doors
               , Skill -> Dice -> Aspect
AddSkill Skill
SkWait (-Dice
2)  -- can't brace, sleep and lurk
               , Skill -> Dice -> Aspect
AddSkill Skill
SkFlying Dice
10  -- flies slowly, but far
               , Flag -> Aspect
SetFlag Flag
Durable ]
  , ieffects :: [Effect]
ieffects = []
  , idesc :: Text
idesc    = Text
"Every bee would die for the queen."
  , ikit :: [(GroupName ItemKind, CStore)]
ikit     = [ (GroupName ItemKind
S_BEE_STING, CStore
COrgan)  -- weaponless when it's used up
               , (GroupName ItemKind
S_VISION_6, CStore
COrgan), (GroupName ItemKind
S_EAR_6, CStore
COrgan)
               , (GroupName ItemKind
S_INSECT_MORTALITY, CStore
COrgan), (GroupName ItemKind
S_ANIMAL_BRAIN, CStore
COrgan) ]
  }
hornetSwarm :: ItemKind
hornetSwarm = ItemKind :: ContentSymbol ItemKind
-> Text
-> Freqs ItemKind
-> [Flavour]
-> Dice
-> Rarity
-> Text
-> Int
-> Dice
-> [Aspect]
-> [Effect]
-> [(GroupName ItemKind, CStore)]
-> Text
-> ItemKind
ItemKind  -- kind of tank with armor, but short-lived
  { isymbol :: ContentSymbol ItemKind
isymbol  = ContentSymbol ItemKind -> ContentSymbol ItemKind
forall c. ContentSymbol ItemKind -> ContentSymbol ItemKind
toContentSymbol ContentSymbol ItemKind
'h'
  , iname :: Text
iname    = Text
"hornet swarm"
  , ifreq :: Freqs ItemKind
ifreq    = [(GroupName ItemKind
ANIMAL, Int
100), (GroupName ItemKind
INSECT, Int
100), (GroupName ItemKind
MOBILE, Int
1), (GroupName ItemKind
MOBILE_ANIMAL, Int
100)]
  , iflavour :: [Flavour]
iflavour = [Color] -> [Flavour]
zipPlain [Color
Magenta]
  , icount :: Dice
icount   = Dice
1
  , irarity :: Rarity
irarity  = [(Double
5, Int
1), (Double
10, Int
4), (Double
20, Int
10)]
      -- should be many, because die after a time
  , iverbHit :: Text
iverbHit = Text
"buzz"
  , iweight :: Int
iweight  = Int
1000
  , idamage :: Dice
idamage  = Dice
0
  , iaspects :: [Aspect]
iaspects = [ Skill -> Dice -> Aspect
AddSkill Skill
SkArmorMelee Dice
80, Skill -> Dice -> Aspect
AddSkill Skill
SkArmorRanged Dice
40
               , Skill -> Dice -> Aspect
AddSkill Skill
SkHurtMelee Dice
50
               , Skill -> Dice -> Aspect
AddSkill Skill
SkMaxHP Dice
10, Skill -> Dice -> Aspect
AddSkill Skill
SkMaxCalm Dice
70
               , Skill -> Dice -> Aspect
AddSkill Skill
SkSpeed Dice
30, Skill -> Dice -> Aspect
AddSkill Skill
SkNocto Dice
2
               , Skill -> Dice -> Aspect
AddSkill Skill
SkAlter (-Dice
2)  -- can't use hard stairs nor doors
               , Skill -> Dice -> Aspect
AddSkill Skill
SkWait (-Dice
2)  -- can't brace, sleep and lurk
               , Skill -> Dice -> Aspect
AddSkill Skill
SkFlying Dice
10  -- flies slowly, but far
               , Flag -> Aspect
SetFlag Flag
Durable ]
  , ieffects :: [Effect]
ieffects = []
  , idesc :: Text
idesc    = Text
"A vicious cloud of stings and hate."
  , ikit :: [(GroupName ItemKind, CStore)]
ikit     = [ (GroupName ItemKind
S_STING, CStore
COrgan)  -- when on cooldown, it's weaponless
               , (GroupName ItemKind
S_VISION_6, CStore
COrgan), (GroupName ItemKind
S_EAR_6, CStore
COrgan)
               , (GroupName ItemKind
S_INSECT_MORTALITY, CStore
COrgan), (GroupName ItemKind
S_ANIMAL_BRAIN, CStore
COrgan) ]
  }
thornbush :: ItemKind
thornbush = ItemKind :: ContentSymbol ItemKind
-> Text
-> Freqs ItemKind
-> [Flavour]
-> Dice
-> Rarity
-> Text
-> Int
-> Dice
-> [Aspect]
-> [Effect]
-> [(GroupName ItemKind, CStore)]
-> Text
-> ItemKind
ItemKind  -- the wimpiest kind of early tank
  { isymbol :: ContentSymbol ItemKind
isymbol  = ContentSymbol ItemKind -> ContentSymbol ItemKind
forall c. ContentSymbol ItemKind -> ContentSymbol ItemKind
toContentSymbol ContentSymbol ItemKind
't'
  , iname :: Text
iname    = Text
"thornbush"
  , ifreq :: Freqs ItemKind
ifreq    = [(GroupName ItemKind
ANIMAL, Int
20), (GroupName ItemKind
IMMOBILE_ANIMAL, Int
20)]
  , iflavour :: [Flavour]
iflavour = [Color] -> [Flavour]
zipPlain [Color
Brown]
  , icount :: Dice
icount   = Dice
1
  , irarity :: Rarity
irarity  = [(Double
1, Int
13)]
  , iverbHit :: Text
iverbHit = Text
"scrape"
  , iweight :: Int
iweight  = Int
80000
  , idamage :: Dice
idamage  = Dice
0
  , iaspects :: [Aspect]
iaspects = [ Skill -> Dice -> Aspect
AddSkill Skill
SkMaxHP Dice
30, Skill -> Dice -> Aspect
AddSkill Skill
SkMaxCalm Dice
999
               , Skill -> Dice -> Aspect
AddSkill Skill
SkSpeed Dice
22, Skill -> Dice -> Aspect
AddSkill Skill
SkNocto Dice
2
               , Skill -> Dice -> Aspect
AddSkill Skill
SkWait Dice
1, Skill -> Dice -> Aspect
AddSkill Skill
SkMelee Dice
1  -- no brain
               , Flag -> Aspect
SetFlag Flag
Durable ]
  , ieffects :: [Effect]
ieffects = []
  , idesc :: Text
idesc    = Text
"Each branch bears long, curved thorns."
  , ikit :: [(GroupName ItemKind, CStore)]
ikit     = [ (GroupName ItemKind
S_THORN, CStore
COrgan)  -- after all run out, it's weaponless
               , (GroupName ItemKind
S_BARK, CStore
COrgan) ]
  }
geyserBoiling :: ItemKind
geyserBoiling = ItemKind :: ContentSymbol ItemKind
-> Text
-> Freqs ItemKind
-> [Flavour]
-> Dice
-> Rarity
-> Text
-> Int
-> Dice
-> [Aspect]
-> [Effect]
-> [(GroupName ItemKind, CStore)]
-> Text
-> ItemKind
ItemKind
  { isymbol :: ContentSymbol ItemKind
isymbol  = ContentSymbol ItemKind -> ContentSymbol ItemKind
forall c. ContentSymbol ItemKind -> ContentSymbol ItemKind
toContentSymbol ContentSymbol ItemKind
'g'
  , iname :: Text
iname    = Text
"geyser"
  , ifreq :: Freqs ItemKind
ifreq    = [(GroupName ItemKind
ANIMAL, Int
8), (GroupName ItemKind
IMMOBILE_ANIMAL, Int
30), (GroupName ItemKind
GEOPHENOMENON, Int
1)]
  , iflavour :: [Flavour]
iflavour = [Color] -> [Flavour]
zipPlain [Color
Blue]
  , icount :: Dice
icount   = Dice
1
  , irarity :: Rarity
irarity  = [(Double
1, Int
10), (Double
10, Int
6)]
  , iverbHit :: Text
iverbHit = Text
"thud"
  , iweight :: Int
iweight  = Int
80000
  , idamage :: Dice
idamage  = Dice
0
  , iaspects :: [Aspect]
iaspects = [ Skill -> Dice -> Aspect
AddSkill Skill
SkMaxHP Dice
10, Skill -> Dice -> Aspect
AddSkill Skill
SkMaxCalm Dice
999
               , Skill -> Dice -> Aspect
AddSkill Skill
SkSpeed Dice
11, Skill -> Dice -> Aspect
AddSkill Skill
SkNocto Dice
2
               , Skill -> Dice -> Aspect
AddSkill Skill
SkWait Dice
1, Skill -> Dice -> Aspect
AddSkill Skill
SkMelee Dice
1  -- no brain
               , Flag -> Aspect
SetFlag Flag
Durable ]
  , ieffects :: [Effect]
ieffects = []
  , idesc :: Text
idesc    = Text
"A jet of acidic water, hot enough to melt flesh."
  , ikit :: [(GroupName ItemKind, CStore)]
ikit     = [(GroupName ItemKind
S_BOILING_VENT, CStore
COrgan), (GroupName ItemKind
S_BOILING_FISSURE, CStore
COrgan)]
  }
geyserArsenic :: ItemKind
geyserArsenic = ItemKind :: ContentSymbol ItemKind
-> Text
-> Freqs ItemKind
-> [Flavour]
-> Dice
-> Rarity
-> Text
-> Int
-> Dice
-> [Aspect]
-> [Effect]
-> [(GroupName ItemKind, CStore)]
-> Text
-> ItemKind
ItemKind
  { isymbol :: ContentSymbol ItemKind
isymbol  = ContentSymbol ItemKind -> ContentSymbol ItemKind
forall c. ContentSymbol ItemKind -> ContentSymbol ItemKind
toContentSymbol ContentSymbol ItemKind
'g'
  , iname :: Text
iname    = Text
"arsenic geyser"
  , ifreq :: Freqs ItemKind
ifreq    = [(GroupName ItemKind
ANIMAL, Int
8), (GroupName ItemKind
IMMOBILE_ANIMAL, Int
40), (GroupName ItemKind
GEOPHENOMENON, Int
1)]
  , iflavour :: [Flavour]
iflavour = [Color] -> [Flavour]
zipPlain [Color
Cyan]
  , icount :: Dice
icount   = Dice
1
  , irarity :: Rarity
irarity  = [(Double
1, Int
10), (Double
10, Int
6)]
  , iverbHit :: Text
iverbHit = Text
"thud"
  , iweight :: Int
iweight  = Int
80000
  , idamage :: Dice
idamage  = Dice
0
  , iaspects :: [Aspect]
iaspects = [ Skill -> Dice -> Aspect
AddSkill Skill
SkMaxHP Dice
20, Skill -> Dice -> Aspect
AddSkill Skill
SkMaxCalm Dice
999
               , Skill -> Dice -> Aspect
AddSkill Skill
SkSpeed Dice
22, Skill -> Dice -> Aspect
AddSkill Skill
SkNocto Dice
2, Skill -> Dice -> Aspect
AddSkill Skill
SkShine Dice
3
               , Skill -> Dice -> Aspect
AddSkill Skill
SkWait Dice
1, Skill -> Dice -> Aspect
AddSkill Skill
SkMelee Dice
1  -- no brain
               , Flag -> Aspect
SetFlag Flag
Durable ]
  , ieffects :: [Effect]
ieffects = []
  , idesc :: Text
idesc    = Text
"The sharp scent betrays the poison within the spray."
  , ikit :: [(GroupName ItemKind, CStore)]
ikit     = [(GroupName ItemKind
S_ARSENIC_VENT, CStore
COrgan), (GroupName ItemKind
S_ARSENIC_FISSURE, CStore
COrgan)]
  }
geyserSulfur :: ItemKind
geyserSulfur = ItemKind :: ContentSymbol ItemKind
-> Text
-> Freqs ItemKind
-> [Flavour]
-> Dice
-> Rarity
-> Text
-> Int
-> Dice
-> [Aspect]
-> [Effect]
-> [(GroupName ItemKind, CStore)]
-> Text
-> ItemKind
ItemKind
  { isymbol :: ContentSymbol ItemKind
isymbol  = ContentSymbol ItemKind -> ContentSymbol ItemKind
forall c. ContentSymbol ItemKind -> ContentSymbol ItemKind
toContentSymbol ContentSymbol ItemKind
'g'
  , iname :: Text
iname    = Text
"sulfur geyser"
  , ifreq :: Freqs ItemKind
ifreq    = [(GroupName ItemKind
ANIMAL, Int
8), (GroupName ItemKind
IMMOBILE_ANIMAL, Int
120), (GroupName ItemKind
GEOPHENOMENON, Int
1)]
  , iflavour :: [Flavour]
iflavour = [Color] -> [Flavour]
zipPlain [Color
BrYellow]  -- exception, animal with bright color
  , icount :: Dice
icount   = Dice
1
  , irarity :: Rarity
irarity  = [(Double
1, Int
10), (Double
10, Int
6)]
  , iverbHit :: Text
iverbHit = Text
"thud"
  , iweight :: Int
iweight  = Int
80000
  , idamage :: Dice
idamage  = Dice
0
  , iaspects :: [Aspect]
iaspects = [ Skill -> Dice -> Aspect
AddSkill Skill
SkMaxHP Dice
20, Skill -> Dice -> Aspect
AddSkill Skill
SkMaxCalm Dice
999
               , Skill -> Dice -> Aspect
AddSkill Skill
SkSpeed Dice
22, Skill -> Dice -> Aspect
AddSkill Skill
SkNocto Dice
2, Skill -> Dice -> Aspect
AddSkill Skill
SkShine Dice
3
               , Skill -> Dice -> Aspect
AddSkill Skill
SkWait Dice
1, Skill -> Dice -> Aspect
AddSkill Skill
SkMelee Dice
1  -- no brain
               , Flag -> Aspect
SetFlag Flag
Durable ]
  , ieffects :: [Effect]
ieffects = []
  , idesc :: Text
idesc    = Text
"The pool boils and bubbles, stinking of rotten eggs. Despite the smell, these waters purify and strengthen."
  , ikit :: [(GroupName ItemKind, CStore)]
ikit     = [(GroupName ItemKind
S_SULFUR_VENT, CStore
COrgan), (GroupName ItemKind
S_SULFUR_FISSURE, CStore
COrgan)]
  }