module Game.LambdaHack.Content.ItemKind
( ItemKind(..)
, Effect(..), TimerDice(..)
, Aspect(..), ThrowMod(..)
, Feature(..), EqpSlot(..)
, aspectTrav
, toVelocity, toLinger, toOrganGameTurn, toOrganActorTurn, toOrganNone
, validateSingleItemKind, validateAllItemKind
) where
import qualified Control.Monad.State as St
import Data.Binary
import Data.Hashable (Hashable)
import Data.Text (Text)
import qualified Data.Text as T
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
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 !Int
| 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 !CStore
| Identify !CStore
| SendFlying !ThrowMod
| PushActor !ThrowMod
| PullActor !ThrowMod
| DropBestWeapon
| ActivateInv !Char
| ApplyPerfume
| OneOf ![Effect]
| OnSmash !Effect
| Recharging !Effect
| Temporary !Text
deriving (Show, Read, Eq, Ord, Generic)
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"
data Aspect a =
Periodic
| Timeout !a
| AddHurtMelee !a
| AddArmorMelee !a
| AddHurtRanged !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)
data ThrowMod = ThrowMod
{ throwVelocity :: !Int
, throwLinger :: !Int
}
deriving (Show, Read, Eq, Ord, Generic)
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
aspectTrav :: Aspect a -> (a -> St.State s b) -> St.State s (Aspect b)
aspectTrav Periodic _ = return Periodic
aspectTrav (Timeout a) f = do
b <- f a
return $! Timeout b
aspectTrav (AddMaxHP a) f = do
b <- f a
return $! AddMaxHP b
aspectTrav (AddMaxCalm a) f = do
b <- f a
return $! AddMaxCalm b
aspectTrav (AddSpeed a) f = do
b <- f a
return $! AddSpeed b
aspectTrav (AddSkills as) _ = return $! AddSkills as
aspectTrav (AddHurtMelee a) f = do
b <- f a
return $! AddHurtMelee b
aspectTrav (AddHurtRanged a) f = do
b <- f a
return $! AddHurtRanged b
aspectTrav (AddArmorMelee a) f = do
b <- f a
return $! AddArmorMelee b
aspectTrav (AddArmorRanged a) f = do
b <- f a
return $! AddArmorRanged b
aspectTrav (AddSight a) f = do
b <- f a
return $! AddSight b
aspectTrav (AddSmell a) f = do
b <- f a
return $! AddSmell b
aspectTrav (AddLight a) f = do
b <- f a
return $! AddLight b
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 if length ps > 1 then ["more than one Periodic specification"] else []
++ let timeoutAspect :: Aspect a -> Bool
timeoutAspect Timeout{} = True
timeoutAspect _ = False
ts = filter timeoutAspect iaspects
in if length ts > 1 then ["more than one Timeout specification"] else []
validateAllItemKind :: [ItemKind] -> [Text]
validateAllItemKind _ = []