{-# 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 :: forall (m :: * -> *). MonadClient m => ActorId -> m ()
invalidateBfsAid ActorId
aid =
  (StateClient -> StateClient) -> m ()
forall (m :: * -> *).
MonadClient m =>
(StateClient -> StateClient) -> m ()
modifyClient ((StateClient -> StateClient) -> m ())
-> (StateClient -> StateClient) -> m ()
forall a b. (a -> b) -> a -> b
$ \StateClient
cli ->
    StateClient
cli {sbfsD = EM.adjust (const BfsInvalid) aid (sbfsD cli)}

invalidateBfsPathAid :: MonadClient m => ActorId -> m ()
invalidateBfsPathAid :: forall (m :: * -> *). MonadClient m => ActorId -> m ()
invalidateBfsPathAid ActorId
aid = do
  let f :: BfsAndPath -> BfsAndPath
f BfsAndPath
BfsInvalid = BfsAndPath
BfsInvalid
      f (BfsAndPath Array BfsDistance
bfsArr EnumMap Point AndPath
_) = Array BfsDistance -> EnumMap Point AndPath -> BfsAndPath
BfsAndPath Array BfsDistance
bfsArr EnumMap Point AndPath
forall k a. EnumMap k a
EM.empty
  (StateClient -> StateClient) -> m ()
forall (m :: * -> *).
MonadClient m =>
(StateClient -> StateClient) -> m ()
modifyClient ((StateClient -> StateClient) -> m ())
-> (StateClient -> StateClient) -> m ()
forall a b. (a -> b) -> a -> b
$ \StateClient
cli -> StateClient
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 :: forall (m :: * -> *). MonadClient m => LevelId -> m ()
invalidateBfsLid LevelId
lid = do
  lvl <- LevelId -> m Level
forall (m :: * -> *). MonadStateRead m => LevelId -> m Level
getLevel LevelId
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 :: forall (m :: * -> *). MonadClient m => Actor -> m ()
invalidateBfsPathLid Actor
body = do
  lvl <- LevelId -> m Level
forall (m :: * -> *). MonadStateRead m => LevelId -> m Level
getLevel (LevelId -> m Level) -> LevelId -> m Level
forall a b. (a -> b) -> a -> b
$ Actor -> LevelId
blid Actor
body
  let close (Point
p, ActorId
_) = Point -> Point -> Int
chessDist Point
p (Actor -> Point
bpos Actor
body) Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
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 :: forall (m :: * -> *). MonadClient m => m ()
invalidateBfsAll =
  (StateClient -> StateClient) -> m ()
forall (m :: * -> *).
MonadClient m =>
(StateClient -> StateClient) -> m ()
modifyClient ((StateClient -> StateClient) -> m ())
-> (StateClient -> StateClient) -> m ()
forall a b. (a -> b) -> a -> b
$ \StateClient
cli -> StateClient
cli {sbfsD = EM.map (const BfsInvalid) (sbfsD cli)}

invalidateBfsPathAll :: MonadClient m => m ()
invalidateBfsPathAll :: forall (m :: * -> *). MonadClient m => m ()
invalidateBfsPathAll = do
  let f :: BfsAndPath -> BfsAndPath
f BfsAndPath
BfsInvalid = BfsAndPath
BfsInvalid
      f (BfsAndPath Array BfsDistance
bfsArr EnumMap Point AndPath
_) = Array BfsDistance -> EnumMap Point AndPath -> BfsAndPath
BfsAndPath Array BfsDistance
bfsArr EnumMap Point AndPath
forall k a. EnumMap k a
EM.empty
  (StateClient -> StateClient) -> m ()
forall (m :: * -> *).
MonadClient m =>
(StateClient -> StateClient) -> m ()
modifyClient ((StateClient -> StateClient) -> m ())
-> (StateClient -> StateClient) -> m ()
forall a b. (a -> b) -> a -> b
$ \StateClient
cli -> StateClient
cli {sbfsD = EM.map f (sbfsD cli)}

createBfs :: MonadClientRead m
          => Bool -> Word8 -> ActorId -> m (PointArray.Array BfsDistance)
createBfs :: forall (m :: * -> *).
MonadClientRead m =>
Bool -> Word8 -> ActorId -> m (Array BfsDistance)
createBfs Bool
canMove Word8
alterSkill0 ActorId
aid =
  if Bool
canMove then do
    b <- (State -> Actor) -> m Actor
forall a. (State -> a) -> m a
forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
getsState ((State -> Actor) -> m Actor) -> (State -> Actor) -> m Actor
forall a b. (a -> b) -> a -> b
$ ActorId -> State -> Actor
getActorBody ActorId
aid
    salter <- getsClient salter
    let source = Actor -> Point
bpos Actor
b
        lalter = AlterLid
salter AlterLid -> LevelId -> Array Word8
forall k a. Enum k => EnumMap k a -> k -> a
EM.! Actor -> LevelId
blid Actor
b
        alterSkill = Word8 -> Word8 -> Word8
forall a. Ord a => a -> a -> a
max Word8
1 Word8
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 Array BfsDistance -> m (Array BfsDistance)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return Array BfsDistance
forall c. UnboxRepClass c => Array c
PointArray.empty

updatePathFromBfs :: MonadClient m
                  => Bool -> BfsAndPath -> ActorId -> Point
                  -> m (PointArray.Array BfsDistance, Maybe AndPath)
updatePathFromBfs :: forall (m :: * -> *).
MonadClient m =>
Bool
-> BfsAndPath
-> ActorId
-> Point
-> m (Array BfsDistance, Maybe AndPath)
updatePathFromBfs Bool
canMove BfsAndPath
bfsAndPathOld ActorId
aid !Point
target = do
  COps{coTileSpeedup} <- (State -> COps) -> m COps
forall a. (State -> a) -> m a
forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
getsState State -> COps
scops
  let (oldBfsArr, oldBfsPath) = case bfsAndPathOld of
        (BfsAndPath Array BfsDistance
bfsArr EnumMap Point AndPath
bfsPath) -> (Array BfsDistance
bfsArr, EnumMap Point AndPath
bfsPath)
        BfsAndPath
BfsInvalid -> [Char] -> (Array BfsDistance, EnumMap Point AndPath)
forall a. HasCallStack => [Char] -> a
error ([Char] -> (Array BfsDistance, EnumMap Point AndPath))
-> [Char] -> (Array BfsDistance, EnumMap Point AndPath)
forall a b. (a -> b) -> a -> b
$ [Char]
"" [Char] -> (BfsAndPath, ActorId, Point) -> [Char]
forall v. Show v => [Char] -> v -> [Char]
`showFailure` (BfsAndPath
bfsAndPathOld, ActorId
aid, Point
target)
  let bfsArr = Array BfsDistance
oldBfsArr
  if not canMove
  then return (bfsArr, Nothing)
  else do
    getActorB <- getsState $ flip getActorBody
    let b = ActorId -> Actor
getActorB ActorId
aid
    fact <- getsState $ (EM.! bfid b) . sfactionD
    seps <- getsClient seps
    salter <- getsClient salter
    lvl <- getLevel (blid b)
    let !lalter = AlterLid
salter AlterLid -> LevelId -> Array Word8
forall k a. Enum k => EnumMap k a -> k -> a
EM.! Actor -> LevelId
blid Actor
b
        fovLit Int
p = TileSpeedup -> ContentId TileKind -> Bool
Tile.isLit TileSpeedup
coTileSpeedup (ContentId TileKind -> Bool) -> ContentId TileKind -> Bool
forall a b. (a -> b) -> a -> b
$ UnboxRep (ContentId TileKind) -> ContentId TileKind
forall c. UnboxRepClass c => UnboxRep c -> c
PointArray.fromUnboxRep
                                            (UnboxRep (ContentId TileKind) -> ContentId TileKind)
-> UnboxRep (ContentId TileKind) -> ContentId TileKind
forall a b. (a -> b) -> a -> b
$ Level -> TileMap
ltile Level
lvl TileMap -> Int -> UnboxRep (ContentId TileKind)
forall c. UnboxRepClass c => Array c -> Int -> UnboxRep c
`PointArray.accessI` Int
p
        addFoeVicinity (Point
p, ActorId
aid2) =
          let b2 :: Actor
b2 = ActorId -> Actor
getActorB ActorId
aid2
          in if FactionId -> Faction -> FactionId -> Bool
isFoe (Actor -> FactionId
bfid Actor
b) Faction
fact (Actor -> FactionId
bfid Actor
b2)
             then Point
p Point -> [Point] -> [Point]
forall a. a -> [a] -> [a]
: Point -> [Point]
vicinityUnsafe Point
p
             else [Point
p]
        bigAdj = [Point] -> EnumSet Point
forall k. Enum k => [k] -> EnumSet k
ES.fromList ([Point] -> EnumSet Point) -> [Point] -> EnumSet Point
forall a b. (a -> b) -> a -> b
$ ((Point, ActorId) -> [Point]) -> [(Point, ActorId)] -> [Point]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (Point, ActorId) -> [Point]
addFoeVicinity ([(Point, ActorId)] -> [Point]) -> [(Point, ActorId)] -> [Point]
forall a b. (a -> b) -> a -> b
$ EnumMap Point ActorId -> [(Point, ActorId)]
forall k a. Enum k => EnumMap k a -> [(k, a)]
EM.assocs
                 (EnumMap Point ActorId -> [(Point, ActorId)])
-> EnumMap Point ActorId -> [(Point, ActorId)]
forall a b. (a -> b) -> a -> b
$ Point -> EnumMap Point ActorId -> EnumMap Point ActorId
forall k a. Enum k => k -> EnumMap k a -> EnumMap k a
EM.delete Point
source (EnumMap Point ActorId -> EnumMap Point ActorId)
-> EnumMap Point ActorId -> EnumMap Point ActorId
forall a b. (a -> b) -> a -> b
$ Level -> EnumMap Point ActorId
lbig Level
lvl  -- don't sidestep oneself
        !source = Actor -> Point
bpos Actor
b
        !mpath = EnumSet Point
-> Array Word8
-> (Int -> Bool)
-> Point
-> Point
-> Int
-> Array BfsDistance
-> Maybe AndPath
findPathBfs EnumSet Point
bigAdj Array Word8
lalter Int -> Bool
fovLit Point
source Point
target Int
seps Array BfsDistance
bfsArr
        !bfsPath =
          EnumMap Point AndPath
-> (AndPath -> EnumMap Point AndPath)
-> Maybe AndPath
-> EnumMap Point AndPath
forall b a. b -> (a -> b) -> Maybe a -> b
maybe EnumMap Point AndPath
oldBfsPath (\AndPath
path -> Point -> AndPath -> EnumMap Point AndPath -> EnumMap Point AndPath
forall k a. Enum k => k -> a -> EnumMap k a -> EnumMap k a
EM.insert Point
target AndPath
path EnumMap Point AndPath
oldBfsPath) Maybe AndPath
mpath
        bap = Array BfsDistance -> EnumMap Point AndPath -> BfsAndPath
BfsAndPath Array BfsDistance
bfsArr EnumMap Point AndPath
bfsPath
    modifyClient $ \StateClient
cli -> StateClient
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 :: forall (m :: * -> *).
MonadClient m =>
ActorId -> Point -> m (Array BfsDistance, Maybe AndPath)
getCacheBfsAndPath ActorId
aid Point
target = do
  mbfs <- (StateClient -> Maybe BfsAndPath) -> m (Maybe BfsAndPath)
forall a. (StateClient -> a) -> m a
forall (m :: * -> *) a.
MonadClientRead m =>
(StateClient -> a) -> m a
getsClient ((StateClient -> Maybe BfsAndPath) -> m (Maybe BfsAndPath))
-> (StateClient -> Maybe BfsAndPath) -> m (Maybe BfsAndPath)
forall a b. (a -> b) -> a -> b
$ ActorId -> EnumMap ActorId BfsAndPath -> Maybe BfsAndPath
forall k a. Enum k => k -> EnumMap k a -> Maybe a
EM.lookup ActorId
aid (EnumMap ActorId BfsAndPath -> Maybe BfsAndPath)
-> (StateClient -> EnumMap ActorId BfsAndPath)
-> StateClient
-> Maybe BfsAndPath
forall b c a. (b -> c) -> (a -> b) -> a -> c
. StateClient -> EnumMap ActorId BfsAndPath
sbfsD
  case mbfs of
    Just bap :: BfsAndPath
bap@(BfsAndPath Array BfsDistance
bfsArr EnumMap Point AndPath
bfsPath) ->
      case Point -> EnumMap Point AndPath -> Maybe AndPath
forall k a. Enum k => k -> EnumMap k a -> Maybe a
EM.lookup Point
target EnumMap Point AndPath
bfsPath of
        Maybe AndPath
Nothing -> do
          (!canMove, _) <- ActorId -> m (Bool, Word8)
forall (m :: * -> *).
MonadClientRead m =>
ActorId -> m (Bool, Word8)
condBFS ActorId
aid
          updatePathFromBfs canMove bap aid target
        mpath :: Maybe AndPath
mpath@Just{} -> (Array BfsDistance, Maybe AndPath)
-> m (Array BfsDistance, Maybe AndPath)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Array BfsDistance
bfsArr, Maybe AndPath
mpath)
    Maybe BfsAndPath
_ -> do
      (canMove, alterSkill) <- ActorId -> m (Bool, Word8)
forall (m :: * -> *).
MonadClientRead m =>
ActorId -> m (Bool, Word8)
condBFS ActorId
aid
      !bfsArr <- createBfs canMove alterSkill aid
      let bfsPath = EnumMap k a
forall k a. EnumMap k a
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 :: forall (m :: * -> *).
MonadClient m =>
ActorId -> m (Array BfsDistance)
getCacheBfs ActorId
aid = do
  mbfs <- (StateClient -> Maybe BfsAndPath) -> m (Maybe BfsAndPath)
forall a. (StateClient -> a) -> m a
forall (m :: * -> *) a.
MonadClientRead m =>
(StateClient -> a) -> m a
getsClient ((StateClient -> Maybe BfsAndPath) -> m (Maybe BfsAndPath))
-> (StateClient -> Maybe BfsAndPath) -> m (Maybe BfsAndPath)
forall a b. (a -> b) -> a -> b
$ ActorId -> EnumMap ActorId BfsAndPath -> Maybe BfsAndPath
forall k a. Enum k => k -> EnumMap k a -> Maybe a
EM.lookup ActorId
aid (EnumMap ActorId BfsAndPath -> Maybe BfsAndPath)
-> (StateClient -> EnumMap ActorId BfsAndPath)
-> StateClient
-> Maybe BfsAndPath
forall b c a. (b -> c) -> (a -> b) -> a -> c
. StateClient -> EnumMap ActorId BfsAndPath
sbfsD
  case mbfs of
    Just (BfsAndPath Array BfsDistance
bfsArr EnumMap Point AndPath
_) -> Array BfsDistance -> m (Array BfsDistance)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return Array BfsDistance
bfsArr
    Maybe BfsAndPath
_ -> do
      (canMove, alterSkill) <- ActorId -> m (Bool, Word8)
forall (m :: * -> *).
MonadClientRead m =>
ActorId -> m (Bool, Word8)
condBFS ActorId
aid
      !bfsArr <- createBfs canMove alterSkill aid
      let bfsPath = EnumMap k a
forall k a. EnumMap k a
EM.empty
      modifyClient $ \StateClient
cli ->
        StateClient
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 :: forall (m :: * -> *).
MonadClient m =>
ActorId -> Point -> m (Maybe AndPath)
getCachePath ActorId
aid Point
target = do
  b <- (State -> Actor) -> m Actor
forall a. (State -> a) -> m a
forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
getsState ((State -> Actor) -> m Actor) -> (State -> Actor) -> m Actor
forall a b. (a -> b) -> a -> b
$ ActorId -> State -> Actor
getActorBody ActorId
aid
  let source = Actor -> Point
bpos Actor
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 :: forall (m :: * -> *).
MonadClient m =>
ActorId -> Target -> m TgtAndPath
createPath ActorId
aid Target
tapTgt = do
  COps{coTileSpeedup} <- (State -> COps) -> m COps
forall a. (State -> a) -> m a
forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
getsState State -> COps
scops
  b <- getsState $ getActorBody aid
  lvl <- getLevel $ blid b
  let stopAtUnwalkable tapPath :: Maybe AndPath
tapPath@(Just AndPath{Int
[Point]
Point
pathSource :: Point
pathList :: [Point]
pathGoal :: Point
pathLen :: Int
pathLen :: AndPath -> Int
pathGoal :: AndPath -> Point
pathList :: AndPath -> [Point]
pathSource :: AndPath -> Point
..}) =
        let ([Point]
walkable, [Point]
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.
              (Point -> Bool) -> [Point] -> ([Point], [Point])
forall a. (a -> Bool) -> [a] -> ([a], [a])
span (TileSpeedup -> ContentId TileKind -> Bool
Tile.isWalkable TileSpeedup
coTileSpeedup (ContentId TileKind -> Bool)
-> (Point -> ContentId TileKind) -> Point -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Level -> Point -> ContentId TileKind
at Level
lvl) [Point]
pathList
        in case [Point]
rest of
          [Point]
_ | [Point] -> Bool
forall a. [a] -> Bool
null [Point]
walkable -> TgtAndPath{Maybe AndPath
Target
tapTgt :: Target
tapPath :: Maybe AndPath
tapPath :: Maybe AndPath
tapTgt :: Target
..}
          [] -> TgtAndPath{Maybe AndPath
Target
tapTgt :: Target
tapPath :: Maybe AndPath
tapPath :: Maybe AndPath
tapTgt :: Target
..}
          [Point
g] | Point
g Point -> Point -> Bool
forall a. Eq a => a -> a -> Bool
== Point
pathGoal -> TgtAndPath{Maybe AndPath
Target
tapTgt :: Target
tapPath :: Maybe AndPath
tapPath :: Maybe AndPath
tapTgt :: Target
..}
            -- the exception is when the tile is explicitly targeted
          Point
newGoal : [Point]
_ ->
            let newTgt :: Target
newTgt = TGoal -> LevelId -> Point -> Target
TPoint TGoal
TBlock (Actor -> LevelId
blid Actor
b) Point
newGoal
                newPath :: AndPath
newPath = AndPath{ pathSource :: Point
pathSource = Actor -> Point
bpos Actor
b
                                 , pathList :: [Point]
pathList = [Point]
walkable  -- no @newGoal@
                                 , pathGoal :: Point
pathGoal = Point
newGoal
                                 , pathLen :: Int
pathLen = [Point] -> Int
forall a. [a] -> Int
length [Point]
walkable Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1 }
            in TgtAndPath{tapTgt :: Target
tapTgt = Target
newTgt, tapPath :: Maybe AndPath
tapPath = AndPath -> Maybe AndPath
forall a. a -> Maybe a
Just AndPath
newPath}
      stopAtUnwalkable Maybe AndPath
Nothing = TgtAndPath{Target
tapTgt :: Target
tapTgt :: Target
tapTgt, tapPath :: Maybe AndPath
tapPath=Maybe AndPath
forall a. Maybe a
Nothing}
  mpos <- getsState $ aidTgtToPos (Just aid) (blid b) (Just tapTgt)
  case mpos of
    Maybe Point
Nothing -> TgtAndPath -> m TgtAndPath
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return TgtAndPath{Target
tapTgt :: Target
tapTgt :: Target
tapTgt, tapPath :: Maybe AndPath
tapPath=Maybe AndPath
forall a. Maybe a
Nothing}
    Just Point
p -> do
      path <- ActorId -> Point -> m (Maybe AndPath)
forall (m :: * -> *).
MonadClient m =>
ActorId -> Point -> m (Maybe AndPath)
getCachePath ActorId
aid Point
p
      return $! stopAtUnwalkable path

condBFS :: MonadClientRead m => ActorId -> m (Bool, Word8)
condBFS :: forall (m :: * -> *).
MonadClientRead m =>
ActorId -> m (Bool, Word8)
condBFS ActorId
aid = do
  side <- (StateClient -> FactionId) -> m FactionId
forall a. (StateClient -> a) -> m a
forall (m :: * -> *) a.
MonadClientRead m =>
(StateClient -> a) -> m a
getsClient StateClient -> FactionId
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 =
        Word8 -> Word8 -> Word8
forall a. Ord a => a -> a -> a
min (Word8
forall a. Bounded a => a
maxBound Word8 -> Word8 -> Word8
forall a. Num a => a -> a -> a
- Word8
1)  -- @maxBound :: Word8@ means unalterable
            (Int -> Word8
forall a. Enum a => Int -> a
toEnum (Int -> Word8) -> Int -> Word8
forall a b. (a -> b) -> a -> b
$ Int -> Int -> Int
forall a. Ord a => a -> a -> a
max Int
0 (Int -> Int) -> Int -> Int
forall a b. (a -> b) -> a -> b
$ Skill -> Skills -> Int
Ability.getSk Skill
Ability.SkAlter Skills
actorMaxSk)
      canMove = Skill -> Skills -> Int
Ability.getSk Skill
Ability.SkMove Skills
actorMaxSk Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
0
                Bool -> Bool -> Bool
|| Skill -> Skills -> Int
Ability.getSk Skill
Ability.SkDisplace Skills
actorMaxSk Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
0
                Bool -> Bool -> Bool
|| Skill -> Skills -> Int
Ability.getSk Skill
Ability.SkProject Skills
actorMaxSk Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
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 = Int
smarkSuspect Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
0 Bool -> Bool -> Bool
|| Faction -> Bool
gunderAI Faction
fact
      skill | Bool
enterSuspect = Word8
alterSkill  -- dig and search as skill allows
            | Bool
otherwise = Word8
0  -- only walkable tiles
  return (canMove, skill)  -- keep it lazy

-- | Furthest (wrt paths) known position.
furthestKnown :: MonadClient m => ActorId -> m Point
furthestKnown :: forall (m :: * -> *). MonadClient m => ActorId -> m Point
furthestKnown ActorId
aid = do
  bfs <- ActorId -> m (Array BfsDistance)
forall (m :: * -> *).
MonadClient m =>
ActorId -> m (Array BfsDistance)
getCacheBfs ActorId
aid
  getMaxIndex <- rndToAction $ oneOf [ PointArray.maxIndexA
                                     , PointArray.maxLastIndexA ]
  let furthestPos = Array BfsDistance -> Point
getMaxIndex Array BfsDistance
bfs
      dist = Array BfsDistance
bfs Array BfsDistance -> Point -> BfsDistance
forall c. UnboxRepClass c => Array c -> Point -> c
PointArray.! Point
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 :: forall (m :: * -> *). MonadClient m => ActorId -> m (Maybe Point)
closestUnknown ActorId
aid = do
  body <- (State -> Actor) -> m Actor
forall a. (State -> a) -> m a
forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
getsState ((State -> Actor) -> m Actor) -> (State -> Actor) -> m Actor
forall a b. (a -> b) -> a -> b
$ ActorId -> State -> Actor
getActorBody ActorId
aid
  lvl <- getLevel $ blid body
  bfs <- getCacheBfs aid
  let closestPoss = Array BfsDistance -> [Point]
forall c. UnboxRepClass c => Array c -> [Point]
PointArray.minIndexesA Array BfsDistance
bfs
      dist = Array BfsDistance
bfs Array BfsDistance -> Point -> BfsDistance
forall c. UnboxRepClass c => Array c -> Point -> c
PointArray.! [Point] -> Point
forall a. HasCallStack => [a] -> a
head [Point]
closestPoss
      !_A = Bool -> () -> ()
forall a. HasCallStack => Bool -> a -> a
assert (Level -> Int
lexpl Level
lvl Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Level -> Int
lseen Level
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 Point
pos =
               let vic :: [Point]
vic = Point -> [Point]
vicinityUnsafe Point
pos
                   countUnknown :: Int -> Point -> Int
                   countUnknown :: Int -> Point -> Int
countUnknown Int
c Point
p =
                     if ContentId TileKind -> Bool
isUknownSpace (ContentId TileKind -> Bool) -> ContentId TileKind -> Bool
forall a b. (a -> b) -> a -> b
$ Level
lvl Level -> Point -> ContentId TileKind
`at` Point
p then Int
c Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1 else Int
c
               in (Int -> Point -> Int) -> Int -> [Point] -> Int
forall b a. (b -> a -> b) -> b -> [a] -> b
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' Int -> Point -> Int
countUnknown Int
0 [Point]
vic
             cmp = (Point -> Int) -> Point -> Point -> Ordering
forall a b. Ord a => (b -> a) -> b -> b -> Ordering
comparing Point -> Int
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 :: forall (m :: * -> *).
MonadClient m =>
ActorId -> m [(Int, (Point, Time))]
closestSmell ActorId
aid = do
  body <- (State -> Actor) -> m Actor
forall a. (State -> a) -> m a
forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
getsState ((State -> Actor) -> m Actor) -> (State -> Actor) -> m Actor
forall a b. (a -> b) -> a -> b
$ ActorId -> State -> Actor
getActorBody ActorId
aid
  Level{lsmell, ltime} <- getLevel $ blid body
  let smells = ((Point, Time) -> Bool) -> [(Point, Time)] -> [(Point, Time)]
forall a. (a -> Bool) -> [a] -> [a]
filter (\(Point
p, Time
sm) -> Time
sm Time -> Time -> Bool
forall a. Ord a => a -> a -> Bool
> Time
ltime Bool -> Bool -> Bool
&& Point
p Point -> Point -> Bool
forall a. Eq a => a -> a -> Bool
/= Actor -> Point
bpos Actor
body)
                      (SmellMap -> [(Point, Time)]
forall k a. Enum k => EnumMap k a -> [(k, a)]
EM.assocs SmellMap
lsmell)
  case smells of
    [] -> [(Int, (Point, Time))] -> m [(Int, (Point, Time))]
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return []
    [(Point, Time)]
_ -> do
      bfs <- ActorId -> m (Array BfsDistance)
forall (m :: * -> *).
MonadClient m =>
ActorId -> m (Array BfsDistance)
getCacheBfs ActorId
aid
      let ts = ((Point, Time) -> Maybe (Int, (Point, Time)))
-> [(Point, Time)] -> [(Int, (Point, Time))]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe (\x :: (Point, Time)
x@(Point
p, Time
_) -> (Int -> (Int, (Point, Time)))
-> Maybe Int -> Maybe (Int, (Point, Time))
forall a b. (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (,(Point, Time)
x) (Array BfsDistance -> Point -> Maybe Int
accessBfs Array BfsDistance
bfs Point
p)) [(Point, Time)]
smells
      return $! sortOn (fst &&& absoluteTimeNegate . snd . snd) ts

data FleeViaStairsOrEscape =
    ViaStairs
  | ViaStairsUp
  | ViaStairsDown
  | ViaEscape
  | ViaExit  -- can change whenever @sexplored@ changes
  | ViaNothing
  | ViaAnything
  deriving (Int -> FleeViaStairsOrEscape -> ShowS
[FleeViaStairsOrEscape] -> ShowS
FleeViaStairsOrEscape -> [Char]
(Int -> FleeViaStairsOrEscape -> ShowS)
-> (FleeViaStairsOrEscape -> [Char])
-> ([FleeViaStairsOrEscape] -> ShowS)
-> Show FleeViaStairsOrEscape
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> FleeViaStairsOrEscape -> ShowS
showsPrec :: Int -> FleeViaStairsOrEscape -> ShowS
$cshow :: FleeViaStairsOrEscape -> [Char]
show :: FleeViaStairsOrEscape -> [Char]
$cshowList :: [FleeViaStairsOrEscape] -> ShowS
showList :: [FleeViaStairsOrEscape] -> ShowS
Show, FleeViaStairsOrEscape -> FleeViaStairsOrEscape -> Bool
(FleeViaStairsOrEscape -> FleeViaStairsOrEscape -> Bool)
-> (FleeViaStairsOrEscape -> FleeViaStairsOrEscape -> Bool)
-> Eq FleeViaStairsOrEscape
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: FleeViaStairsOrEscape -> FleeViaStairsOrEscape -> Bool
== :: FleeViaStairsOrEscape -> FleeViaStairsOrEscape -> Bool
$c/= :: FleeViaStairsOrEscape -> FleeViaStairsOrEscape -> Bool
/= :: FleeViaStairsOrEscape -> FleeViaStairsOrEscape -> Bool
Eq)

embedBenefit :: MonadClientRead m
             => FleeViaStairsOrEscape -> ActorId
             -> [(Point, ItemBag)]
             -> m [(Double, (Point, ItemBag))]
embedBenefit :: forall (m :: * -> *).
MonadClientRead m =>
FleeViaStairsOrEscape
-> ActorId -> [(Point, ItemBag)] -> m [(Double, (Point, ItemBag))]
embedBenefit FleeViaStairsOrEscape
fleeVia ActorId
aid [(Point, ItemBag)]
pbags = do
  COps{cocave, coTileSpeedup} <- (State -> COps) -> m COps
forall a. (State -> a) -> m a
forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
getsState State -> COps
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 =
        ((ActorId, Actor) -> Bool)
-> [(ActorId, Actor)] -> [(ActorId, Actor)]
forall a. (a -> Bool) -> [a] -> [a]
filter (\(ActorId
_, Actor
body) -> Actor -> LevelId
blid Actor
body LevelId -> LevelId -> Bool
forall a. Eq a => a -> a -> Bool
== Actor -> LevelId
blid Actor
b) [(ActorId, Actor)]
oursExploring
      spawnFreqs = CaveKind -> Freqs ItemKind
CK.cactorFreq (CaveKind -> Freqs ItemKind) -> CaveKind -> Freqs ItemKind
forall a b. (a -> b) -> a -> b
$ ContentData CaveKind -> ContentId CaveKind -> CaveKind
forall a. ContentData a -> ContentId a -> a
okind ContentData CaveKind
cocave (ContentId CaveKind -> CaveKind) -> ContentId CaveKind -> CaveKind
forall a b. (a -> b) -> a -> b
$ Level -> ContentId CaveKind
lkind Level
lvl
      hasGroup GroupName ItemKind
grp = Int -> Maybe Int -> Int
forall a. a -> Maybe a -> a
fromMaybe Int
0 (GroupName ItemKind -> Freqs ItemKind -> Maybe Int
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup GroupName ItemKind
grp Freqs ItemKind
spawnFreqs) Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
0
      lvlSpawnsUs = ((GroupName ItemKind, Int) -> Bool) -> Freqs ItemKind -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (GroupName ItemKind -> Bool
hasGroup (GroupName ItemKind -> Bool)
-> ((GroupName ItemKind, Int) -> GroupName ItemKind)
-> (GroupName ItemKind, Int)
-> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (GroupName ItemKind, Int) -> GroupName ItemKind
forall a b. (a, b) -> a
fst) (Freqs ItemKind -> Bool) -> Freqs ItemKind -> Bool
forall a b. (a -> b) -> a -> b
$ ((GroupName ItemKind, Int) -> Bool)
-> Freqs ItemKind -> Freqs ItemKind
forall a. (a -> Bool) -> [a] -> [a]
filter ((Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
0) (Int -> Bool)
-> ((GroupName ItemKind, Int) -> Int)
-> (GroupName ItemKind, Int)
-> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (GroupName ItemKind, Int) -> Int
forall a b. (a, b) -> b
snd)
                                         (Freqs ItemKind -> Freqs ItemKind)
-> Freqs ItemKind -> Freqs ItemKind
forall a b. (a -> b) -> a -> b
$ FactionKind -> Freqs ItemKind
fgroups (Faction -> FactionKind
gkind Faction
fact)
  actorSk <- if fleeVia `elem` [ViaAnything, ViaExit]
                  -- targeting, possibly when not a leader
             then getsState $ getActorMaxSkills aid
             else currentSkillsClient aid
  let alterSkill = Skill -> Skills -> Int
Ability.getSk Skill
Ability.SkAlter Skills
actorSk
  condOurAdj <- getsState $ any (\(ActorId
_, Actor
b2) -> FactionId -> Faction -> FactionId -> Bool
isFriend (Actor -> FactionId
bfid Actor
b) Faction
fact (Actor -> FactionId
bfid Actor
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 Point
p = TileSpeedup -> ContentId TileKind -> Int
Tile.alterMinSkill TileSpeedup
coTileSpeedup (ContentId TileKind -> Int) -> ContentId TileKind -> Int
forall a b. (a -> b) -> a -> b
$ Level
lvl Level -> Point -> ContentId TileKind
`at` Point
p
      lidExplored = LevelId -> EnumSet LevelId -> Bool
forall k. Enum k => k -> EnumSet k -> Bool
ES.member (Actor -> LevelId
blid Actor
b) EnumSet LevelId
explored
      allExplored = EnumSet LevelId -> Int
forall k. EnumSet k -> Int
ES.size EnumSet LevelId
explored Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Dungeon -> Int
forall k a. EnumMap k a -> Int
EM.size Dungeon
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 ItemId
iid = ItemKind -> [Effect]
IK.ieffects (ItemKind -> [Effect]) -> ItemKind -> [Effect]
forall a b. (a -> b) -> a -> b
$ ItemId -> ItemKind
getKind ItemId
iid
      feats ItemBag
bag = (ItemId -> [Effect]) -> [ItemId] -> [Effect]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap ItemId -> [Effect]
iidToEffs ([ItemId] -> [Effect]) -> [ItemId] -> [Effect]
forall a b. (a -> b) -> a -> b
$ ItemBag -> [ItemId]
forall k a. Enum k => EnumMap k a -> [k]
EM.keys ItemBag
bag
      -- For simplicity, we assume at most one exit at each position.
      -- AI uses exit regardless of traps or treasures at the spot.
      bens (Point
_, ItemBag
bag) = case (Effect -> Bool) -> [Effect] -> Maybe Effect
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Maybe a
find Effect -> Bool
IK.isEffEscapeOrAscend ([Effect] -> Maybe Effect) -> [Effect] -> Maybe Effect
forall a b. (a -> b) -> a -> b
$ ItemBag -> [Effect]
feats ItemBag
bag of
        Just IK.Escape{} ->
          -- Escape (or guard) only after exploring, for high score, etc.
          let escapeOrGuard :: Bool
escapeOrGuard =
                FactionKind -> Bool
fcanEscape (Faction -> FactionKind
gkind Faction
fact)
                Bool -> Bool -> Bool
|| FleeViaStairsOrEscape
fleeVia FleeViaStairsOrEscape -> FleeViaStairsOrEscape -> Bool
forall a. Eq a => a -> a -> Bool
== FleeViaStairsOrEscape
ViaExit  -- target to guard after explored
          in if FleeViaStairsOrEscape
fleeVia FleeViaStairsOrEscape -> [FleeViaStairsOrEscape] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [FleeViaStairsOrEscape
ViaAnything, FleeViaStairsOrEscape
ViaEscape, FleeViaStairsOrEscape
ViaExit]
                Bool -> Bool -> Bool
&& Bool
escapeOrGuard
                Bool -> Bool -> Bool
&& Bool
allExplored
             then Double
10
             else Double
0  -- don't escape prematurely
        Just (IK.Ascend Bool
up) ->  -- change levels sensibly, in teams
          let easier :: Bool
easier = Bool
up Bool -> Bool -> Bool
forall a. Eq a => a -> a -> Bool
/= (LevelId -> Int
forall a. Enum a => a -> Int
fromEnum (Actor -> LevelId
blid Actor
b) Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
0)
              unexpForth :: Bool
unexpForth = if Bool
up then Bool
unexploredTrue else Bool
unexploredFalse
              unexpBack :: Bool
unexpBack = if Bool -> Bool
not Bool
up then Bool
unexploredTrue else Bool
unexploredFalse
              -- Forbid loops via peeking at unexplored and getting back.
              aiCond :: Bool
aiCond = if Bool
unexpForth
                       then Bool
easier Bool -> Bool -> Bool
&& Bool
condEnoughGear
                            Bool -> Bool -> Bool
|| (Bool -> Bool
not Bool
unexpBack Bool -> Bool -> Bool
|| Bool
easier) Bool -> Bool -> Bool
&& Bool
lidExplored
                       else Bool -> Bool
not Bool
unexpBack Bool -> Bool -> Bool
&& Bool
easier Bool -> Bool -> Bool
&& Bool
allExplored
                            Bool -> Bool -> Bool
&& [Point] -> Bool
forall a. [a] -> Bool
null (Level -> [Point]
lescape Level
lvl)
              -- Prefer one direction of stairs, to team up
              -- and prefer embed (may, e.g., create loot) over stairs.
              v :: Double
v = if Bool
aiCond then if Bool
easier then Double
10 else Double
1 else Double
0
              guardingStash :: Bool
guardingStash = case Faction -> Maybe (LevelId, Point)
gstash Faction
fact of
                Maybe (LevelId, Point)
Nothing -> Bool
False
                Just (LevelId
lid, Point
p) ->
                  LevelId
lid LevelId -> LevelId -> Bool
forall a. Eq a => a -> a -> Bool
== Actor -> LevelId
blid Actor
b
                  Bool -> Bool -> Bool
&& ([(ActorId, Actor)] -> Int
forall a. [a] -> Int
length [(ActorId, Actor)]
oursExploring Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
1
                      Bool -> Bool -> Bool
|| Bool
lvlSpawnsUs)
                  Bool -> Bool -> Bool
&& ([(ActorId, Actor)] -> Int
forall a. [a] -> Int
length [(ActorId, Actor)]
oursExploringLid Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
1
                        -- not @==@ in case guard temporarily nonmoving
                      Bool -> Bool -> Bool
|| Point
p Point -> Point -> Bool
forall a. Eq a => a -> a -> Bool
== Actor -> Point
bpos Actor
b Bool -> Bool -> Bool
&& Bool -> Bool
not Bool
condOurAdj)
                           -- don't leave the post; let the others explore
          in case FleeViaStairsOrEscape
fleeVia of
            FleeViaStairsOrEscape
_ | Bool
guardingStash -> Double
0
            FleeViaStairsOrEscape
ViaStairsUp | Bool
up -> Double
1
            FleeViaStairsOrEscape
ViaStairsDown | Bool -> Bool
not Bool
up -> Double
1
            FleeViaStairsOrEscape
ViaStairs -> Double
v
            FleeViaStairsOrEscape
ViaExit -> Double
v
            FleeViaStairsOrEscape
ViaAnything -> Double
v
            FleeViaStairsOrEscape
_ -> Double
0  -- don't ascend prematurely
        Maybe Effect
_ ->
          if FleeViaStairsOrEscape
fleeVia FleeViaStairsOrEscape -> [FleeViaStairsOrEscape] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [FleeViaStairsOrEscape
ViaNothing, FleeViaStairsOrEscape
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 :: Double
sacrificeForExperiment = Double
101  -- single explosion acceptable
                   sumBen :: Double
sumBen = [Double] -> Double
forall a. Num a => [a] -> a
sum ([Double] -> Double) -> [Double] -> Double
forall a b. (a -> b) -> a -> b
$ (ItemId -> Double) -> [ItemId] -> [Double]
forall a b. (a -> b) -> [a] -> [b]
map (\ItemId
iid ->
                     Benefit -> Double
benApply (Benefit -> Double) -> Benefit -> Double
forall a b. (a -> b) -> a -> b
$ DiscoveryBenefit
discoBenefit DiscoveryBenefit -> ItemId -> Benefit
forall k a. Enum k => EnumMap k a -> k -> a
EM.! ItemId
iid) (ItemBag -> [ItemId]
forall k a. Enum k => EnumMap k a -> [k]
EM.keys ItemBag
bag)
               in Double -> Double -> Double
forall a. Ord a => a -> a -> a
min Double
1000 (Double -> Double) -> Double -> Double
forall a b. (a -> b) -> a -> b
$ Double
sacrificeForExperiment Double -> Double -> Double
forall a. Num a => a -> a -> a
+ Double
sumBen
          else Double
0
      underFeet Point
p = Point
p Point -> Point -> Bool
forall a. Eq a => a -> a -> Bool
== Actor -> Point
bpos Actor
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 (Point
p, ItemBag
_) = Point -> Bool
underFeet Point
p
                 Bool -> Bool -> Bool
|| Int
alterSkill Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int -> Int
forall a. Enum a => a -> Int
fromEnum (Point -> Int
alterMinSkill Point
p)
                 Bool -> Bool -> Bool
|| TileSpeedup -> ContentId TileKind -> Bool
Tile.isSuspect TileSpeedup
coTileSpeedup (Level
lvl Level -> Point -> ContentId TileKind
`at` Point
p)
                    Bool -> Bool -> Bool
&& Int
alterSkill Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
2
      benFeats = ((Point, ItemBag) -> (Double, (Point, ItemBag)))
-> [(Point, ItemBag)] -> [(Double, (Point, ItemBag))]
forall a b. (a -> b) -> [a] -> [b]
map (\(Point, ItemBag)
pbag -> ((Point, ItemBag) -> Double
bens (Point, ItemBag)
pbag, (Point, ItemBag)
pbag)) ([(Point, ItemBag)] -> [(Double, (Point, ItemBag))])
-> [(Point, ItemBag)] -> [(Double, (Point, ItemBag))]
forall a b. (a -> b) -> a -> b
$ ((Point, ItemBag) -> Bool)
-> [(Point, ItemBag)] -> [(Point, ItemBag)]
forall a. (a -> Bool) -> [a] -> [a]
filter (Point, ItemBag) -> Bool
f [(Point, ItemBag)]
pbags
      considered (Double
benefitAndSacrifice, (Point
p, ItemBag
_bag)) =
        Double
benefitAndSacrifice Double -> Double -> Bool
forall a. Ord a => a -> a -> Bool
> Double
0
        -- For speed and to avoid greedy AI loops, only experiment with few.
        Bool -> Bool -> Bool
&& TileSpeedup -> ContentId TileKind -> Bool
Tile.consideredByAI TileSpeedup
coTileSpeedup (Level
lvl Level -> Point -> ContentId TileKind
`at` Point
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 :: forall (m :: * -> *).
MonadClient m =>
FleeViaStairsOrEscape
-> ActorId -> m [(Int, (Point, (Point, ItemBag)))]
closestTriggers FleeViaStairsOrEscape
fleeVia ActorId
aid = do
  COps{corule=RuleContent{rWidthMax, rHeightMax}} <- (State -> COps) -> m COps
forall a. (State -> a) -> m a
forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
getsState State -> COps
scops
  b <- getsState $ getActorBody aid
  lvl <- getLevel (blid b)
  let pbags = EnumMap Point ItemBag -> [(Point, ItemBag)]
forall k a. Enum k => EnumMap k a -> [(k, a)]
EM.assocs (EnumMap Point ItemBag -> [(Point, ItemBag)])
-> EnumMap Point ItemBag -> [(Point, ItemBag)]
forall a b. (a -> b) -> a -> b
$ Level -> EnumMap Point ItemBag
lembed Level
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 (Double
cid, (Point
p0, ItemBag
bag)) =
        (Point -> (Double, (Point, (Point, ItemBag))))
-> [Point] -> [(Double, (Point, (Point, ItemBag)))]
forall a b. (a -> b) -> [a] -> [b]
map (\Point
p -> (Double
cid, (Point
p, (Point
p0, ItemBag
bag))))
            (Int -> Int -> Point -> [Point]
vicinityBounded Int
rWidthMax Int
rHeightMax Point
p0)
      vicAll = ((Double, (Point, ItemBag))
 -> [(Double, (Point, (Point, ItemBag)))])
-> [(Double, (Point, ItemBag))]
-> [(Double, (Point, (Point, ItemBag)))]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (Double, (Point, ItemBag)) -> [(Double, (Point, (Point, ItemBag)))]
vicTrigger [(Double, (Point, ItemBag))]
efeat
  return $!
    let mix (Double
benefit, b
ppbag) Int
dist =
          let maxd :: Int
maxd = BfsDistance -> BfsDistance -> Int
subtractBfsDistance BfsDistance
maxBfsDistance BfsDistance
apartBfs
              v :: Double
v = Int -> Double
intToDouble (Int -> Double) -> Int -> Double
forall a b. (a -> b) -> a -> b
$ Int
maxd Int -> Int -> Int
forall a. Integral a => a -> a -> a
`div` (Int
dist Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1)
          in (Double -> a
forall b. Integral b => Double -> b
forall a b. (RealFrac a, Integral b) => a -> b
ceiling (Double -> a) -> Double -> a
forall a b. (a -> b) -> a -> b
$ Double
benefit Double -> Double -> Double
forall a. Num a => a -> a -> a
* Double
v, b
ppbag)
    in mapMaybe (\bpp :: (Double, (Point, (Point, ItemBag)))
bpp@(Double
_, (Point
p, (Point, ItemBag)
_)) ->
         (Double, (Point, (Point, ItemBag)))
-> Int -> (Int, (Point, (Point, ItemBag)))
forall {a} {b}. Integral a => (Double, b) -> Int -> (a, b)
mix (Double, (Point, (Point, ItemBag)))
bpp (Int -> (Int, (Point, (Point, ItemBag))))
-> Maybe Int -> Maybe (Int, (Point, (Point, ItemBag)))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Array BfsDistance -> Point -> Maybe Int
accessBfs Array BfsDistance
bfs Point
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 :: forall (m :: * -> *). MonadClientRead m => ActorId -> m Bool
condEnoughGearM ActorId
aid = do
  b <- (State -> Actor) -> m Actor
forall a. (State -> a) -> m a
forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
getsState ((State -> Actor) -> m Actor) -> (State -> Actor) -> m Actor
forall a b. (a -> b) -> a -> b
$ ActorId -> State -> Actor
getActorBody ActorId
aid
  fact <- getsState $ (EM.! bfid b) . sfactionD
  let followDoctrine =
        Faction -> Doctrine
gdoctrine Faction
fact Doctrine -> [Doctrine] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Doctrine
Ability.TFollow, Doctrine
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 :: forall (m :: * -> *).
MonadClientRead m =>
Bool -> LevelId -> m Bool
unexploredDepth !Bool
up !LevelId
lidCurrent = do
  dungeon <- (State -> Dungeon) -> m Dungeon
forall a. (State -> a) -> m a
forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
getsState State -> Dungeon
sdungeon
  explored <- getsClient sexplored
  let allExplored = EnumSet LevelId -> Int
forall k. EnumSet k -> Int
ES.size EnumSet LevelId
explored Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Dungeon -> Int
forall k a. EnumMap k a -> Int
EM.size Dungeon
dungeon
      unexploredD =
        let unex :: LevelId -> Bool
unex !LevelId
lid = Bool
allExplored
                        Bool -> Bool -> Bool
&& Bool -> Bool
not ([Point] -> Bool
forall a. [a] -> Bool
null ([Point] -> Bool) -> [Point] -> Bool
forall a b. (a -> b) -> a -> b
$ Level -> [Point]
lescape (Level -> [Point]) -> Level -> [Point]
forall a b. (a -> b) -> a -> b
$ Dungeon
dungeon Dungeon -> LevelId -> Level
forall k a. Enum k => EnumMap k a -> k -> a
EM.! LevelId
lid)
                        Bool -> Bool -> Bool
|| LevelId -> EnumSet LevelId -> Bool
forall k. Enum k => k -> EnumSet k -> Bool
ES.notMember LevelId
lid EnumSet LevelId
explored
                        Bool -> Bool -> Bool
|| LevelId -> Bool
unexploredD LevelId
lid
        in (LevelId -> Bool) -> [LevelId] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any LevelId -> Bool
unex ([LevelId] -> Bool) -> (LevelId -> [LevelId]) -> LevelId -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Dungeon -> Bool -> LevelId -> [LevelId]
ascendInBranch Dungeon
dungeon Bool
up
  return $ unexploredD lidCurrent  -- keep it lazy

-- | Closest (wrt paths) items.
closestItems :: MonadClient m => ActorId -> m [(Int, (Point, ItemBag))]
closestItems :: forall (m :: * -> *).
MonadClient m =>
ActorId -> m [(Int, (Point, ItemBag))]
closestItems ActorId
aid = do
  body <- (State -> Actor) -> m Actor
forall a. (State -> a) -> m a
forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
getsState ((State -> Actor) -> m Actor) -> (State -> Actor) -> m Actor
forall a b. (a -> b) -> a -> b
$ ActorId -> State -> Actor
getActorBody ActorId
aid
  Level{lfloor, lbig} <- getLevel $ blid body
  factionD <- getsState sfactionD
  per <- getPerFid $ blid body
  let canSee Point
p = Point -> EnumSet Point -> Bool
forall k. Enum k => k -> EnumSet k -> Bool
ES.member Point
p (Perception -> EnumSet Point
totalVisible Perception
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 = ((FactionId, Faction) -> (FactionId, Maybe (LevelId, Point)))
-> [(FactionId, Faction)] -> [(FactionId, Maybe (LevelId, Point))]
forall a b. (a -> b) -> [a] -> [b]
map ((Faction -> Maybe (LevelId, Point))
-> (FactionId, Faction) -> (FactionId, Maybe (LevelId, Point))
forall b c d. (b -> c) -> (d, b) -> (d, c)
forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> a (d, b) (d, c)
second Faction -> Maybe (LevelId, Point)
gstash) ([(FactionId, Faction)] -> [(FactionId, Maybe (LevelId, Point))])
-> [(FactionId, Faction)] -> [(FactionId, Maybe (LevelId, Point))]
forall a b. (a -> b) -> a -> b
$ EnumMap FactionId Faction -> [(FactionId, Faction)]
forall k a. Enum k => EnumMap k a -> [(k, a)]
EM.assocs EnumMap FactionId Faction
factionD
      stashToRemove :: (FactionId, Maybe (LevelId, Point)) -> [Point]
      stashToRemove (FactionId
fid, Just (LevelId
lid, Point
pos))
        | LevelId
lid LevelId -> LevelId -> Bool
forall a. Eq a => a -> a -> Bool
== Actor -> LevelId
blid Actor
body
          Bool -> Bool -> Bool
&& (FactionId
fid FactionId -> FactionId -> Bool
forall a. Eq a => a -> a -> Bool
== Actor -> FactionId
bfid Actor
body Bool -> Bool -> Bool
|| Point
pos Point -> EnumMap Point ActorId -> Bool
forall k a. Enum k => k -> EnumMap k a -> Bool
`EM.member` EnumMap Point ActorId
lbig Bool -> Bool -> Bool
|| Bool -> Bool
not (Point -> Bool
canSee Point
pos)) =
            [Point
pos]
      stashToRemove (FactionId, Maybe (LevelId, Point))
_ = []
      stashesToRemove = [Point] -> EnumSet Point
forall k. Enum k => [k] -> EnumSet k
ES.fromList ([Point] -> EnumSet Point) -> [Point] -> EnumSet Point
forall a b. (a -> b) -> a -> b
$ ((FactionId, Maybe (LevelId, Point)) -> [Point])
-> [(FactionId, Maybe (LevelId, Point))] -> [Point]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (FactionId, Maybe (LevelId, Point)) -> [Point]
stashToRemove [(FactionId, Maybe (LevelId, Point))]
stashes
      lfloorBarStashes = EnumMap Point ItemBag -> EnumSet Point -> EnumMap Point ItemBag
forall k a. Enum k => EnumMap k a -> EnumSet k -> EnumMap k a
EM.withoutKeys EnumMap Point ItemBag
lfloor EnumSet Point
stashesToRemove
  if EM.null lfloorBarStashes then return [] else do
    bfs <- getCacheBfs aid
    let mix b
pbag Int
dist =
          let maxd :: Int
maxd = BfsDistance -> BfsDistance -> Int
subtractBfsDistance BfsDistance
maxBfsDistance BfsDistance
apartBfs
              -- Beware of overflowing 32-bit integers.
              -- Here distance is the only factor influencing frequency.
              -- Whether item is desirable is checked later on.
              v :: Int
v = (Int
maxd Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
10) Int -> Int -> Int
forall a. Integral a => a -> a -> a
`div` (Int
dist Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1)
          in (Int
v, b
pbag)
    return $! mapMaybe (\(Point
p, ItemBag
bag) ->
      (Point, ItemBag) -> Int -> (Int, (Point, ItemBag))
forall {b}. b -> Int -> (Int, b)
mix (Point
p, ItemBag
bag) (Int -> (Int, (Point, ItemBag)))
-> Maybe Int -> Maybe (Int, (Point, ItemBag))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Array BfsDistance -> Point -> Maybe Int
accessBfs Array BfsDistance
bfs Point
p) (EM.assocs lfloorBarStashes)

-- | Closest (wrt paths) enemy actors.
closestFoes :: MonadClient m
            => [(ActorId, Actor)] -> ActorId -> m [(Int, (ActorId, Actor))]
closestFoes :: forall (m :: * -> *).
MonadClient m =>
[(ActorId, Actor)] -> ActorId -> m [(Int, (ActorId, Actor))]
closestFoes [(ActorId, Actor)]
foes ActorId
aid =
  case [(ActorId, Actor)]
foes of
    [] -> [(Int, (ActorId, Actor))] -> m [(Int, (ActorId, Actor))]
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return []
    [(ActorId, Actor)]
_ -> do
      bfs <- ActorId -> m (Array BfsDistance)
forall (m :: * -> *).
MonadClient m =>
ActorId -> m (Array BfsDistance)
getCacheBfs ActorId
aid
      let ds = ((ActorId, Actor) -> Maybe (Int, (ActorId, Actor)))
-> [(ActorId, Actor)] -> [(Int, (ActorId, Actor))]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe (\x :: (ActorId, Actor)
x@(ActorId
_, Actor
b) -> (Int -> (Int, (ActorId, Actor)))
-> Maybe Int -> Maybe (Int, (ActorId, Actor))
forall a b. (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (,(ActorId, Actor)
x) (Array BfsDistance -> Point -> Maybe Int
accessBfs Array BfsDistance
bfs (Actor -> Point
bpos Actor
b))) [(ActorId, Actor)]
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 :: forall (m :: * -> *).
MonadClient m =>
ActorId -> m [(Int, (FactionId, Point))]
closestStashes ActorId
aid = do
  COps{cocave} <- (State -> COps) -> m COps
forall a. (State -> a) -> m a
forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
getsState State -> COps
scops
  factionD <- getsState sfactionD
  b <- getsState $ getActorBody aid
  lvl <- getLevel (blid b)
  oursExploring <- getsState $ oursExploringAssocs (bfid b)
  let fact = EnumMap FactionId Faction
factionD EnumMap FactionId Faction -> FactionId -> Faction
forall k a. Enum k => EnumMap k a -> k -> a
EM.! Actor -> FactionId
bfid Actor
b
      spawnFreqs = CaveKind -> Freqs ItemKind
CK.cactorFreq (CaveKind -> Freqs ItemKind) -> CaveKind -> Freqs ItemKind
forall a b. (a -> b) -> a -> b
$ ContentData CaveKind -> ContentId CaveKind -> CaveKind
forall a. ContentData a -> ContentId a -> a
okind ContentData CaveKind
cocave (ContentId CaveKind -> CaveKind) -> ContentId CaveKind -> CaveKind
forall a b. (a -> b) -> a -> b
$ Level -> ContentId CaveKind
lkind Level
lvl
      hasGroup GroupName ItemKind
grp = Int -> Maybe Int -> Int
forall a. a -> Maybe a -> a
fromMaybe Int
0 (GroupName ItemKind -> Freqs ItemKind -> Maybe Int
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup GroupName ItemKind
grp Freqs ItemKind
spawnFreqs) Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
0
      lvlSpawnsUs = ((GroupName ItemKind, Int) -> Bool) -> Freqs ItemKind -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (GroupName ItemKind -> Bool
hasGroup (GroupName ItemKind -> Bool)
-> ((GroupName ItemKind, Int) -> GroupName ItemKind)
-> (GroupName ItemKind, Int)
-> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (GroupName ItemKind, Int) -> GroupName ItemKind
forall a b. (a, b) -> a
fst) (Freqs ItemKind -> Bool) -> Freqs ItemKind -> Bool
forall a b. (a -> b) -> a -> b
$ ((GroupName ItemKind, Int) -> Bool)
-> Freqs ItemKind -> Freqs ItemKind
forall a. (a -> Bool) -> [a] -> [a]
filter ((Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
0) (Int -> Bool)
-> ((GroupName ItemKind, Int) -> Int)
-> (GroupName ItemKind, Int)
-> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (GroupName ItemKind, Int) -> Int
forall a b. (a, b) -> b
snd)
                                         (Freqs ItemKind -> Freqs ItemKind)
-> Freqs ItemKind -> Freqs ItemKind
forall a b. (a -> b) -> a -> b
$ FactionKind -> Freqs ItemKind
fgroups (Faction -> FactionKind
gkind Faction
fact)
      qualifyStash (FactionId
fid2, Faction{Maybe (LevelId, Point)
gstash :: Faction -> Maybe (LevelId, Point)
gstash :: Maybe (LevelId, Point)
gstash}) = case Maybe (LevelId, Point)
gstash of
        Maybe (LevelId, Point)
Nothing -> Maybe (FactionId, Point)
forall a. Maybe a
Nothing
        Just (LevelId
lid, Point
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 LevelId
lid LevelId -> LevelId -> Bool
forall a. Eq a => a -> a -> Bool
== Actor -> LevelId
blid Actor
b
             Bool -> Bool -> Bool
&& (FactionId
fid2 FactionId -> FactionId -> Bool
forall a. Eq a => a -> a -> Bool
== Actor -> FactionId
bfid Actor
b
                 Bool -> Bool -> Bool
&& Maybe ActorId -> Bool
forall a. Maybe a -> Bool
isNothing (Point -> Level -> Maybe ActorId
posToBigLvl Point
pos Level
lvl)  -- unguarded
                 Bool -> Bool -> Bool
&& ([(ActorId, Actor)] -> Int
forall a. [a] -> Int
length [(ActorId, Actor)]
oursExploring Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
1  -- other actors able to explore
                     Bool -> Bool -> Bool
|| Bool
lvlSpawnsUs)  -- or future spawned will be able
                 Bool -> Bool -> Bool
|| FactionId -> Faction -> FactionId -> Bool
isFoe (Actor -> FactionId
bfid Actor
b) Faction
fact FactionId
fid2)
          then (FactionId, Point) -> Maybe (FactionId, Point)
forall a. a -> Maybe a
Just (FactionId
fid2, Point
pos)
          else Maybe (FactionId, Point)
forall a. Maybe a
Nothing
  case mapMaybe qualifyStash $ EM.assocs factionD of
    [] -> [(Int, (FactionId, Point))] -> m [(Int, (FactionId, Point))]
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return []
    [(FactionId, Point)]
stashes -> do
      bfs <- ActorId -> m (Array BfsDistance)
forall (m :: * -> *).
MonadClient m =>
ActorId -> m (Array BfsDistance)
getCacheBfs ActorId
aid
      let ds = ((FactionId, Point) -> Maybe (Int, (FactionId, Point)))
-> [(FactionId, Point)] -> [(Int, (FactionId, Point))]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe (\x :: (FactionId, Point)
x@(FactionId
_, Point
pos) -> (Int -> (Int, (FactionId, Point)))
-> Maybe Int -> Maybe (Int, (FactionId, Point))
forall a b. (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (,(FactionId, Point)
x) (Array BfsDistance -> Point -> Maybe Int
accessBfs Array BfsDistance
bfs Point
pos)) [(FactionId, Point)]
stashes
      return $! sortBy (comparing fst) ds

oursExploringAssocs :: FactionId -> State -> [(ActorId, Actor)]
oursExploringAssocs :: FactionId -> State -> [(ActorId, Actor)]
oursExploringAssocs FactionId
fid State
s =
  let f :: (ActorId, Actor) -> Bool
f (!ActorId
aid, !Actor
b) = Actor -> FactionId
bfid Actor
b FactionId -> FactionId -> Bool
forall a. Eq a => a -> a -> Bool
== FactionId
fid
                     Bool -> Bool -> Bool
&& Bool -> Bool
not (Actor -> Bool
bproj Actor
b)
                     Bool -> Bool -> Bool
&& Actor -> Int64
bhp Actor
b Int64 -> Int64 -> Bool
forall a. Ord a => a -> a -> Bool
> Int64
0  -- dead can stay forever on a frozen level
                     Bool -> Bool -> Bool
&& (Actor -> Watchfulness
bwatch Actor
b Watchfulness -> [Watchfulness] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Watchfulness
WSleep, Watchfulness
WWake]
                           -- if asleep, probably has walking skill normally;
                           -- when left alone will wake up and guard or explore
                        Bool -> Bool -> Bool
|| let actorMaxSk :: Skills
actorMaxSk = State -> ActorMaxSkills
sactorMaxSkills State
s ActorMaxSkills -> ActorId -> Skills
forall k a. Enum k => EnumMap k a -> k -> a
EM.! ActorId
aid
                           in Skill -> Skills -> Int
Ability.getSk Skill
Ability.SkMove Skills
actorMaxSk Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
0
                              Bool -> Bool -> Bool
|| Skill -> Skills -> Int
Ability.getSk Skill
Ability.SkMove Skills
actorMaxSk Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< -Int
50)
                                   -- a hacky way to rule out tmp immobile
  in ((ActorId, Actor) -> Bool)
-> [(ActorId, Actor)] -> [(ActorId, Actor)]
forall a. (a -> Bool) -> [a] -> [a]
filter (ActorId, Actor) -> Bool
f ([(ActorId, Actor)] -> [(ActorId, Actor)])
-> [(ActorId, Actor)] -> [(ActorId, Actor)]
forall a b. (a -> b) -> a -> b
$ EnumMap ActorId Actor -> [(ActorId, Actor)]
forall k a. Enum k => EnumMap k a -> [(k, a)]
EM.assocs (EnumMap ActorId Actor -> [(ActorId, Actor)])
-> EnumMap ActorId Actor -> [(ActorId, Actor)]
forall a b. (a -> b) -> a -> b
$ State -> EnumMap ActorId Actor
sactorD State
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 :: forall (m :: * -> *).
MonadClient m =>
ActorId -> m (Maybe (Point, Int))
closestHideout ActorId
aid = do
  COps{coTileSpeedup} <- (State -> COps) -> m COps
forall a. (State -> a) -> m a
forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
getsState State -> COps
scops
  b <- getsState $ getActorBody aid
  lvl <- getLevel (blid b)
  bfs <- getCacheBfs aid
  let minHideout :: (Point, BfsDistance) -> Point -> BfsDistance
                 -> (Point, BfsDistance)
      minHideout (Point
pMin, BfsDistance
distMin) Point
p BfsDistance
dist =
        if BfsDistance
dist BfsDistance -> BfsDistance -> Bool
forall a. Ord a => a -> a -> Bool
> BfsDistance
minKnownBfs Bool -> Bool -> Bool
&& BfsDistance
dist BfsDistance -> BfsDistance -> Bool
forall a. Ord a => a -> a -> Bool
< BfsDistance
distMin
           Bool -> Bool -> Bool
&& TileSpeedup -> ContentId TileKind -> Bool
Tile.isHideout TileSpeedup
coTileSpeedup (Level
lvl Level -> Point -> ContentId TileKind
`at` Point
p)
        then (Point
p, BfsDistance
dist)
        else (Point
pMin, BfsDistance
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)