-- Copyright (c) 2008--2011 Andres Loeh
-- Copyright (c) 2010--2021 Mikolaj Konarski and others (see git history)
-- This file is a part of the computer game Allure of the Stars
-- and is released under the terms of the GNU Affero General Public License.
-- For license and copyright information, see the file LICENSE.
--
-- | Actor (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 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
  , pattern CRAWL_HERO, pattern EXTERMINATOR_HERO, pattern RAIDER_HERO, pattern MERCENARY_HERO, pattern AQUATIC_ANIMAL, pattern AQUATIC_MONSTER, pattern EXPLOSIVE_MONSTER, pattern ROBOT, pattern MOBILE_ROBOT, pattern IMMOBILE_ROBOT, pattern CONSTRUCTION_ROBOT, pattern MECHANICAL_CONTRAPTION, pattern GAUNTLET_ROBOT
  , pattern S_BULLTEPROOF_VEST, pattern S_PERFUME_POTION, pattern S_EMPTY_FLASK
  , pattern COOKED_FOOD, pattern MERCENARY_WEAPON, pattern MERCENARY_AMMO, pattern RAW_MEAT_CHUNK, pattern ROASTED_MEAT_CHUNK, pattern NEEDLE, pattern CAN_OF_STICKY_FOAM, pattern TRANQUILIZER_DART, pattern WASTE_CONTAINER, pattern CONSTRUCTION_HOOTER, pattern SPOTLIGHT, pattern BLOWTORCH, pattern POLE, pattern POLE_OR_HANDLE, pattern BREACHING_TOOL, pattern BONDING_TOOL, pattern SHARPENING_TOOL, pattern WIRECUTTING_TOOL
  , 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, GroupName ItemKind
S_BULLTEPROOF_VEST, GroupName ItemKind
S_PERFUME_POTION, GroupName ItemKind
S_EMPTY_FLASK]

pattern S_WOODEN_TORCH, S_SANDSTONE_ROCK, S_BULLTEPROOF_VEST, S_PERFUME_POTION, S_EMPTY_FLASK :: 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]
-> [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]
    [GroupName ItemKind]
-> [GroupName ItemKind] -> [GroupName ItemKind]
forall a. [a] -> [a] -> [a]
++ [GroupName ItemKind
CRAWL_HERO, GroupName ItemKind
EXTERMINATOR_HERO, GroupName ItemKind
RAIDER_HERO, GroupName ItemKind
MERCENARY_HERO, GroupName ItemKind
AQUATIC_ANIMAL, GroupName ItemKind
AQUATIC_MONSTER, GroupName ItemKind
EXPLOSIVE_MONSTER, GroupName ItemKind
ROBOT, GroupName ItemKind
MOBILE_ROBOT, GroupName ItemKind
IMMOBILE_ROBOT, GroupName ItemKind
CONSTRUCTION_ROBOT, GroupName ItemKind
MECHANICAL_CONTRAPTION, GroupName ItemKind
GAUNTLET_ROBOT]
    [GroupName ItemKind]
-> [GroupName ItemKind] -> [GroupName ItemKind]
forall a. [a] -> [a] -> [a]
++ [GroupName ItemKind
COOKED_FOOD, GroupName ItemKind
MERCENARY_WEAPON, GroupName ItemKind
MERCENARY_AMMO, GroupName ItemKind
RAW_MEAT_CHUNK, GroupName ItemKind
ROASTED_MEAT_CHUNK, GroupName ItemKind
NEEDLE, GroupName ItemKind
CAN_OF_STICKY_FOAM, GroupName ItemKind
TRANQUILIZER_DART, GroupName ItemKind
WASTE_CONTAINER, GroupName ItemKind
CONSTRUCTION_HOOTER, GroupName ItemKind
SPOTLIGHT, GroupName ItemKind
BLOWTORCH, GroupName ItemKind
POLE, GroupName ItemKind
POLE_OR_HANDLE, GroupName ItemKind
BREACHING_TOOL, GroupName ItemKind
BONDING_TOOL, GroupName ItemKind
SHARPENING_TOOL, GroupName ItemKind
WIRECUTTING_TOOL]

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 :: 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 CRAWL_HERO, EXTERMINATOR_HERO, RAIDER_HERO, MERCENARY_HERO, AQUATIC_ANIMAL, AQUATIC_MONSTER, EXPLOSIVE_MONSTER, ROBOT, MOBILE_ROBOT, IMMOBILE_ROBOT, CONSTRUCTION_ROBOT, MECHANICAL_CONTRAPTION, GAUNTLET_ROBOT :: GroupName ItemKind

pattern COOKED_FOOD, MERCENARY_WEAPON, MERCENARY_AMMO, RAW_MEAT_CHUNK, ROASTED_MEAT_CHUNK, NEEDLE, CAN_OF_STICKY_FOAM, TRANQUILIZER_DART, WASTE_CONTAINER, CONSTRUCTION_HOOTER, SPOTLIGHT, BLOWTORCH, POLE, POLE_OR_HANDLE, BREACHING_TOOL, BONDING_TOOL, SHARPENING_TOOL, WIRECUTTING_TOOL :: GroupName ItemKind

-- ** Common
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 "fighter"
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"

-- ** Allure-specific
pattern $bCRAWL_HERO :: GroupName ItemKind
$mCRAWL_HERO :: forall r. GroupName ItemKind -> (Void# -> r) -> (Void# -> r) -> r
CRAWL_HERO = GroupName "crawl professional"
pattern $bEXTERMINATOR_HERO :: GroupName ItemKind
$mEXTERMINATOR_HERO :: forall r. GroupName ItemKind -> (Void# -> r) -> (Void# -> r) -> r
EXTERMINATOR_HERO = GroupName "exterminator"
pattern $bRAIDER_HERO :: GroupName ItemKind
$mRAIDER_HERO :: forall r. GroupName ItemKind -> (Void# -> r) -> (Void# -> r) -> r
RAIDER_HERO = GroupName "raider"
pattern $bMERCENARY_HERO :: GroupName ItemKind
$mMERCENARY_HERO :: forall r. GroupName ItemKind -> (Void# -> r) -> (Void# -> r) -> r
MERCENARY_HERO = GroupName "mercenary"
pattern $bAQUATIC_ANIMAL :: GroupName ItemKind
$mAQUATIC_ANIMAL :: forall r. GroupName ItemKind -> (Void# -> r) -> (Void# -> r) -> r
AQUATIC_ANIMAL = GroupName "aquatic animal"
pattern $bAQUATIC_MONSTER :: GroupName ItemKind
$mAQUATIC_MONSTER :: forall r. GroupName ItemKind -> (Void# -> r) -> (Void# -> r) -> r
AQUATIC_MONSTER = GroupName "aquatic monstrosity"
pattern $bEXPLOSIVE_MONSTER :: GroupName ItemKind
$mEXPLOSIVE_MONSTER :: forall r. GroupName ItemKind -> (Void# -> r) -> (Void# -> r) -> r
EXPLOSIVE_MONSTER = GroupName "explosive monstrosity"
pattern $bROBOT :: GroupName ItemKind
$mROBOT :: forall r. GroupName ItemKind -> (Void# -> r) -> (Void# -> r) -> r
ROBOT = GroupName "robot"
pattern $bMOBILE_ROBOT :: GroupName ItemKind
$mMOBILE_ROBOT :: forall r. GroupName ItemKind -> (Void# -> r) -> (Void# -> r) -> r
MOBILE_ROBOT = GroupName "mobile robot"
pattern $bIMMOBILE_ROBOT :: GroupName ItemKind
$mIMMOBILE_ROBOT :: forall r. GroupName ItemKind -> (Void# -> r) -> (Void# -> r) -> r
IMMOBILE_ROBOT = GroupName "immobile robot"
pattern $bCONSTRUCTION_ROBOT :: GroupName ItemKind
$mCONSTRUCTION_ROBOT :: forall r. GroupName ItemKind -> (Void# -> r) -> (Void# -> r) -> r
CONSTRUCTION_ROBOT = GroupName "construction robot"
pattern $bMECHANICAL_CONTRAPTION :: GroupName ItemKind
$mMECHANICAL_CONTRAPTION :: forall r. GroupName ItemKind -> (Void# -> r) -> (Void# -> r) -> r
MECHANICAL_CONTRAPTION = GroupName "mechanical contraption"
pattern $bGAUNTLET_ROBOT :: GroupName ItemKind
$mGAUNTLET_ROBOT :: forall r. GroupName ItemKind -> (Void# -> r) -> (Void# -> r) -> r
GAUNTLET_ROBOT = GroupName "virus-infested robot"

-- ** Common
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"

-- ** Allure-specific
pattern $bS_BULLTEPROOF_VEST :: GroupName ItemKind
$mS_BULLTEPROOF_VEST :: forall r. GroupName ItemKind -> (Void# -> r) -> (Void# -> r) -> r
S_BULLTEPROOF_VEST = GroupName "bulletproof vest"
pattern $bS_PERFUME_POTION :: GroupName ItemKind
$mS_PERFUME_POTION :: forall r. GroupName ItemKind -> (Void# -> r) -> (Void# -> r) -> r
S_PERFUME_POTION = GroupName "perfume potion"
pattern $bS_EMPTY_FLASK :: GroupName ItemKind
$mS_EMPTY_FLASK :: forall r. GroupName ItemKind -> (Void# -> r) -> (Void# -> r) -> r
S_EMPTY_FLASK = GroupName "empty flask"

pattern $bCOOKED_FOOD :: GroupName ItemKind
$mCOOKED_FOOD :: forall r. GroupName ItemKind -> (Void# -> r) -> (Void# -> r) -> r
COOKED_FOOD = GroupName "cooked food"
pattern $bMERCENARY_WEAPON :: GroupName ItemKind
$mMERCENARY_WEAPON :: forall r. GroupName ItemKind -> (Void# -> r) -> (Void# -> r) -> r
MERCENARY_WEAPON = GroupName "mercenary weapon"
pattern $bMERCENARY_AMMO :: GroupName ItemKind
$mMERCENARY_AMMO :: forall r. GroupName ItemKind -> (Void# -> r) -> (Void# -> r) -> r
MERCENARY_AMMO = GroupName "mercenary ammo"
pattern $bRAW_MEAT_CHUNK :: GroupName ItemKind
$mRAW_MEAT_CHUNK :: forall r. GroupName ItemKind -> (Void# -> r) -> (Void# -> r) -> r
RAW_MEAT_CHUNK = GroupName "raw meat chunk"
pattern $bROASTED_MEAT_CHUNK :: GroupName ItemKind
$mROASTED_MEAT_CHUNK :: forall r. GroupName ItemKind -> (Void# -> r) -> (Void# -> r) -> r
ROASTED_MEAT_CHUNK = GroupName "roasted meat chunk"
pattern $bNEEDLE :: GroupName ItemKind
$mNEEDLE :: forall r. GroupName ItemKind -> (Void# -> r) -> (Void# -> r) -> r
NEEDLE = GroupName "needle"
pattern $bCAN_OF_STICKY_FOAM :: GroupName ItemKind
$mCAN_OF_STICKY_FOAM :: forall r. GroupName ItemKind -> (Void# -> r) -> (Void# -> r) -> r
CAN_OF_STICKY_FOAM = GroupName "can of sticky foam"
pattern $bTRANQUILIZER_DART :: GroupName ItemKind
$mTRANQUILIZER_DART :: forall r. GroupName ItemKind -> (Void# -> r) -> (Void# -> r) -> r
TRANQUILIZER_DART = GroupName "tranquillizer dart"
pattern $bWASTE_CONTAINER :: GroupName ItemKind
$mWASTE_CONTAINER :: forall r. GroupName ItemKind -> (Void# -> r) -> (Void# -> r) -> r
WASTE_CONTAINER = GroupName "waste container"
pattern $bCONSTRUCTION_HOOTER :: GroupName ItemKind
$mCONSTRUCTION_HOOTER :: forall r. GroupName ItemKind -> (Void# -> r) -> (Void# -> r) -> r
CONSTRUCTION_HOOTER = GroupName "construction hooter"
pattern $bSPOTLIGHT :: GroupName ItemKind
$mSPOTLIGHT :: forall r. GroupName ItemKind -> (Void# -> r) -> (Void# -> r) -> r
SPOTLIGHT = GroupName "spotlight"
pattern $bBLOWTORCH :: GroupName ItemKind
$mBLOWTORCH :: forall r. GroupName ItemKind -> (Void# -> r) -> (Void# -> r) -> r
BLOWTORCH = GroupName "blowtorch"
pattern $bPOLE :: GroupName ItemKind
$mPOLE :: forall r. GroupName ItemKind -> (Void# -> r) -> (Void# -> r) -> r
POLE = GroupName "pole"
pattern $bPOLE_OR_HANDLE :: GroupName ItemKind
$mPOLE_OR_HANDLE :: forall r. GroupName ItemKind -> (Void# -> r) -> (Void# -> r) -> r
POLE_OR_HANDLE = GroupName "pole or handle"
pattern $bBREACHING_TOOL :: GroupName ItemKind
$mBREACHING_TOOL :: forall r. GroupName ItemKind -> (Void# -> r) -> (Void# -> r) -> r
BREACHING_TOOL = GroupName "breaching tool"
pattern $bBONDING_TOOL :: GroupName ItemKind
$mBONDING_TOOL :: forall r. GroupName ItemKind -> (Void# -> r) -> (Void# -> r) -> r
BONDING_TOOL = GroupName "bonding tool"
pattern $bSHARPENING_TOOL :: GroupName ItemKind
$mSHARPENING_TOOL :: forall r. GroupName ItemKind -> (Void# -> r) -> (Void# -> r) -> r
SHARPENING_TOOL = GroupName "sharpening tool"
pattern $bWIRECUTTING_TOOL :: GroupName ItemKind
$mWIRECUTTING_TOOL :: forall r. GroupName ItemKind -> (Void# -> r) -> (Void# -> r) -> r
WIRECUTTING_TOOL = GroupName "wirecutting tool"

-- * Content

actors :: [ItemKind]
actors :: [ItemKind]
actors =
  [ItemKind
warrior, ItemKind
warrior2, ItemKind
exterminator, ItemKind
raider, ItemKind
scout, ItemKind
ranger, ItemKind
escapist, ItemKind
ambusher, ItemKind
brawler, ItemKind
fighter, ItemKind
mercenary, ItemKind
civilian, ItemKind
civilian2, ItemKind
civilian3, ItemKind
civilian4, ItemKind
civilian5, ItemKind
eye, ItemKind
fastEye, ItemKind
nose, ItemKind
elbow, ItemKind
elbowTank, ItemKind
intruder, ItemKind
torsor, ItemKind
goldenJackal, ItemKind
griffonVulture, ItemKind
skunk, ItemKind
armadillo, ItemKind
gilaMonster, ItemKind
rattlesnake, ItemKind
hyena, ItemKind
komodoDragon, ItemKind
alligator, ItemKind
giantOctopus, ItemKind
lion, ItemKind
rhinoceros, ItemKind
beeSwarm, ItemKind
hornetSwarm, ItemKind
thornbush, ItemKind
razorwireFence, ItemKind
electricFence, ItemKind
activeFence, ItemKind
steamFaucet, ItemKind
coolingFaucet, ItemKind
medbotFaucet, ItemKind
dustFaucet, ItemKind
fuelFaucet, ItemKind
surveillanceDrone, ItemKind
shepherdDrone, ItemKind
huntingDrone, ItemKind
homeRobot, ItemKind
wasteRobot, ItemKind
wasteRobotNoEqp, ItemKind
lightRobot, ItemKind
heavyRobot, ItemKind
weldedRobot, ItemKind
cleanerRobot]

warrior,    warrior2, exterminator, raider, scout, ranger, escapist, ambusher, brawler, fighter, mercenary, civilian, civilian2, civilian3, civilian4, civilian5, eye, fastEye, nose, elbow, elbowTank, intruder, torsor, goldenJackal, griffonVulture, skunk, armadillo, gilaMonster, rattlesnake, hyena, komodoDragon, alligator, giantOctopus, lion, rhinoceros, beeSwarm, hornetSwarm, thornbush, razorwireFence, electricFence, activeFence, steamFaucet, coolingFaucet, medbotFaucet, dustFaucet, fuelFaucet, surveillanceDrone, shepherdDrone, huntingDrone, homeRobot, wasteRobot, wasteRobotNoEqp, lightRobot, heavyRobot, weldedRobot, cleanerRobot :: 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)
              , (GroupName ItemKind
S_ANIMAL_STOMACH, CStore
COrgan), (GroupName ItemKind
S_HUNGRY, CStore
COrgan)
              , (GroupName ItemKind
BACKSTORY, CStore
COrgan) ]
                  -- TODO: when enough backstory items created,
                  -- include many backstory categories here instead and add
                  -- a bit of variation among warriors, some kinds
                  -- getting a good and a bad where another test a mixed one
                  -- instead, etc. Characters should still be recognizable
                  -- and slighty different backstory emphasis between games
                  -- matches human plasticity.
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
CRAWL_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
90  -- 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
GENETIC_FLAW_10, CStore
COrgan)
                  , (GroupName ItemKind
S_EMPTY_FLASK, CStore
CStash)
                  , (GroupName ItemKind
COMMON_ITEM, CStore
CStash) ]
  , idesc :: Text
idesc    = Text
"A human equipped for an adventure."
  }
warrior2 :: ItemKind
warrior2 = ItemKind
warrior
  { ifreq :: Freqs ItemKind
ifreq    = [(GroupName ItemKind
CRAWL_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
GENETIC_FLAW_10, CStore
COrgan)
                  , (GroupName ItemKind
S_EMPTY_FLASK, CStore
CStash)
                  , (GroupName ItemKind
COOKED_FOOD, CStore
CStash) ]
  }
exterminator :: ItemKind
exterminator = ItemKind
warrior
  { ifreq :: Freqs ItemKind
ifreq    = [(GroupName ItemKind
EXTERMINATOR_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
GENETIC_FLAW_10, CStore
COrgan)
                  , (GroupName ItemKind
STARTING_WEAPON, CStore
CEqp)
                  , (GroupName ItemKind
ARMOR_RANGED, CStore
CEqp) ]
  , idesc :: Text
idesc    = Text
"A human self-defending with makeshift equipment."
  }
raider :: ItemKind
raider = ItemKind
warrior
  { ifreq :: Freqs ItemKind
ifreq    = [(GroupName ItemKind
RAIDER_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
GENETIC_FLAW_10, CStore
COrgan)
                  , (GroupName ItemKind
ARMOR_RANGED, CStore
CEqp)
                  , (GroupName ItemKind
WEAK_ARROW, CStore
CStash) ]
  , idesc :: Text
idesc    = Text
"A human equipped for a raid."
  }
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  -- no flaw
               [(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 :: Text
idesc    = Text
"A human equipped for scouting."
  }
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  -- no flaw
               [(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 :: Text
idesc    = Text
"A human equipped for ranged fight."
  }
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  -- no flaw
               [(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 :: Text
idesc    = Text
"A human equipped for an escape."
  }
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 :: Text
idesc    = Text
"A human equipped for an ambush."
  }
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  -- no flaw
               [(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 :: Text
idesc    = Text
"A human equipped for melee fight."
  }
fighter :: ItemKind
fighter = 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
STARTING_WEAPON, CStore
CEqp)
                  , (GroupName ItemKind
EXPLOSIVE, CStore
CStash) ]
  , idesc :: Text
idesc    = Text
"A human equipped for intense combat."
  }
mercenary :: ItemKind
mercenary = ItemKind
brawler
  { iname :: Text
iname    = Text
"mercenary"  -- different name, because a very distinct faction
  , ifreq :: Freqs ItemKind
ifreq    = [(GroupName ItemKind
MERCENARY_HERO, Int
100), (GroupName ItemKind
MOBILE, Int
1)]
  , ikit :: [(GroupName ItemKind, CStore)]
ikit     = [(GroupName ItemKind, CStore)]
humanOrgans  -- no flaw
               [(GroupName ItemKind, CStore)]
-> [(GroupName ItemKind, CStore)] -> [(GroupName ItemKind, CStore)]
forall a. [a] -> [a] -> [a]
++ [ (GroupName ItemKind
MERCENARY_WEAPON, CStore
CEqp)
                  , (GroupName ItemKind
S_BULLTEPROOF_VEST, CStore
CEqp)
                  , (GroupName ItemKind
MERCENARY_AMMO, CStore
CStash)
                  , (GroupName ItemKind
EXPLOSIVE, CStore
CStash) ]
  , idesc :: Text
idesc    = Text
"A professional security contractor."
  }

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    = ""
  }

-- * Aliens

-- 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  -- depends on items it finds rather than special organs
  { isymbol :: ContentSymbol ItemKind
isymbol  = ContentSymbol ItemKind -> ContentSymbol ItemKind
forall c. ContentSymbol ItemKind -> ContentSymbol ItemKind
toContentSymbol ContentSymbol ItemKind
'w'
  , iname :: Text
iname    = Text
"beckoning walker"
  , 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 Double -> Double -> Double
forall a. Num a => a -> a -> a
* Double
10Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/Double
16, Int
0), (Double
4 Double -> Double -> Double
forall a. Num a => a -> a -> a
* Double
10Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/Double
16, 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
"Walks with a stately dignity. You read death in the slow beckoning gestures of its revolting upper appendages."
  , ikit :: [(GroupName ItemKind, CStore)]
ikit     = [ (GroupName ItemKind
S_FOOT, CStore
COrgan), (GroupName ItemKind
S_TENTACLE, CStore
COrgan)
               , (GroupName ItemKind
S_BARK, CStore
COrgan), (GroupName ItemKind
S_EYE_6, CStore
COrgan)
               , (GroupName ItemKind
S_SAPIENT_BRAIN, CStore
COrgan) ]  -- no voice, no hearing
  }
fastEye :: ItemKind
fastEye = ItemKind :: ContentSymbol ItemKind
-> Text
-> Freqs ItemKind
-> [Flavour]
-> Dice
-> Rarity
-> Text
-> Int
-> Dice
-> [Aspect]
-> [Effect]
-> [(GroupName ItemKind, CStore)]
-> Text
-> ItemKind
ItemKind  -- glass cannon; depends mostly on items it finds
  { isymbol :: ContentSymbol ItemKind
isymbol  = ContentSymbol ItemKind -> ContentSymbol ItemKind
forall c. ContentSymbol ItemKind -> ContentSymbol ItemKind
toContentSymbol ContentSymbol ItemKind
'b'
  , iname :: Text
iname    = Text
"rolling biter"
  , 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 Double -> Double -> Double
forall a. Num a => a -> a -> a
* Double
10Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/Double
16, Int
0), (Double
4 Double -> Double -> Double
forall a. Num a => a -> a -> a
* Double
10Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/Double
16, Int
3), (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
12, 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
SkHurtMelee Dice
20
               , Skill -> Dice -> Aspect
AddSkill Skill
SkAggression Dice
1
               , Flag -> Aspect
SetFlag Flag
Durable ]
  , ieffects :: [Effect]
ieffects = []
  , idesc :: Text
idesc    = Text
"It bites as blindingly fast as it runs. Or rolls? Also, cuts and pierces."
  , ikit :: [(GroupName ItemKind, CStore)]
ikit     = [ (GroupName ItemKind
S_JAW, CStore
COrgan), (GroupName ItemKind
S_RAZOR, CStore
COrgan), (GroupName ItemKind
S_HORN, CStore
COrgan)
               , (GroupName ItemKind
S_SMALL_CLAW, CStore
COrgan)  -- at least one non-timed, not deadly
               , (GroupName ItemKind
S_SPEED_GLAND_10, CStore
COrgan)  -- -30 armor with horn, +20 melee
               , (GroupName ItemKind
S_EYE_3, 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  -- sniffs only; a tank requiring multiple weapon hits to beat;
                 -- no armor, so special kinds of damage don't help;
                 -- slow, but despite that, danger when strong weapons wielded!
  { isymbol :: ContentSymbol ItemKind
isymbol  = ContentSymbol ItemKind -> ContentSymbol ItemKind
forall c. ContentSymbol ItemKind -> ContentSymbol ItemKind
toContentSymbol ContentSymbol ItemKind
'h'
  , iname :: Text
iname    = Text
"crawling horror"
  , ifreq :: Freqs ItemKind
ifreq    = [ (GroupName ItemKind
MONSTER, Int
100), (GroupName ItemKind
MOBILE, Int
1), (GroupName ItemKind
MOBILE_MONSTER, Int
100)
               , (GroupName ItemKind
AQUATIC, Int
30), (GroupName ItemKind
AQUATIC_MONSTER, Int
30) ]  -- likes liquids
  , iflavour :: [Flavour]
iflavour = [Color] -> [Flavour]
zipFancy [Color
BrGreen]
  , icount :: Dice
icount   = Dice
1
  , irarity :: Rarity
irarity  = [(Double
3 Double -> Double -> Double
forall a. Num a => a -> a -> a
* Double
10Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/Double
16, Int
0), (Double
4 Double -> Double -> Double
forall a. Num a => a -> a -> a
* Double
10Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/Double
16, Int
5), (Double
10, Int
9)]
  , 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
60, Skill -> Dice -> Aspect
AddSkill Skill
SkMaxCalm Dice
30
               , Skill -> Dice -> Aspect
AddSkill Skill
SkSpeed Dice
15, 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
               , Skill -> Dice -> Aspect
AddSkill Skill
SkSwimming Dice
30
               , Flag -> Aspect
SetFlag Flag
Durable ]
  , ieffects :: [Effect]
ieffects = []
  , idesc :: Text
idesc    = Text
"A blind, slimy mass of fluid tissue. You'd think it's powerless, but as soon as it touches your trembling body, slapping, stinging and burning, it won't let go."
  , 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_STING, CStore
COrgan)
               , (GroupName ItemKind
S_NOSTRIL, CStore
COrgan), (GroupName ItemKind
S_HUNGRY, 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
's'
  , iname :: Text
iname    = Text
"creepy shooter"
  , 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 Double -> Double -> Double
forall a. Num a => a -> a -> a
* Double
10Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/Double
16, Int
0), (Double
4 Double -> Double -> Double
forall a. Num a => a -> a -> a
* Double
10Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/Double
16, 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
12, Skill -> Dice -> Aspect
AddSkill Skill
SkMaxCalm Dice
100
               , 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 use even cultural artifacts
               , Skill -> Dice -> Aspect
AddSkill Skill
SkMelee (-Dice
1)
               , Flag -> Aspect
SetFlag Flag
Durable ]
  , ieffects :: [Effect]
ieffects = []
  , idesc :: Text
idesc    = Text
"It moves in sudden jerks and never makes a noise. Speaks in hard objects hurled at deadly speeds."
  , ikit :: [(GroupName ItemKind, CStore)]
ikit     = [ (GroupName ItemKind
S_SPEED_GLAND_5, CStore
COrgan)  -- -25 armor
               , (GroupName ItemKind
S_EYE_6, 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
CEqp), (GroupName ItemKind
ANY_ARROW, CStore
CStash)
               , (GroupName ItemKind
WEAK_ARROW, CStore
CEqp), (GroupName ItemKind
WEAK_ARROW, CStore
CStash) ]
  }

-- * Allure-specific aliens

elbowTank :: ItemKind
elbowTank = ItemKind
elbow
  { iname :: Text
iname    = Text
"armored shooter"
  , iflavour :: [Flavour]
iflavour = [Color] -> [Flavour]
zipFancy [Color
Magenta]
  , irarity :: Rarity
irarity  = [(Double
10, Int
0), (Double
40, Int
30)]  -- only appears among late spawns
  , ikit :: [(GroupName ItemKind, CStore)]
ikit     = ItemKind -> [(GroupName ItemKind, CStore)]
ikit ItemKind
elbow [(GroupName ItemKind, CStore)]
-> [(GroupName ItemKind, CStore)] -> [(GroupName ItemKind, CStore)]
forall a. [a] -> [a] -> [a]
++ [(GroupName ItemKind
S_ARMORED_SKIN, CStore
COrgan), (GroupName ItemKind
S_JET_BOOSTER, CStore
COrgan)]
  }
-- TODO: the main fun in this actor will be chain explosions and for this,
-- it needs to spawn in groups and move in groups. Neither is implemented yet.
-- For now, we try to amass the actors on arena levels over water and in rooms.
-- Low HP is needed to ensure the chain reaction. Lack of ranged combat
-- makes the rule to attack it from a distance straightforward.
intruder :: ItemKind
intruder = 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
'i'
  , iname :: Text
iname    = Text
"bobbing intruder"
  , ifreq :: Freqs ItemKind
ifreq    = [ (GroupName ItemKind
MONSTER, Int
100), (GroupName ItemKind
MOBILE, Int
1), (GroupName ItemKind
MOBILE_MONSTER, Int
100)
               , (GroupName ItemKind
EXPLOSIVE_MONSTER, Int
100)
               , (GroupName ItemKind
AQUATIC, Int
1) ]  -- neutral to water, unlike other actors
  , iflavour :: [Flavour]
iflavour = [Color] -> [Flavour]
zipFancy [Color
BrCyan]
  , icount :: Dice
icount   = Dice
1
  , irarity :: Rarity
irarity  = [(Double
3 Double -> Double -> Double
forall a. Num a => a -> a -> a
* Double
10Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/Double
16, Int
0), (Double
4 Double -> Double -> Double
forall a. Num a => a -> a -> a
* Double
10Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/Double
16, Int
5), (Double
10, Int
9)]
  , 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
6, Skill -> Dice -> Aspect
AddSkill Skill
SkMaxCalm Dice
50
               , 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
1)  -- can't project
               , Skill -> Dice -> Aspect
AddSkill Skill
SkApply Dice
1  -- can use even cultural artifacts
               , 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 ]
  , ieffects :: [Effect]
ieffects = []
  , idesc :: Text
idesc    = Text
"It starts, bobs and halts, scanning for movement. Effortlessly it resumes covering the ground, gliding two meters above the floor. Its pumped organic body, though large, pulses with fragility. It doesn't skirt the walls and instead takes ownership of any space it boldly parks in the middle of."
  , ikit :: [(GroupName ItemKind, CStore)]
ikit     = [ (GroupName ItemKind
S_FLOTATION_BAG, CStore
COrgan)
               , (GroupName ItemKind
S_TENTACLE, CStore
COrgan), (GroupName ItemKind
S_TENTACLE, CStore
COrgan)
               , (GroupName ItemKind
S_TIP, CStore
COrgan)  -- at least one non-timed
               , (GroupName ItemKind
S_HOOKED_CLAW, CStore
COrgan)
               , (GroupName ItemKind
S_EYE_6, CStore
COrgan), (GroupName ItemKind
S_EAR_6, CStore
COrgan)
               , (GroupName ItemKind
S_SAPIENT_BRAIN, CStore
COrgan) ]  -- no voice, no hearing
  }

-- * Alien uniques

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
'M'
  , iname :: Text
iname    = Text
"The Maker"
  , 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
14 Double -> Double -> Double
forall a. Num a => a -> a -> a
* Double
10Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/Double
16, Int
0), (Double
15 Double -> Double -> Double
forall a. Num a => a -> a -> a
* Double
10Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/Double
16, 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, Text -> Aspect
ELabel Text
"of Contact"
               , Skill -> Dice -> Aspect
AddSkill Skill
SkMaxHP Dice
400  -- -50 melee armor, so higher HP
               , Skill -> Dice -> Aspect
AddSkill Skill
SkMaxCalm Dice
100
               , Skill -> Dice -> Aspect
AddSkill Skill
SkSpeed Dice
5
               , 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 use even 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 = [Effect -> Effect
OnSmash (Effect -> Effect) -> Effect -> Effect
forall a b. (a -> b) -> a -> b
$ Text -> Text -> Effect
VerbMsg Text
"mount the last plea for mutual understanding and voluntary exchange of body parts" Text
"."]
  , idesc :: Text
idesc    = Text
"The mind, the big heart behind it all. Warmth and sympathy pour out through the graceful undulation of tentacles, sharp claws, snapping jaw and dripping fangs."
  , ikit :: [(GroupName ItemKind, CStore)]
ikit     = [ (GroupName ItemKind
S_TENTACLE, CStore
COrgan), (GroupName ItemKind
S_HOOKED_CLAW, CStore
COrgan)
               , (GroupName ItemKind
S_LARGE_JAW, CStore
COrgan), (GroupName ItemKind
S_VENOM_FANG, CStore
COrgan)
               , (GroupName ItemKind
S_SMALL_CLAW, CStore
COrgan)  -- at least one non-timed, not deadly
               , (GroupName ItemKind
S_SPEED_GLAND_10, CStore
COrgan)
               , (GroupName ItemKind
S_EYE_6, CStore
COrgan), (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) ]
  }

-- * 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_POWERFUL_HIND_LEGS, CStore
COrgan)  -- useful for aggressive actor
               , (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)
               , (GroupName ItemKind
S_ANIMAL_STOMACH, CStore
COrgan), (GroupName ItemKind
GENETIC_FLAW_3, 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)
               , (GroupName ItemKind
S_ANIMAL_STOMACH, CStore
COrgan), (GroupName ItemKind
GENETIC_FLAW_3, 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)
               , (GroupName ItemKind
S_ANIMAL_STOMACH, CStore
COrgan), (GroupName ItemKind
GENETIC_FLAW_3, 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  -- a tank with armor, so special damage defeats it
  { 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)
               , (GroupName ItemKind
S_ANIMAL_STOMACH, CStore
COrgan), (GroupName ItemKind
GENETIC_FLAW_3, CStore
COrgan)
               , (GroupName ItemKind
RAW_MEAT_CHUNK, CStore
CEqp) ]
  }
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)  -- small reptile, hungers slowly
               , (GroupName ItemKind
GENETIC_FLAW_3, 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_COILED_TAIL, CStore
COrgan)  -- useful for an aggressive actor
               , (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)  -- small reptile, hungers slowly
               , (GroupName ItemKind
GENETIC_FLAW_3, CStore
COrgan)
               , (GroupName ItemKind
RAW_MEAT_CHUNK, CStore
CEqp) ]
  }
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)
               , (GroupName ItemKind
S_ANIMAL_STOMACH, CStore
COrgan), (GroupName ItemKind
GENETIC_FLAW_3, 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)
               , (GroupName ItemKind
S_ANIMAL_STOMACH, CStore
COrgan)
               , (GroupName ItemKind
GENETIC_FLAW_3, CStore
COrgan)  -- not to wake it up too soon
               , (GroupName ItemKind
RAW_MEAT_CHUNK, CStore
CEqp), (GroupName ItemKind
RAW_MEAT_CHUNK, CStore
CEqp) ]
  }
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)
               , (GroupName ItemKind
AQUATIC, Int
70), (GroupName ItemKind
AQUATIC_ANIMAL, Int
70) ]  -- amphibious
  , iflavour :: [Flavour]
iflavour = [Color] -> [Flavour]
zipPlain [Color
Blue]
  , icount :: Dice
icount   = Dice
1
  , irarity :: Rarity
irarity  = [(Double
9, Int
0), (Double
10, Int
10), (Double
20, Int
10), (Double
40, Int
40)]
      -- extra spawns in water, so lower rarity, except 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
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
               , Skill -> Dice -> Aspect
AddSkill Skill
SkWait Dice
1  -- can sleep despite the genetic flaw
               , Skill -> Dice -> Aspect
AddSkill Skill
SkApply Dice
1  -- can eat food despite the genetic flaw
               , 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)
               , (GroupName ItemKind
S_ANIMAL_STOMACH, CStore
COrgan), (GroupName ItemKind
GENETIC_FLAW_10, CStore
COrgan)
               , (GroupName ItemKind
RAW_MEAT_CHUNK, CStore
CEqp), (GroupName ItemKind
RAW_MEAT_CHUNK, CStore
CEqp) ]
  }

-- * Allure-specific animals

giantOctopus :: ItemKind
giantOctopus = 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
'o'
  , iname :: Text
iname    = Text
"giant octopus"
  , ifreq :: Freqs ItemKind
ifreq    = [ (GroupName ItemKind
ANIMAL, Int
100), (GroupName ItemKind
MOBILE, Int
1), (GroupName ItemKind
MOBILE_ANIMAL, Int
100)
               , (GroupName ItemKind
AQUATIC, Int
90), (GroupName ItemKind
AQUATIC_ANIMAL, Int
90) ]  -- weak on land
  , iflavour :: [Flavour]
iflavour = [Color] -> [Flavour]
zipPlain [Color
BrMagenta]  -- very exotic, so bright color
  , icount :: Dice
icount   = Dice
1
  , irarity :: Rarity
irarity  = [(Double
3 Double -> Double -> Double
forall a. Num a => a -> a -> a
* Double
10Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/Double
16, Int
0), (Double
4 Double -> Double -> Double
forall a. Num a => a -> a -> a
* Double
10Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/Double
16, Int
5), (Double
7, Int
3)]
                 -- weak, but non-standard behaviour, so spoils initial mastery;
                 -- later on not too common, because annoying
  , iverbHit :: Text
iverbHit = Text
"thud"
  , iweight :: Int
iweight  = Int
72000
  , idamage :: Dice
idamage  = Dice
0
  , iaspects :: [Aspect]
iaspects = [ Skill -> Dice -> Aspect
AddSkill Skill
SkMaxHP Dice
20, Skill -> Dice -> Aspect
AddSkill Skill
SkMaxCalm Dice
80
               , Skill -> Dice -> Aspect
AddSkill Skill
SkSwimming Dice
100  -- swims better than walks
               , Skill -> Dice -> Aspect
AddSkill Skill
SkSpeed Dice
27, Skill -> Dice -> Aspect
AddSkill Skill
SkNocto Dice
3 -- good night vision
               , 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
"It has eight arms of rage and sees through the night. Copes with lower gravity better than most animals."  -- TODO: change when slowness on land is implemented
  , ikit :: [(GroupName ItemKind, CStore)]
ikit     = [ (GroupName ItemKind
S_INK_SAC, CStore
COrgan)
               , (GroupName ItemKind
S_TENTACLE, CStore
COrgan), (GroupName ItemKind
S_TENTACLE, CStore
COrgan)
               , (GroupName ItemKind
S_TENTACLE, CStore
COrgan), (GroupName ItemKind
S_TENTACLE, CStore
COrgan)
               , (GroupName ItemKind
S_SMALL_BEAK, CStore
COrgan)  -- TODO: use when tentacles torn out
               , (GroupName ItemKind
S_EYE_8, CStore
COrgan)
                   -- shots not too damaging, so can have strong sight
               , (GroupName ItemKind
S_ANIMAL_BRAIN, CStore
COrgan)
               , (GroupName ItemKind
S_ANIMAL_STOMACH, CStore
COrgan), (GroupName ItemKind
GENETIC_FLAW_3, CStore
COrgan)
               , (GroupName ItemKind
RAW_MEAT_CHUNK, CStore
CEqp), (GroupName ItemKind
RAW_MEAT_CHUNK, CStore
CEqp) ]
 }
lion :: ItemKind
lion = ItemKind :: ContentSymbol ItemKind
-> Text
-> Freqs ItemKind
-> [Flavour]
-> Dice
-> Rarity
-> Text
-> Int
-> Dice
-> [Aspect]
-> [Effect]
-> [(GroupName ItemKind, CStore)]
-> Text
-> ItemKind
ItemKind  -- emphatically not a tank
  { isymbol :: ContentSymbol ItemKind
isymbol  = ContentSymbol ItemKind -> ContentSymbol ItemKind
forall c. ContentSymbol ItemKind -> ContentSymbol ItemKind
toContentSymbol ContentSymbol ItemKind
'l'
  , iname :: Text
iname    = Text
"Lion"
  , 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
Red]
  , icount :: Dice
icount   = Dice
1
  , irarity :: Rarity
irarity  = [(Double
10, Int
0), (Double
30, Int
50)]  -- only appears among late spawns
  , iverbHit :: Text
iverbHit = Text
"thud"
  , iweight :: Int
iweight  = Int
140000
  , idamage :: Dice
idamage  = Dice
0
  , iaspects :: [Aspect]
iaspects = [ Skill -> Dice -> Aspect
AddSkill Skill
SkMaxHP Dice
120, Skill -> Dice -> Aspect
AddSkill Skill
SkMaxCalm Dice
80
               , Skill -> Dice -> Aspect
AddSkill Skill
SkSpeed Dice
30, Skill -> Dice -> Aspect
AddSkill Skill
SkNocto Dice
2
               , Skill -> Dice -> Aspect
AddSkill Skill
SkHurtMelee Dice
60  -- great fighter
               , Skill -> Dice -> Aspect
AddSkill Skill
SkAggression Dice
2  -- late spawn
               , Skill -> Dice -> Aspect
AddSkill Skill
SkApply Dice
1  -- can eat food despite the genetic flaw
               , Flag -> Aspect
SetFlag Flag
Durable ]
  , ieffects :: [Effect]
ieffects = []
  , idesc :: Text
idesc    = Text
"At the repeated violation of their pride area, the irritated felines emerge from hiding."
  , ikit :: [(GroupName ItemKind, CStore)]
ikit     = [ (GroupName ItemKind
S_POWERFUL_HIND_LEGS, CStore
COrgan)
               , (GroupName ItemKind
S_LARGE_JAW, CStore
COrgan), (GroupName ItemKind
S_SMALL_CLAW, CStore
COrgan)
               , (GroupName ItemKind
S_EYE_6, CStore
COrgan), (GroupName ItemKind
S_EAR_6, CStore
COrgan)
               , (GroupName ItemKind
S_ANIMAL_BRAIN, CStore
COrgan)
               , (GroupName ItemKind
S_ANIMAL_STOMACH, CStore
COrgan), (GroupName ItemKind
GENETIC_FLAW_10, CStore
COrgan)
               , (GroupName ItemKind
RAW_MEAT_CHUNK, CStore
CEqp), (GroupName ItemKind
RAW_MEAT_CHUNK, CStore
CEqp) ]
  }

-- * Animal uniques

rhinoceros :: ItemKind
rhinoceros = ItemKind :: ContentSymbol ItemKind
-> Text
-> Freqs ItemKind
-> [Flavour]
-> Dice
-> Rarity
-> Text
-> Int
-> Dice
-> [Aspect]
-> [Effect]
-> [(GroupName ItemKind, CStore)]
-> Text
-> ItemKind
ItemKind  -- impressive tank boss with some armor
  { isymbol :: ContentSymbol ItemKind
isymbol  = ContentSymbol ItemKind -> ContentSymbol ItemKind
forall c. ContentSymbol ItemKind -> ContentSymbol ItemKind
toContentSymbol ContentSymbol ItemKind
'R'
  , iname :: Text
iname    = Text
"Billy"
  , 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
7 Double -> Double -> Double
forall a. Num a => a -> a -> a
* Double
10Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/Double
16, Int
0), (Double
8 Double -> Double -> Double
forall a. Num a => a -> a -> a
* Double
10Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/Double
16, Int
1000), (Double
9 Double -> Double -> Double
forall a. Num a => a -> a -> a
* Double
10Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/Double
16, Int
0)]  -- unique
  , iverbHit :: Text
iverbHit = Text
"thud"
  , iweight :: Int
iweight  = Int
80000
  , idamage :: Dice
idamage  = Dice
0
  , iaspects :: [Aspect]
iaspects = [ Flag -> Aspect
SetFlag Flag
Unique, Text -> Aspect
ELabel Text
"the Maddened Rhinoceros"
               , Skill -> Dice -> Aspect
AddSkill Skill
SkMaxHP Dice
200, Skill -> Dice -> Aspect
AddSkill Skill
SkMaxCalm Dice
60  -- quite late
               , Skill -> Dice -> Aspect
AddSkill Skill
SkSpeed Dice
27, Skill -> Dice -> Aspect
AddSkill Skill
SkNocto Dice
2
               , Skill -> Dice -> Aspect
AddSkill Skill
SkHurtMelee Dice
50  -- mass gives extra damage
               , 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; can use easy stairs
               , Flag -> Aspect
SetFlag Flag
Durable ]
  , ieffects :: [Effect]
ieffects = [Effect -> Effect
OnSmash (Effect -> Effect) -> Effect -> Effect
forall a b. (a -> b) -> a -> b
$ Text -> Text -> Effect
VerbMsg Text
"bellow triumphantly!" Text
""]
  , idesc :: Text
idesc    = Text
"The last of its kind. Blind with rage, or perhaps due to the postoperative scars. A huge mass of muscle that charges at deadly speed."
  , ikit :: [(GroupName ItemKind, CStore)]
ikit     = [ (GroupName ItemKind
S_RHINO_HORN, CStore
COrgan), (GroupName ItemKind
S_FOOT, CStore
COrgan)
               , (GroupName ItemKind
S_RHINO_INERTIA, 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)
               , (GroupName ItemKind
S_ANIMAL_STOMACH, CStore
COrgan)
               , (GroupName ItemKind
RAW_MEAT_CHUNK, CStore
CEqp), (GroupName ItemKind
RAW_MEAT_CHUNK, CStore
CEqp)
               , (GroupName ItemKind
RAW_MEAT_CHUNK, CStore
CEqp), (GroupName ItemKind
RAW_MEAT_CHUNK, CStore
CEqp) ]
  }

-- * 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
25), (GroupName ItemKind
IMMOBILE_ANIMAL, Int
40)]
  , 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) ]
  }

-- * Robots, Allure-specific

-- Robots have any colors but only f, d and r letters. Avoid these letters
-- for other factions.

razorwireFence :: ItemKind
razorwireFence = 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
'f'
  , iname :: Text
iname    = Text
"razorwire fence"
  , ifreq :: Freqs ItemKind
ifreq    = [(GroupName ItemKind
ROBOT, Int
15), (GroupName ItemKind
IMMOBILE_ROBOT, Int
10), (GroupName ItemKind
MECHANICAL_CONTRAPTION, Int
1)]
  , iflavour :: [Flavour]
iflavour = [Color] -> [Flavour]
zipPlain [Color
Cyan]
  , icount :: Dice
icount   = Dice
1
  , irarity :: Rarity
irarity  = [(Double
3 Double -> Double -> Double
forall a. Num a => a -> a -> a
* Double
10Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/Double
16, Int
0), (Double
4 Double -> Double -> Double
forall a. Num a => a -> a -> a
* Double
10Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/Double
16, Int
20), (Double
10, Int
4)]
  , iverbHit :: Text
iverbHit = Text
"scrape"
  , iweight :: Int
iweight  = Int
80000
  , idamage :: Dice
idamage  = Dice
0
  , iaspects :: [Aspect]
iaspects = [ Skill -> Dice -> Aspect
AddSkill Skill
SkArmorMelee Dice
30, Skill -> Dice -> Aspect
AddSkill Skill
SkArmorRanged Dice
15
               , Skill -> Dice -> Aspect
AddSkill Skill
SkMaxHP Dice
30, Skill -> Dice -> Aspect
AddSkill Skill
SkMaxCalm Dice
999
               , Skill -> Dice -> Aspect
AddSkill Skill
SkSpeed Dice
20, 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
"Must have been bought by previous ship owners to contain the wild animal infestation."
  , ikit :: [(GroupName ItemKind, CStore)]
ikit     = [(GroupName ItemKind
S_RAZOR, CStore
COrgan), (GroupName ItemKind
S_THORN, CStore
COrgan)]
  }
electricFence :: ItemKind
electricFence = 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
'f'
  , iname :: Text
iname    = Text
"electric fence"
  , ifreq :: Freqs ItemKind
ifreq    = [(GroupName ItemKind
ROBOT, Int
40), (GroupName ItemKind
IMMOBILE_ROBOT, Int
10), (GroupName ItemKind
MECHANICAL_CONTRAPTION, Int
1)]
  , iflavour :: [Flavour]
iflavour = [Color] -> [Flavour]
zipPlain [Color
Blue]
  , icount :: Dice
icount   = Dice
1
  , irarity :: Rarity
irarity  = [(Double
3 Double -> Double -> Double
forall a. Num a => a -> a -> a
* Double
10Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/Double
16, Int
0), (Double
4 Double -> Double -> Double
forall a. Num a => a -> a -> a
* Double
10Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/Double
16, Int
10), (Double
10, Int
10), (Double
20, Int
10)]
  , 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
999
                   -- no armor, because regenerates; high HP instead
               , Skill -> Dice -> Aspect
AddSkill Skill
SkSpeed Dice
40, 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
"Marginally intelligent electric shepherd. Originally used in orbital dairy farms and planetary zoos. The long support on which proximity sensors, actuators and wires are socketed, ensures animals can't jump above the fence, even in reduced gravity."
  , ikit :: [(GroupName ItemKind, CStore)]
ikit     = [ (GroupName ItemKind
S_LIVE_WIRE, CStore
COrgan), (GroupName ItemKind
ELECTRIC_AMBIENCE, CStore
COrgan)
               , (GroupName ItemKind
POLE_OR_HANDLE, CStore
CEqp) ]
  }
activeFence :: ItemKind
activeFence = 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
'f'
  , iname :: Text
iname    = Text
"active fence"
  , ifreq :: Freqs ItemKind
ifreq    = [(GroupName ItemKind
ROBOT, Int
30), (GroupName ItemKind
IMMOBILE_ROBOT, Int
20), (GroupName ItemKind
MECHANICAL_CONTRAPTION, Int
1)]
  , iflavour :: [Flavour]
iflavour = [Color] -> [Flavour]
zipPlain [Color
BrMagenta]
  , icount :: Dice
icount   = Dice
1
  , irarity :: Rarity
irarity  = [(Double
5 Double -> Double -> Double
forall a. Num a => a -> a -> a
* Double
10Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/Double
16, Int
0), (Double
10, Int
7), (Double
20, Int
10)]
  , iverbHit :: Text
iverbHit = Text
"thud"
  , iweight :: Int
iweight  = Int
80000
  , idamage :: Dice
idamage  = Dice
0
  , iaspects :: [Aspect]
iaspects = [ Skill -> Dice -> Aspect
AddSkill Skill
SkArmorMelee Dice
30, Skill -> Dice -> Aspect
AddSkill Skill
SkArmorRanged Dice
15
               , Skill -> Dice -> Aspect
AddSkill Skill
SkMaxHP Dice
20, Skill -> Dice -> Aspect
AddSkill Skill
SkMaxCalm Dice
999
               , Skill -> Dice -> Aspect
AddSkill Skill
SkSpeed Dice
20, Skill -> Dice -> Aspect
AddSkill Skill
SkNocto Dice
2
               , Skill -> Dice -> Aspect
AddSkill Skill
SkWait Dice
1
               , Skill -> Dice -> Aspect
AddSkill Skill
SkProject Dice
3  -- no brain, but can lob
               , Flag -> Aspect
SetFlag Flag
Durable ]
  , ieffects :: [Effect]
ieffects = []
  , idesc :: Text
idesc    = Text
"Makeshift, mostly non-lethal, autonomous perimeter defense outpost."
  , ikit :: [(GroupName ItemKind, CStore)]
ikit     = [ (GroupName ItemKind
S_VISION_6, CStore
COrgan)
               , (GroupName ItemKind
NEEDLE, CStore
CStash), (GroupName ItemKind
CAN_OF_STICKY_FOAM, CStore
CStash) ]
                   -- can of sticky foam is exploitable, but it spawns
                   -- reasonably often only on one level and not for
                   -- a long period
  }
steamFaucet :: ItemKind
steamFaucet = 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
'f'
  , iname :: Text
iname    = Text
"steam faucet"
  , ifreq :: Freqs ItemKind
ifreq    = [(GroupName ItemKind
ROBOT, Int
8), (GroupName ItemKind
IMMOBILE_ROBOT, Int
15), (GroupName ItemKind
MECHANICAL_CONTRAPTION, Int
1)]
  , iflavour :: [Flavour]
iflavour = [Color] -> [Flavour]
zipPlain [Color
BrGreen]
  , 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
7, 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 cracked valve on one of the superheated water pipes spreading radially outward from the tokamak level."
  , ikit :: [(GroupName ItemKind, CStore)]
ikit     = [(GroupName ItemKind
S_BOILING_VENT, CStore
COrgan), (GroupName ItemKind
S_BOILING_FISSURE, CStore
COrgan)]
  }
coolingFaucet :: ItemKind
coolingFaucet = 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
'f'
  , iname :: Text
iname    = Text
"cooling faucet"
  , ifreq :: Freqs ItemKind
ifreq    = [(GroupName ItemKind
ROBOT, Int
8), (GroupName ItemKind
IMMOBILE_ROBOT, Int
15), (GroupName ItemKind
MECHANICAL_CONTRAPTION, Int
1)]
  , iflavour :: [Flavour]
iflavour = [Color] -> [Flavour]
zipPlain [Color
BrBlue]
  , 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
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
"An emergency pressure-release vent on a supercooling circuit reservoir."
  , ikit :: [(GroupName ItemKind, CStore)]
ikit     = [(GroupName ItemKind
S_COOLING_VENT, CStore
COrgan), (GroupName ItemKind
S_COOLING_FISSURE, CStore
COrgan)]
  }
medbotFaucet :: ItemKind
medbotFaucet = 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
'f'
  , iname :: Text
iname    = Text
"nano medbot faucet"
  , ifreq :: Freqs ItemKind
ifreq    = [(GroupName ItemKind
ROBOT, Int
10), (GroupName ItemKind
IMMOBILE_ROBOT, Int
100), (GroupName ItemKind
MECHANICAL_CONTRAPTION, Int
1)]
  , iflavour :: [Flavour]
iflavour = [Color] -> [Flavour]
zipPlain [Color
BrYellow]
  , 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
"A faucet of a malfunctioning nano medical robot dispenser. Let's hope the medbots are still effective."
  , ikit :: [(GroupName ItemKind, CStore)]
ikit     = [(GroupName ItemKind
S_MEDBOT_VENT, CStore
COrgan), (GroupName ItemKind
S_MEDBOT_FISSURE, CStore
COrgan)]
  }
dustFaucet :: ItemKind
dustFaucet = 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
'f'
  , iname :: Text
iname    = Text
"dust faucet"
  , ifreq :: Freqs ItemKind
ifreq    = [ (GroupName ItemKind
ROBOT, Int
4)  -- usually nothing to ignite
               , (GroupName ItemKind
IMMOBILE_ROBOT, Int
30)  -- except when other faucets around
               , (GroupName ItemKind
MECHANICAL_CONTRAPTION, Int
1) ]
  , iflavour :: [Flavour]
iflavour = [Color] -> [Flavour]
zipPlain [Color
BrCyan]
  , icount :: Dice
icount   = Dice
1
  , irarity :: Rarity
irarity  = [(Double
3, Int
20), (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 torn pipeline for venting flammable powders filtered from cargo areas out into the void, where they cannot ignite. Depending on the pressure in subsidiary ducts, it may contain dust of aluminum, magnesium, titanium, flour, starch, various nitrates and perchlorates."
  , ikit :: [(GroupName ItemKind, CStore)]
ikit     = [(GroupName ItemKind
S_DUST_VENT, CStore
COrgan), (GroupName ItemKind
S_DUST_FISSURE, CStore
COrgan)]
  }
fuelFaucet :: ItemKind
fuelFaucet = 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
'f'
  , iname :: Text
iname    = Text
"burning fuel faucet"
  , ifreq :: Freqs ItemKind
ifreq    = [(GroupName ItemKind
ROBOT, Int
30), (GroupName ItemKind
MECHANICAL_CONTRAPTION, Int
1)]
      -- common not in outermost level but in the dungeon, because it's
      -- self-contained, providing both fuel and ignition
  , iflavour :: [Flavour]
iflavour = [Color] -> [Flavour]
zipPlain [Color
BrRed]
  , icount :: Dice
icount   = Dice
1
  , irarity :: Rarity
irarity  = [(Double
3 Double -> Double -> Double
forall a. Num a => a -> a -> a
* Double
10Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/Double
16, Int
0), (Double
4 Double -> Double -> Double
forall a. Num a => a -> a -> a
* Double
10Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/Double
16, Int
6), (Double
10, Int
12), (Double
20, Int
10)]
  , 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
"Fuel station gone wrong. Multiple emergency subsystems added over the years, owing to valiant regulatory lawmaking efforts, keep it from exploding by turning off and on the vent and each other in a complex cyclical pattern."
  , ikit :: [(GroupName ItemKind, CStore)]
ikit     = [(GroupName ItemKind
S_FUEL_VENT, CStore
COrgan), (GroupName ItemKind
S_FUEL_FISSURE, CStore
COrgan)]
  }
surveillanceDrone :: ItemKind
surveillanceDrone = 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
'd'
  , iname :: Text
iname    = Text
"surveillance drone"
  , ifreq :: Freqs ItemKind
ifreq    = [(GroupName ItemKind
ROBOT, Int
100), (GroupName ItemKind
MOBILE, Int
100), (GroupName ItemKind
MOBILE_ROBOT, Int
100)]
  , iflavour :: [Flavour]
iflavour = [Color] -> [Flavour]
zipPlain [Color
Blue]
  , icount :: Dice
icount   = Dice
1
  , irarity :: Rarity
irarity  = [(Double
1, Int
3)]
  , iverbHit :: Text
iverbHit = Text
"clank"
  , iweight :: Int
iweight  = Int
1000
  , idamage :: Dice
idamage  = Dice
0
  , iaspects :: [Aspect]
iaspects = [ Skill -> Dice -> Aspect
AddSkill Skill
SkArmorMelee Dice
30, Skill -> Dice -> Aspect
AddSkill Skill
SkArmorRanged Dice
15
               , Skill -> Dice -> Aspect
AddSkill Skill
SkMaxHP Dice
6, Skill -> Dice -> Aspect
AddSkill Skill
SkMaxCalm Dice
90
               , Skill -> Dice -> Aspect
AddSkill Skill
SkSpeed Dice
25, Skill -> Dice -> Aspect
AddSkill Skill
SkNocto Dice
2
               , Skill -> Dice -> Aspect
AddSkill Skill
SkMoveItem (-Dice
1)  -- almost as dumb as an animal
               , Skill -> Dice -> Aspect
AddSkill Skill
SkProject (-Dice
1)
               , Skill -> Dice -> Aspect
AddSkill Skill
SkMelee (-Dice
1)
               , Flag -> Aspect
SetFlag Flag
Durable ]
  , ieffects :: [Effect]
ieffects = []
  , idesc :: Text
idesc    = Text
"A video camera in each room would violate privacy of passengers, hence surveillance drones. Programmed to be easy to fend off, they try to keep a respectful distance, even at the cost to themselves."
  , ikit :: [(GroupName ItemKind, CStore)]
ikit     = [ (GroupName ItemKind
S_JET_BOOSTER, CStore
COrgan)
               , (GroupName ItemKind
S_VISION_16, CStore
COrgan), (GroupName ItemKind
S_ROBOT_BRAIN, CStore
COrgan) ]
  }
shepherdDrone :: ItemKind
shepherdDrone = 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
'd'
  , iname :: Text
iname    = Text
"oversight drone"
  , ifreq :: Freqs ItemKind
ifreq    = [ (GroupName ItemKind
ROBOT, Int
100), (GroupName ItemKind
MOBILE, Int
100), (GroupName ItemKind
MOBILE_ROBOT, Int
100)
               , (GroupName ItemKind
CONSTRUCTION_ROBOT, Int
100), (GroupName ItemKind
GAUNTLET_ROBOT, Int
150) ]
  , iflavour :: [Flavour]
iflavour = [Color] -> [Flavour]
zipPlain [Color
BrRed]
  , icount :: Dice
icount   = Dice
1
  , irarity :: Rarity
irarity  = [(Double
1, Int
3), (Double
10, Int
4)]  -- gets summoned often, so low base rarity
  , iverbHit :: Text
iverbHit = Text
"clank"
  , 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
SkMaxHP Dice
10, Skill -> Dice -> Aspect
AddSkill Skill
SkMaxCalm Dice
60
               , Skill -> Dice -> Aspect
AddSkill Skill
SkSpeed Dice
25, Skill -> Dice -> Aspect
AddSkill Skill
SkNocto Dice
2
               , Skill -> Dice -> Aspect
AddSkill Skill
SkAggression Dice
2  -- scout
               , Skill -> Dice -> Aspect
AddSkill Skill
SkMoveItem (-Dice
1)  -- almost as dumb as an animal
               , Skill -> Dice -> Aspect
AddSkill Skill
SkProject (-Dice
1)
               , Flag -> Aspect
SetFlag Flag
Durable ]
  , ieffects :: [Effect]
ieffects = []
  , idesc :: Text
idesc    = Text
"A tiny airborne robot designed to take construction measurements, synchronize robot workers and report irregularities. It seems to be in need of resetting itself."
  , ikit :: [(GroupName ItemKind, CStore)]
ikit     = [ (GroupName ItemKind
S_JET_BOOSTER, CStore
COrgan), (GroupName ItemKind
S_LIVE_WIRE, CStore
COrgan)
               , (GroupName ItemKind
S_VISION_16, CStore
COrgan), (GroupName ItemKind
S_EAR_8, CStore
COrgan)
               , (GroupName ItemKind
S_ROBOT_BRAIN, CStore
COrgan) ]
  }
huntingDrone :: ItemKind
huntingDrone = 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
'd'
  , iname :: Text
iname    = Text
"hunting drone"
  , ifreq :: Freqs ItemKind
ifreq    = [(GroupName ItemKind
ROBOT, Int
100), (GroupName ItemKind
MOBILE, Int
100), (GroupName ItemKind
MOBILE_ROBOT, Int
100)]
  , iflavour :: [Flavour]
iflavour = [Color] -> [Flavour]
zipPlain [Color
Green]
  , icount :: Dice
icount   = Dice
1
  , irarity :: Rarity
irarity  = [(Double
4, Int
0), (Double
5, Int
5), (Double
10, Int
8), (Double
20, Int
10)]
  , iverbHit :: Text
iverbHit = Text
"clank"
  , iweight :: Int
iweight  = Int
500
  , idamage :: Dice
idamage  = Dice
0
  , iaspects :: [Aspect]
iaspects = [ Skill -> Dice -> Aspect
AddSkill Skill
SkArmorMelee Dice
30, Skill -> Dice -> Aspect
AddSkill Skill
SkArmorRanged Dice
15
               , 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
               , Skill -> Dice -> Aspect
AddSkill Skill
SkMoveItem (-Dice
1)  -- almost as dumb as an animal
               , Skill -> Dice -> Aspect
AddSkill Skill
SkMelee (-Dice
1)  -- but can project
               , Flag -> Aspect
SetFlag Flag
Durable ]
  , ieffects :: [Effect]
ieffects = []
  , idesc :: Text
idesc    = Text
"Originally designed for hunting down and putting to sleep stray animals. The sleeping agent has long since dried up and the propulsion got rather unpredictable."
  , ikit :: [(GroupName ItemKind, CStore)]
ikit     = [ (GroupName ItemKind
S_JET_BOOSTER, CStore
COrgan)
               , (GroupName ItemKind
S_EYE_8, CStore
COrgan), (GroupName ItemKind
S_NOSTRIL, CStore
COrgan), (GroupName ItemKind
S_EAR_8, CStore
COrgan)
                   -- week projectiles, so strong sight OK
               , (GroupName ItemKind
S_ROBOT_BRAIN, CStore
COrgan)
               , (GroupName ItemKind
NEEDLE, CStore
CStash), (GroupName ItemKind
TRANQUILIZER_DART, CStore
CStash) ]
  }
homeRobot :: ItemKind
homeRobot = 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
"feral home robot"
               -- TODO: name another 'deranged', tertiary imperative: survival
  , ifreq :: Freqs ItemKind
ifreq    = [ (GroupName ItemKind
ROBOT, Int
100), (GroupName ItemKind
MOBILE, Int
100), (GroupName ItemKind
MOBILE_ROBOT, Int
100)
               , (GroupName ItemKind
GAUNTLET_ROBOT, Int
100) ]
  , iflavour :: [Flavour]
iflavour = [Color] -> [Flavour]
zipPlain [Color
Magenta]
  , icount :: Dice
icount   = Dice
1
  , irarity :: Rarity
irarity  = [(Double
1, Int
15), (Double
10, Int
5)]
  , iverbHit :: Text
iverbHit = Text
"clank"
  , iweight :: Int
iweight  = Int
80000
  , idamage :: Dice
idamage  = Dice
0
  , iaspects :: [Aspect]
iaspects = [ Skill -> Dice -> Aspect
AddSkill Skill
SkMaxHP Dice
12, 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
SkProject (-Dice
1)  -- can't project
               , Flag -> Aspect
SetFlag Flag
Durable ]
  , ieffects :: [Effect]
ieffects = []
  , idesc :: Text
idesc    = Text
"Once a timid household robot, now sufficiently adapted to survive in the deadly environment."
  , ikit :: [(GroupName ItemKind, CStore)]
ikit     = [ (GroupName ItemKind
S_FIST, 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_ROBOT_BRAIN, CStore
COrgan) ]
  }
wasteRobot :: ItemKind
wasteRobot = ItemKind :: ContentSymbol ItemKind
-> Text
-> Freqs ItemKind
-> [Flavour]
-> Dice
-> Rarity
-> Text
-> Int
-> Dice
-> [Aspect]
-> [Effect]
-> [(GroupName ItemKind, CStore)]
-> Text
-> ItemKind
ItemKind  -- not a tank, because smell-only alien is already a tank
  { isymbol :: ContentSymbol ItemKind
isymbol  = ContentSymbol ItemKind -> ContentSymbol ItemKind
forall c. ContentSymbol ItemKind -> ContentSymbol ItemKind
toContentSymbol ContentSymbol ItemKind
'r'
  , iname :: Text
iname    = Text
"waste disposal robot"
  , ifreq :: Freqs ItemKind
ifreq    = [ (GroupName ItemKind
ROBOT, Int
100), (GroupName ItemKind
MOBILE, Int
100), (GroupName ItemKind
MOBILE_ROBOT, Int
100)
               , (GroupName ItemKind
CONSTRUCTION_ROBOT, Int
100) ]
  , iflavour :: [Flavour]
iflavour = [Color] -> [Flavour]
zipPlain [Color
Green]
  , icount :: Dice
icount   = Dice
1
  , irarity :: Rarity
irarity  = [(Double
5, Int
9)]  -- gets summoned often, so low base rarity
  , iverbHit :: Text
iverbHit = Text
"clank"
  , 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
30
               , Skill -> Dice -> Aspect
AddSkill Skill
SkSpeed Dice
15, Skill -> Dice -> Aspect
AddSkill Skill
SkNocto Dice
2
               , Flag -> Aspect
SetFlag Flag
Durable ]
  , ieffects :: [Effect]
ieffects = []
  , idesc :: Text
idesc    = Text
"You are not in its database, hence you are waste. It can't see and you smell funny, so that's it."
  , ikit :: [(GroupName ItemKind, CStore)]
ikit     = [ (GroupName ItemKind
S_TENTACLE, CStore
COrgan), (GroupName ItemKind
S_SNOUT, CStore
COrgan)
               , (GroupName ItemKind
S_NOSTRIL, CStore
COrgan)  -- only smell, for variety
               , (GroupName ItemKind
S_ROBOT_BRAIN, CStore
COrgan)
               , (GroupName ItemKind
WASTE_CONTAINER, CStore
CEqp) ]
  }
wasteRobotNoEqp :: ItemKind
wasteRobotNoEqp = ItemKind
wasteRobot  -- no drops, for gauntlet and to avoid junk
  { ifreq :: Freqs ItemKind
ifreq    = [ (GroupName ItemKind
MOBILE, Int
100), (GroupName ItemKind
GAUNTLET_ROBOT, Int
250) ]
  , ikit :: [(GroupName ItemKind, CStore)]
ikit     = [ (GroupName ItemKind
S_TENTACLE, CStore
COrgan), (GroupName ItemKind
S_SNOUT, CStore
COrgan)
               , (GroupName ItemKind
S_NOSTRIL, CStore
COrgan)  -- only smell, for variety
               , (GroupName ItemKind
S_ROBOT_BRAIN, CStore
COrgan) ]
  }
lightRobot :: ItemKind
lightRobot = 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
"decoration robot"
  , ifreq :: Freqs ItemKind
ifreq    = [ (GroupName ItemKind
ROBOT, Int
100), (GroupName ItemKind
MOBILE, Int
100), (GroupName ItemKind
MOBILE_ROBOT, Int
100)
               , (GroupName ItemKind
CONSTRUCTION_ROBOT, Int
100) ]
  , iflavour :: [Flavour]
iflavour = [Color] -> [Flavour]
zipPlain [Color
BrYellow]
  , icount :: Dice
icount   = Dice
1
  , irarity :: Rarity
irarity  = [(Double
3 Double -> Double -> Double
forall a. Num a => a -> a -> a
* Double
10Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/Double
16, Int
0), (Double
4 Double -> Double -> Double
forall a. Num a => a -> a -> a
* Double
10Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/Double
16, Int
6), (Double
10, Int
6)]
                 -- gets summoned often, so low rarity
  , iverbHit :: Text
iverbHit = Text
"clank"
  , iweight :: Int
iweight  = Int
80000
  , idamage :: Dice
idamage  = Dice
0
  , iaspects :: [Aspect]
iaspects = [ Skill -> Dice -> Aspect
AddSkill Skill
SkMaxHP Dice
17, Skill -> Dice -> Aspect
AddSkill Skill
SkMaxCalm Dice
40
                   -- can't summon again for a long time;
                   -- loses a lot of sight after summoning
               , Skill -> Dice -> Aspect
AddSkill Skill
SkSpeed Dice
30, Skill -> Dice -> Aspect
AddSkill Skill
SkNocto Dice
2
               , Skill -> Dice -> Aspect
AddSkill Skill
SkProject Dice
2  -- can lob
               , Skill -> Dice -> Aspect
AddSkill Skill
SkAlter Dice
3  -- uses all stairs
               , Skill -> Dice -> Aspect
AddSkill Skill
SkApply Dice
1  -- can apply the hooter
               , Flag -> Aspect
SetFlag Flag
Durable ]
  , ieffects :: [Effect]
ieffects = []
  , idesc :: Text
idesc    = Text
"Interior and exterior decoration robot. Strongly fancies deep reds recently."
  , ikit :: [(GroupName ItemKind, CStore)]
ikit     = [ (GroupName ItemKind
S_HOOKED_CLAW, CStore
COrgan), (GroupName ItemKind
S_TENTACLE, CStore
COrgan), (GroupName ItemKind
S_FOOT, CStore
COrgan)
               , (GroupName ItemKind
S_HULL_PLATING, CStore
COrgan)
               , (GroupName ItemKind
S_EYE_6, CStore
COrgan), (GroupName ItemKind
S_EAR_8, CStore
COrgan)
               , (GroupName ItemKind
S_ROBOT_BRAIN, CStore
COrgan)
               , (GroupName ItemKind
CONSTRUCTION_HOOTER, CStore
CEqp) ]
  }
heavyRobot :: ItemKind
heavyRobot = ItemKind :: ContentSymbol ItemKind
-> Text
-> Freqs ItemKind
-> [Flavour]
-> Dice
-> Rarity
-> Text
-> Int
-> Dice
-> [Aspect]
-> [Effect]
-> [(GroupName ItemKind, CStore)]
-> Text
-> ItemKind
ItemKind  -- summoning tank with armor, but fortunately weak
                       -- weapons; danger when strong weapons wielded!
  { isymbol :: ContentSymbol ItemKind
isymbol  = ContentSymbol ItemKind -> ContentSymbol ItemKind
forall c. ContentSymbol ItemKind -> ContentSymbol ItemKind
toContentSymbol ContentSymbol ItemKind
'r'
  , iname :: Text
iname    = Text
"demolition robot"
  , ifreq :: Freqs ItemKind
ifreq    = [ (GroupName ItemKind
ROBOT, Int
100), (GroupName ItemKind
MOBILE, Int
100), (GroupName ItemKind
MOBILE_ROBOT, Int
100)
               , (GroupName ItemKind
CONSTRUCTION_ROBOT, Int
70) ]
  , iflavour :: [Flavour]
iflavour = [Color] -> [Flavour]
zipPlain [Color
Cyan]
  , icount :: Dice
icount   = Dice
1
  , irarity :: Rarity
irarity  = [(Double
7 Double -> Double -> Double
forall a. Num a => a -> a -> a
* Double
10Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/Double
16, Int
0), (Double
8 Double -> Double -> Double
forall a. Num a => a -> a -> a
* Double
10Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/Double
16, Int
4), (Double
10, Int
13), (Double
30, Int
30)]
  , iverbHit :: Text
iverbHit = Text
"clank"
  , iweight :: Int
iweight  = Int
800000
  , idamage :: Dice
idamage  = Dice
0
  , iaspects :: [Aspect]
iaspects = [ Skill -> Dice -> Aspect
AddSkill Skill
SkMaxHP Dice
60, Skill -> Dice -> Aspect
AddSkill Skill
SkMaxCalm Dice
40
                   -- can't summon again for a long time;
                   -- loses a lot of sight after summoning
               , 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
SkAlter Dice
3  -- uses all stairs
               , Skill -> Dice -> Aspect
AddSkill Skill
SkApply Dice
1  -- can apply the hooter
               , Flag -> Aspect
SetFlag Flag
Durable ]
  , ieffects :: [Effect]
ieffects = []
  , idesc :: Text
idesc    = Text
"Heavy multi-purpose construction robot. Excels at discharging, dismantling and demolition."
  , ikit :: [(GroupName ItemKind, CStore)]
ikit     = [ (GroupName ItemKind
S_HORN, CStore
COrgan), (GroupName ItemKind
S_FIST, CStore
COrgan), (GroupName ItemKind
S_SMALL_CLAW, CStore
COrgan)
               , (GroupName ItemKind
S_HULL_PLATING, CStore
COrgan)
               , (GroupName ItemKind
S_EYE_3, CStore
COrgan), (GroupName ItemKind
S_EAR_6, CStore
COrgan)
               , (GroupName ItemKind
S_ROBOT_BRAIN, CStore
COrgan)
               , (GroupName ItemKind
SPOTLIGHT, CStore
CEqp), (GroupName ItemKind
CONSTRUCTION_HOOTER, CStore
CEqp) ]
  }

-- * Robot uniques, Allure-specific

weldedRobot :: ItemKind
weldedRobot = 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
'L'
  , iname :: Text
iname    = Text
"Bob"
  , ifreq :: Freqs ItemKind
ifreq    = [(GroupName ItemKind
ROBOT, Int
100), (GroupName ItemKind
IMMOBILE_ROBOT, Int
100)]
  , iflavour :: [Flavour]
iflavour = [Color] -> [Flavour]
zipPlain [Color
BrCyan]
  , icount :: Dice
icount   = Dice
1
  , irarity :: Rarity
irarity  = [(Double
1 Double -> Double -> Double
forall a. Num a => a -> a -> a
* Double
10Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/Double
16, Int
1000), (Double
2 Double -> Double -> Double
forall a. Num a => a -> a -> a
* Double
10Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/Double
16, Int
0)]  -- unique
  , iverbHit :: Text
iverbHit = Text
"clank"
  , iweight :: Int
iweight  = Int
80000
  , idamage :: Dice
idamage  = Dice
0
  , iaspects :: [Aspect]
iaspects = [ Flag -> Aspect
SetFlag Flag
Unique, Text -> Aspect
ELabel Text
"the Welded Luggage Robot"
               , Skill -> Dice -> Aspect
AddSkill Skill
SkMaxHP Dice
200, Skill -> Dice -> Aspect
AddSkill Skill
SkMaxCalm Dice
100
               , Skill -> Dice -> Aspect
AddSkill Skill
SkSpeed Dice
20, Skill -> Dice -> Aspect
AddSkill Skill
SkNocto Dice
2
               , Flag -> Aspect
SetFlag Flag
Durable ]
  , ieffects :: [Effect]
ieffects = [Effect -> Effect
OnSmash (Effect -> Effect) -> Effect -> Effect
forall a b. (a -> b) -> a -> b
$ Text -> Text -> Effect
VerbMsg Text
"lament dying with disfigured and welded feet that nobody wanted to fix with the blowtorch" Text
"."]
  , idesc :: Text
idesc    = Text
"A well-built humanoid luggage unloading robot with a smooth silvery satin skin. Its graceful moves are stunted by a thick irregular weld fastening both its shapely legs to the floor. A whiff of smoke escapes whenever it opens its mouth in a charming toothy smile while brandishing a blowtorch in its trembling hand. Blowtorch! That's the key to open the welded staircase."
  , ikit :: [(GroupName ItemKind, CStore)]
ikit     = [ (GroupName ItemKind
S_FIST, CStore
COrgan)
               , (GroupName ItemKind
S_EYE_6, CStore
COrgan), (GroupName ItemKind
S_EAR_3, CStore
COrgan)
               , (GroupName ItemKind
S_MOUTH_VENT, CStore
COrgan)
               , (GroupName ItemKind
S_ROBOT_BRAIN, CStore
COrgan)
               , (GroupName ItemKind
S_CRUDE_WELD, CStore
COrgan)
               , (GroupName ItemKind
S_CURRENCY, CStore
CGround) -- to ensure newbies know to visit
               , (GroupName ItemKind
BLOWTORCH, CStore
CEqp)
               , (GroupName ItemKind
S_PERFUME_POTION, CStore
CStash), (GroupName ItemKind
WIRECUTTING_TOOL, CStore
CStash) ]
                   -- establish stash to ensure heroes pick up blowtorch ASAP
  }
cleanerRobot :: ItemKind
cleanerRobot = 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
'C'
  , iname :: Text
iname    = Text
"The Void Cleaner Robot"
  , ifreq :: Freqs ItemKind
ifreq    = [(GroupName ItemKind
ROBOT, Int
100), (GroupName ItemKind
MOBILE, Int
1)]
  , iflavour :: [Flavour]
iflavour = [Color] -> [Flavour]
zipPlain [Color
BrGreen]
  , icount :: Dice
icount   = Dice
1
  , irarity :: Rarity
irarity  = [(Double
11 Double -> Double -> Double
forall a. Num a => a -> a -> a
* Double
10Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/Double
16, Int
0), (Double
12 Double -> Double -> Double
forall a. Num a => a -> a -> a
* Double
10Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/Double
16, Int
1000), (Double
13 Double -> Double -> Double
forall a. Num a => a -> a -> a
* Double
10Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/Double
16, Int
0)]  -- unique
  , iverbHit :: Text
iverbHit = Text
"clank"
  , iweight :: Int
iweight  = Int
800000
  , idamage :: Dice
idamage  = Dice
0
  , iaspects :: [Aspect]
iaspects = [ Flag -> Aspect
SetFlag Flag
Unique
               , Skill -> Dice -> Aspect
AddSkill Skill
SkMaxHP Dice
120
                   -- doubly regenerates and huge armor (72), so lower HP
               , Skill -> Dice -> Aspect
AddSkill Skill
SkMaxCalm Dice
40
                   -- can't summon again for a long time;
                   -- loses a lot of sight after summoning
               , Skill -> Dice -> Aspect
AddSkill Skill
SkSpeed Dice
18, Skill -> Dice -> Aspect
AddSkill Skill
SkNocto Dice
2
               , Skill -> Dice -> Aspect
AddSkill Skill
SkAggression Dice
1
                   -- can't use hard stairs nor dig; a weak miniboss;
                   -- however, it can use the easy stairs and so change levels
               , Skill -> Dice -> Aspect
AddSkill Skill
SkApply Dice
1  -- can apply the hooter
               , Flag -> Aspect
SetFlag Flag
Durable ]
  , ieffects :: [Effect]
ieffects = [Effect -> Effect
OnSmash (Effect -> Effect) -> Effect -> Effect
forall a b. (a -> b) -> a -> b
$ Text -> Text -> Effect
VerbMsg Text
"clumsily try to pick up a dust speck" Text
"."]
  , idesc :: Text
idesc    = Text
"An oversize waste disposal robot repaired with parts from a demolition robot, including a scaled up goal matrix. The cosmic void is now the only acceptable model of cleanliness. The robot's bulky trunk doesn't fit into even the larger lift carriages."
  , ikit :: [(GroupName ItemKind, CStore)]
ikit     = [ (GroupName ItemKind
S_TENTACLE, CStore
COrgan), (GroupName ItemKind
S_SNOUT, CStore
COrgan)
               , (GroupName ItemKind
S_HORN, CStore
COrgan), (GroupName ItemKind
S_SMALL_CLAW, CStore
COrgan)  -- no fist
               , (GroupName ItemKind
S_LIVE_WIRE, CStore
COrgan)  -- patched from parts
               , (GroupName ItemKind
ELECTRIC_AMBIENCE, CStore
COrgan)  -- regeneration
               , (GroupName ItemKind
S_BOILING_VENT, CStore
COrgan)  -- regeneration
               , (GroupName ItemKind
S_HULL_PLATING, CStore
COrgan)
                   -- the only such armor, except for weak animals; plus
                   -- the WASTE_CONTAINER, so only hammers and proj effective
               , (GroupName ItemKind
S_EYE_3, CStore
COrgan), (GroupName ItemKind
S_NOSTRIL, CStore
COrgan), (GroupName ItemKind
S_EAR_6, CStore
COrgan)
               , (GroupName ItemKind
S_ROBOT_BRAIN, CStore
COrgan)
               , (GroupName ItemKind
S_CURRENCY, CStore
CStash)
               , (GroupName ItemKind
S_CURRENCY, CStore
CStash)
               , (GroupName ItemKind
S_CURRENCY, CStore
CStash)
               , (GroupName ItemKind
WASTE_CONTAINER, CStore
CEqp), (GroupName ItemKind
SPOTLIGHT, CStore
CEqp)
               , (GroupName ItemKind
CONSTRUCTION_HOOTER, CStore
CEqp) ]
  }