-- 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.
--
-- | Temporary aspect pseudo-item definitions.
module Content.ItemKindTemporary
  ( -- * Group name patterns
    pattern S_IMMOBILE, pattern S_PACIFIED, pattern S_IRREPLACEABLE, pattern S_RETAINING, pattern S_IMPATIENT, pattern S_DISPOSSESSED, pattern S_WITHHOLDING, pattern S_PARSIMONIOUS
  , pattern S_MORE_MOBILE, pattern S_MORE_COMBATIVE, pattern S_MORE_DISPLACING, pattern S_MORE_MODIFYING, pattern S_MORE_PATIENT, pattern S_MORE_TIDY, pattern S_MORE_PROJECTING, pattern S_MORE_PRACTICAL
  , pattern S_STRENGTHENED, pattern S_WEAKENED, pattern S_PROTECTED_FROM_MELEE, pattern S_PROTECTED_FROM_RANGED, pattern S_DEFENSELESS, pattern S_RESOLUTE, pattern S_HASTED, pattern S_SLOWED, pattern S_FAR_SIGHTED, pattern S_BLIND, pattern S_KEEN_SMELLING, pattern S_FOUL_SMELLING, pattern S_ROSE_SMELLING, pattern S_RANGED_DEFLECTING, pattern S_MELEE_DEFLECTING, pattern S_SHINY_EYED, pattern S_DEAFENED, pattern S_DEAF, pattern S_DRUNK, pattern S_FRENZIED, pattern S_REGENERATING, pattern S_POISONED, pattern S_SLOW_RESISTANT, pattern S_POISON_RESISTANT
  , pattern S_PAINTED
  , temporariesGNSingleton, noStatGN, bonusStatGN
  , -- * Content
    temporaries
  ) 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.Flavour

-- * Group name patterns

noStatGN :: [GroupName ItemKind]
noStatGN :: [GroupName ItemKind]
noStatGN =
       [GroupName ItemKind
S_IMMOBILE, GroupName ItemKind
S_PACIFIED, GroupName ItemKind
S_IRREPLACEABLE, GroupName ItemKind
S_RETAINING, GroupName ItemKind
S_IMPATIENT, GroupName ItemKind
S_DISPOSSESSED, GroupName ItemKind
S_WITHHOLDING, GroupName ItemKind
S_PARSIMONIOUS]

bonusStatGN :: [GroupName ItemKind]
bonusStatGN :: [GroupName ItemKind]
bonusStatGN =
       [GroupName ItemKind
S_MORE_MOBILE, GroupName ItemKind
S_MORE_COMBATIVE, GroupName ItemKind
S_MORE_DISPLACING, GroupName ItemKind
S_MORE_MODIFYING, GroupName ItemKind
S_MORE_PATIENT, GroupName ItemKind
S_MORE_TIDY, GroupName ItemKind
S_MORE_PROJECTING, GroupName ItemKind
S_MORE_PRACTICAL]

temporariesGNSingleton :: [GroupName ItemKind]
temporariesGNSingleton :: [GroupName ItemKind]
temporariesGNSingleton =
       [GroupName ItemKind
S_STRENGTHENED, GroupName ItemKind
S_WEAKENED, GroupName ItemKind
S_PROTECTED_FROM_MELEE, GroupName ItemKind
S_PROTECTED_FROM_RANGED, GroupName ItemKind
S_DEFENSELESS, GroupName ItemKind
S_RESOLUTE, GroupName ItemKind
S_HASTED, GroupName ItemKind
S_SLOWED, GroupName ItemKind
S_FAR_SIGHTED, GroupName ItemKind
S_BLIND, GroupName ItemKind
S_KEEN_SMELLING, GroupName ItemKind
S_FOUL_SMELLING, GroupName ItemKind
S_ROSE_SMELLING, GroupName ItemKind
S_RANGED_DEFLECTING, GroupName ItemKind
S_MELEE_DEFLECTING, GroupName ItemKind
S_SHINY_EYED, GroupName ItemKind
S_DEAFENED, GroupName ItemKind
S_DEAF, GroupName ItemKind
S_DRUNK, GroupName ItemKind
S_FRENZIED, GroupName ItemKind
S_REGENERATING, GroupName ItemKind
S_POISONED, GroupName ItemKind
S_SLOW_RESISTANT, GroupName ItemKind
S_POISON_RESISTANT]
    [GroupName ItemKind]
-> [GroupName ItemKind] -> [GroupName ItemKind]
forall a. [a] -> [a] -> [a]
++ [GroupName ItemKind]
noStatGN [GroupName ItemKind]
-> [GroupName ItemKind] -> [GroupName ItemKind]
forall a. [a] -> [a] -> [a]
++ [GroupName ItemKind]
bonusStatGN
    [GroupName ItemKind]
-> [GroupName ItemKind] -> [GroupName ItemKind]
forall a. [a] -> [a] -> [a]
++ [GroupName ItemKind
S_PAINTED]

pattern S_IMMOBILE, S_PACIFIED, S_IRREPLACEABLE, S_RETAINING, S_IMPATIENT, S_DISPOSSESSED, S_WITHHOLDING, S_PARSIMONIOUS :: GroupName ItemKind

pattern S_MORE_MOBILE, S_MORE_COMBATIVE, S_MORE_DISPLACING, S_MORE_MODIFYING, S_MORE_PATIENT, S_MORE_TIDY, S_MORE_PROJECTING, S_MORE_PRACTICAL :: GroupName ItemKind

pattern S_STRENGTHENED, S_WEAKENED, S_PROTECTED_FROM_MELEE, S_PROTECTED_FROM_RANGED, S_DEFENSELESS, S_RESOLUTE, S_HASTED, S_SLOWED, S_FAR_SIGHTED, S_BLIND, S_KEEN_SMELLING, S_FOUL_SMELLING, S_ROSE_SMELLING, S_RANGED_DEFLECTING, S_MELEE_DEFLECTING, S_SHINY_EYED, S_DEAFENED, S_DEAF, S_DRUNK, S_FRENZIED, S_REGENERATING, S_POISONED, S_SLOW_RESISTANT, S_POISON_RESISTANT :: GroupName ItemKind

pattern S_PAINTED :: GroupName ItemKind

pattern $bS_STRENGTHENED :: GroupName ItemKind
$mS_STRENGTHENED :: forall r. GroupName ItemKind -> (Void# -> r) -> (Void# -> r) -> r
S_STRENGTHENED = GroupName "strengthened"
pattern $bS_WEAKENED :: GroupName ItemKind
$mS_WEAKENED :: forall r. GroupName ItemKind -> (Void# -> r) -> (Void# -> r) -> r
S_WEAKENED = GroupName "weakened"
pattern $bS_PROTECTED_FROM_MELEE :: GroupName ItemKind
$mS_PROTECTED_FROM_MELEE :: forall r. GroupName ItemKind -> (Void# -> r) -> (Void# -> r) -> r
S_PROTECTED_FROM_MELEE = GroupName "protected from melee"
pattern $bS_PROTECTED_FROM_RANGED :: GroupName ItemKind
$mS_PROTECTED_FROM_RANGED :: forall r. GroupName ItemKind -> (Void# -> r) -> (Void# -> r) -> r
S_PROTECTED_FROM_RANGED = GroupName "protected from ranged"
pattern $bS_DEFENSELESS :: GroupName ItemKind
$mS_DEFENSELESS :: forall r. GroupName ItemKind -> (Void# -> r) -> (Void# -> r) -> r
S_DEFENSELESS = GroupName "defenseless"
pattern $bS_RESOLUTE :: GroupName ItemKind
$mS_RESOLUTE :: forall r. GroupName ItemKind -> (Void# -> r) -> (Void# -> r) -> r
S_RESOLUTE = GroupName "resolute"
pattern $bS_HASTED :: GroupName ItemKind
$mS_HASTED :: forall r. GroupName ItemKind -> (Void# -> r) -> (Void# -> r) -> r
S_HASTED = GroupName "hasted"
pattern $bS_SLOWED :: GroupName ItemKind
$mS_SLOWED :: forall r. GroupName ItemKind -> (Void# -> r) -> (Void# -> r) -> r
S_SLOWED = GroupName "slowed"
pattern $bS_FAR_SIGHTED :: GroupName ItemKind
$mS_FAR_SIGHTED :: forall r. GroupName ItemKind -> (Void# -> r) -> (Void# -> r) -> r
S_FAR_SIGHTED = GroupName "far-sighted"
pattern $bS_BLIND :: GroupName ItemKind
$mS_BLIND :: forall r. GroupName ItemKind -> (Void# -> r) -> (Void# -> r) -> r
S_BLIND = GroupName "blind"
pattern $bS_KEEN_SMELLING :: GroupName ItemKind
$mS_KEEN_SMELLING :: forall r. GroupName ItemKind -> (Void# -> r) -> (Void# -> r) -> r
S_KEEN_SMELLING = GroupName "keen-smelling"
pattern $bS_FOUL_SMELLING :: GroupName ItemKind
$mS_FOUL_SMELLING :: forall r. GroupName ItemKind -> (Void# -> r) -> (Void# -> r) -> r
S_FOUL_SMELLING = GroupName "foul-smelling"
pattern $bS_ROSE_SMELLING :: GroupName ItemKind
$mS_ROSE_SMELLING :: forall r. GroupName ItemKind -> (Void# -> r) -> (Void# -> r) -> r
S_ROSE_SMELLING = GroupName "rose-smelling"
pattern $bS_RANGED_DEFLECTING :: GroupName ItemKind
$mS_RANGED_DEFLECTING :: forall r. GroupName ItemKind -> (Void# -> r) -> (Void# -> r) -> r
S_RANGED_DEFLECTING = GroupName "ranged-deflecting"
pattern $bS_MELEE_DEFLECTING :: GroupName ItemKind
$mS_MELEE_DEFLECTING :: forall r. GroupName ItemKind -> (Void# -> r) -> (Void# -> r) -> r
S_MELEE_DEFLECTING = GroupName "melee-deflecting"
pattern $bS_SHINY_EYED :: GroupName ItemKind
$mS_SHINY_EYED :: forall r. GroupName ItemKind -> (Void# -> r) -> (Void# -> r) -> r
S_SHINY_EYED = GroupName "shiny-eyed"
pattern $bS_DEAFENED :: GroupName ItemKind
$mS_DEAFENED :: forall r. GroupName ItemKind -> (Void# -> r) -> (Void# -> r) -> r
S_DEAFENED = GroupName "deafened"
pattern $bS_DEAF :: GroupName ItemKind
$mS_DEAF :: forall r. GroupName ItemKind -> (Void# -> r) -> (Void# -> r) -> r
S_DEAF = GroupName "deaf"
pattern $bS_DRUNK :: GroupName ItemKind
$mS_DRUNK :: forall r. GroupName ItemKind -> (Void# -> r) -> (Void# -> r) -> r
S_DRUNK = GroupName "drunk"
pattern $bS_FRENZIED :: GroupName ItemKind
$mS_FRENZIED :: forall r. GroupName ItemKind -> (Void# -> r) -> (Void# -> r) -> r
S_FRENZIED = GroupName "frenzied"
pattern $bS_REGENERATING :: GroupName ItemKind
$mS_REGENERATING :: forall r. GroupName ItemKind -> (Void# -> r) -> (Void# -> r) -> r
S_REGENERATING = GroupName "regenerating"
pattern $bS_POISONED :: GroupName ItemKind
$mS_POISONED :: forall r. GroupName ItemKind -> (Void# -> r) -> (Void# -> r) -> r
S_POISONED = GroupName "poisoned"
pattern $bS_SLOW_RESISTANT :: GroupName ItemKind
$mS_SLOW_RESISTANT :: forall r. GroupName ItemKind -> (Void# -> r) -> (Void# -> r) -> r
S_SLOW_RESISTANT = GroupName "slow resistant"
pattern $bS_POISON_RESISTANT :: GroupName ItemKind
$mS_POISON_RESISTANT :: forall r. GroupName ItemKind -> (Void# -> r) -> (Void# -> r) -> r
S_POISON_RESISTANT = GroupName "poison resistant"
pattern $bS_IMMOBILE :: GroupName ItemKind
$mS_IMMOBILE :: forall r. GroupName ItemKind -> (Void# -> r) -> (Void# -> r) -> r
S_IMMOBILE = GroupName "immobile"
pattern $bS_PACIFIED :: GroupName ItemKind
$mS_PACIFIED :: forall r. GroupName ItemKind -> (Void# -> r) -> (Void# -> r) -> r
S_PACIFIED = GroupName "pacified"
pattern $bS_IRREPLACEABLE :: GroupName ItemKind
$mS_IRREPLACEABLE :: forall r. GroupName ItemKind -> (Void# -> r) -> (Void# -> r) -> r
S_IRREPLACEABLE = GroupName "irreplaceable"
pattern $bS_RETAINING :: GroupName ItemKind
$mS_RETAINING :: forall r. GroupName ItemKind -> (Void# -> r) -> (Void# -> r) -> r
S_RETAINING = GroupName "retaining"
pattern $bS_IMPATIENT :: GroupName ItemKind
$mS_IMPATIENT :: forall r. GroupName ItemKind -> (Void# -> r) -> (Void# -> r) -> r
S_IMPATIENT = GroupName "impatient"
pattern $bS_DISPOSSESSED :: GroupName ItemKind
$mS_DISPOSSESSED :: forall r. GroupName ItemKind -> (Void# -> r) -> (Void# -> r) -> r
S_DISPOSSESSED = GroupName "dispossessed"
pattern $bS_WITHHOLDING :: GroupName ItemKind
$mS_WITHHOLDING :: forall r. GroupName ItemKind -> (Void# -> r) -> (Void# -> r) -> r
S_WITHHOLDING = GroupName "withholding"
pattern $bS_PARSIMONIOUS :: GroupName ItemKind
$mS_PARSIMONIOUS :: forall r. GroupName ItemKind -> (Void# -> r) -> (Void# -> r) -> r
S_PARSIMONIOUS = GroupName "parsimonious"
pattern $bS_MORE_MOBILE :: GroupName ItemKind
$mS_MORE_MOBILE :: forall r. GroupName ItemKind -> (Void# -> r) -> (Void# -> r) -> r
S_MORE_MOBILE = GroupName "super-mobile"
pattern $bS_MORE_COMBATIVE :: GroupName ItemKind
$mS_MORE_COMBATIVE :: forall r. GroupName ItemKind -> (Void# -> r) -> (Void# -> r) -> r
S_MORE_COMBATIVE = GroupName "super-combative"
pattern $bS_MORE_DISPLACING :: GroupName ItemKind
$mS_MORE_DISPLACING :: forall r. GroupName ItemKind -> (Void# -> r) -> (Void# -> r) -> r
S_MORE_DISPLACING = GroupName "super-displacing"
pattern $bS_MORE_MODIFYING :: GroupName ItemKind
$mS_MORE_MODIFYING :: forall r. GroupName ItemKind -> (Void# -> r) -> (Void# -> r) -> r
S_MORE_MODIFYING = GroupName "super-modifying"
pattern $bS_MORE_PATIENT :: GroupName ItemKind
$mS_MORE_PATIENT :: forall r. GroupName ItemKind -> (Void# -> r) -> (Void# -> r) -> r
S_MORE_PATIENT = GroupName "super-patient"
pattern $bS_MORE_TIDY :: GroupName ItemKind
$mS_MORE_TIDY :: forall r. GroupName ItemKind -> (Void# -> r) -> (Void# -> r) -> r
S_MORE_TIDY = GroupName "super-tidy"
pattern $bS_MORE_PROJECTING :: GroupName ItemKind
$mS_MORE_PROJECTING :: forall r. GroupName ItemKind -> (Void# -> r) -> (Void# -> r) -> r
S_MORE_PROJECTING = GroupName "super-projecting"
pattern $bS_MORE_PRACTICAL :: GroupName ItemKind
$mS_MORE_PRACTICAL :: forall r. GroupName ItemKind -> (Void# -> r) -> (Void# -> r) -> r
S_MORE_PRACTICAL = GroupName "super-practical"

-- ** Allure-specific
pattern $bS_PAINTED :: GroupName ItemKind
$mS_PAINTED :: forall r. GroupName ItemKind -> (Void# -> r) -> (Void# -> r) -> r
S_PAINTED = GroupName "painted"

-- * Content

temporaries :: [ItemKind]
temporaries :: [ItemKind]
temporaries =
  [ItemKind
tmpStrengthened, ItemKind
tmpWeakened, ItemKind
tmpProtectedMelee, ItemKind
tmpProtectedRanged, ItemKind
tmpDefenseless, ItemKind
tmpResolute, ItemKind
tmpFast20, ItemKind
tmpSlow10, ItemKind
tmpFarSighted, ItemKind
tmpBlind, ItemKind
tmpKeenSmelling, ItemKind
tmpFoulSmelling, ItemKind
tmpRoseSmelling, ItemKind
tmpRangedDeflecting, ItemKind
tmpMeleeDeflecting, ItemKind
tmpNoctovision, ItemKind
tmpDeafened, ItemKind
tmpDeaf, ItemKind
tmpDrunk, ItemKind
tmpBonusSkAggresion, ItemKind
tmpRegenerating, ItemKind
tmpPoisoned, ItemKind
tmpSlow10Resistant, ItemKind
tmpPoisonResistant, ItemKind
tmpNoSkMove, ItemKind
tmpNoSkMelee, ItemKind
tmpNoSkDisplace, ItemKind
tmpNoSkAlter, ItemKind
tmpNoSkWait, ItemKind
tmpNoSkMoveItem, ItemKind
tmpNoSkProject, ItemKind
tmpNoSkApply, ItemKind
tmpBonusSkMove, ItemKind
tmpBonusSkMelee, ItemKind
tmpBonusSkDisplace, ItemKind
tmpBonusSkAlter, ItemKind
tmpBonusSkWait, ItemKind
tmpBonusSkMoveItem, ItemKind
tmpBonusSkProject, ItemKind
tmpBonusSkApply]
  [ItemKind] -> [ItemKind] -> [ItemKind]
forall a. [a] -> [a] -> [a]
++ [ItemKind
tmpPainted]

tmpStrengthened,    tmpWeakened, tmpProtectedMelee, tmpProtectedRanged, tmpDefenseless, tmpResolute, tmpFast20, tmpSlow10, tmpFarSighted, tmpBlind, tmpKeenSmelling, tmpFoulSmelling, tmpRoseSmelling, tmpRangedDeflecting, tmpMeleeDeflecting, tmpNoctovision, tmpDeafened, tmpDeaf, tmpDrunk, tmpBonusSkAggresion, tmpRegenerating, tmpPoisoned, tmpSlow10Resistant, tmpPoisonResistant, tmpNoSkMove, tmpNoSkMelee, tmpNoSkDisplace, tmpNoSkAlter, tmpNoSkWait, tmpNoSkMoveItem, tmpNoSkProject, tmpNoSkApply, tmpBonusSkMove, tmpBonusSkMelee, tmpBonusSkDisplace, tmpBonusSkAlter, tmpBonusSkWait, tmpBonusSkMoveItem, tmpBonusSkProject, tmpBonusSkApply :: ItemKind

tmpPainted :: ItemKind

-- The @name@ is be used in item description, so it should be an adjective
-- describing the temporary set of aspects.
-- The messages are needed also under @OnSmash@ to display when item removed
-- via @DropItem@ and not via natural periodic activation.
tmpAspects :: GroupName ItemKind -> [Aspect] -> ItemKind
tmpAspects :: GroupName ItemKind -> [Aspect] -> ItemKind
tmpAspects grp :: GroupName ItemKind
grp aspects :: [Aspect]
aspects =
  let name :: Text
name = GroupName ItemKind -> Text
forall a. GroupName a -> Text
fromGroupName GroupName ItemKind
grp  -- @iname@ must match @ifreq@, see @myBadGrps@
  in $WItemKind :: Char
-> Text
-> Freqs ItemKind
-> [Flavour]
-> Dice
-> Rarity
-> Text
-> Int
-> Dice
-> [Aspect]
-> [Effect]
-> [(GroupName ItemKind, CStore)]
-> Text
-> ItemKind
ItemKind
    { isymbol :: Char
isymbol  = '+'
    , iname :: Text
iname    = Text
name
    , ifreq :: Freqs ItemKind
ifreq    = [(GroupName ItemKind
grp, 1), (GroupName ItemKind
CONDITION, 1)]
    , iflavour :: [Flavour]
iflavour = [Color] -> [Flavour]
zipPlain [Color
BrWhite]
    , icount :: Dice
icount   = 1
    , irarity :: Rarity
irarity  = [(1, 1)]
    , iverbHit :: Text
iverbHit = "affect"
    , iweight :: Int
iweight  = 0
    , idamage :: Dice
idamage  = 0
    , iaspects :: [Aspect]
iaspects = -- timeout is 0; activates and vanishes soon,
                 -- depending on initial timer setting
                 [Aspect]
aspects
                 [Aspect] -> [Aspect] -> [Aspect]
forall a. [a] -> [a] -> [a]
++ [Flag -> Aspect
SetFlag Flag
Periodic, Flag -> Aspect
SetFlag Flag
Fragile, Flag -> Aspect
SetFlag Flag
Condition]
    , ieffects :: [Effect]
ieffects = [ Effect -> Effect
OnSmash (Effect -> Effect) -> Effect -> Effect
forall a b. (a -> b) -> a -> b
$ Text -> Effect
verbMsgLess Text
name
                   -- announce partial neutralization, but don't spam
                   -- about normal periodic wear each turn
                 , Effect -> Effect
OnSmash (Effect -> Effect) -> Effect -> Effect
forall a b. (a -> b) -> a -> b
$ Text -> Effect
verbMsgNoLonger Text
name  -- for forced neutralization
                 , Text -> Effect
verbMsgNoLonger Text
name ]  -- for periodic wear of last copy
    , idesc :: Text
idesc    = ""  -- no description needed; powers are enough
    , ikit :: [(GroupName ItemKind, CStore)]
ikit     = []
    }

tmpEffects :: GroupName ItemKind -> Dice -> [Effect] -> ItemKind
tmpEffects :: GroupName ItemKind -> Dice -> [Effect] -> ItemKind
tmpEffects grp :: GroupName ItemKind
grp icount :: Dice
icount effects :: [Effect]
effects =
  let tmp :: ItemKind
tmp = GroupName ItemKind -> [Aspect] -> ItemKind
tmpAspects GroupName ItemKind
grp []
  in ItemKind
tmp { Dice
icount :: Dice
icount :: Dice
icount
         , ieffects :: [Effect]
ieffects = [Effect]
effects [Effect] -> [Effect] -> [Effect]
forall a. [a] -> [a] -> [a]
++ ItemKind -> [Effect]
ieffects ItemKind
tmp
         }

tmpStrengthened :: ItemKind
tmpStrengthened = GroupName ItemKind -> [Aspect] -> ItemKind
tmpAspects GroupName ItemKind
S_STRENGTHENED [Skill -> Dice -> Aspect
AddSkill Skill
SkHurtMelee 20]
tmpWeakened :: ItemKind
tmpWeakened = GroupName ItemKind -> [Aspect] -> ItemKind
tmpAspects GroupName ItemKind
S_WEAKENED
                         [Skill -> Dice -> Aspect
AddSkill Skill
SkHurtMelee (-30)]  -- don't cancel out ^
tmpProtectedMelee :: ItemKind
tmpProtectedMelee = GroupName ItemKind -> [Aspect] -> ItemKind
tmpAspects GroupName ItemKind
S_PROTECTED_FROM_MELEE
                               [Skill -> Dice -> Aspect
AddSkill Skill
SkArmorMelee 50]
tmpProtectedRanged :: ItemKind
tmpProtectedRanged = GroupName ItemKind -> [Aspect] -> ItemKind
tmpAspects GroupName ItemKind
S_PROTECTED_FROM_RANGED
                                [Skill -> Dice -> Aspect
AddSkill Skill
SkArmorRanged 25]
tmpDefenseless :: ItemKind
tmpDefenseless = GroupName ItemKind -> [Aspect] -> ItemKind
tmpAspects GroupName ItemKind
S_DEFENSELESS [ Skill -> Dice -> Aspect
AddSkill Skill
SkArmorMelee (-50)
                                          , Skill -> Dice -> Aspect
AddSkill Skill
SkArmorRanged (-25) ]
tmpResolute :: ItemKind
tmpResolute = GroupName ItemKind -> [Aspect] -> ItemKind
tmpAspects GroupName ItemKind
S_RESOLUTE [Skill -> Dice -> Aspect
AddSkill Skill
SkMaxCalm 60]
tmpFast20 :: ItemKind
tmpFast20 = GroupName ItemKind -> [Aspect] -> ItemKind
tmpAspects GroupName ItemKind
S_HASTED [Skill -> Dice -> Aspect
AddSkill Skill
SkSpeed 20]
tmpSlow10 :: ItemKind
tmpSlow10 = GroupName ItemKind -> [Aspect] -> ItemKind
tmpAspects GroupName ItemKind
S_SLOWED [Skill -> Dice -> Aspect
AddSkill Skill
SkSpeed (-10)]
tmpFarSighted :: ItemKind
tmpFarSighted = GroupName ItemKind -> [Aspect] -> ItemKind
tmpAspects GroupName ItemKind
S_FAR_SIGHTED [Skill -> Dice -> Aspect
AddSkill Skill
SkSight 5]
tmpBlind :: ItemKind
tmpBlind = GroupName ItemKind -> [Aspect] -> ItemKind
tmpAspects GroupName ItemKind
S_BLIND [ Skill -> Dice -> Aspect
AddSkill Skill
SkSight (-99)
                              , Skill -> Dice -> Aspect
AddSkill Skill
SkArmorMelee (-30) ]
tmpKeenSmelling :: ItemKind
tmpKeenSmelling = GroupName ItemKind -> [Aspect] -> ItemKind
tmpAspects GroupName ItemKind
S_KEEN_SMELLING [Skill -> Dice -> Aspect
AddSkill Skill
SkSmell 2]
tmpFoulSmelling :: ItemKind
tmpFoulSmelling = GroupName ItemKind -> [Aspect] -> ItemKind
tmpAspects GroupName ItemKind
S_FOUL_SMELLING [Skill -> Dice -> Aspect
AddSkill Skill
SkOdor 2]
tmpRoseSmelling :: ItemKind
tmpRoseSmelling = GroupName ItemKind -> [Aspect] -> ItemKind
tmpAspects GroupName ItemKind
S_ROSE_SMELLING [Skill -> Dice -> Aspect
AddSkill Skill
SkOdor (-4)]
tmpRangedDeflecting :: ItemKind
tmpRangedDeflecting =
  GroupName ItemKind -> [Aspect] -> ItemKind
tmpAspects GroupName ItemKind
S_RANGED_DEFLECTING [Skill -> Dice -> Aspect
AddSkill Skill
SkDeflectRanged 1]
tmpMeleeDeflecting :: ItemKind
tmpMeleeDeflecting =
  GroupName ItemKind -> [Aspect] -> ItemKind
tmpAspects GroupName ItemKind
S_MELEE_DEFLECTING [Skill -> Dice -> Aspect
AddSkill Skill
SkDeflectMelee 1]
tmpNoctovision :: ItemKind
tmpNoctovision = GroupName ItemKind -> [Aspect] -> ItemKind
tmpAspects GroupName ItemKind
S_SHINY_EYED [Skill -> Dice -> Aspect
AddSkill Skill
SkNocto 2]
tmpDeafened :: ItemKind
tmpDeafened = GroupName ItemKind -> [Aspect] -> ItemKind
tmpAspects GroupName ItemKind
S_DEAFENED [Skill -> Dice -> Aspect
AddSkill Skill
SkHearing (-6)]
tmpDeaf :: ItemKind
tmpDeaf = GroupName ItemKind -> [Aspect] -> ItemKind
tmpAspects GroupName ItemKind
S_DEAF [ Skill -> Dice -> Aspect
AddSkill Skill
SkHearing (-99)
                            , Skill -> Dice -> Aspect
AddSkill Skill
SkArmorMelee (-30) ]
tmpDrunk :: ItemKind
tmpDrunk = GroupName ItemKind -> [Aspect] -> ItemKind
tmpAspects GroupName ItemKind
S_DRUNK [ Skill -> Dice -> Aspect
AddSkill Skill
SkHurtMelee 30  -- fury
                              , Skill -> Dice -> Aspect
AddSkill Skill
SkArmorRanged (-30)
                              , Skill -> Dice -> Aspect
AddSkill Skill
SkSight (-8) ]

tmpBonusSkAggresion :: ItemKind
tmpBonusSkAggresion =
  GroupName ItemKind -> [Aspect] -> ItemKind
tmpAspects GroupName ItemKind
S_FRENZIED [ Skill -> Dice -> Aspect
AddSkill Skill
SkAggression 5
                        , Skill -> Dice -> Aspect
AddSkill Skill
SkArmorMelee (-30) ]

tmpRegenerating :: ItemKind
tmpRegenerating =
  GroupName ItemKind -> Dice -> [Effect] -> ItemKind
tmpEffects GroupName ItemKind
S_REGENERATING (4 Dice -> Dice -> Dice
forall a. Num a => a -> a -> a
+ 1 Int -> Int -> Dice
`d` 2) [Int -> Effect
RefillHP 1]
tmpPoisoned :: ItemKind
tmpPoisoned =
  GroupName ItemKind -> Dice -> [Effect] -> ItemKind
tmpEffects GroupName ItemKind
S_POISONED (3 Dice -> Dice -> Dice
forall a. Num a => a -> a -> a
+ 1 Int -> Int -> Dice
`d` 2) [Int -> Effect
RefillHP (-1)]
tmpSlow10Resistant :: ItemKind
tmpSlow10Resistant =
  GroupName ItemKind -> Dice -> [Effect] -> ItemKind
tmpEffects GroupName ItemKind
S_SLOW_RESISTANT (8 Dice -> Dice -> Dice
forall a. Num a => a -> a -> a
+ 1 Int -> Int -> Dice
`d` 4)
             [Int -> Int -> CStore -> GroupName ItemKind -> Effect
DropItem 1 1 CStore
COrgan GroupName ItemKind
S_SLOWED]
tmpPoisonResistant :: ItemKind
tmpPoisonResistant =
  GroupName ItemKind -> Dice -> [Effect] -> ItemKind
tmpEffects GroupName ItemKind
S_POISON_RESISTANT (8 Dice -> Dice -> Dice
forall a. Num a => a -> a -> a
+ 1 Int -> Int -> Dice
`d` 4)
             [Int -> Int -> CStore -> GroupName ItemKind -> Effect
DropItem 1 Int
forall a. Bounded a => a
maxBound CStore
COrgan GroupName ItemKind
S_POISONED]

tmpNoSkMove :: ItemKind
tmpNoSkMove =
  GroupName ItemKind -> [Aspect] -> ItemKind
tmpAspects GroupName ItemKind
S_IMMOBILE [Skill -> Dice -> Aspect
AddSkill Skill
SkMove (-99)]
tmpNoSkMelee :: ItemKind
tmpNoSkMelee =
  GroupName ItemKind -> [Aspect] -> ItemKind
tmpAspects GroupName ItemKind
S_PACIFIED [Skill -> Dice -> Aspect
AddSkill Skill
SkMelee (-99)]
tmpNoSkDisplace :: ItemKind
tmpNoSkDisplace =
  GroupName ItemKind -> [Aspect] -> ItemKind
tmpAspects GroupName ItemKind
S_IRREPLACEABLE [Skill -> Dice -> Aspect
AddSkill Skill
SkDisplace (-99)]
tmpNoSkAlter :: ItemKind
tmpNoSkAlter =
  GroupName ItemKind -> [Aspect] -> ItemKind
tmpAspects GroupName ItemKind
S_RETAINING [Skill -> Dice -> Aspect
AddSkill Skill
SkAlter (-99)]
tmpNoSkWait :: ItemKind
tmpNoSkWait =
  GroupName ItemKind -> [Aspect] -> ItemKind
tmpAspects GroupName ItemKind
S_IMPATIENT [Skill -> Dice -> Aspect
AddSkill Skill
SkWait (-99)]
tmpNoSkMoveItem :: ItemKind
tmpNoSkMoveItem =
  GroupName ItemKind -> [Aspect] -> ItemKind
tmpAspects GroupName ItemKind
S_DISPOSSESSED [Skill -> Dice -> Aspect
AddSkill Skill
SkMoveItem (-99)]
tmpNoSkProject :: ItemKind
tmpNoSkProject =
  GroupName ItemKind -> [Aspect] -> ItemKind
tmpAspects GroupName ItemKind
S_WITHHOLDING [Skill -> Dice -> Aspect
AddSkill Skill
SkProject (-99)]
tmpNoSkApply :: ItemKind
tmpNoSkApply =
  GroupName ItemKind -> [Aspect] -> ItemKind
tmpAspects GroupName ItemKind
S_PARSIMONIOUS [Skill -> Dice -> Aspect
AddSkill Skill
SkApply (-99)]

tmpBonusSkMove :: ItemKind
tmpBonusSkMove =
  GroupName ItemKind -> [Aspect] -> ItemKind
tmpAspects GroupName ItemKind
S_MORE_MOBILE [Skill -> Dice -> Aspect
AddSkill Skill
SkMove 5]
tmpBonusSkMelee :: ItemKind
tmpBonusSkMelee =
  GroupName ItemKind -> [Aspect] -> ItemKind
tmpAspects GroupName ItemKind
S_MORE_COMBATIVE [Skill -> Dice -> Aspect
AddSkill Skill
SkMelee 5]
tmpBonusSkDisplace :: ItemKind
tmpBonusSkDisplace =
  GroupName ItemKind -> [Aspect] -> ItemKind
tmpAspects GroupName ItemKind
S_MORE_DISPLACING [Skill -> Dice -> Aspect
AddSkill Skill
SkDisplace 5]
tmpBonusSkAlter :: ItemKind
tmpBonusSkAlter =
  GroupName ItemKind -> [Aspect] -> ItemKind
tmpAspects GroupName ItemKind
S_MORE_MODIFYING [Skill -> Dice -> Aspect
AddSkill Skill
SkAlter 5]
tmpBonusSkWait :: ItemKind
tmpBonusSkWait =
  GroupName ItemKind -> [Aspect] -> ItemKind
tmpAspects GroupName ItemKind
S_MORE_PATIENT [Skill -> Dice -> Aspect
AddSkill Skill
SkWait 5]
tmpBonusSkMoveItem :: ItemKind
tmpBonusSkMoveItem =
  GroupName ItemKind -> [Aspect] -> ItemKind
tmpAspects GroupName ItemKind
S_MORE_TIDY [Skill -> Dice -> Aspect
AddSkill Skill
SkMoveItem 5]
tmpBonusSkProject :: ItemKind
tmpBonusSkProject =
  GroupName ItemKind -> [Aspect] -> ItemKind
tmpAspects GroupName ItemKind
S_MORE_PROJECTING [Skill -> Dice -> Aspect
AddSkill Skill
SkProject 8]
    -- TODO: 11, but let player control potion throwing by non-pointmen;
    -- beware also of capReinforced and other sources of the skill
tmpBonusSkApply :: ItemKind
tmpBonusSkApply =
  GroupName ItemKind -> [Aspect] -> ItemKind
tmpAspects GroupName ItemKind
S_MORE_PRACTICAL [Skill -> Dice -> Aspect
AddSkill Skill
SkApply 5]

-- ** Allure-specific

tmpPainted :: ItemKind
tmpPainted = GroupName ItemKind -> [Aspect] -> ItemKind
tmpAspects GroupName ItemKind
S_PAINTED [ Skill -> Dice -> Aspect
AddSkill Skill
SkArmorMelee (-50)
                                  , Skill -> Dice -> Aspect
AddSkill Skill
SkArmorRanged (-25)
                                  , Skill -> Dice -> Aspect
AddSkill Skill
SkShine 1 ]