module Game.LambdaHack.Common.ActorState
( actorAssocsLvl, actorAssocs, actorList
, actorNotProjAssocsLvl, actorNotProjAssocs, actorNotProjList
, calculateTotal, nearbyFreePoints, whereTo
, posToActors, posToActor, getItemBody, memActor
, getActorBody, updateActorBody
, getActorItem, getFloorItem, getActorBag
, actorContainer, actorContainerB, getActorInv
, tryFindHeroK, foesAdjacent
) where
import Control.Exception.Assert.Sugar
import qualified Data.Char as Char
import qualified Data.EnumMap.Strict as EM
import qualified Data.EnumSet as ES
import Data.List
import Data.Maybe
import Game.LambdaHack.Common.Actor
import Game.LambdaHack.Common.Faction
import Game.LambdaHack.Common.Item
import qualified Game.LambdaHack.Common.Kind as Kind
import Game.LambdaHack.Common.Level
import Game.LambdaHack.Common.Point
import Game.LambdaHack.Common.State
import qualified Game.LambdaHack.Common.Tile as Tile
import Game.LambdaHack.Common.Vector
import Game.LambdaHack.Content.TileKind
actorAssocsLvl :: (FactionId -> Bool) -> Level -> ActorDict
-> [(ActorId, Actor)]
actorAssocsLvl p lvl actorD =
mapMaybe (\aid -> let actor = actorD EM.! aid
in if p (bfid actor)
then Just (aid, actor)
else Nothing)
$ concat $ EM.elems $ lprio lvl
actorAssocs :: (FactionId -> Bool) -> LevelId -> State
-> [(ActorId, Actor)]
actorAssocs p lid s =
actorAssocsLvl p (sdungeon s EM.! lid) (sactorD s)
actorList :: (FactionId -> Bool) -> LevelId -> State
-> [Actor]
actorList p lid s = map snd $ actorAssocs p lid s
actorNotProjAssocsLvl :: (FactionId -> Bool) -> Level -> ActorDict
-> [(ActorId, Actor)]
actorNotProjAssocsLvl p lvl actorD =
mapMaybe (\aid -> let actor = actorD EM.! aid
in if not (bproj actor) && p (bfid actor)
then Just (aid, actor)
else Nothing)
$ concat $ EM.elems $ lprio lvl
actorNotProjAssocs :: (FactionId -> Bool) -> LevelId -> State
-> [(ActorId, Actor)]
actorNotProjAssocs p lid s =
actorNotProjAssocsLvl p (sdungeon s EM.! lid) (sactorD s)
actorNotProjList :: (FactionId -> Bool) -> LevelId -> State
-> [Actor]
actorNotProjList p lid s = map snd $ actorNotProjAssocs p lid s
posToActor :: Point -> LevelId -> State
-> Maybe ((ActorId, Actor), [(ItemId, Item)])
posToActor pos lid s = listToMaybe $ posToActors pos lid s
posToActors :: Point -> LevelId -> State
-> [((ActorId, Actor), [(ItemId, Item)])]
posToActors pos lid s =
let as = actorAssocs (const True) lid s
aps = filter (\(_, b) -> bpos b == pos) as
f iid = (iid, getItemBody iid s)
g (aid, b) = ((aid, b), map f $ EM.keys $ bbag b)
l = map g aps
in assert (length l <= 1 || all (bproj . snd . fst) l
`blame` "many actors at the same position" `twith` l)
l
nearbyFreePoints :: Kind.Ops TileKind
-> (Kind.Id TileKind -> Bool) -> Point -> LevelId -> State
-> [Point]
nearbyFreePoints cotile f start lid s =
let lvl@Level{lxsize, lysize} = sdungeon s EM.! lid
as = actorList (const True) lid s
good p = f (lvl `at` p)
&& Tile.isWalkable cotile (lvl `at` p)
&& unoccupied as p
ps = nub $ start : concatMap (vicinity lxsize lysize) ps
in filter good ps
calculateTotal :: Actor -> State -> (ItemBag, Int)
calculateTotal body s =
let bs = actorList (== bfid body) (blid body) s
bag = EM.unionsWith (+) $ map bbag $ if null bs then [body] else bs
items = map (\(iid, k) -> (getItemBody iid s, k))
$ EM.assocs bag
in (bag, sum $ map itemPrice items)
itemPrice :: (Item, Int) -> Int
itemPrice (item, jcount) =
case jsymbol item of
'$' -> jcount
'*' -> jcount * 100
_ -> 0
foesAdjacent :: X -> Y -> Point -> [Actor] -> Bool
foesAdjacent lxsize lysize pos foes =
let vic = ES.fromList $ vicinity lxsize lysize pos
lfs = ES.fromList $ map bpos foes
in not $ ES.null $ ES.intersection vic lfs
tryFindActor :: State -> (Actor -> Bool) -> Maybe (ActorId, Actor)
tryFindActor s p =
find (p . snd) $ EM.assocs $ sactorD s
tryFindHeroK :: State -> FactionId -> Int -> Maybe (ActorId, Actor)
tryFindHeroK s fact k =
let c | k == 0 = '@'
| k > 0 && k < 10 = Char.intToDigit k
| otherwise = assert `failure` "no digit" `twith` k
in tryFindActor s (\body -> bsymbol body == c
&& not (bproj body)
&& bfid body == fact)
whereTo :: LevelId
-> Point
-> Int
-> Dungeon
-> (LevelId, Point)
whereTo lid pos k dungeon = assert (k /= 0) $
let lvl = dungeon EM.! lid
stairs = (if k < 0 then snd else fst) (lstair lvl)
defaultStairs = 0
mindex = elemIndex pos stairs
i = fromMaybe defaultStairs mindex
in case ascendInBranch dungeon k lid of
[] | isNothing mindex -> (lid, pos)
[] -> assert `failure` "no dungeon level to go to" `twith` (lid, pos, k)
ln : _ -> let lvlTgt = dungeon EM.! ln
stairsTgt = (if k < 0 then fst else snd) (lstair lvlTgt)
in if length stairsTgt < i + 1
then assert `failure` "no stairs at index"
`twith` (lid, pos, k, ln, stairsTgt, i)
else (ln, stairsTgt !! i)
getActorBody :: ActorId -> State -> Actor
getActorBody aid s =
fromMaybe (assert `failure` "body not found" `twith` (aid, s))
$ EM.lookup aid $ sactorD s
updateActorBody :: ActorId -> (Actor -> Actor) -> State -> State
updateActorBody aid f s =
let alt Nothing = assert `failure` "no body to update" `twith` (aid, s)
alt (Just b) = Just $ f b
in updateActorD (EM.alter alt aid) s
getActorBag :: ActorId -> State -> ItemBag
getActorBag aid s = bbag $ getActorBody aid s
actorContainer :: ActorId -> ItemInv -> ItemId -> Container
actorContainer aid binv iid =
case find ((== iid) . snd) $ EM.assocs binv of
Just (l, _) -> CActor aid l
Nothing -> assert `failure` "item not in inventory" `twith` (aid, binv, iid)
actorContainerB :: ActorId -> Actor -> ItemId -> Item -> Maybe Container
actorContainerB aid body iid item =
case find ((== iid) . snd) $ EM.assocs (binv body) of
Just (l, _) -> Just $ CActor aid l
Nothing ->
let l = if jsymbol item == '$' then Just $ InvChar '$' else Nothing
in case assignLetter iid l body of
Just l2 -> Just $ CActor aid l2
Nothing -> Nothing
getActorInv :: ActorId -> State -> ItemInv
getActorInv aid s = binv $ getActorBody aid s
getActorItem :: ActorId -> State -> [(ItemId, Item)]
getActorItem aid s =
let f iid = (iid, getItemBody iid s)
in map f $ EM.keys $ getActorBag aid s
getFloorItem :: LevelId -> Point -> State -> [(ItemId, Item)]
getFloorItem lid pos s =
let f iid = (iid, getItemBody iid s)
in map f $ EM.keys $ sdungeon s EM.! lid `atI` pos
getItemBody :: ItemId -> State -> Item
getItemBody iid s =
fromMaybe (assert `failure` "item body not found"
`twith` (iid, s)) $ EM.lookup iid $ sitemD s
memActor :: ActorId -> LevelId -> State -> Bool
memActor aid lid s =
maybe False ((== lid) . blid) $ EM.lookup aid $ sactorD s