{-# LANGUAGE DeriveGeneric #-}
module Game.LambdaHack.Common.ItemAspect
( AspectRecord(..), KindMean(..)
, emptyAspectRecord, addMeanAspect, castAspect, aspectsRandom
, aspectRecordToList, rollAspectRecord, getSkill, checkFlag, meanAspect
, onlyMinorEffects, itemTrajectory, totalRange, isHumanTrinket
, goesIntoEqp, goesIntoInv, goesIntoSha, loreFromMode, loreFromContainer
#ifdef EXPOSE_INTERNAL
, ceilingMeanDice
#endif
) where
import Prelude ()
import Game.LambdaHack.Core.Prelude
import qualified Control.Monad.Trans.State.Strict as St
import Data.Binary
import qualified Data.EnumSet as ES
import Data.Hashable (Hashable)
import qualified Data.Text as T
import GHC.Generics (Generic)
import qualified System.Random as R
import Game.LambdaHack.Common.Time
import Game.LambdaHack.Common.Types
import Game.LambdaHack.Common.Vector
import qualified Game.LambdaHack.Content.ItemKind as IK
import qualified Game.LambdaHack.Core.Dice as Dice
import Game.LambdaHack.Common.Point
import Game.LambdaHack.Core.Random
import qualified Game.LambdaHack.Definition.Ability as Ability
import Game.LambdaHack.Definition.Defs
data AspectRecord = AspectRecord
{ aTimeout :: Int
, aSkills :: Ability.Skills
, aFlags :: Ability.Flags
, aELabel :: Text
, aToThrow :: IK.ThrowMod
, aHideAs :: Maybe (GroupName IK.ItemKind)
, aEqpSlot :: Maybe Ability.EqpSlot
}
deriving (Show, Eq, Ord, Generic)
instance Hashable AspectRecord
instance Binary AspectRecord
data KindMean = KindMean
{ kmConst :: Bool
, kmMean :: AspectRecord
}
deriving (Show, Eq, Ord, Generic)
emptyAspectRecord :: AspectRecord
emptyAspectRecord = AspectRecord
{ aTimeout = 0
, aSkills = Ability.zeroSkills
, aFlags = Ability.Flags ES.empty
, aELabel = ""
, aToThrow = IK.ThrowMod 100 100 1
, aHideAs = Nothing
, aEqpSlot = Nothing
}
castAspect :: Dice.AbsDepth -> Dice.AbsDepth -> AspectRecord -> IK.Aspect
-> Rnd AspectRecord
castAspect !ldepth !totalDepth !ar !asp =
case asp of
IK.Timeout d -> do
n <- castDice ldepth totalDepth d
return $! assert (aTimeout ar == 0) $ ar {aTimeout = n}
IK.AddSkill sk d -> do
n <- castDice ldepth totalDepth d
return $! if n /= 0
then ar {aSkills = Ability.addSk sk n (aSkills ar)}
else ar
IK.SetFlag feat ->
return $! ar {aFlags = Ability.Flags
$ ES.insert feat (Ability.flags $ aFlags ar)}
IK.ELabel t -> return $! ar {aELabel = t}
IK.ToThrow tt -> return $! ar {aToThrow = tt}
IK.HideAs ha -> return $! ar {aHideAs = Just ha}
IK.EqpSlot slot -> return $! ar {aEqpSlot = Just slot}
IK.Odds d aspects1 aspects2 -> do
pick1 <- oddsDice ldepth totalDepth d
foldlM' (castAspect ldepth totalDepth) ar $
if pick1 then aspects1 else aspects2
aspectsRandom :: [IK.Aspect] -> Bool
aspectsRandom ass =
let rollM depth =
foldlM' (castAspect (Dice.AbsDepth depth) (Dice.AbsDepth 10))
emptyAspectRecord ass
gen = R.mkStdGen 0
(ar0, gen0) = St.runState (rollM 0) gen
(ar1, gen1) = St.runState (rollM 10) gen0
in show gen /= show gen0 || show gen /= show gen1 || ar0 /= ar1
addMeanAspect :: AspectRecord -> IK.Aspect -> AspectRecord
addMeanAspect !ar !asp =
case asp of
IK.Timeout d ->
let n = ceilingMeanDice d
in assert (aTimeout ar == 0) $ ar {aTimeout = n}
IK.AddSkill sk d ->
let n = ceilingMeanDice d
in if n /= 0
then ar {aSkills = Ability.addSk sk n (aSkills ar)}
else ar
IK.SetFlag feat ->
ar {aFlags = Ability.Flags $ ES.insert feat (Ability.flags $ aFlags ar)}
IK.ELabel t -> ar {aELabel = t}
IK.ToThrow tt -> ar {aToThrow = tt}
IK.HideAs ha -> ar {aHideAs = Just ha}
IK.EqpSlot slot -> ar {aEqpSlot = Just slot}
IK.Odds{} -> ar
ceilingMeanDice :: Dice.Dice -> Int
ceilingMeanDice d = ceiling $ Dice.meanDice d
aspectRecordToList :: AspectRecord -> [IK.Aspect]
aspectRecordToList AspectRecord{..} =
[IK.Timeout $ Dice.intToDice aTimeout | aTimeout /= 0]
++ [ IK.AddSkill sk $ Dice.intToDice n
| (sk, n) <- Ability.skillsToList aSkills ]
++ [IK.SetFlag feat | feat <- ES.elems $ Ability.flags aFlags]
++ [IK.ELabel aELabel | not $ T.null aELabel]
++ [IK.ToThrow aToThrow | not $ aToThrow == IK.ThrowMod 100 100 1]
++ maybe [] (\ha -> [IK.HideAs ha]) aHideAs
++ maybe [] (\slot -> [IK.EqpSlot slot]) aEqpSlot
rollAspectRecord :: [IK.Aspect] -> Dice.AbsDepth -> Dice.AbsDepth
-> Rnd AspectRecord
rollAspectRecord ass ldepth totalDepth =
foldlM' (castAspect ldepth totalDepth) emptyAspectRecord ass
getSkill :: Ability.Skill -> AspectRecord -> Int
{-# INLINE getSkill #-}
getSkill sk ar = Ability.getSk sk $ aSkills ar
checkFlag :: Ability.Flag -> AspectRecord -> Bool
{-# INLINE checkFlag #-}
checkFlag flag ar = Ability.checkFl flag (aFlags ar)
meanAspect :: IK.ItemKind -> AspectRecord
meanAspect kind = foldl' addMeanAspect emptyAspectRecord (IK.iaspects kind)
onlyMinorEffects :: AspectRecord -> IK.ItemKind -> Bool
onlyMinorEffects ar kind =
checkFlag Ability.MinorEffects ar
|| not (any (not . IK.onSmashEffect) $ IK.ieffects kind)
itemTrajectory :: AspectRecord -> IK.ItemKind -> [Point]
-> ([Vector], (Speed, Int))
itemTrajectory ar itemKind path =
let IK.ThrowMod{..} = aToThrow ar
in computeTrajectory (IK.iweight itemKind) throwVelocity throwLinger path
totalRange :: AspectRecord -> IK.ItemKind -> Int
totalRange ar itemKind = snd $ snd $ itemTrajectory ar itemKind []
isHumanTrinket :: IK.ItemKind -> Bool
isHumanTrinket itemKind =
maybe False (> 0) $ lookup "valuable" $ IK.ifreq itemKind
goesIntoEqp :: AspectRecord -> Bool
goesIntoEqp ar = checkFlag Ability.Equipable ar
|| checkFlag Ability.Meleeable ar
goesIntoInv :: AspectRecord -> Bool
goesIntoInv ar = not (checkFlag Ability.Precious ar) && not (goesIntoEqp ar)
goesIntoSha :: AspectRecord -> Bool
goesIntoSha ar = checkFlag Ability.Precious ar && not (goesIntoEqp ar)
loreFromMode :: ItemDialogMode -> SLore
loreFromMode c = case c of
MStore COrgan -> SOrgan
MStore _ -> SItem
MOrgans -> undefined
MOwned -> SItem
MSkills -> undefined
MLore slore -> slore
MPlaces -> undefined
loreFromContainer :: AspectRecord -> Container -> SLore
loreFromContainer arItem c = case c of
CFloor{} -> SItem
CEmbed{} -> SEmbed
CActor _ store -> if | checkFlag Ability.Blast arItem -> SBlast
| checkFlag Ability.Condition arItem -> SCondition
| otherwise -> loreFromMode $ MStore store
CTrunk{} -> if checkFlag Ability.Blast arItem then SBlast else STrunk