{-# LANGUAGE TupleSections #-} -- | Breadth first search and related algorithms using the client monad. module Game.LambdaHack.Client.BfsM ( invalidateBfsAid, invalidateBfsPathAid , invalidateBfsLid, invalidateBfsPathLid , invalidateBfsAll, invalidateBfsPathAll , createBfs, getCacheBfsAndPath, getCacheBfs , getCachePath, createPath, condBFS , furthestKnown, closestUnknown, closestSmell , FleeViaStairsOrEscape(..) , embedBenefit, closestTriggers, condEnoughGearM, closestItems, closestFoes , closestStashes, oursExploringAssocs, closestHideout #ifdef EXPOSE_INTERNAL , unexploredDepth, updatePathFromBfs #endif ) where import Prelude () import Game.LambdaHack.Core.Prelude import qualified Data.EnumMap.Strict as EM import qualified Data.EnumSet as ES import Data.Word import Game.LambdaHack.Client.Bfs import Game.LambdaHack.Client.CommonM import Game.LambdaHack.Client.MonadClient import Game.LambdaHack.Client.State import Game.LambdaHack.Common.Actor import Game.LambdaHack.Common.ActorState import Game.LambdaHack.Common.Faction import Game.LambdaHack.Common.Item import qualified Game.LambdaHack.Common.ItemAspect as IA import Game.LambdaHack.Common.Kind import Game.LambdaHack.Common.Level import Game.LambdaHack.Common.MonadStateRead import Game.LambdaHack.Common.Perception import Game.LambdaHack.Common.Point import qualified Game.LambdaHack.Common.PointArray as PointArray 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.CaveKind as CK import Game.LambdaHack.Content.FactionKind import qualified Game.LambdaHack.Content.ItemKind as IK import Game.LambdaHack.Content.RuleKind import Game.LambdaHack.Content.TileKind (isUknownSpace) import Game.LambdaHack.Core.Random import qualified Game.LambdaHack.Definition.Ability as Ability import Game.LambdaHack.Definition.Defs invalidateBfsAid :: MonadClient m => ActorId -> m () invalidateBfsAid aid = modifyClient $ \cli -> cli {sbfsD = EM.adjust (const BfsInvalid) aid (sbfsD cli)} invalidateBfsPathAid :: MonadClient m => ActorId -> m () invalidateBfsPathAid aid = do let f BfsInvalid = BfsInvalid f (BfsAndPath bfsArr _) = BfsAndPath bfsArr EM.empty modifyClient $ \cli -> cli {sbfsD = EM.adjust f aid (sbfsD cli)} -- Even very distant actors affected, e.g., when a hidden door found in a wall. invalidateBfsLid :: MonadClient m => LevelId -> m () invalidateBfsLid lid = do lvl <- getLevel lid -- No need to filter, because foes won't be in our BFS map and looking up -- in our BFS map is faster than in all actors map. mapM_ invalidateBfsAid $ EM.elems $ lbig lvl -- We invalidate, but not when actors move, since they are likely to move -- out of the way in time. We only do, when they appear or disappear, -- because they may be immobile or too close to move away before we get there. -- We also don't consider far actors, since they are likely to disappear -- again or to be far from our path. If they close enough to be lit -- by our light, or one step further, that's worth taking seriously. invalidateBfsPathLid :: MonadClient m => Actor -> m () invalidateBfsPathLid body = do lvl <- getLevel $ blid body let close (p, _) = chessDist p (bpos body) <= 3 -- heuristic -- No need to filter more, because foes won't be in our BFS map and looking up -- in our BFS map is faster than in all actors map. mapM_ (invalidateBfsPathAid . snd) $ filter close $ EM.assocs $ lbig lvl invalidateBfsAll :: MonadClient m => m () invalidateBfsAll = modifyClient $ \cli -> cli {sbfsD = EM.map (const BfsInvalid) (sbfsD cli)} invalidateBfsPathAll :: MonadClient m => m () invalidateBfsPathAll = do let f BfsInvalid = BfsInvalid f (BfsAndPath bfsArr _) = BfsAndPath bfsArr EM.empty modifyClient $ \cli -> cli {sbfsD = EM.map f (sbfsD cli)} createBfs :: MonadClientRead m => Bool -> Word8 -> ActorId -> m (PointArray.Array BfsDistance) createBfs canMove alterSkill0 aid = if canMove then do b <- getsState $ getActorBody aid salter <- getsClient salter let source = bpos b lalter = salter EM.! blid b alterSkill = max 1 alterSkill0 -- We increase 0 skill to 1, to also path through unknown tiles. -- Since there are no other tiles that require skill 1, this is safe. stabs <- getsClient stabs return $! fillBfs lalter alterSkill source stabs else return PointArray.empty updatePathFromBfs :: MonadClient m => Bool -> BfsAndPath -> ActorId -> Point -> m (PointArray.Array BfsDistance, Maybe AndPath) updatePathFromBfs canMove bfsAndPathOld aid !target = do COps{coTileSpeedup} <- getsState scops let (oldBfsArr, oldBfsPath) = case bfsAndPathOld of (BfsAndPath bfsArr bfsPath) -> (bfsArr, bfsPath) BfsInvalid -> error $ "" `showFailure` (bfsAndPathOld, aid, target) let bfsArr = oldBfsArr if not canMove then return (bfsArr, Nothing) else do getActorB <- getsState $ flip getActorBody let b = getActorB aid fact <- getsState $ (EM.! bfid b) . sfactionD seps <- getsClient seps salter <- getsClient salter lvl <- getLevel (blid b) let !lalter = salter EM.! blid b fovLit p = Tile.isLit coTileSpeedup $ PointArray.fromUnboxRep $ ltile lvl `PointArray.accessI` p addFoeVicinity (p, aid2) = let b2 = getActorB aid2 in if isFoe (bfid b) fact (bfid b2) then p : vicinityUnsafe p else [p] bigAdj = ES.fromList $ concatMap addFoeVicinity $ EM.assocs $ EM.delete source $ lbig lvl -- don't sidestep oneself !source = bpos b !mpath = findPathBfs bigAdj lalter fovLit source target seps bfsArr !bfsPath = maybe oldBfsPath (\path -> EM.insert target path oldBfsPath) mpath bap = BfsAndPath bfsArr bfsPath modifyClient $ \cli -> cli {sbfsD = EM.insert aid bap $ sbfsD cli} return (bfsArr, mpath) -- | Get cached BFS array and path or, if not stored, generate and store first. getCacheBfsAndPath :: forall m. MonadClient m => ActorId -> Point -> m (PointArray.Array BfsDistance, Maybe AndPath) getCacheBfsAndPath aid target = do mbfs <- getsClient $ EM.lookup aid . sbfsD case mbfs of Just bap@(BfsAndPath bfsArr bfsPath) -> case EM.lookup target bfsPath of Nothing -> do (!canMove, _) <- condBFS aid updatePathFromBfs canMove bap aid target mpath@Just{} -> return (bfsArr, mpath) _ -> do (canMove, alterSkill) <- condBFS aid !bfsArr <- createBfs canMove alterSkill aid let bfsPath = EM.empty updatePathFromBfs canMove (BfsAndPath bfsArr bfsPath) aid target -- | Get cached BFS array or, if not stored, generate and store first. getCacheBfs :: MonadClient m => ActorId -> m (PointArray.Array BfsDistance) getCacheBfs aid = do mbfs <- getsClient $ EM.lookup aid . sbfsD case mbfs of Just (BfsAndPath bfsArr _) -> return bfsArr _ -> do (canMove, alterSkill) <- condBFS aid !bfsArr <- createBfs canMove alterSkill aid let bfsPath = EM.empty modifyClient $ \cli -> cli {sbfsD = EM.insert aid (BfsAndPath bfsArr bfsPath) (sbfsD cli)} return bfsArr -- | Get cached BFS path or, if not stored, generate and store first. getCachePath :: MonadClient m => ActorId -> Point -> m (Maybe AndPath) getCachePath aid target = do b <- getsState $ getActorBody aid let source = bpos b if source == target then return $ Just $ AndPath (bpos b) [] target 0 -- speedup else snd <$> getCacheBfsAndPath aid target createPath :: MonadClient m => ActorId -> Target -> m TgtAndPath createPath aid tapTgt = do COps{coTileSpeedup} <- getsState scops b <- getsState $ getActorBody aid lvl <- getLevel $ blid b let stopAtUnwalkable tapPath@(Just AndPath{..}) = let (walkable, rest) = -- Unknown tiles are not walkable, so path stops just before. -- which is good, because by the time actor reaches the tile, -- it is known and target is recalculated with new info, -- perhaps sidestepping the tile, e.g., if explosive. span (Tile.isWalkable coTileSpeedup . at lvl) pathList in case rest of _ | null walkable -> TgtAndPath{..} [] -> TgtAndPath{..} [g] | g == pathGoal -> TgtAndPath{..} -- the exception is when the tile is explicitly targeted newGoal : _ -> let newTgt = TPoint TBlock (blid b) newGoal newPath = AndPath{ pathSource = bpos b , pathList = walkable -- no @newGoal@ , pathGoal = newGoal , pathLen = length walkable + 1 } in TgtAndPath{tapTgt = newTgt, tapPath = Just newPath} stopAtUnwalkable Nothing = TgtAndPath{tapTgt, tapPath=Nothing} mpos <- getsState $ aidTgtToPos (Just aid) (blid b) (Just tapTgt) case mpos of Nothing -> return TgtAndPath{tapTgt, tapPath=Nothing} Just p -> do path <- getCachePath aid p return $! stopAtUnwalkable path condBFS :: MonadClientRead m => ActorId -> m (Bool, Word8) condBFS aid = do side <- getsClient sside -- We assume the actor eventually becomes a leader (or has the same -- set of skills as the leader, anyway). Otherwise we'd have -- to reset BFS after leader changes, but it would still lead to -- wasted movement if, e.g., non-leaders move but only leaders open doors -- and leader change is very rare. actorMaxSk <- getsState $ getActorMaxSkills aid let alterSkill = min (maxBound - 1) -- @maxBound :: Word8@ means unalterable (toEnum $ max 0 $ Ability.getSk Ability.SkAlter actorMaxSk) canMove = Ability.getSk Ability.SkMove actorMaxSk > 0 || Ability.getSk Ability.SkDisplace actorMaxSk > 0 || Ability.getSk Ability.SkProject actorMaxSk > 0 smarkSuspect <- getsClient smarkSuspect fact <- getsState $ (EM.! side) . sfactionD let -- Under UI, playing a hero party, we let AI set our target each -- turn for non-pointmen that can't move and can't alter, -- usually to TUnknown. This is rather useless, but correct. enterSuspect = smarkSuspect > 0 || gunderAI fact skill | enterSuspect = alterSkill -- dig and search as skill allows | otherwise = 0 -- only walkable tiles return (canMove, skill) -- keep it lazy -- | Furthest (wrt paths) known position. furthestKnown :: MonadClient m => ActorId -> m Point furthestKnown aid = do bfs <- getCacheBfs aid getMaxIndex <- rndToAction $ oneOf [ PointArray.maxIndexA , PointArray.maxLastIndexA ] let furthestPos = getMaxIndex bfs dist = bfs PointArray.! furthestPos return $! assert (dist > apartBfs `blame` (aid, furthestPos, dist)) furthestPos -- | Closest reachable unknown tile position, if any. -- -- Note: some of these tiles are behind suspect tiles and they are chosen -- in preference to more distant directly accessible unknown tiles. -- This is in principle OK, but in dungeons with few hidden doors -- AI is at a disadvantage (and with many hidden doors, it fares as well -- as a human that deduced the dungeon properties). Changing Bfs to accomodate -- all dungeon styles would be complex and would slow down the engine. -- -- If the level has inaccessible open areas (at least from the stairs AI used) -- the level will be nevertheless here finally labeled as explored, -- to enable transition to other levels. -- We should generally avoid such levels, because digging and/or trying -- to find other stairs leading to disconnected areas is not KISS -- so we don't do this in AI, so AI is at a disadvantage. -- -- If the closest unknown is more than 126 tiles away from the targeting -- actor, the level will marked as explored. We could complicate the code -- and not mark if the unknown is too far as opposed to inaccessible, -- but then if it is both too distant and inaccessible, AI would be -- permanently stuck on such levels. To cope with this, escapes need to be -- placed on open or small levels, or in dispersed enough that they don't -- appear in such potentially unexplored potions of caves. Other than that, -- this is rather harmless and hard to exploit, so let it be. -- The principled way to fix this would be to extend BFS to @Word16@, -- but then it takes too long to compute on maze levels, so we'd need -- to optimize hard for JS. closestUnknown :: MonadClient m => ActorId -> m (Maybe Point) closestUnknown aid = do body <- getsState $ getActorBody aid lvl <- getLevel $ blid body bfs <- getCacheBfs aid let closestPoss = PointArray.minIndexesA bfs dist = bfs PointArray.! head closestPoss !_A = assert (lexpl lvl >= lseen lvl) () return $! if lexpl lvl <= lseen lvl -- Some unknown may still be visible and even pathable, but we already -- know from global level info that they are inaccessible. || dist >= apartBfs -- Global level info may tell us that terrain was changed and so -- some new explorable tile appeared, but we don't care about those -- and we know we already explored all initially seen unknown tiles -- and it's enough for us (otherwise we'd need to hunt all around -- the map for tiles altered by enemies). then Nothing else let unknownAround pos = let vic = vicinityUnsafe pos countUnknown :: Int -> Point -> Int countUnknown c p = if isUknownSpace $ lvl `at` p then c + 1 else c in foldl' countUnknown 0 vic cmp = comparing unknownAround in Just $ maximumBy cmp closestPoss -- | Finds smells closest to the actor, except under the actor, -- because actors consume smell only moving over them, not standing. -- Of the closest, prefers the newest smell. closestSmell :: MonadClient m => ActorId -> m [(Int, (Point, Time))] closestSmell aid = do body <- getsState $ getActorBody aid Level{lsmell, ltime} <- getLevel $ blid body let smells = filter (\(p, sm) -> sm > ltime && p /= bpos body) (EM.assocs lsmell) case smells of [] -> return [] _ -> do bfs <- getCacheBfs aid let ts = mapMaybe (\x@(p, _) -> fmap (,x) (accessBfs bfs p)) smells return $! sortOn (fst &&& absoluteTimeNegate . snd . snd) ts data FleeViaStairsOrEscape = ViaStairs | ViaStairsUp | ViaStairsDown | ViaEscape | ViaExit -- can change whenever @sexplored@ changes | ViaNothing | ViaAnything deriving (Show, Eq) embedBenefit :: MonadClientRead m => FleeViaStairsOrEscape -> ActorId -> [(Point, ItemBag)] -> m [(Double, (Point, ItemBag))] embedBenefit fleeVia aid pbags = do COps{cocave, coTileSpeedup} <- getsState scops dungeon <- getsState sdungeon explored <- getsClient sexplored b <- getsState $ getActorBody aid fact <- getsState $ (EM.! bfid b) . sfactionD lvl <- getLevel (blid b) oursExploring <- getsState $ oursExploringAssocs (bfid b) let oursExploringLid = filter (\(_, body) -> blid body == blid b) oursExploring spawnFreqs = CK.cactorFreq $ okind cocave $ lkind lvl hasGroup grp = fromMaybe 0 (lookup grp spawnFreqs) > 0 lvlSpawnsUs = any (hasGroup . fst) $ filter ((> 0) . snd) $ fgroups (gkind fact) actorSk <- if fleeVia `elem` [ViaAnything, ViaExit] -- targeting, possibly when not a leader then getsState $ getActorMaxSkills aid else currentSkillsClient aid let alterSkill = Ability.getSk Ability.SkAlter actorSk condOurAdj <- getsState $ any (\(_, b2) -> isFriend (bfid b) fact (bfid b2)) . adjacentBigAssocs b unexploredTrue <- unexploredDepth True (blid b) unexploredFalse <- unexploredDepth False (blid b) condEnoughGear <- condEnoughGearM aid discoBenefit <- getsClient sdiscoBenefit getKind <- getsState $ flip getIidKind let alterMinSkill p = Tile.alterMinSkill coTileSpeedup $ lvl `at` p lidExplored = ES.member (blid b) explored allExplored = ES.size explored == EM.size dungeon -- Ignoring the number of items, because only one of each @iid@ -- is triggered at the same time, others are left to be used later on. -- Taking the kind the item hides under into consideration, because -- it's a best guess only, for AI and UI. iidToEffs iid = IK.ieffects $ getKind iid feats bag = concatMap iidToEffs $ EM.keys bag -- For simplicity, we assume at most one exit at each position. -- AI uses exit regardless of traps or treasures at the spot. bens (_, bag) = case find IK.isEffEscapeOrAscend $ feats bag of Just IK.Escape{} -> -- Escape (or guard) only after exploring, for high score, etc. let escapeOrGuard = fcanEscape (gkind fact) || fleeVia == ViaExit -- target to guard after explored in if fleeVia `elem` [ViaAnything, ViaEscape, ViaExit] && escapeOrGuard && allExplored then 10 else 0 -- don't escape prematurely Just (IK.Ascend up) -> -- change levels sensibly, in teams let easier = up /= (fromEnum (blid b) > 0) unexpForth = if up then unexploredTrue else unexploredFalse unexpBack = if not up then unexploredTrue else unexploredFalse -- Forbid loops via peeking at unexplored and getting back. aiCond = if unexpForth then easier && condEnoughGear || (not unexpBack || easier) && lidExplored else not unexpBack && easier && allExplored && null (lescape lvl) -- Prefer one direction of stairs, to team up -- and prefer embed (may, e.g., create loot) over stairs. v = if aiCond then if easier then 10 else 1 else 0 guardingStash = case gstash fact of Nothing -> False Just (lid, p) -> lid == blid b && (length oursExploring > 1 || lvlSpawnsUs) && (length oursExploringLid <= 1 -- not @==@ in case guard temporarily nonmoving || p == bpos b && not condOurAdj) -- don't leave the post; let the others explore in case fleeVia of _ | guardingStash -> 0 ViaStairsUp | up -> 1 ViaStairsDown | not up -> 1 ViaStairs -> v ViaExit -> v ViaAnything -> v _ -> 0 -- don't ascend prematurely _ -> if fleeVia `elem` [ViaNothing, ViaAnything] then -- Actor uses the embedded item on himself, hence @benApply@. -- Let distance be the deciding factor and also prevent -- overflow on 32-bit machines. let sacrificeForExperiment = 101 -- single explosion acceptable sumBen = sum $ map (\iid -> benApply $ discoBenefit EM.! iid) (EM.keys bag) in min 1000 $ sacrificeForExperiment + sumBen else 0 underFeet p = p == bpos b -- if enter and alter, be more permissive -- Only actors with high enough @SkAlter@ can trigger terrain. -- Blocking actors and items not checked, because they can be moved -- before the actor gets to the location, or after. f (p, _) = underFeet p || alterSkill >= fromEnum (alterMinSkill p) || Tile.isSuspect coTileSpeedup (lvl `at` p) && alterSkill >= 2 benFeats = map (\pbag -> (bens pbag, pbag)) $ filter f pbags considered (benefitAndSacrifice, (p, _bag)) = benefitAndSacrifice > 0 -- For speed and to avoid greedy AI loops, only experiment with few. && Tile.consideredByAI coTileSpeedup (lvl `at` p) return $! filter considered benFeats -- | Closest (wrt paths) AI-triggerable tiles with embedded items. -- In AI, the level the actor is on is either explored or the actor already -- has a weapon equipped, so no need to explore further, he tries to find -- enemies on other levels, but before that, he triggers other tiles -- in hope of some loot or beneficial effect to enter next level with. closestTriggers :: MonadClient m => FleeViaStairsOrEscape -> ActorId -> m [(Int, (Point, (Point, ItemBag)))] closestTriggers fleeVia aid = do COps{corule=RuleContent{rWidthMax, rHeightMax}} <- getsState scops b <- getsState $ getActorBody aid lvl <- getLevel (blid b) let pbags = EM.assocs $ lembed lvl efeat <- embedBenefit fleeVia aid pbags -- The advantage of targeting the tiles in vicinity of triggers is that -- triggers don't need to be pathable (and so AI doesn't bump into them -- by chance while walking elsewhere) and that many accesses to the tiles -- are more likely to be targeted by different AI actors (even starting -- from the same location), so there is less risk of clogging stairs and, -- OTOH, siege of stairs or escapes is more effective. bfs <- getCacheBfs aid let vicTrigger (cid, (p0, bag)) = map (\p -> (cid, (p, (p0, bag)))) (vicinityBounded rWidthMax rHeightMax p0) vicAll = concatMap vicTrigger efeat return $! let mix (benefit, ppbag) dist = let maxd = subtractBfsDistance maxBfsDistance apartBfs v = intToDouble $ maxd `div` (dist + 1) in (ceiling $ benefit * v, ppbag) in mapMaybe (\bpp@(_, (p, _)) -> mix bpp <$> accessBfs bfs p) vicAll -- | Check whether the actor has enough gear to go look for enemies. -- We assume weapons in equipment are better than any among organs -- or at least provide some essential diversity. -- Disabled if, due to doctrine, actors follow leader and so would -- repeatedly move towards and away from stairs at leader change, -- depending on current leader's gear. -- Number of items of a single kind is ignored, because variety is needed. condEnoughGearM :: MonadClientRead m => ActorId -> m Bool condEnoughGearM aid = do b <- getsState $ getActorBody aid fact <- getsState $ (EM.! bfid b) . sfactionD let followDoctrine = gdoctrine fact `elem` [Ability.TFollow, Ability.TFollowNoItems] eqpAssocs <- getsState $ fullAssocs aid [CEqp] return $ not followDoctrine -- keep it lazy && (any (IA.checkFlag Ability.Meleeable . aspectRecordFull . snd) eqpAssocs || length eqpAssocs >= 3) unexploredDepth :: MonadClientRead m => Bool -> LevelId -> m Bool unexploredDepth !up !lidCurrent = do dungeon <- getsState sdungeon explored <- getsClient sexplored let allExplored = ES.size explored == EM.size dungeon unexploredD = let unex !lid = allExplored && not (null $ lescape $ dungeon EM.! lid) || ES.notMember lid explored || unexploredD lid in any unex . ascendInBranch dungeon up return $ unexploredD lidCurrent -- keep it lazy -- | Closest (wrt paths) items. closestItems :: MonadClient m => ActorId -> m [(Int, (Point, ItemBag))] closestItems aid = do body <- getsState $ getActorBody aid Level{lfloor, lbig} <- getLevel $ blid body factionD <- getsState sfactionD per <- getPerFid $ blid body let canSee p = ES.member p (totalVisible per) -- Don't consider items at any stash location that an actor stands over -- or can stand over, but it's out of our LOS. -- In case of the own stash, don't consider regardless of actors and LOS. -- Own stash items are already owned, enemy stash is already targetted -- and allied or neutral stashes with actors on top are unlikely -- to be vacated and cause AI to wonder around forever or look up, -- leave, return hopeful, find a guard, repeat. let stashes = map (second gstash) $ EM.assocs factionD stashToRemove :: (FactionId, Maybe (LevelId, Point)) -> [Point] stashToRemove (fid, Just (lid, pos)) | lid == blid body && (fid == bfid body || pos `EM.member` lbig || not (canSee pos)) = [pos] stashToRemove _ = [] stashesToRemove = ES.fromList $ concatMap stashToRemove stashes lfloorBarStashes = EM.withoutKeys lfloor stashesToRemove if EM.null lfloorBarStashes then return [] else do bfs <- getCacheBfs aid let mix pbag dist = let maxd = subtractBfsDistance maxBfsDistance apartBfs -- Beware of overflowing 32-bit integers. -- Here distance is the only factor influencing frequency. -- Whether item is desirable is checked later on. v = (maxd * 10) `div` (dist + 1) in (v, pbag) return $! mapMaybe (\(p, bag) -> mix (p, bag) <$> accessBfs bfs p) (EM.assocs lfloorBarStashes) -- | Closest (wrt paths) enemy actors. closestFoes :: MonadClient m => [(ActorId, Actor)] -> ActorId -> m [(Int, (ActorId, Actor))] closestFoes foes aid = case foes of [] -> return [] _ -> do bfs <- getCacheBfs aid let ds = mapMaybe (\x@(_, b) -> fmap (,x) (accessBfs bfs (bpos b))) foes return $! sortBy (comparing fst) ds -- | Closest (wrt paths) enemy or our unguarded stash locations. If it's ours, -- we want to guard it, it enemy, loot it. Neutral and friendly stashes -- not chased to avoid loops of bloodless takeovers. closestStashes :: MonadClient m => ActorId -> m [(Int, (FactionId, Point))] closestStashes aid = do COps{cocave} <- getsState scops factionD <- getsState sfactionD b <- getsState $ getActorBody aid lvl <- getLevel (blid b) oursExploring <- getsState $ oursExploringAssocs (bfid b) let fact = factionD EM.! bfid b spawnFreqs = CK.cactorFreq $ okind cocave $ lkind lvl hasGroup grp = fromMaybe 0 (lookup grp spawnFreqs) > 0 lvlSpawnsUs = any (hasGroup . fst) $ filter ((> 0) . snd) $ fgroups (gkind fact) qualifyStash (fid2, Faction{gstash}) = case gstash of Nothing -> Nothing Just (lid, pos) -> -- The condition below is more strict that in @updateTgt@ -- to avoid loops by changing target of actor displacing -- and walking over stash to @TStash@. if lid == blid b && (fid2 == bfid b && isNothing (posToBigLvl pos lvl) -- unguarded && (length oursExploring > 1 -- other actors able to explore || lvlSpawnsUs) -- or future spawned will be able || isFoe (bfid b) fact fid2) then Just (fid2, pos) else Nothing case mapMaybe qualifyStash $ EM.assocs factionD of [] -> return [] stashes -> do bfs <- getCacheBfs aid let ds = mapMaybe (\x@(_, pos) -> fmap (,x) (accessBfs bfs pos)) stashes return $! sortBy (comparing fst) ds oursExploringAssocs :: FactionId -> State -> [(ActorId, Actor)] oursExploringAssocs fid s = let f (!aid, !b) = bfid b == fid && not (bproj b) && bhp b > 0 -- dead can stay forever on a frozen level && (bwatch b `elem` [WSleep, WWake] -- if asleep, probably has walking skill normally; -- when left alone will wake up and guard or explore || let actorMaxSk = sactorMaxSkills s EM.! aid in Ability.getSk Ability.SkMove actorMaxSk > 0 || Ability.getSk Ability.SkMove actorMaxSk < -50) -- a hacky way to rule out tmp immobile in filter f $ EM.assocs $ sactorD s -- | Find the nearest walkable position in dark, if any. Deterministic, -- to let all friends gather up and defend in the same shelter. -- Ignore position underfoot. closestHideout :: MonadClient m => ActorId -> m (Maybe (Point, Int)) closestHideout aid = do COps{coTileSpeedup} <- getsState scops b <- getsState $ getActorBody aid lvl <- getLevel (blid b) bfs <- getCacheBfs aid let minHideout :: (Point, BfsDistance) -> Point -> BfsDistance -> (Point, BfsDistance) minHideout (pMin, distMin) p dist = if dist > minKnownBfs && dist < distMin && Tile.isHideout coTileSpeedup (lvl `at` p) then (p, dist) else (pMin, distMin) (p1, dist1) = PointArray.ifoldlA' minHideout (bpos b, maxBfsDistance) bfs return $! if p1 == bpos b -- possibly hideout underfoot; ignore then Nothing else Just (p1, subtractBfsDistance dist1 apartBfs)