{-# LANGUAGE DeriveGeneric, GeneralizedNewtypeDeriving, TupleSections #-}
module Game.LambdaHack.Common.Item
( Item(..), ItemIdentity(..)
, ItemKindIx, ItemDisco(..), ItemFull(..), ItemFullKit
, DiscoveryKind, DiscoveryAspect, ItemIxMap, Benefit(..), DiscoveryBenefit
, ItemTimer, ItemQuant, ItemBag, ItemDict
, itemToFull6, aspectRecordFull, strongestSlot, ncharges, hasCharge
, strongestMelee, unknownMeleeBonus, unknownSpeedBonus
, conditionMeleeBonus, conditionSpeedBonus, armorHurtCalculation
#ifdef EXPOSE_INTERNAL
, valueAtEqpSlot, unknownAspect
#endif
) where
import Prelude ()
import Game.LambdaHack.Core.Prelude
import Data.Binary
import qualified Data.EnumMap.Strict as EM
import qualified Data.EnumSet as ES
import Data.Hashable (Hashable)
import qualified Data.Ix as Ix
import qualified Data.Ord as Ord
import GHC.Generics (Generic)
import qualified Game.LambdaHack.Common.ItemAspect as IA
import Game.LambdaHack.Common.Kind
import Game.LambdaHack.Common.Time
import Game.LambdaHack.Common.Types
import qualified Game.LambdaHack.Content.ItemKind as IK
import qualified Game.LambdaHack.Core.Dice as Dice
import Game.LambdaHack.Definition.Ability (EqpSlot (..))
import qualified Game.LambdaHack.Definition.Ability as Ability
import Game.LambdaHack.Definition.Defs
import Game.LambdaHack.Definition.Flavour
data Item = Item
{ jkind :: ItemIdentity
, jfid :: Maybe FactionId
, jflavour :: Flavour
}
deriving (Show, Eq, Generic)
instance Hashable Item
instance Binary Item
data ItemIdentity =
IdentityObvious (ContentId IK.ItemKind)
| IdentityCovered ItemKindIx (ContentId IK.ItemKind)
deriving (Show, Eq, Generic)
instance Hashable ItemIdentity
instance Binary ItemIdentity
type DiscoveryAspect = EM.EnumMap ItemId IA.AspectRecord
newtype ItemKindIx = ItemKindIx Word16
deriving (Show, Eq, Ord, Enum, Ix.Ix, Hashable, Binary)
data ItemDisco =
ItemDiscoFull IA.AspectRecord
| ItemDiscoMean IA.KindMean
deriving (Show, Eq, Ord)
data ItemFull = ItemFull
{ itemBase :: Item
, itemKindId :: ContentId IK.ItemKind
, itemKind :: IK.ItemKind
, itemDisco :: ItemDisco
, itemSuspect :: Bool
}
deriving Show
type ItemFullKit = (ItemFull, ItemQuant)
type DiscoveryKind = EM.EnumMap ItemKindIx (ContentId IK.ItemKind)
type ItemIxMap = EM.EnumMap ItemKindIx (ES.EnumSet ItemId)
data Benefit = Benefit
{ benInEqp :: Bool
, benPickup :: Double
, benApply :: Double
, benMelee :: Double
, benFling :: Double
}
deriving (Show, Generic)
instance Binary Benefit
type DiscoveryBenefit = EM.EnumMap ItemId Benefit
type ItemTimer = [Time]
type ItemQuant = (Int, ItemTimer)
type ItemBag = EM.EnumMap ItemId ItemQuant
type ItemDict = EM.EnumMap ItemId Item
itemToFull6 :: COps -> DiscoveryKind -> DiscoveryAspect -> ItemId -> Item
-> ItemFull
itemToFull6 COps{coitem, coItemSpeedup} discoKind discoAspect iid itemBase =
let (itemKindId, itemSuspect) = case jkind itemBase of
IdentityObvious ik -> (ik, False)
IdentityCovered ix ik ->
maybe (ik, True) (, False) $ ix `EM.lookup` discoKind
itemKind = okind coitem itemKindId
km = getKindMean itemKindId coItemSpeedup
itemAspectMean | itemSuspect = km {IA.kmConst = False}
| otherwise = km
itemDisco = case EM.lookup iid discoAspect of
Just itemAspect -> ItemDiscoFull itemAspect
Nothing -> ItemDiscoMean itemAspectMean
in ItemFull {..}
aspectRecordFull :: ItemFull -> IA.AspectRecord
aspectRecordFull itemFull =
case itemDisco itemFull of
ItemDiscoFull itemAspect -> itemAspect
ItemDiscoMean itemAspectMean -> IA.kmMean itemAspectMean
strongestSlot :: DiscoveryBenefit -> Ability.EqpSlot -> [(ItemId, ItemFullKit)]
-> [(Int, (ItemId, ItemFullKit))]
strongestSlot discoBenefit eqpSlot is =
let f (iid, (itemFull, kit)) =
let Benefit{benInEqp, benPickup, benMelee} = discoBenefit EM.! iid
in if not benInEqp
then Nothing
else Just $
let ben = case eqpSlot of
EqpSlotWeaponFast ->
ceiling benPickup
EqpSlotWeaponBig ->
ceiling (- benMelee)
_ -> valueAtEqpSlot eqpSlot $ aspectRecordFull itemFull
in (ben, (iid, (itemFull, kit)))
in sortBy (flip $ Ord.comparing fst) $ mapMaybe f is
valueAtEqpSlot :: EqpSlot -> IA.AspectRecord -> Int
valueAtEqpSlot eqpSlot arItem@IA.AspectRecord{..} =
case eqpSlot of
EqpSlotMove -> Ability.getSk Ability.SkMove aSkills
EqpSlotMelee -> Ability.getSk Ability.SkMelee aSkills
EqpSlotDisplace -> Ability.getSk Ability.SkDisplace aSkills
EqpSlotAlter -> Ability.getSk Ability.SkAlter aSkills
EqpSlotWait -> Ability.getSk Ability.SkWait aSkills
EqpSlotMoveItem -> Ability.getSk Ability.SkMoveItem aSkills
EqpSlotProject -> Ability.getSk Ability.SkProject aSkills
EqpSlotApply -> Ability.getSk Ability.SkApply aSkills
EqpSlotSwimming -> Ability.getSk Ability.SkSwimming aSkills
EqpSlotFlying -> Ability.getSk Ability.SkFlying aSkills
EqpSlotHurtMelee -> Ability.getSk Ability.SkHurtMelee aSkills
EqpSlotArmorMelee -> Ability.getSk Ability.SkArmorMelee aSkills
EqpSlotArmorRanged -> Ability.getSk Ability.SkArmorRanged aSkills
EqpSlotMaxHP -> Ability.getSk Ability.SkMaxHP aSkills
EqpSlotSpeed -> Ability.getSk Ability.SkSpeed aSkills
EqpSlotSight -> Ability.getSk Ability.SkSight aSkills
EqpSlotShine -> Ability.getSk Ability.SkShine aSkills
EqpSlotMiscBonus ->
aTimeout
+ Ability.getSk Ability.SkMaxCalm aSkills
+ Ability.getSk Ability.SkSmell aSkills
+ Ability.getSk Ability.SkNocto aSkills
EqpSlotWeaponFast -> error $ "" `showFailure` arItem
EqpSlotWeaponBig -> error $ "" `showFailure` arItem
ncharges :: Time -> ItemFull -> ItemQuant -> Int
ncharges localTime itemFull (itemK, itemTimer) =
let timeout = IA.aTimeout $ aspectRecordFull itemFull
timeoutTurns = timeDeltaScale (Delta timeTurn) timeout
charging startT = timeShift startT timeoutTurns > localTime
it1 = filter charging itemTimer
in itemK - length it1
hasCharge :: Time -> ItemFull -> ItemQuant -> Bool
hasCharge localTime itemFull (itemK, itemTimer) =
ncharges localTime itemFull (itemK, itemTimer) > 0
strongestMelee :: Bool -> Maybe DiscoveryBenefit -> Time
-> [(ItemId, ItemFullKit)]
-> [(Double, (Int, (ItemId, ItemFullKit)))]
strongestMelee _ _ _ [] = []
strongestMelee ignoreCharges mdiscoBenefit localTime kitAss =
let f (iid, (itemFull, kit)) =
let rawDmg = IK.damageUsefulness $ itemKind itemFull
knownOrConstantAspects = case itemDisco itemFull of
ItemDiscoMean IA.KindMean{kmConst} -> kmConst
ItemDiscoFull{} -> True
unIDedBonus | knownOrConstantAspects
|| isNothing mdiscoBenefit = 0
| otherwise = 1000
totalValue = case mdiscoBenefit of
Just discoBenefit ->
let Benefit{benMelee} = discoBenefit EM.! iid
in - benMelee + unIDedBonus
Nothing -> rawDmg
ncha = ncharges localTime itemFull kit
in ( if ignoreCharges || ncha > 0
then totalValue
else -100000
, (ncha, (iid, (itemFull, kit))) )
in sortBy (flip $ Ord.comparing fst)
$ filter ((> -100000) . fst) $ map f kitAss
unknownAspect :: (IK.Aspect -> [Dice.Dice]) -> ItemFull -> Bool
unknownAspect f ItemFull{itemKind=IK.ItemKind{iaspects}, ..} =
case itemDisco of
ItemDiscoMean IA.KindMean{kmConst} ->
let unknown x = let (minD, maxD) = Dice.infsupDice x
in minD /= maxD
in itemSuspect || not kmConst && or (concatMap (map unknown . f) iaspects)
ItemDiscoFull{} -> False
unknownMeleeBonus :: [ItemFull] -> Bool
unknownMeleeBonus =
let p (IK.AddSkill Ability.SkHurtMelee k) = [k]
p _ = []
f itemFull b = b || unknownAspect p itemFull
in foldr f False
unknownSpeedBonus :: [ItemFull] -> Bool
unknownSpeedBonus =
let p (IK.AddSkill Ability.SkSpeed k) = [k]
p _ = []
f itemFull b = b || unknownAspect p itemFull
in foldr f False
conditionMeleeBonus :: [ItemFullKit] -> Int
conditionMeleeBonus kitAss =
let f (itemFull, (itemK, _)) k =
let arItem = aspectRecordFull itemFull
in if IA.checkFlag Ability.Condition arItem
then k + itemK * IA.getSkill Ability.SkHurtMelee arItem
else k
in foldr f 0 kitAss
conditionSpeedBonus :: [ItemFullKit] -> Int
conditionSpeedBonus kitAss =
let f (itemFull, (itemK, _)) k =
let arItem = aspectRecordFull itemFull
in if IA.checkFlag Ability.Condition arItem
then k + itemK * IA.getSkill Ability.SkSpeed arItem
else k
in foldr f 0 kitAss
armorHurtCalculation :: Bool -> Ability.Skills -> Ability.Skills -> Int
armorHurtCalculation proj sMaxSk tMaxSk =
let trim200 n = min 200 $ max (-200) n
itemBonus =
trim200 (Ability.getSk Ability.SkHurtMelee sMaxSk)
- if proj
then trim200 (Ability.getSk Ability.SkArmorRanged tMaxSk)
else trim200 (Ability.getSk Ability.SkArmorMelee tMaxSk)
in 100 + min 99 (max (-99) itemBonus)