module Game.LambdaHack.Content.ItemKind
( ItemKind(..)
, Effect(..), TimerDice(..)
, Aspect(..), ThrowMod(..)
, Feature(..), EqpSlot(..)
, slotName
, toVelocity, toLinger, toOrganGameTurn, toOrganActorTurn, toOrganNone
, validateSingleItemKind, validateAllItemKind
) where
import Control.DeepSeq
import Data.Binary
import Data.Foldable (Foldable)
import Data.Hashable (Hashable)
import qualified Data.Set as S
import Data.Text (Text)
import qualified Data.Text as T
import Data.Traversable (Traversable)
import GHC.Generics (Generic)
import qualified NLP.Miniutter.English as MU
import qualified Game.LambdaHack.Common.Ability as Ability
import qualified Game.LambdaHack.Common.Dice as Dice
import Game.LambdaHack.Common.Flavour
import Game.LambdaHack.Common.Misc
import Game.LambdaHack.Common.Msg
data ItemKind = ItemKind
{ isymbol :: !Char
, iname :: !Text
, ifreq :: !(Freqs ItemKind)
, iflavour :: ![Flavour]
, icount :: !Dice.Dice
, irarity :: !Rarity
, iverbHit :: !MU.Part
, iweight :: !Int
, iaspects :: ![Aspect Dice.Dice]
, ieffects :: ![Effect]
, ifeature :: ![Feature]
, idesc :: !Text
, ikit :: ![(GroupName ItemKind, CStore)]
}
deriving Show
data Effect =
NoEffect !Text
| Hurt !Dice.Dice
| Burn !Dice.Dice
| Explode !(GroupName ItemKind)
| RefillHP !Int
| OverfillHP !Int
| RefillCalm !Int
| OverfillCalm !Int
| Dominate
| Impress
| CallFriend !Dice.Dice
| Summon !(Freqs ItemKind) !Dice.Dice
| Ascend !Int
| Escape !Int
| Paralyze !Dice.Dice
| InsertMove !Dice.Dice
| Teleport !Dice.Dice
| CreateItem !CStore !(GroupName ItemKind) !TimerDice
| DropItem !CStore !(GroupName ItemKind) !Bool
| PolyItem
| Identify
| SendFlying !ThrowMod
| PushActor !ThrowMod
| PullActor !ThrowMod
| DropBestWeapon
| ActivateInv !Char
| ApplyPerfume
| OneOf ![Effect]
| OnSmash !Effect
| Recharging !Effect
| Temporary !Text
deriving (Show, Read, Eq, Ord, Generic)
instance NFData Effect
data TimerDice =
TimerNone
| TimerGameTurn !Dice.Dice
| TimerActorTurn !Dice.Dice
deriving (Read, Eq, Ord, Generic)
instance Show TimerDice where
show TimerNone = "0"
show (TimerGameTurn nDm) =
show nDm ++ " " ++ if nDm == 1 then "turn" else "turns"
show (TimerActorTurn nDm) =
show nDm ++ " " ++ if nDm == 1 then "move" else "moves"
instance NFData TimerDice
data Aspect a =
Unique
| Periodic
| Timeout !a
| AddHurtMelee !a
| AddHurtRanged !a
| AddArmorMelee !a
| AddArmorRanged !a
| AddMaxHP !a
| AddMaxCalm !a
| AddSpeed !a
| AddSkills !Ability.Skills
| AddSight !a
| AddSmell !a
| AddLight !a
deriving (Show, Read, Eq, Ord, Generic, Functor, Foldable, Traversable)
data ThrowMod = ThrowMod
{ throwVelocity :: !Int
, throwLinger :: !Int
}
deriving (Show, Read, Eq, Ord, Generic)
instance NFData ThrowMod
data Feature =
Fragile
| Durable
| ToThrow !ThrowMod
| Identified
| Applicable
| EqpSlot !EqpSlot !Text
| Precious
| Tactic !Tactic
deriving (Show, Eq, Ord, Generic)
data EqpSlot =
EqpSlotPeriodic
| EqpSlotTimeout
| EqpSlotAddHurtMelee
| EqpSlotAddArmorMelee
| EqpSlotAddHurtRanged
| EqpSlotAddArmorRanged
| EqpSlotAddMaxHP
| EqpSlotAddMaxCalm
| EqpSlotAddSpeed
| EqpSlotAddSkills Ability.Ability
| EqpSlotAddSight
| EqpSlotAddSmell
| EqpSlotAddLight
| EqpSlotWeapon
deriving (Show, Eq, Ord, Generic)
instance Hashable Effect
instance Hashable TimerDice
instance Hashable a => Hashable (Aspect a)
instance Hashable ThrowMod
instance Hashable Feature
instance Hashable EqpSlot
instance Binary Effect
instance Binary TimerDice
instance Binary a => Binary (Aspect a)
instance Binary ThrowMod
instance Binary Feature
instance Binary EqpSlot
slotName :: EqpSlot -> Text
slotName EqpSlotPeriodic = "periodicity"
slotName EqpSlotTimeout = "timeout"
slotName EqpSlotAddHurtMelee = "to melee damage"
slotName EqpSlotAddArmorMelee = "melee armor"
slotName EqpSlotAddHurtRanged = "to ranged damage"
slotName EqpSlotAddArmorRanged = "ranged armor"
slotName EqpSlotAddMaxHP = "max HP"
slotName EqpSlotAddMaxCalm = "max Calm"
slotName EqpSlotAddSpeed = "speed"
slotName EqpSlotAddSkills{} = "skills"
slotName EqpSlotAddSight = "sight radius"
slotName EqpSlotAddSmell = "smell radius"
slotName EqpSlotAddLight = "light radius"
slotName EqpSlotWeapon = "weapon damage"
toVelocity :: Int -> Feature
toVelocity n = ToThrow $ ThrowMod n 100
toLinger :: Int -> Feature
toLinger n = ToThrow $ ThrowMod 100 n
toOrganGameTurn :: GroupName ItemKind -> Dice.Dice -> Effect
toOrganGameTurn grp nDm = CreateItem COrgan grp (TimerGameTurn nDm)
toOrganActorTurn :: GroupName ItemKind -> Dice.Dice -> Effect
toOrganActorTurn grp nDm = CreateItem COrgan grp (TimerActorTurn nDm)
toOrganNone :: GroupName ItemKind -> Effect
toOrganNone grp = CreateItem COrgan grp TimerNone
validateSingleItemKind :: ItemKind -> [Text]
validateSingleItemKind ItemKind{..} =
[ "iname longer than 23" | T.length iname > 23 ]
++ validateRarity irarity
++ let periodicAspect :: Aspect a -> Bool
periodicAspect Periodic = True
periodicAspect _ = False
ps = filter periodicAspect iaspects
in ["more than one Periodic specification" | length ps > 1]
++ let timeoutAspect :: Aspect a -> Bool
timeoutAspect Timeout{} = True
timeoutAspect _ = False
ts = filter timeoutAspect iaspects
in ["more than one Timeout specification" | length ts > 1]
validateAllItemKind :: [ItemKind] -> [Text]
validateAllItemKind content =
let kindFreq :: S.Set (GroupName ItemKind)
kindFreq = let tuples = [ cgroup
| k <- content
, (cgroup, n) <- ifreq k
, n > 0 ]
in S.fromList tuples
missingGroups = [ cgroup
| k <- content
, (cgroup, _) <- ikit k
, S.notMember cgroup kindFreq ]
errorMsg = case missingGroups of
[] -> []
_ -> ["no groups" <+> tshow missingGroups
<+> "among content that has groups"
<+> tshow (S.elems kindFreq)]
in errorMsg