-- | Definitions of items embedded in map tiles.
module Content.ItemKindEmbed
  ( -- * Group name patterns
    pattern SCRATCH_ON_WALL, pattern OBSCENE_PICTOGRAM, pattern SUBTLE_FRESCO, pattern TREASURE_CACHE, pattern TREASURE_CACHE_TRAP, pattern SIGNAGE, pattern SMALL_FIRE, pattern BIG_FIRE, pattern FROST, pattern RUBBLE, pattern DOORWAY_TRAP_UNKNOWN, pattern DOORWAY_TRAP, pattern STAIRS_UP, pattern STAIRS_DOWN, pattern ESCAPE, pattern STAIRS_TRAP_UP, pattern STAIRS_TRAP_DOWN, pattern LECTERN, pattern SHALLOW_WATER, pattern STRAIGHT_PATH, pattern FROZEN_GROUND
  , embedsGN
  , -- * Content
    embeds
  ) where

import Prelude ()

import Game.LambdaHack.Core.Prelude

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

import Content.ItemKindActor
import Content.ItemKindBlast
import Content.ItemKindTemporary

-- * Group name patterns

embedsGN :: [GroupName ItemKind]
embedsGN :: [GroupName ItemKind]
embedsGN =
       [GroupName ItemKind
SCRATCH_ON_WALL, GroupName ItemKind
OBSCENE_PICTOGRAM, GroupName ItemKind
SUBTLE_FRESCO, GroupName ItemKind
TREASURE_CACHE, GroupName ItemKind
TREASURE_CACHE_TRAP, GroupName ItemKind
SIGNAGE, GroupName ItemKind
SMALL_FIRE, GroupName ItemKind
BIG_FIRE, GroupName ItemKind
FROST, GroupName ItemKind
RUBBLE, GroupName ItemKind
DOORWAY_TRAP_UNKNOWN, GroupName ItemKind
DOORWAY_TRAP, GroupName ItemKind
STAIRS_UP, GroupName ItemKind
STAIRS_DOWN, GroupName ItemKind
ESCAPE, GroupName ItemKind
STAIRS_TRAP_UP, GroupName ItemKind
STAIRS_TRAP_DOWN, GroupName ItemKind
LECTERN, GroupName ItemKind
SHALLOW_WATER, GroupName ItemKind
STRAIGHT_PATH, GroupName ItemKind
FROZEN_GROUND]

pattern SCRATCH_ON_WALL, OBSCENE_PICTOGRAM, SUBTLE_FRESCO, TREASURE_CACHE, TREASURE_CACHE_TRAP, SIGNAGE, SMALL_FIRE, BIG_FIRE, FROST, RUBBLE, DOORWAY_TRAP_UNKNOWN, DOORWAY_TRAP, STAIRS_UP, STAIRS_DOWN, ESCAPE, STAIRS_TRAP_UP, STAIRS_TRAP_DOWN, LECTERN, SHALLOW_WATER, STRAIGHT_PATH, FROZEN_GROUND :: GroupName ItemKind

pattern $mSCRATCH_ON_WALL :: forall {r}. GroupName ItemKind -> ((# #) -> r) -> ((# #) -> r) -> r
$bSCRATCH_ON_WALL :: GroupName ItemKind
SCRATCH_ON_WALL = GroupName "scratch on wall"
pattern $mOBSCENE_PICTOGRAM :: forall {r}. GroupName ItemKind -> ((# #) -> r) -> ((# #) -> r) -> r
$bOBSCENE_PICTOGRAM :: GroupName ItemKind
OBSCENE_PICTOGRAM = GroupName "obscene pictogram"
pattern $mSUBTLE_FRESCO :: forall {r}. GroupName ItemKind -> ((# #) -> r) -> ((# #) -> r) -> r
$bSUBTLE_FRESCO :: GroupName ItemKind
SUBTLE_FRESCO = GroupName "subtle fresco"
pattern $mTREASURE_CACHE :: forall {r}. GroupName ItemKind -> ((# #) -> r) -> ((# #) -> r) -> r
$bTREASURE_CACHE :: GroupName ItemKind
TREASURE_CACHE = GroupName "treasure cache"
pattern $mTREASURE_CACHE_TRAP :: forall {r}. GroupName ItemKind -> ((# #) -> r) -> ((# #) -> r) -> r
$bTREASURE_CACHE_TRAP :: GroupName ItemKind
TREASURE_CACHE_TRAP = GroupName "treasure cache trap"
pattern $mSIGNAGE :: forall {r}. GroupName ItemKind -> ((# #) -> r) -> ((# #) -> r) -> r
$bSIGNAGE :: GroupName ItemKind
SIGNAGE = GroupName "signage"
pattern $mSMALL_FIRE :: forall {r}. GroupName ItemKind -> ((# #) -> r) -> ((# #) -> r) -> r
$bSMALL_FIRE :: GroupName ItemKind
SMALL_FIRE = GroupName "small fire"
pattern $mBIG_FIRE :: forall {r}. GroupName ItemKind -> ((# #) -> r) -> ((# #) -> r) -> r
$bBIG_FIRE :: GroupName ItemKind
BIG_FIRE = GroupName "big fire"
pattern $mFROST :: forall {r}. GroupName ItemKind -> ((# #) -> r) -> ((# #) -> r) -> r
$bFROST :: GroupName ItemKind
FROST = GroupName "frozen mass"
pattern $mRUBBLE :: forall {r}. GroupName ItemKind -> ((# #) -> r) -> ((# #) -> r) -> r
$bRUBBLE :: GroupName ItemKind
RUBBLE = GroupName "rubble"
pattern $mDOORWAY_TRAP_UNKNOWN :: forall {r}. GroupName ItemKind -> ((# #) -> r) -> ((# #) -> r) -> r
$bDOORWAY_TRAP_UNKNOWN :: GroupName ItemKind
DOORWAY_TRAP_UNKNOWN = GroupName "doorway trap unknown"
pattern $mDOORWAY_TRAP :: forall {r}. GroupName ItemKind -> ((# #) -> r) -> ((# #) -> r) -> r
$bDOORWAY_TRAP :: GroupName ItemKind
DOORWAY_TRAP = GroupName "doorway trap"
pattern $mSTAIRS_UP :: forall {r}. GroupName ItemKind -> ((# #) -> r) -> ((# #) -> r) -> r
$bSTAIRS_UP :: GroupName ItemKind
STAIRS_UP = GroupName "stairs up"
pattern $mSTAIRS_DOWN :: forall {r}. GroupName ItemKind -> ((# #) -> r) -> ((# #) -> r) -> r
$bSTAIRS_DOWN :: GroupName ItemKind
STAIRS_DOWN = GroupName "stairs down"
pattern $mESCAPE :: forall {r}. GroupName ItemKind -> ((# #) -> r) -> ((# #) -> r) -> r
$bESCAPE :: GroupName ItemKind
ESCAPE = GroupName "escape"
pattern $mSTAIRS_TRAP_UP :: forall {r}. GroupName ItemKind -> ((# #) -> r) -> ((# #) -> r) -> r
$bSTAIRS_TRAP_UP :: GroupName ItemKind
STAIRS_TRAP_UP = GroupName "stairs trap up"
pattern $mSTAIRS_TRAP_DOWN :: forall {r}. GroupName ItemKind -> ((# #) -> r) -> ((# #) -> r) -> r
$bSTAIRS_TRAP_DOWN :: GroupName ItemKind
STAIRS_TRAP_DOWN = GroupName "stairs trap down"
pattern $mLECTERN :: forall {r}. GroupName ItemKind -> ((# #) -> r) -> ((# #) -> r) -> r
$bLECTERN :: GroupName ItemKind
LECTERN = GroupName "lectern"
pattern $mSHALLOW_WATER :: forall {r}. GroupName ItemKind -> ((# #) -> r) -> ((# #) -> r) -> r
$bSHALLOW_WATER :: GroupName ItemKind
SHALLOW_WATER = GroupName "shallow water"
pattern $mSTRAIGHT_PATH :: forall {r}. GroupName ItemKind -> ((# #) -> r) -> ((# #) -> r) -> r
$bSTRAIGHT_PATH :: GroupName ItemKind
STRAIGHT_PATH = GroupName "straight path"
pattern $mFROZEN_GROUND :: forall {r}. GroupName ItemKind -> ((# #) -> r) -> ((# #) -> r) -> r
$bFROZEN_GROUND :: GroupName ItemKind
FROZEN_GROUND = GroupName "frozen ground"

-- * Content

embeds :: [ItemKind]
embeds :: [ItemKind]
embeds =
  [ItemKind
scratchOnWall, ItemKind
obscenePictogram, ItemKind
subtleFresco, ItemKind
treasureCache, ItemKind
treasureCacheTrap, ItemKind
signageExit, ItemKind
signageEmbed, ItemKind
signageMerchandise, ItemKind
fireSmall, ItemKind
fireBig, ItemKind
frost, ItemKind
rubble, ItemKind
doorwayTrapTemplate, ItemKind
doorwayTrap1, ItemKind
doorwayTrap2, ItemKind
doorwayTrap3, ItemKind
stairsUp, ItemKind
stairsDown, ItemKind
escape, ItemKind
stairsTrapUp, ItemKind
stairsTrapDown, ItemKind
lectern, ItemKind
shallowWater, ItemKind
straightPath, ItemKind
frozenGround]

scratchOnWall,    obscenePictogram, subtleFresco, treasureCache, treasureCacheTrap, signageExit, signageEmbed, signageMerchandise, fireSmall, fireBig, frost, rubble, doorwayTrapTemplate, doorwayTrap1, doorwayTrap2, doorwayTrap3, stairsUp, stairsDown, escape, stairsTrapUp, stairsTrapDown, lectern, shallowWater, straightPath, frozenGround :: ItemKind


-- Make sure very few walls are substantially useful, e.g., caches,
-- and none that are secret. Otherwise the player will spend a lot of time
-- bumping walls, which is boring compared to fights or dialogues
-- and ever worse, the player will bump all secret walls, wasting time
-- and foregoing the fun of guessing how to find entrance to a disjoint part
-- of the level by bumping the least number of secret walls.
scratchOnWall :: ItemKind
scratchOnWall = ItemKind
  { isymbol :: ContentSymbol ItemKind
isymbol  = ContentSymbol ItemKind -> ContentSymbol ItemKind
forall c. ContentSymbol ItemKind -> ContentSymbol ItemKind
toContentSymbol ContentSymbol ItemKind
'?'
  , iname :: Text
iname    = Text
"claw mark"
  , ifreq :: Freqs ItemKind
ifreq    = [(GroupName ItemKind
SCRATCH_ON_WALL, Int
1)]
  , iflavour :: [Flavour]
iflavour = [Color] -> [Flavour]
zipPlain [Color
BrBlack]
  , icount :: Dice
icount   = Dice
1
  , irarity :: Rarity
irarity  = [(Double
1, Int
1)]
  , iverbHit :: Text
iverbHit = Text
"scratch"
  , iweight :: Int
iweight  = Int
1000
  , idamage :: Dice
idamage  = Dice
0
  , iaspects :: [Aspect]
iaspects = [Flag -> Aspect
SetFlag Flag
Durable]
  , ieffects :: [Effect]
ieffects = [ Text -> Text -> Effect
VerbMsg Text
"start making sense of the scratches" Text
"."
               , DetectKind -> Int -> Effect
Detect DetectKind
DetectHidden Int
4 ]
  , idesc :: Text
idesc    = Text
"A seemingly random series of scratches, carved deep into the wall."
  , ikit :: [(GroupName ItemKind, CStore)]
ikit     = []
  }
obscenePictogram :: ItemKind
obscenePictogram = ItemKind
  { isymbol :: ContentSymbol ItemKind
isymbol  = ContentSymbol ItemKind -> ContentSymbol ItemKind
forall c. ContentSymbol ItemKind -> ContentSymbol ItemKind
toContentSymbol ContentSymbol ItemKind
'*'
  , iname :: Text
iname    = Text
"obscene pictogram"
  , ifreq :: Freqs ItemKind
ifreq    = [(GroupName ItemKind
OBSCENE_PICTOGRAM, Int
1)]
  , iflavour :: [Flavour]
iflavour = [Color] -> [Flavour]
zipPlain [Color
BrMagenta]
  , icount :: Dice
icount   = Dice
1
  , irarity :: Rarity
irarity  = [(Double
1, Int
1)]
  , iverbHit :: Text
iverbHit = Text
"infuriate"
  , iweight :: Int
iweight  = Int
1000
  , idamage :: Dice
idamage  = Dice
0
  , iaspects :: [Aspect]
iaspects = [Dice -> Aspect
Timeout Dice
7, Flag -> Aspect
SetFlag Flag
Durable]
  , ieffects :: [Effect]
ieffects = [ Text -> Text -> Effect
VerbMsg Text
"enter destructive rage at the sight of an obscene pictogram" Text
"."
               , Int -> Effect
RefillCalm (-Int
20)
               , [Effect] -> Effect
OneOf [ GroupName ItemKind -> Dice -> Effect
toOrganGood GroupName ItemKind
S_STRENGTHENED (Dice
3 Dice -> Dice -> Dice
forall a. Num a => a -> a -> a
+ Int
1 Int -> Int -> Dice
`d` Int
2)
                       , Maybe Int -> CStore -> GroupName ItemKind -> TimerDice -> Effect
CreateItem Maybe Int
forall a. Maybe a
Nothing CStore
CGround GroupName ItemKind
S_SANDSTONE_ROCK TimerDice
timerNone ]
               ]
  , idesc :: Text
idesc    = Text
"It's not even anatomically possible."
  , ikit :: [(GroupName ItemKind, CStore)]
ikit     = []
  }
subtleFresco :: ItemKind
subtleFresco = ItemKind
  { isymbol :: ContentSymbol ItemKind
isymbol  = ContentSymbol ItemKind -> ContentSymbol ItemKind
forall c. ContentSymbol ItemKind -> ContentSymbol ItemKind
toContentSymbol ContentSymbol ItemKind
'*'
  , iname :: Text
iname    = Text
"subtle fresco"
  , ifreq :: Freqs ItemKind
ifreq    = [(GroupName ItemKind
SUBTLE_FRESCO, Int
1)]
  , iflavour :: [Flavour]
iflavour = [Color] -> [Flavour]
zipPlain [Color
BrGreen]
  , icount :: Dice
icount   = Dice
1
  , irarity :: Rarity
irarity  = [(Double
1, Int
1)]
  , iverbHit :: Text
iverbHit = Text
"sooth"
  , iweight :: Int
iweight  = Int
1000
  , idamage :: Dice
idamage  = Dice
0
  , iaspects :: [Aspect]
iaspects = [Dice -> Aspect
Timeout Dice
7, Flag -> Aspect
SetFlag Flag
Durable]
  , ieffects :: [Effect]
ieffects = [ Text -> Text -> Effect
VerbMsg Text
"feel refreshed by the subtle fresco" Text
"."
               , GroupName ItemKind -> Dice -> Effect
toOrganGood GroupName ItemKind
S_FAR_SIGHTED (Dice
3 Dice -> Dice -> Dice
forall a. Num a => a -> a -> a
+ Int
1 Int -> Int -> Dice
`d` Int
2)
               , GroupName ItemKind -> Dice -> Effect
toOrganGood GroupName ItemKind
S_KEEN_SMELLING (Dice
3 Dice -> Dice -> Dice
forall a. Num a => a -> a -> a
+ Int
1 Int -> Int -> Dice
`d` Int
2) ]
                 -- hearing gets a boost through bracing, so no need here
  , idesc :: Text
idesc    = Text
"Expensive yet tasteful."
  , ikit :: [(GroupName ItemKind, CStore)]
ikit     = []
  }
treasureCache :: ItemKind
treasureCache = ItemKind
  { isymbol :: ContentSymbol ItemKind
isymbol  = ContentSymbol ItemKind -> ContentSymbol ItemKind
forall c. ContentSymbol ItemKind -> ContentSymbol ItemKind
toContentSymbol ContentSymbol ItemKind
'o'
  , iname :: Text
iname    = Text
"treasure cache"
  , ifreq :: Freqs ItemKind
ifreq    = [(GroupName ItemKind
TREASURE_CACHE, Int
1)]
  , iflavour :: [Flavour]
iflavour = [Color] -> [Flavour]
zipPlain [Color
BrBlue]
  , icount :: Dice
icount   = Dice
1
  , irarity :: Rarity
irarity  = [(Double
1, Int
1)]
  , iverbHit :: Text
iverbHit = Text
"crash"
  , iweight :: Int
iweight  = Int
10000
  , idamage :: Dice
idamage  = Dice
0
  , iaspects :: [Aspect]
iaspects = [Flag -> Aspect
SetFlag Flag
Durable]
  , ieffects :: [Effect]
ieffects = [Maybe Int -> CStore -> GroupName ItemKind -> TimerDice -> Effect
CreateItem Maybe Int
forall a. Maybe a
Nothing CStore
CGround GroupName ItemKind
COMMON_ITEM TimerDice
timerNone]
  , idesc :: Text
idesc    = Text
"Glittering treasure, just waiting to be taken."
  , ikit :: [(GroupName ItemKind, CStore)]
ikit     = []
  }
reliefMsg :: Effect
reliefMsg :: Effect
reliefMsg = Text -> Text -> Effect
VerbMsg Text
"sigh with relief when nothing explodes in your face!" Text
""
treasureCacheTrap :: ItemKind
treasureCacheTrap = ItemKind
  { isymbol :: ContentSymbol ItemKind
isymbol  = ContentSymbol ItemKind -> ContentSymbol ItemKind
forall c. ContentSymbol ItemKind -> ContentSymbol ItemKind
toContentSymbol ContentSymbol ItemKind
'^'
  , iname :: Text
iname    = Text
"cache trap"
  , ifreq :: Freqs ItemKind
ifreq    = [(GroupName ItemKind
TREASURE_CACHE_TRAP, Int
1)]
  , iflavour :: [Flavour]
iflavour = [Color] -> [Flavour]
zipPlain [Color
Red]
  , icount :: Dice
icount   = Dice
1
  , irarity :: Rarity
irarity  = [(Double
1, Int
1)]
  , iverbHit :: Text
iverbHit = Text
"taint"
  , iweight :: Int
iweight  = Int
1000
  , idamage :: Dice
idamage  = Dice
0
  , iaspects :: [Aspect]
iaspects = []  -- not Durable, springs at most once
  , ieffects :: [Effect]
ieffects = [[Effect] -> Effect
OneOf [ GroupName ItemKind -> Dice -> Effect
toOrganBad GroupName ItemKind
S_BLIND (Dice
10 Dice -> Dice -> Dice
forall a. Num a => a -> a -> a
+ Int
1 Int -> Int -> Dice
`d` Int
10)
                      , Int -> Effect
RefillCalm (-Int
99)
                      , GroupName ItemKind -> Effect
Explode GroupName ItemKind
S_FOCUSED_CONCUSSION
                      , Effect
reliefMsg, Effect
reliefMsg ]]
  , idesc :: Text
idesc    = Text
"It's a trap!"
  , ikit :: [(GroupName ItemKind, CStore)]
ikit     = []
  }
signageExit :: ItemKind
signageExit = ItemKind
  { isymbol :: ContentSymbol ItemKind
isymbol  = ContentSymbol ItemKind -> ContentSymbol ItemKind
forall c. ContentSymbol ItemKind -> ContentSymbol ItemKind
toContentSymbol ContentSymbol ItemKind
'?'
  , iname :: Text
iname    = Text
"inscription"
  , ifreq :: Freqs ItemKind
ifreq    = [(GroupName ItemKind
SIGNAGE, Int
100)]
  , iflavour :: [Flavour]
iflavour = [Color] -> [Flavour]
zipPlain [Color
BrGreen]
  , icount :: Dice
icount   = Dice
1
  , irarity :: Rarity
irarity  = [(Double
1, Int
1)]
  , iverbHit :: Text
iverbHit = Text
"whack"
  , iweight :: Int
iweight  = Int
10000
  , idamage :: Dice
idamage  = Dice
0
  , iaspects :: [Aspect]
iaspects = [Flag -> Aspect
SetFlag Flag
Durable]
  , ieffects :: [Effect]
ieffects = [DetectKind -> Int -> Effect
Detect DetectKind
DetectExit Int
100]
  , idesc :: Text
idesc    = Text
"Crude big arrows hastily carved by unknown hands."
  , ikit :: [(GroupName ItemKind, CStore)]
ikit     = []
  }
signageEmbed :: ItemKind
signageEmbed = ItemKind
signageExit
  { iname    = "notice"
  , ifreq    = [(SIGNAGE, 100)]
  , iflavour = zipPlain [Cyan]
  , ieffects = [Detect DetectEmbed 12]
  , idesc    = "The battered poster is untitled and unsigned."
  }
signageMerchandise :: ItemKind
signageMerchandise = ItemKind
signageExit
  { iname    = "treasure map"
  , ifreq    = [(SIGNAGE, 100)]
  , iflavour = zipPlain [BrCyan]
  , ieffects = [Detect DetectLoot 20]
  , idesc    = "In equal parts cryptic and promising."
  }
fireSmall :: ItemKind
fireSmall = ItemKind
  { isymbol :: ContentSymbol ItemKind
isymbol  = ContentSymbol ItemKind -> ContentSymbol ItemKind
forall c. ContentSymbol ItemKind -> ContentSymbol ItemKind
toContentSymbol ContentSymbol ItemKind
'o'
  , iname :: Text
iname    = Text
"small fire"
  , ifreq :: Freqs ItemKind
ifreq    = [(GroupName ItemKind
SMALL_FIRE, Int
1)]
  , iflavour :: [Flavour]
iflavour = [Color] -> [Flavour]
zipPlain [Color
BrRed]
  , icount :: Dice
icount   = Dice
1
  , irarity :: Rarity
irarity  = [(Double
1, Int
1)]
  , iverbHit :: Text
iverbHit = Text
"burn"
  , iweight :: Int
iweight  = Int
10000
  , idamage :: Dice
idamage  = Dice
0
  , iaspects :: [Aspect]
iaspects = [Flag -> Aspect
SetFlag Flag
Durable]
  , ieffects :: [Effect]
ieffects = [Dice -> Effect
Burn Dice
1, GroupName ItemKind -> Effect
Explode GroupName ItemKind
S_SINGLE_SPARK]
  , idesc :: Text
idesc    = Text
"A few small logs, burning brightly."
  , ikit :: [(GroupName ItemKind, CStore)]
ikit     = []
  }
fireBig :: ItemKind
fireBig = ItemKind
fireSmall
  { isymbol  = toContentSymbol '0'
  , iname    = "big fire"
  , ifreq    = [(BIG_FIRE, 1)]
  , iflavour = zipPlain [Red]
  , ieffects = [ Burn 2
               , CreateItem Nothing CGround S_WOODEN_TORCH timerNone
               , Explode S_SPARK ]
  , idesc    = "Glowing with light and warmth."
  , ikit     = []
  }
frost :: ItemKind
frost = ItemKind
  { isymbol :: ContentSymbol ItemKind
isymbol  = ContentSymbol ItemKind -> ContentSymbol ItemKind
forall c. ContentSymbol ItemKind -> ContentSymbol ItemKind
toContentSymbol ContentSymbol ItemKind
'^'
  , iname :: Text
iname    = Text
"frost"
  , ifreq :: Freqs ItemKind
ifreq    = [(GroupName ItemKind
FROST, Int
1)]
  , iflavour :: [Flavour]
iflavour = [Color] -> [Flavour]
zipPlain [Color
BrBlue]
  , icount :: Dice
icount   = Dice
1
  , irarity :: Rarity
irarity  = [(Double
1, Int
1)]
  , iverbHit :: Text
iverbHit = Text
"burn"
  , iweight :: Int
iweight  = Int
10000
  , idamage :: Dice
idamage  = Dice
0
  , iaspects :: [Aspect]
iaspects = [Flag -> Aspect
SetFlag Flag
Durable]
  , ieffects :: [Effect]
ieffects = [ Dice -> Effect
Burn Dice
1  -- sensory ambiguity between hot and cold
               , Int -> Effect
RefillCalm Int
20  -- cold reason
               , ThrowMod -> Effect
PushActor (Int -> Int -> Int -> ThrowMod
ThrowMod Int
400 Int
10 Int
1) ]  -- slippery ice
  , idesc :: Text
idesc    = Text
"Intricate patterns of shining ice."
  , ikit :: [(GroupName ItemKind, CStore)]
ikit     = []
  }
rubble :: ItemKind
rubble = ItemKind
  { isymbol :: ContentSymbol ItemKind
isymbol  = ContentSymbol ItemKind -> ContentSymbol ItemKind
forall c. ContentSymbol ItemKind -> ContentSymbol ItemKind
toContentSymbol ContentSymbol ItemKind
'&'
  , iname :: Text
iname    = Text
"rubble"
  , ifreq :: Freqs ItemKind
ifreq    = [(GroupName ItemKind
RUBBLE, Int
1)]
  , iflavour :: [Flavour]
iflavour = [Color] -> [Flavour]
zipPlain [Color
BrYellow]
  , icount :: Dice
icount   = Dice
1
  , irarity :: Rarity
irarity  = [(Double
1, Int
1)]
  , iverbHit :: Text
iverbHit = Text
"bury"
  , iweight :: Int
iweight  = Int
100000
  , idamage :: Dice
idamage  = Dice
0
  , iaspects :: [Aspect]
iaspects = [Flag -> Aspect
SetFlag Flag
Durable]
  , ieffects :: [Effect]
ieffects = [[Effect] -> Effect
OneOf [ GroupName ItemKind -> Effect
Explode GroupName ItemKind
S_FOCUSED_GLASS_HAIL
                      , GroupName ItemKind -> Dice -> Effect
Summon GroupName ItemKind
MOBILE_ANIMAL (Dice -> Effect) -> Dice -> Effect
forall a b. (a -> b) -> a -> b
$ Int
1 Int -> Int -> Dice
`dL` Int
2
                      , GroupName ItemKind -> Effect
toOrganNoTimer GroupName ItemKind
S_POISONED
                      , Maybe Int -> CStore -> GroupName ItemKind -> TimerDice -> Effect
CreateItem Maybe Int
forall a. Maybe a
Nothing CStore
CGround GroupName ItemKind
ANY_ARROW TimerDice
timerNone
                      , Maybe Int -> CStore -> GroupName ItemKind -> TimerDice -> Effect
CreateItem Maybe Int
forall a. Maybe a
Nothing CStore
CGround GroupName ItemKind
STARTING_WEAPON TimerDice
timerNone
                      , Effect
reliefMsg, Effect
reliefMsg, Effect
reliefMsg
                      , Effect
reliefMsg, Effect
reliefMsg, Effect
reliefMsg ]]
  , idesc :: Text
idesc    = Text
"Broken chunks of rock and glass."
  , ikit :: [(GroupName ItemKind, CStore)]
ikit     = []
  }
doorwayTrapTemplate :: ItemKind
doorwayTrapTemplate = ItemKind
  { isymbol :: ContentSymbol ItemKind
isymbol  = ContentSymbol ItemKind -> ContentSymbol ItemKind
forall c. ContentSymbol ItemKind -> ContentSymbol ItemKind
toContentSymbol ContentSymbol ItemKind
'+'
  , iname :: Text
iname    = Text
"doorway trap"
  , ifreq :: Freqs ItemKind
ifreq    = [(GroupName ItemKind
DOORWAY_TRAP_UNKNOWN, Int
1), (GroupName ItemKind
DOORWAY_TRAP, Int
0)]
      -- the void group needed to pick the item for tile triggering
      -- even when not yet identified
  , iflavour :: [Flavour]
iflavour = [Color] -> [Flavour]
zipPlain [Color]
brightCol
  , icount :: Dice
icount   = Dice
1
  , irarity :: Rarity
irarity  = [(Double
1, Int
1)]
  , iverbHit :: Text
iverbHit = Text
"cripple"
  , iweight :: Int
iweight  = Int
10000
  , idamage :: Dice
idamage  = Dice
0
  , iaspects :: [Aspect]
iaspects = [GroupName ItemKind -> Aspect
PresentAs GroupName ItemKind
DOORWAY_TRAP_UNKNOWN]
      -- not Durable, springs at most once
  , ieffects :: [Effect]
ieffects = []
  , idesc :: Text
idesc    = Text
"Just turn the handle..."
  , ikit :: [(GroupName ItemKind, CStore)]
ikit     = []
  }
doorwayTrap1 :: ItemKind
doorwayTrap1 = ItemKind
doorwayTrapTemplate
  { ifreq    = [(DOORWAY_TRAP, 50)]
  , ieffects = [toOrganBad S_BLIND $ (1 `dL` 4) * 5]
  -- , idesc    = ""
  }
doorwayTrap2 :: ItemKind
doorwayTrap2 = ItemKind
doorwayTrapTemplate
  { ifreq    = [(DOORWAY_TRAP, 25)]
  , ieffects = [toOrganBad S_SLOWED $ (1 `dL` 4) * 10]
  -- , idesc    = ""
  }
doorwayTrap3 :: ItemKind
doorwayTrap3 = ItemKind
doorwayTrapTemplate
  { ifreq    = [(DOORWAY_TRAP, 25)]
  , ieffects = [toOrganBad S_WEAKENED $ (1 `dL` 4) * 10 ]
  -- , idesc    = ""
  }
stairsUp :: ItemKind
stairsUp = ItemKind
  { isymbol :: ContentSymbol ItemKind
isymbol  = ContentSymbol ItemKind -> ContentSymbol ItemKind
forall c. ContentSymbol ItemKind -> ContentSymbol ItemKind
toContentSymbol ContentSymbol ItemKind
'<'
  , iname :: Text
iname    = Text
"flight"
  , ifreq :: Freqs ItemKind
ifreq    = [(GroupName ItemKind
STAIRS_UP, Int
1)]
  , iflavour :: [Flavour]
iflavour = [Color] -> [Flavour]
zipPlain [Color
BrWhite]
  , icount :: Dice
icount   = Dice
1
  , irarity :: Rarity
irarity  = [(Double
1, Int
1)]
  , iverbHit :: Text
iverbHit = Text
"crash"  -- the verb is only used when the item hits,
                        -- not when it's applied otherwise, e.g., from tile
  , iweight :: Int
iweight  = Int
100000
  , idamage :: Dice
idamage  = Dice
0
  , iaspects :: [Aspect]
iaspects = [Text -> Aspect
ELabel Text
"of steps", Flag -> Aspect
SetFlag Flag
Durable]
  , ieffects :: [Effect]
ieffects = [Bool -> Effect
Ascend Bool
True]
  , idesc :: Text
idesc    = Text
"Stairs that rise towards escape."
  , ikit :: [(GroupName ItemKind, CStore)]
ikit     = []
  }
stairsDown :: ItemKind
stairsDown = ItemKind
stairsUp
  { isymbol  = toContentSymbol '>'
  , ifreq    = [(STAIRS_DOWN, 1)]
  , ieffects = [Ascend False]
  , idesc    = ""
  }
escape :: ItemKind
escape = ItemKind
stairsUp
  { isymbol  = toContentSymbol '>'
  , iname    = "way"
  , ifreq    = [(ESCAPE, 1)]
  , iflavour = zipPlain [BrGreen]
  , iaspects = [SetFlag Durable]
  , ieffects = [Escape]
  , idesc    = "May this nightmare have an end?"
                 -- generic escape, so the text should be too;
                 -- for moon outdoors, spaceship, everywhere
  }
stairsTrapUp :: ItemKind
stairsTrapUp = ItemKind
  { isymbol :: ContentSymbol ItemKind
isymbol  = ContentSymbol ItemKind -> ContentSymbol ItemKind
forall c. ContentSymbol ItemKind -> ContentSymbol ItemKind
toContentSymbol ContentSymbol ItemKind
'^'
  , iname :: Text
iname    = Text
"staircase trap"
  , ifreq :: Freqs ItemKind
ifreq    = [(GroupName ItemKind
STAIRS_TRAP_UP, Int
1)]
  , iflavour :: [Flavour]
iflavour = [Color] -> [Flavour]
zipPlain [Color
BrRed]
  , icount :: Dice
icount   = Dice
1
  , irarity :: Rarity
irarity  = [(Double
1, Int
1)]
  , iverbHit :: Text
iverbHit = Text
"buffet"
  , iweight :: Int
iweight  = Int
10000
  , idamage :: Dice
idamage  = Dice
0
  , iaspects :: [Aspect]
iaspects = []  -- not Durable, springs at most once
  , ieffects :: [Effect]
ieffects = [ Text -> Text -> Effect
VerbMsgFail Text
"be caught in an updraft" Text
"."
               , Dice -> Effect
Teleport (Dice -> Effect) -> Dice -> Effect
forall a b. (a -> b) -> a -> b
$ Dice
3 Dice -> Dice -> Dice
forall a. Num a => a -> a -> a
+ Int
1 Int -> Int -> Dice
`dL` Int
10 ]
  , idesc :: Text
idesc    = Text
"A hidden spring, to help the unwary soar."
  , ikit :: [(GroupName ItemKind, CStore)]
ikit     = []
  }
-- Needs to be separate from stairsTrapUp, to make sure the item is
-- registered after up stairs (not only after down stairs)
-- so that effects are invoked in the proper order and, e.g., teleport works.
stairsTrapDown :: ItemKind
stairsTrapDown = ItemKind
stairsTrapUp
  { ifreq    = [(STAIRS_TRAP_DOWN, 1)]
  , iflavour = zipPlain [Red]
  , iverbHit = "open up under"
  , ieffects = [ VerbMsgFail "tumble down the stairwell" "."
               , toOrganGood S_DRUNK (20 + 1 `d` 5) ]
  , idesc    = "A treacherous slab, to teach those who are too proud."
  }
lectern :: ItemKind
lectern = ItemKind
  { isymbol :: ContentSymbol ItemKind
isymbol  = ContentSymbol ItemKind -> ContentSymbol ItemKind
forall c. ContentSymbol ItemKind -> ContentSymbol ItemKind
toContentSymbol ContentSymbol ItemKind
'?'
  , iname :: Text
iname    = Text
"lectern"
  , ifreq :: Freqs ItemKind
ifreq    = [(GroupName ItemKind
LECTERN, Int
1)]
  , iflavour :: [Flavour]
iflavour = [Color] -> [Flavour]
zipFancy [Color
BrYellow]
  , icount :: Dice
icount   = Dice
1
  , irarity :: Rarity
irarity  = [(Double
1, Int
1)]
  , iverbHit :: Text
iverbHit = Text
"ask"
  , iweight :: Int
iweight  = Int
10000
  , idamage :: Dice
idamage  = Dice
0
  , iaspects :: [Aspect]
iaspects = []  -- not Durable, springs at most once
  , ieffects :: [Effect]
ieffects = [ [Effect] -> Effect
OneOf [ Maybe Int -> CStore -> GroupName ItemKind -> TimerDice -> Effect
CreateItem Maybe Int
forall a. Maybe a
Nothing CStore
CGround GroupName ItemKind
ANY_SCROLL TimerDice
timerNone
                       , DetectKind -> Int -> Effect
Detect DetectKind
DetectAll Int
20
                       , GroupName ItemKind -> Dice -> Effect
toOrganBad GroupName ItemKind
S_DEFENSELESS (Dice -> Effect) -> Dice -> Effect
forall a b. (a -> b) -> a -> b
$ (Int
1 Int -> Int -> Dice
`dL` Int
6) Dice -> Dice -> Dice
forall a. Num a => a -> a -> a
* Dice
10
                       , GroupName ItemKind -> Dice -> Effect
toOrganGood GroupName ItemKind
S_DRUNK (Dice
20 Dice -> Dice -> Dice
forall a. Num a => a -> a -> a
+ Int
1 Int -> Int -> Dice
`d` Int
5) ]
               , GroupName ItemKind -> Effect
Explode GroupName ItemKind
S_DEFENSELESSNESS_RUNOUT ]
  , idesc :: Text
idesc    = Text
"A dark wood stand, where strange priests once preached."
  , ikit :: [(GroupName ItemKind, CStore)]
ikit     = []
  }
shallowWater :: ItemKind
shallowWater = ItemKind
  { isymbol :: ContentSymbol ItemKind
isymbol  = ContentSymbol ItemKind -> ContentSymbol ItemKind
forall c. ContentSymbol ItemKind -> ContentSymbol ItemKind
toContentSymbol ContentSymbol ItemKind
'~'
  , iname :: Text
iname    = Text
"shallow water"
  , ifreq :: Freqs ItemKind
ifreq    = [(GroupName ItemKind
SHALLOW_WATER, Int
1)]
  , iflavour :: [Flavour]
iflavour = [Color] -> [Flavour]
zipFancy [Color
BrCyan]
  , icount :: Dice
icount   = Dice
1
  , irarity :: Rarity
irarity  = [(Double
1, Int
1)]
  , iverbHit :: Text
iverbHit = Text
"impede"
  , iweight :: Int
iweight  = Int
10000
  , idamage :: Dice
idamage  = Dice
0
  , iaspects :: [Aspect]
iaspects = [Flag -> Aspect
SetFlag Flag
Durable]
  , ieffects :: [Effect]
ieffects = [Dice -> Effect
ParalyzeInWater Dice
2]
  , idesc :: Text
idesc    = Text
""
  , ikit :: [(GroupName ItemKind, CStore)]
ikit     = []
  }
straightPath :: ItemKind
straightPath = ItemKind
  { isymbol :: ContentSymbol ItemKind
isymbol  = ContentSymbol ItemKind -> ContentSymbol ItemKind
forall c. ContentSymbol ItemKind -> ContentSymbol ItemKind
toContentSymbol ContentSymbol ItemKind
'.'
  , iname :: Text
iname    = Text
"straight path"
  , ifreq :: Freqs ItemKind
ifreq    = [(GroupName ItemKind
STRAIGHT_PATH, Int
1)]
  , iflavour :: [Flavour]
iflavour = [Color] -> [Flavour]
zipFancy [Color
BrRed]
  , icount :: Dice
icount   = Dice
1
  , irarity :: Rarity
irarity  = [(Double
1, Int
1)]
  , iverbHit :: Text
iverbHit = Text
"propel"
  , iweight :: Int
iweight  = Int
10000
  , idamage :: Dice
idamage  = Dice
0
  , iaspects :: [Aspect]
iaspects = [Flag -> Aspect
SetFlag Flag
Durable]
  , ieffects :: [Effect]
ieffects = [Dice -> Effect
InsertMove Dice
2]
  , idesc :: Text
idesc    = Text
""
  , ikit :: [(GroupName ItemKind, CStore)]
ikit     = []
  }
frozenGround :: ItemKind
frozenGround = ItemKind
  { isymbol :: ContentSymbol ItemKind
isymbol  = ContentSymbol ItemKind -> ContentSymbol ItemKind
forall c. ContentSymbol ItemKind -> ContentSymbol ItemKind
toContentSymbol ContentSymbol ItemKind
'.'
  , iname :: Text
iname    = Text
"shade"
  , ifreq :: Freqs ItemKind
ifreq    = [(GroupName ItemKind
FROZEN_GROUND, Int
1)]
  , iflavour :: [Flavour]
iflavour = [Color] -> [Flavour]
zipFancy [Color
BrBlue]
  , icount :: Dice
icount   = Dice
10  -- very thick ice and refreezes, but not too large and boring
  , irarity :: Rarity
irarity  = [(Double
1, Int
1)]
  , iverbHit :: Text
iverbHit = Text
"betray"
  , iweight :: Int
iweight  = Int
10000
  , idamage :: Dice
idamage  = Dice
0
  , iaspects :: [Aspect]
iaspects = [Text -> Aspect
ELabel Text
"of ice"]
                 -- no Durable or some items would be impossible to pick up
  , ieffects :: [Effect]
ieffects = [ThrowMod -> Effect
PushActor (Int -> Int -> Int -> ThrowMod
ThrowMod Int
400 Int
10 Int
1)]
                  -- the high speed represents gliding rather than flying
                  -- and so no need to lift actor's weight off the ground;
                  -- low linger comes from abrupt halt over normal surface
  , idesc :: Text
idesc    = Text
""
  , ikit :: [(GroupName ItemKind, CStore)]
ikit     = []
  }