{-# LANGUAGE TupleSections #-}
module Game.LambdaHack.Common.ActorState
( fidActorNotProjGlobalAssocs, actorAssocs, fidActorRegularAssocs
, fidActorRegularIds, foeRegularAssocs, foeRegularList
, friendRegularAssocs, friendRegularList, bagAssocs, bagAssocsK
, posToBig, posToBigAssoc, posToProjs, posToProjAssocs
, posToAids, posToAidAssocs
, calculateTotal, itemPrice, mergeItemQuant, findIid
, combinedGround, combinedOrgan, combinedEqp, combinedInv
, combinedItems, combinedFromLore
, getActorBody, getActorMaxSkills, actorCurrentSkills, canTraverse
, getCarriedAssocsAndTrunk, getCarriedIidCStore, getContainerBag
, getFloorBag, getEmbedBag, getBodyStoreBag
, mapActorItems_, getActorAssocs, getActorAssocsK
, memActor, getLocalTime, regenCalmDelta, actorInAmbient, canDeAmbientList
, dispEnemy, itemToFull, fullAssocs, kitAssocs
, getItemKindId, getIidKindId, getItemKind, getIidKind
, getItemKindIdServer, getIidKindIdServer, getItemKindServer, getIidKindServer
, lidFromC, posFromC, anyFoeAdj, adjacentBigAssocs, adjacentProjAssocs
, armorHurtBonus, inMelee
) where
import Prelude ()
import Game.LambdaHack.Core.Prelude
import qualified Data.EnumMap.Strict as EM
import qualified Data.EnumSet as ES
import Data.Int (Int64)
import GHC.Exts (inline)
import Game.LambdaHack.Common.Actor
import Game.LambdaHack.Common.Faction
import Game.LambdaHack.Common.Item
import Game.LambdaHack.Common.Kind
import Game.LambdaHack.Common.Level
import Game.LambdaHack.Common.Misc
import Game.LambdaHack.Common.State
import qualified Game.LambdaHack.Common.Tile as Tile
import Game.LambdaHack.Common.Time
import Game.LambdaHack.Common.Types
import Game.LambdaHack.Common.Vector
import qualified Game.LambdaHack.Content.ItemKind as IK
import Game.LambdaHack.Content.ModeKind
import qualified Game.LambdaHack.Content.TileKind as TK
import Game.LambdaHack.Common.Point
import qualified Game.LambdaHack.Definition.Ability as Ability
import Game.LambdaHack.Definition.Defs
fidActorNotProjGlobalAssocs :: FactionId -> State -> [(ActorId, Actor)]
fidActorNotProjGlobalAssocs fid s =
let f (_, b) = not (bproj b) && bfid b == fid
in filter f $ EM.assocs $ sactorD s
actorAssocs :: (FactionId -> Bool) -> LevelId -> State
-> [(ActorId, Actor)]
actorAssocs p lid s =
let f (_, b) = blid b == lid && p (bfid b)
in filter f $ EM.assocs $ sactorD s
actorRegularAssocs :: (FactionId -> Bool) -> LevelId -> State
-> [(ActorId, Actor)]
{-# INLINE actorRegularAssocs #-}
actorRegularAssocs p lid s =
let f (_, b) = not (bproj b) && blid b == lid && p (bfid b) && bhp b > 0
in filter f $ EM.assocs $ sactorD s
fidActorRegularAssocs :: FactionId -> LevelId -> State -> [(ActorId, Actor)]
fidActorRegularAssocs fid = actorRegularAssocs (== fid)
fidActorRegularIds :: FactionId -> LevelId -> State -> [ActorId]
fidActorRegularIds fid lid s =
map fst $ actorRegularAssocs (== fid) lid s
foeRegularAssocs :: FactionId -> LevelId -> State -> [(ActorId, Actor)]
foeRegularAssocs fid lid s =
let fact = (EM.! fid) . sfactionD $ s
in actorRegularAssocs (inline isFoe fid fact) lid s
foeRegularList :: FactionId -> LevelId -> State -> [Actor]
foeRegularList fid lid s =
let fact = (EM.! fid) . sfactionD $ s
in map snd $ actorRegularAssocs (inline isFoe fid fact) lid s
friendRegularAssocs :: FactionId -> LevelId -> State -> [(ActorId, Actor)]
friendRegularAssocs fid lid s =
let fact = (EM.! fid) . sfactionD $ s
in actorRegularAssocs (inline isFriend fid fact) lid s
friendRegularList :: FactionId -> LevelId -> State -> [Actor]
friendRegularList fid lid s =
let fact = (EM.! fid) . sfactionD $ s
in map snd $ actorRegularAssocs (inline isFriend fid fact) lid s
bagAssocs :: State -> ItemBag -> [(ItemId, Item)]
bagAssocs s bag =
let iidItem iid = (iid, getItemBody iid s)
in map iidItem $ EM.keys bag
bagAssocsK :: State -> ItemBag -> [(ItemId, (Item, ItemQuant))]
bagAssocsK s bag =
let iidItem (iid, kit) = (iid, (getItemBody iid s, kit))
in map iidItem $ EM.assocs bag
posToBig :: Point -> LevelId -> State -> Maybe ActorId
posToBig pos lid s = posToBigLvl pos $ sdungeon s EM.! lid
posToBigAssoc :: Point -> LevelId -> State -> Maybe (ActorId, Actor)
posToBigAssoc pos lid s =
let maid = posToBigLvl pos $ sdungeon s EM.! lid
in fmap (\aid -> (aid, getActorBody aid s)) maid
posToProjs :: Point -> LevelId -> State -> [ActorId]
posToProjs pos lid s = posToProjsLvl pos $ sdungeon s EM.! lid
posToProjAssocs :: Point -> LevelId -> State -> [(ActorId, Actor)]
posToProjAssocs pos lid s =
let l = posToProjsLvl pos $ sdungeon s EM.! lid
in map (\aid -> (aid, getActorBody aid s)) l
posToAids :: Point -> LevelId -> State -> [ActorId]
posToAids pos lid s = posToAidsLvl pos $ sdungeon s EM.! lid
posToAidAssocs :: Point -> LevelId -> State -> [(ActorId, Actor)]
posToAidAssocs pos lid s =
let l = posToAidsLvl pos $ sdungeon s EM.! lid
in map (\aid -> (aid, getActorBody aid s)) l
calculateTotal :: FactionId -> State -> (ItemBag, Int)
calculateTotal fid s =
let bag = combinedItems fid s
items = map (\(iid, (k, _)) -> (getItemBody iid s, k)) $ EM.assocs bag
price (item, k) = itemPrice k $ getItemKind item s
in (bag, sum $ map price items)
itemPrice :: Int -> IK.ItemKind -> Int
itemPrice jcount itemKind = case lookup "valuable" $ IK.ifreq itemKind of
Just k -> jcount * k
Nothing -> 0
mergeItemQuant :: ItemQuant -> ItemQuant -> ItemQuant
mergeItemQuant (k2, it2) (k1, it1) = (k1 + k2, it1 ++ it2)
findIid :: ActorId -> FactionId -> ItemId -> State
-> [(ActorId, (Actor, CStore))]
findIid leader fid iid s =
let actors = fidActorNotProjGlobalAssocs fid s
itemsOfActor (aid, b) =
let itemsOfCStore store =
let bag = getBodyStoreBag b store s
in map (\iid2 -> (iid2, (aid, (b, store)))) (EM.keys bag)
stores = [CInv, CEqp, COrgan] ++ [CSha | aid == leader]
in concatMap itemsOfCStore stores
items = concatMap itemsOfActor actors
in map snd $ filter ((== iid) . fst) items
combinedGround :: FactionId -> State -> ItemBag
combinedGround fid s =
let bs = inline fidActorNotProjGlobalAssocs fid s
in EM.unionsWith mergeItemQuant
$ map (\(_, b) -> getFloorBag (blid b) (bpos b) s) bs
combinedOrgan :: FactionId -> State -> ItemBag
combinedOrgan fid s =
let bs = inline fidActorNotProjGlobalAssocs fid s
in EM.unionsWith mergeItemQuant $ map (borgan . snd) bs
combinedEqp :: FactionId -> State -> ItemBag
combinedEqp fid s =
let bs = inline fidActorNotProjGlobalAssocs fid s
in EM.unionsWith mergeItemQuant $ map (beqp . snd) bs
combinedInv :: FactionId -> State -> ItemBag
combinedInv fid s =
let bs = inline fidActorNotProjGlobalAssocs fid s
in EM.unionsWith mergeItemQuant $ map (binv . snd) bs
combinedItems :: FactionId -> State -> ItemBag
combinedItems fid s =
let shaBag = gsha $ sfactionD s EM.! fid
bs = map snd $ inline fidActorNotProjGlobalAssocs fid s
in EM.unionsWith mergeItemQuant $ map binv bs ++ map beqp bs ++ [shaBag]
combinedFromLore :: SLore -> FactionId -> State -> ItemBag
combinedFromLore slore fid s = case slore of
SItem -> combinedItems fid s
SOrgan -> combinedOrgan fid s
STrunk -> combinedOrgan fid s
SCondition -> combinedOrgan fid s
SBlast -> EM.empty
SEmbed -> EM.empty
getActorBody :: ActorId -> State -> Actor
{-# INLINE getActorBody #-}
getActorBody aid s = sactorD s EM.! aid
getActorMaxSkills :: ActorId -> State -> Ability.Skills
{-# INLINE getActorMaxSkills #-}
getActorMaxSkills aid s = sactorMaxSkills s EM.! aid
actorCurrentSkills :: Maybe ActorId -> ActorId -> State -> Ability.Skills
actorCurrentSkills mleader aid s =
let body = getActorBody aid s
actorMaxSk = getActorMaxSkills aid s
player = gplayer . (EM.! bfid body) . sfactionD $ s
skillsFromTactic = Ability.tacticSkills $ ftactic player
factionSkills
| Just aid == mleader = Ability.zeroSkills
| otherwise = fskillsOther player `Ability.addSkills` skillsFromTactic
in actorMaxSk `Ability.addSkills` factionSkills
canTraverse :: ActorId -> State -> Bool
canTraverse aid s =
let actorMaxSk = getActorMaxSkills aid s
in Ability.getSk Ability.SkMove actorMaxSk > 0
&& Ability.getSk Ability.SkAlter actorMaxSk >= fromEnum TK.talterForStairs
getCarriedAssocsAndTrunk :: Actor -> State -> [(ItemId, Item)]
getCarriedAssocsAndTrunk b s =
let trunk = EM.singleton (btrunk b) (1, [])
in bagAssocs s $ EM.unionsWith const [binv b, beqp b, borgan b, trunk]
getCarriedIidCStore :: Actor -> [(ItemId, CStore)]
getCarriedIidCStore b =
let bagCarried (cstore, bag) = map (,cstore) $ EM.keys bag
in concatMap bagCarried [(CInv, binv b), (CEqp, beqp b), (COrgan, borgan b)]
getContainerBag :: Container -> State -> ItemBag
getContainerBag c s = case c of
CFloor lid p -> getFloorBag lid p s
CEmbed lid p -> getEmbedBag lid p s
CActor aid cstore -> let b = getActorBody aid s
in getBodyStoreBag b cstore s
CTrunk{} -> EM.empty
getFloorBag :: LevelId -> Point -> State -> ItemBag
getFloorBag lid p s = EM.findWithDefault EM.empty p
$ lfloor (sdungeon s EM.! lid)
getEmbedBag :: LevelId -> Point -> State -> ItemBag
getEmbedBag lid p s = EM.findWithDefault EM.empty p
$ lembed (sdungeon s EM.! lid)
getBodyStoreBag :: Actor -> CStore -> State -> ItemBag
getBodyStoreBag b cstore s =
case cstore of
CGround -> getFloorBag (blid b) (bpos b) s
COrgan -> borgan b
CEqp -> beqp b
CInv -> binv b
CSha -> gsha $ sfactionD s EM.! bfid b
mapActorItems_ :: Monad m
=> (CStore -> ItemId -> ItemQuant -> m a) -> Actor -> State
-> m ()
mapActorItems_ f b s = do
let notProcessed = [CGround]
sts = [minBound..maxBound] \\ notProcessed
g cstore = do
let bag = getBodyStoreBag b cstore s
mapM_ (uncurry $ f cstore) $ EM.assocs bag
mapM_ g sts
getActorAssocs :: ActorId -> CStore -> State -> [(ItemId, Item)]
getActorAssocs aid cstore s =
let b = getActorBody aid s
in bagAssocs s $ getBodyStoreBag b cstore s
getActorAssocsK :: ActorId -> CStore -> State -> [(ItemId, (Item, ItemQuant))]
getActorAssocsK aid cstore s =
let b = getActorBody aid s
in bagAssocsK s $ getBodyStoreBag b cstore s
memActor :: ActorId -> LevelId -> State -> Bool
memActor aid lid s =
maybe False ((== lid) . blid) $ EM.lookup aid $ sactorD s
getLocalTime :: LevelId -> State -> Time
getLocalTime lid s = ltime $ sdungeon s EM.! lid
regenCalmDelta :: ActorId -> Actor -> State -> Int64
regenCalmDelta aid body s =
let calmIncr = oneM
actorMaxSk = getActorMaxSkills aid s
maxDeltaCalm = xM (Ability.getSk Ability.SkMaxCalm actorMaxSk)
- bcalm body
fact = (EM.! bfid body) . sfactionD $ s
isHeardFoe (!p, aid2) =
let b = getActorBody aid2 s
in inline chessDist p (bpos body) <= 3
&& not (actorWaitsOrSleeps b)
&& inline isFoe (bfid body) fact (bfid b)
actorRelaxed = deltaBenign $ bcalmDelta body
actorWasRelaxed = deltaWasBenign $ bcalmDelta body
in if | not actorRelaxed -> 0
| any isHeardFoe $ EM.assocs $ lbig $ sdungeon s EM.! blid body ->
minusM1
| actorWasRelaxed -> min calmIncr (max 0 maxDeltaCalm)
| otherwise -> 0
actorInAmbient :: Actor -> State -> Bool
actorInAmbient b s =
let lvl = (EM.! blid b) . sdungeon $ s
in Tile.isLit (coTileSpeedup $ scops s) (lvl `at` bpos b)
canDeAmbientList :: Actor -> State -> [Point]
canDeAmbientList b s =
let COps{coTileSpeedup} = scops s
lvl = (EM.! blid b) . sdungeon $ s
posDeAmbient p =
let t = lvl `at` p
in Tile.isWalkable coTileSpeedup t
&& not (Tile.isLit coTileSpeedup t)
in if Tile.isLit coTileSpeedup (lvl `at` bpos b)
then filter posDeAmbient (vicinityUnsafe $ bpos b)
else []
dispEnemy :: ActorId -> ActorId -> Ability.Skills -> State -> Bool
dispEnemy source target actorMaxSk s =
let hasBackup b =
let adjAssocs = adjacentBigAssocs b s
fact = sfactionD s EM.! bfid b
friend (_, b2) = isFriend (bfid b) fact (bfid b2) && bhp b2 > 0
in any friend adjAssocs
sb = getActorBody source s
tb = getActorBody target s
dozes = bwatch tb `elem` [WSleep, WWake]
in bproj tb
|| not (actorDying tb
|| actorWaits tb
|| Ability.getSk Ability.SkMove actorMaxSk <= 0
&& not dozes
|| hasBackup sb && hasBackup tb)
itemToFull :: ItemId -> State -> ItemFull
itemToFull iid s =
itemToFull6 (scops s) (sdiscoKind s) (sdiscoAspect s) iid (getItemBody iid s)
fullAssocs :: ActorId -> [CStore] -> State -> [(ItemId, ItemFull)]
fullAssocs aid cstores s =
let allAssocs = concatMap (\cstore -> getActorAssocsK aid cstore s) cstores
iToFull (iid, (item, _kit)) =
(iid, itemToFull6 (scops s) (sdiscoKind s) (sdiscoAspect s) iid item)
in map iToFull allAssocs
kitAssocs :: ActorId -> [CStore] -> State -> [(ItemId, ItemFullKit)]
kitAssocs aid cstores s =
let allAssocs = concatMap (\cstore -> getActorAssocsK aid cstore s) cstores
iToFull (iid, (item, kit)) =
(iid, ( itemToFull6 (scops s) (sdiscoKind s) (sdiscoAspect s) iid item
, kit ))
in map iToFull allAssocs
getItemKindId :: Item -> State -> ContentId IK.ItemKind
getItemKindId item s = case jkind item of
IdentityObvious ik -> ik
IdentityCovered ix ik -> fromMaybe ik $ EM.lookup ix $ sdiscoKind s
getIidKindId :: ItemId -> State -> ContentId IK.ItemKind
getIidKindId iid s = getItemKindId (getItemBody iid s) s
getItemKind :: Item -> State -> IK.ItemKind
getItemKind item s = okind (coitem $ scops s) $ getItemKindId item s
getIidKind :: ItemId -> State -> IK.ItemKind
getIidKind iid s = getItemKind (getItemBody iid s) s
getItemKindIdServer :: Item -> State -> ContentId IK.ItemKind
getItemKindIdServer item s = case jkind item of
IdentityObvious ik -> ik
IdentityCovered ix _ik -> fromMaybe (error $ show $ jkind item)
(EM.lookup ix $ sdiscoKind s)
getIidKindIdServer :: ItemId -> State -> ContentId IK.ItemKind
getIidKindIdServer iid s = getItemKindIdServer (getItemBody iid s) s
getItemKindServer :: Item -> State -> IK.ItemKind
getItemKindServer item s = okind (coitem $ scops s) $ getItemKindIdServer item s
getIidKindServer :: ItemId -> State -> IK.ItemKind
getIidKindServer iid s = getItemKindServer (getItemBody iid s) s
lidFromC :: Container -> State -> LevelId
lidFromC (CFloor lid _) _ = lid
lidFromC (CEmbed lid _) _ = lid
lidFromC (CActor aid _) s = blid $ getActorBody aid s
lidFromC (CTrunk _ lid _) _ = lid
posFromC :: Container -> State -> Point
posFromC (CFloor _ pos) _ = pos
posFromC (CEmbed _ pos) _ = pos
posFromC (CActor aid _) s = bpos $ getActorBody aid s
posFromC c@CTrunk{} _ = error $ "" `showFailure` c
anyFoeAdj :: ActorId -> State -> Bool
anyFoeAdj aid s =
let body = getActorBody aid s
lvl = (EM.! blid body) . sdungeon $ s
fact = (EM.! bfid body) . sfactionD $ s
f !p = case posToBigLvl p lvl of
Nothing -> False
Just aid2 -> g $ getActorBody aid2 s
g !b = inline isFoe (bfid body) fact (bfid b)
&& bhp b > 0
h !p = case posToProjsLvl p lvl of
[] -> False
aid2 : _ -> g $ getActorBody aid2 s
in any (\ p -> f p || h p) $ vicinityUnsafe $ bpos body
adjacentBigAssocs :: Actor -> State -> [(ActorId, Actor)]
{-# INLINE adjacentBigAssocs #-}
adjacentBigAssocs body s =
let lvl = (EM.! blid body) . sdungeon $ s
f !p = posToBigLvl p lvl
g !aid = (aid, getActorBody aid s)
in map g $ mapMaybe f $ vicinityUnsafe $ bpos body
adjacentProjAssocs :: Actor -> State -> [(ActorId, Actor)]
{-# INLINE adjacentProjAssocs #-}
adjacentProjAssocs body s =
let lvl = (EM.! blid body) . sdungeon $ s
f !p = posToProjsLvl p lvl
g !aid = (aid, getActorBody aid s)
in map g $ concatMap f $ vicinityUnsafe $ bpos body
armorHurtBonus :: ActorId -> ActorId -> State -> Int
armorHurtBonus source target s =
let sb = getActorBody source s
sMaxSk = getActorMaxSkills source s
tMaxSk = getActorMaxSkills target s
in armorHurtCalculation (bproj sb) sMaxSk tMaxSk
inMelee :: FactionId -> LevelId -> State -> Bool
inMelee !fid !lid s =
let fact = sfactionD s EM.! fid
f !b = blid b == lid
&& inline isFoe fid fact (bfid b)
&& bhp b > 0
allFoes = filter f $ EM.elems $ sactorD s
g !b = bfid b == fid
&& blid b == lid
&& not (bproj b)
&& bhp b > 0
allOurs = filter g $ EM.elems $ sactorD s
setFoeVicinity = ES.fromList $ concatMap (vicinityUnsafe . bpos) allFoes
in not (ES.null setFoeVicinity)
&& any (\b -> bpos b `ES.member` setFoeVicinity) allOurs