{-# 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
  Level
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.
  (ActorId -> m ()) -> [ActorId] -> m ()
forall (t :: * -> *) (m :: * -> *) a.
(Foldable t, Monad m) =>
(a -> m ()) -> t a -> m ()
mapM_ ActorId -> m ()
forall (m :: * -> *). MonadClient m => ActorId -> m ()
invalidateBfsAid ([ActorId] -> m ()) -> [ActorId] -> m ()
forall a b. (a -> b) -> a -> b
$ EnumMap Point ActorId -> [ActorId]
forall k a. EnumMap k a -> [a]
EM.elems (EnumMap Point ActorId -> [ActorId])
-> EnumMap Point ActorId -> [ActorId]
forall a b. (a -> b) -> a -> b
$ Level -> EnumMap Point ActorId
lbig Level
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
  Level
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, ActorId) -> Bool
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.
  ((Point, ActorId) -> m ()) -> [(Point, ActorId)] -> m ()
forall (t :: * -> *) (m :: * -> *) a.
(Foldable t, Monad m) =>
(a -> m ()) -> t a -> m ()
mapM_ (ActorId -> m ()
forall (m :: * -> *). MonadClient m => ActorId -> m ()
invalidateBfsPathAid (ActorId -> m ())
-> ((Point, ActorId) -> ActorId) -> (Point, ActorId) -> m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Point, ActorId) -> ActorId
forall a b. (a, b) -> b
snd) ([(Point, ActorId)] -> m ()) -> [(Point, ActorId)] -> m ()
forall a b. (a -> b) -> a -> b
$ ((Point, ActorId) -> Bool)
-> [(Point, ActorId)] -> [(Point, ActorId)]
forall a. (a -> Bool) -> [a] -> [a]
filter (Point, ActorId) -> Bool
close ([(Point, ActorId)] -> [(Point, ActorId)])
-> [(Point, ActorId)] -> [(Point, ActorId)]
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
$ Level -> EnumMap Point ActorId
lbig Level
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
    Actor
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
    AlterLid
salter <- (StateClient -> AlterLid) -> m AlterLid
forall a. (StateClient -> a) -> m a
forall (m :: * -> *) a.
MonadClientRead m =>
(StateClient -> a) -> m a
getsClient StateClient -> AlterLid
salter
    let source :: Point
source = Actor -> Point
bpos Actor
b
        lalter :: Array Word8
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
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.
    (PrimArray Int, PrimArray Int)
stabs <- (StateClient -> (PrimArray Int, PrimArray Int))
-> m (PrimArray Int, PrimArray Int)
forall a. (StateClient -> a) -> m a
forall (m :: * -> *) a.
MonadClientRead m =>
(StateClient -> a) -> m a
getsClient StateClient -> (PrimArray Int, PrimArray Int)
stabs
    Array BfsDistance -> m (Array BfsDistance)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Array BfsDistance -> m (Array BfsDistance))
-> Array BfsDistance -> m (Array BfsDistance)
forall a b. (a -> b) -> a -> b
$! Array Word8
-> Word8
-> Point
-> (PrimArray Int, PrimArray Int)
-> Array BfsDistance
fillBfs Array Word8
lalter Word8
alterSkill Point
source (PrimArray Int, PrimArray Int)
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{TileSpeedup
coTileSpeedup :: TileSpeedup
coTileSpeedup :: COps -> TileSpeedup
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 (Array BfsDistance
oldBfsArr, EnumMap Point AndPath
oldBfsPath) = case BfsAndPath
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
bfsArr = Array BfsDistance
oldBfsArr
  if Bool -> Bool
not Bool
canMove
  then (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
forall a. Maybe a
Nothing)
  else do
    ActorId -> Actor
getActorB <- (State -> ActorId -> Actor) -> m (ActorId -> Actor)
forall a. (State -> a) -> m a
forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
getsState ((State -> ActorId -> Actor) -> m (ActorId -> Actor))
-> (State -> ActorId -> Actor) -> m (ActorId -> Actor)
forall a b. (a -> b) -> a -> b
$ (ActorId -> State -> Actor) -> State -> ActorId -> Actor
forall a b c. (a -> b -> c) -> b -> a -> c
flip ActorId -> State -> Actor
getActorBody
    let b :: Actor
b = ActorId -> Actor
getActorB ActorId
aid
    Faction
fact <- (State -> Faction) -> m Faction
forall a. (State -> a) -> m a
forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
getsState ((State -> Faction) -> m Faction)
-> (State -> Faction) -> m Faction
forall a b. (a -> b) -> a -> b
$ (EnumMap FactionId Faction -> FactionId -> Faction
forall k a. Enum k => EnumMap k a -> k -> a
EM.! Actor -> FactionId
bfid Actor
b) (EnumMap FactionId Faction -> Faction)
-> (State -> EnumMap FactionId Faction) -> State -> Faction
forall b c a. (b -> c) -> (a -> b) -> a -> c
. State -> EnumMap FactionId Faction
sfactionD
    Int
seps <- (StateClient -> Int) -> m Int
forall a. (StateClient -> a) -> m a
forall (m :: * -> *) a.
MonadClientRead m =>
(StateClient -> a) -> m a
getsClient StateClient -> Int
seps
    AlterLid
salter <- (StateClient -> AlterLid) -> m AlterLid
forall a. (StateClient -> a) -> m a
forall (m :: * -> *) a.
MonadClientRead m =>
(StateClient -> a) -> m a
getsClient StateClient -> AlterLid
salter
    Level
lvl <- LevelId -> m Level
forall (m :: * -> *). MonadStateRead m => LevelId -> m Level
getLevel (Actor -> LevelId
blid Actor
b)
    let !lalter :: Array Word8
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 -> Bool
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, ActorId) -> [Point]
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 :: EnumSet Point
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 :: Point
source = Actor -> Point
bpos Actor
b
        !mpath :: Maybe AndPath
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
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 :: BfsAndPath
bap = Array BfsDistance -> EnumMap Point AndPath -> BfsAndPath
BfsAndPath Array BfsDistance
bfsArr EnumMap Point AndPath
bfsPath
    (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.insert aid bap $ sbfsD cli}
    (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)

-- | 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
  Maybe BfsAndPath
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 Maybe BfsAndPath
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
          (!Bool
canMove, Word8
_) <- ActorId -> m (Bool, Word8)
forall (m :: * -> *).
MonadClientRead m =>
ActorId -> m (Bool, Word8)
condBFS ActorId
aid
          Bool
-> BfsAndPath
-> ActorId
-> Point
-> m (Array BfsDistance, Maybe AndPath)
forall (m :: * -> *).
MonadClient m =>
Bool
-> BfsAndPath
-> ActorId
-> Point
-> m (Array BfsDistance, Maybe AndPath)
updatePathFromBfs Bool
canMove BfsAndPath
bap ActorId
aid Point
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
      (Bool
canMove, Word8
alterSkill) <- ActorId -> m (Bool, Word8)
forall (m :: * -> *).
MonadClientRead m =>
ActorId -> m (Bool, Word8)
condBFS ActorId
aid
      !Array BfsDistance
bfsArr <- Bool -> Word8 -> ActorId -> m (Array BfsDistance)
forall (m :: * -> *).
MonadClientRead m =>
Bool -> Word8 -> ActorId -> m (Array BfsDistance)
createBfs Bool
canMove Word8
alterSkill ActorId
aid
      let bfsPath :: EnumMap k a
bfsPath = EnumMap k a
forall k a. EnumMap k a
EM.empty
      Bool
-> BfsAndPath
-> ActorId
-> Point
-> m (Array BfsDistance, Maybe AndPath)
forall (m :: * -> *).
MonadClient m =>
Bool
-> BfsAndPath
-> ActorId
-> Point
-> m (Array BfsDistance, Maybe AndPath)
updatePathFromBfs Bool
canMove (Array BfsDistance -> EnumMap Point AndPath -> BfsAndPath
BfsAndPath Array BfsDistance
bfsArr EnumMap Point AndPath
forall k a. EnumMap k a
bfsPath) ActorId
aid Point
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
  Maybe BfsAndPath
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 Maybe BfsAndPath
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
      (Bool
canMove, Word8
alterSkill) <- ActorId -> m (Bool, Word8)
forall (m :: * -> *).
MonadClientRead m =>
ActorId -> m (Bool, Word8)
condBFS ActorId
aid
      !Array BfsDistance
bfsArr <- Bool -> Word8 -> ActorId -> m (Array BfsDistance)
forall (m :: * -> *).
MonadClientRead m =>
Bool -> Word8 -> ActorId -> m (Array BfsDistance)
createBfs Bool
canMove Word8
alterSkill ActorId
aid
      let bfsPath :: EnumMap k a
bfsPath = EnumMap k a
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.insert aid (BfsAndPath bfsArr bfsPath) (sbfsD cli)}
      Array BfsDistance -> m (Array BfsDistance)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return Array BfsDistance
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
  Actor
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 :: Point
source = Actor -> Point
bpos Actor
b
  if Point
source Point -> Point -> Bool
forall a. Eq a => a -> a -> Bool
== Point
target
  then Maybe AndPath -> m (Maybe AndPath)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe AndPath -> m (Maybe AndPath))
-> Maybe AndPath -> m (Maybe AndPath)
forall a b. (a -> b) -> a -> b
$ AndPath -> Maybe AndPath
forall a. a -> Maybe a
Just (AndPath -> Maybe AndPath) -> AndPath -> Maybe AndPath
forall a b. (a -> b) -> a -> b
$ Point -> [Point] -> Point -> Int -> AndPath
AndPath (Actor -> Point
bpos Actor
b) [] Point
target Int
0  -- speedup
  else (Array BfsDistance, Maybe AndPath) -> Maybe AndPath
forall a b. (a, b) -> b
snd ((Array BfsDistance, Maybe AndPath) -> Maybe AndPath)
-> m (Array BfsDistance, Maybe AndPath) -> m (Maybe AndPath)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ActorId -> Point -> m (Array BfsDistance, Maybe AndPath)
forall (m :: * -> *).
MonadClient m =>
ActorId -> Point -> m (Array BfsDistance, Maybe AndPath)
getCacheBfsAndPath ActorId
aid Point
target

createPath :: MonadClient m => ActorId -> Target -> m TgtAndPath
createPath :: forall (m :: * -> *).
MonadClient m =>
ActorId -> Target -> m TgtAndPath
createPath ActorId
aid Target
tapTgt = do
  COps{TileSpeedup
coTileSpeedup :: COps -> TileSpeedup
coTileSpeedup :: TileSpeedup
coTileSpeedup} <- (State -> COps) -> m COps
forall a. (State -> a) -> m a
forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
getsState State -> COps
scops
  Actor
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
  Level
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
b
  let stopAtUnwalkable :: Maybe AndPath -> TgtAndPath
stopAtUnwalkable tapPath :: Maybe AndPath
tapPath@(Just AndPath{Int
[Point]
Point
pathSource :: Point
pathList :: [Point]
pathGoal :: Point
pathLen :: Int
pathSource :: AndPath -> Point
pathList :: AndPath -> [Point]
pathGoal :: AndPath -> Point
pathLen :: AndPath -> Int
..}) =
        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
tapTgt :: Target
tapPath :: Maybe AndPath
..}
          [] -> TgtAndPath{Maybe AndPath
Target
tapTgt :: Target
tapPath :: Maybe AndPath
tapTgt :: Target
tapPath :: Maybe AndPath
..}
          [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
tapTgt :: Target
tapPath :: Maybe AndPath
..}
            -- 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}
  Maybe Point
mpos <- (State -> Maybe Point) -> m (Maybe Point)
forall a. (State -> a) -> m a
forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
getsState ((State -> Maybe Point) -> m (Maybe Point))
-> (State -> Maybe Point) -> m (Maybe Point)
forall a b. (a -> b) -> a -> b
$ Maybe ActorId -> LevelId -> Maybe Target -> State -> Maybe Point
aidTgtToPos (ActorId -> Maybe ActorId
forall a. a -> Maybe a
Just ActorId
aid) (Actor -> LevelId
blid Actor
b) (Target -> Maybe Target
forall a. a -> Maybe a
Just Target
tapTgt)
  case Maybe Point
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
      Maybe AndPath
path <- ActorId -> Point -> m (Maybe AndPath)
forall (m :: * -> *).
MonadClient m =>
ActorId -> Point -> m (Maybe AndPath)
getCachePath ActorId
aid Point
p
      TgtAndPath -> m TgtAndPath
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (TgtAndPath -> m TgtAndPath) -> TgtAndPath -> m TgtAndPath
forall a b. (a -> b) -> a -> b
$! Maybe AndPath -> TgtAndPath
stopAtUnwalkable Maybe AndPath
path

condBFS :: MonadClientRead m => ActorId -> m (Bool, Word8)
condBFS :: forall (m :: * -> *).
MonadClientRead m =>
ActorId -> m (Bool, Word8)
condBFS ActorId
aid = do
  FactionId
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.
  Skills
actorMaxSk <- (State -> Skills) -> m Skills
forall a. (State -> a) -> m a
forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
getsState ((State -> Skills) -> m Skills) -> (State -> Skills) -> m Skills
forall a b. (a -> b) -> a -> b
$ ActorId -> State -> Skills
getActorMaxSkills ActorId
aid
  let alterSkill :: Word8
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 :: Bool
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
  Int
smarkSuspect <- (StateClient -> Int) -> m Int
forall a. (StateClient -> a) -> m a
forall (m :: * -> *) a.
MonadClientRead m =>
(StateClient -> a) -> m a
getsClient StateClient -> Int
smarkSuspect
  Faction
fact <- (State -> Faction) -> m Faction
forall a. (State -> a) -> m a
forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
getsState ((State -> Faction) -> m Faction)
-> (State -> Faction) -> m Faction
forall a b. (a -> b) -> a -> b
$ (EnumMap FactionId Faction -> FactionId -> Faction
forall k a. Enum k => EnumMap k a -> k -> a
EM.! FactionId
side) (EnumMap FactionId Faction -> Faction)
-> (State -> EnumMap FactionId Faction) -> State -> Faction
forall b c a. (b -> c) -> (a -> b) -> a -> c
. State -> EnumMap FactionId Faction
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 :: Bool
enterSuspect = Int
smarkSuspect Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
0 Bool -> Bool -> Bool
|| Faction -> Bool
gunderAI Faction
fact
      skill :: Word8
skill | Bool
enterSuspect = Word8
alterSkill  -- dig and search as skill allows
            | Bool
otherwise = Word8
0  -- only walkable tiles
  (Bool, Word8) -> m (Bool, Word8)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Bool
canMove, Word8
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
  Array BfsDistance
bfs <- ActorId -> m (Array BfsDistance)
forall (m :: * -> *).
MonadClient m =>
ActorId -> m (Array BfsDistance)
getCacheBfs ActorId
aid
  Array BfsDistance -> Point
getMaxIndex <- Rnd (Array BfsDistance -> Point) -> m (Array BfsDistance -> Point)
forall (m :: * -> *) a. MonadClient m => Rnd a -> m a
rndToAction (Rnd (Array BfsDistance -> Point)
 -> m (Array BfsDistance -> Point))
-> Rnd (Array BfsDistance -> Point)
-> m (Array BfsDistance -> Point)
forall a b. (a -> b) -> a -> b
$ [Array BfsDistance -> Point] -> Rnd (Array BfsDistance -> Point)
forall a. [a] -> Rnd a
oneOf [ Array BfsDistance -> Point
forall c. UnboxRepClass c => Array c -> Point
PointArray.maxIndexA
                                     , Array BfsDistance -> Point
forall c. UnboxRepClass c => Array c -> Point
PointArray.maxLastIndexA ]
  let furthestPos :: Point
furthestPos = Array BfsDistance -> Point
getMaxIndex Array BfsDistance
bfs
      dist :: BfsDistance
dist = Array BfsDistance
bfs Array BfsDistance -> Point -> BfsDistance
forall c. UnboxRepClass c => Array c -> Point -> c
PointArray.! Point
furthestPos
  Point -> m Point
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Point -> m Point) -> Point -> m Point
forall a b. (a -> b) -> a -> b
$! Bool -> Point -> Point
forall a. HasCallStack => Bool -> a -> a
assert (BfsDistance
dist BfsDistance -> BfsDistance -> Bool
forall a. Ord a => a -> a -> Bool
> BfsDistance
apartBfs Bool -> (ActorId, Point, BfsDistance) -> Bool
forall v. Show v => Bool -> v -> Bool
`blame` (ActorId
aid, Point
furthestPos, BfsDistance
dist))
                   Point
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
  Actor
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
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
  Array BfsDistance
bfs <- ActorId -> m (Array BfsDistance)
forall (m :: * -> *).
MonadClient m =>
ActorId -> m (Array BfsDistance)
getCacheBfs ActorId
aid
  let closestPoss :: [Point]
closestPoss = Array BfsDistance -> [Point]
forall c. UnboxRepClass c => Array c -> [Point]
PointArray.minIndexesA Array BfsDistance
bfs
      dist :: BfsDistance
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 :: ()
_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) ()
  Maybe Point -> m (Maybe Point)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe Point -> m (Maybe Point)) -> Maybe Point -> m (Maybe Point)
forall a b. (a -> b) -> a -> b
$!
    if Level -> Int
lexpl Level
lvl Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Level -> Int
lseen Level
lvl
         -- Some unknown may still be visible and even pathable, but we already
         -- know from global level info that they are inaccessible.
       Bool -> Bool -> Bool
|| BfsDistance
dist BfsDistance -> BfsDistance -> Bool
forall a. Ord a => a -> a -> Bool
>= BfsDistance
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 Maybe Point
forall a. Maybe a
Nothing
    else let unknownAround :: Point -> Int
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 -> Point -> Ordering
cmp = (Point -> Int) -> Point -> Point -> Ordering
forall a b. Ord a => (b -> a) -> b -> b -> Ordering
comparing Point -> Int
unknownAround
         in Point -> Maybe Point
forall a. a -> Maybe a
Just (Point -> Maybe Point) -> Point -> Maybe Point
forall a b. (a -> b) -> a -> b
$ (Point -> Point -> Ordering) -> [Point] -> Point
forall (t :: * -> *) a.
Foldable t =>
(a -> a -> Ordering) -> t a -> a
maximumBy Point -> Point -> Ordering
cmp [Point]
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
  Actor
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{SmellMap
lsmell :: SmellMap
lsmell :: Level -> SmellMap
lsmell, Time
ltime :: Time
ltime :: Level -> Time
ltime} <- 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 smells :: [(Point, Time)]
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 [(Point, Time)]
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
      Array BfsDistance
bfs <- ActorId -> m (Array BfsDistance)
forall (m :: * -> *).
MonadClient m =>
ActorId -> m (Array BfsDistance)
getCacheBfs ActorId
aid
      let ts :: [(Int, (Point, Time))]
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
      [(Int, (Point, Time))] -> m [(Int, (Point, Time))]
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return ([(Int, (Point, Time))] -> m [(Int, (Point, Time))])
-> [(Int, (Point, Time))] -> m [(Int, (Point, Time))]
forall a b. (a -> b) -> a -> b
$! ((Int, (Point, Time)) -> (Int, Time))
-> [(Int, (Point, Time))] -> [(Int, (Point, Time))]
forall b a. Ord b => (a -> b) -> [a] -> [a]
sortOn ((Int, (Point, Time)) -> Int
forall a b. (a, b) -> a
fst ((Int, (Point, Time)) -> Int)
-> ((Int, (Point, Time)) -> Time)
-> (Int, (Point, Time))
-> (Int, Time)
forall b c c'. (b -> c) -> (b -> c') -> b -> (c, c')
forall (a :: * -> * -> *) b c c'.
Arrow a =>
a b c -> a b c' -> a b (c, c')
&&& Time -> Time
absoluteTimeNegate (Time -> Time)
-> ((Int, (Point, Time)) -> Time) -> (Int, (Point, Time)) -> Time
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Point, Time) -> Time
forall a b. (a, b) -> b
snd ((Point, Time) -> Time)
-> ((Int, (Point, Time)) -> (Point, Time))
-> (Int, (Point, Time))
-> Time
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Int, (Point, Time)) -> (Point, Time)
forall a b. (a, b) -> b
snd) [(Int, (Point, Time))]
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{ContentData CaveKind
cocave :: ContentData CaveKind
cocave :: COps -> ContentData CaveKind
cocave, TileSpeedup
coTileSpeedup :: COps -> TileSpeedup
coTileSpeedup :: TileSpeedup
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
dungeon <- (State -> Dungeon) -> m Dungeon
forall a. (State -> a) -> m a
forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
getsState State -> Dungeon
sdungeon
  EnumSet LevelId
explored <- (StateClient -> EnumSet LevelId) -> m (EnumSet LevelId)
forall a. (StateClient -> a) -> m a
forall (m :: * -> *) a.
MonadClientRead m =>
(StateClient -> a) -> m a
getsClient StateClient -> EnumSet LevelId
sexplored
  Actor
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
  Faction
fact <- (State -> Faction) -> m Faction
forall a. (State -> a) -> m a
forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
getsState ((State -> Faction) -> m Faction)
-> (State -> Faction) -> m Faction
forall a b. (a -> b) -> a -> b
$ (EnumMap FactionId Faction -> FactionId -> Faction
forall k a. Enum k => EnumMap k a -> k -> a
EM.! Actor -> FactionId
bfid Actor
b) (EnumMap FactionId Faction -> Faction)
-> (State -> EnumMap FactionId Faction) -> State -> Faction
forall b c a. (b -> c) -> (a -> b) -> a -> c
. State -> EnumMap FactionId Faction
sfactionD
  Level
lvl <- LevelId -> m Level
forall (m :: * -> *). MonadStateRead m => LevelId -> m Level
getLevel (Actor -> LevelId
blid Actor
b)
  [(ActorId, Actor)]
oursExploring <- (State -> [(ActorId, Actor)]) -> m [(ActorId, Actor)]
forall a. (State -> a) -> m a
forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
getsState ((State -> [(ActorId, Actor)]) -> m [(ActorId, Actor)])
-> (State -> [(ActorId, Actor)]) -> m [(ActorId, Actor)]
forall a b. (a -> b) -> a -> b
$ FactionId -> State -> [(ActorId, Actor)]
oursExploringAssocs (Actor -> FactionId
bfid Actor
b)
  let oursExploringLid :: [(ActorId, Actor)]
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 :: Freqs ItemKind
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 -> Bool
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 :: Bool
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)
  Skills
actorSk <- 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
ViaExit]
                  -- targeting, possibly when not a leader
             then (State -> Skills) -> m Skills
forall a. (State -> a) -> m a
forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
getsState ((State -> Skills) -> m Skills) -> (State -> Skills) -> m Skills
forall a b. (a -> b) -> a -> b
$ ActorId -> State -> Skills
getActorMaxSkills ActorId
aid
             else ActorId -> m Skills
forall (m :: * -> *). MonadClientRead m => ActorId -> m Skills
currentSkillsClient ActorId
aid
  let alterSkill :: Int
alterSkill = Skill -> Skills -> Int
Ability.getSk Skill
Ability.SkAlter Skills
actorSk
  Bool
condOurAdj <- (State -> Bool) -> m Bool
forall a. (State -> a) -> m a
forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
getsState ((State -> Bool) -> m Bool) -> (State -> Bool) -> m Bool
forall a b. (a -> b) -> a -> b
$ ((ActorId, Actor) -> Bool) -> [(ActorId, Actor)] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (\(ActorId
_, Actor
b2) -> FactionId -> Faction -> FactionId -> Bool
isFriend (Actor -> FactionId
bfid Actor
b) Faction
fact (Actor -> FactionId
bfid Actor
b2))
                            ([(ActorId, Actor)] -> Bool)
-> (State -> [(ActorId, Actor)]) -> State -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Actor -> State -> [(ActorId, Actor)]
adjacentBigAssocs Actor
b
  Bool
unexploredTrue <- Bool -> LevelId -> m Bool
forall (m :: * -> *).
MonadClientRead m =>
Bool -> LevelId -> m Bool
unexploredDepth Bool
True (Actor -> LevelId
blid Actor
b)
  Bool
unexploredFalse <- Bool -> LevelId -> m Bool
forall (m :: * -> *).
MonadClientRead m =>
Bool -> LevelId -> m Bool
unexploredDepth Bool
False (Actor -> LevelId
blid Actor
b)
  Bool
condEnoughGear <- ActorId -> m Bool
forall (m :: * -> *). MonadClientRead m => ActorId -> m Bool
condEnoughGearM ActorId
aid
  DiscoveryBenefit
discoBenefit <- (StateClient -> DiscoveryBenefit) -> m DiscoveryBenefit
forall a. (StateClient -> a) -> m a
forall (m :: * -> *) a.
MonadClientRead m =>
(StateClient -> a) -> m a
getsClient StateClient -> DiscoveryBenefit
sdiscoBenefit
  ItemId -> ItemKind
getKind <- (State -> ItemId -> ItemKind) -> m (ItemId -> ItemKind)
forall a. (State -> a) -> m a
forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
getsState ((State -> ItemId -> ItemKind) -> m (ItemId -> ItemKind))
-> (State -> ItemId -> ItemKind) -> m (ItemId -> ItemKind)
forall a b. (a -> b) -> a -> b
$ (ItemId -> State -> ItemKind) -> State -> ItemId -> ItemKind
forall a b c. (a -> b -> c) -> b -> a -> c
flip ItemId -> State -> ItemKind
getIidKind
  let alterMinSkill :: Point -> Int
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 :: Bool
lidExplored = LevelId -> EnumSet LevelId -> Bool
forall k. Enum k => k -> EnumSet k -> Bool
ES.member (Actor -> LevelId
blid Actor
b) EnumSet LevelId
explored
      allExplored :: Bool
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 -> [Effect]
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 -> [Effect]
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) -> Double
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 -> Bool
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, ItemBag) -> Bool
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 :: [(Double, (Point, ItemBag))]
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, (Point, ItemBag)) -> Bool
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)
  [(Double, (Point, ItemBag))] -> m [(Double, (Point, ItemBag))]
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return ([(Double, (Point, ItemBag))] -> m [(Double, (Point, ItemBag))])
-> [(Double, (Point, ItemBag))] -> m [(Double, (Point, ItemBag))]
forall a b. (a -> b) -> a -> b
$! ((Double, (Point, ItemBag)) -> Bool)
-> [(Double, (Point, ItemBag))] -> [(Double, (Point, ItemBag))]
forall a. (a -> Bool) -> [a] -> [a]
filter (Double, (Point, ItemBag)) -> Bool
considered [(Double, (Point, ItemBag))]
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 :: COps -> RuleContent
corule=RuleContent{Int
rWidthMax :: Int
rWidthMax :: RuleContent -> Int
rWidthMax, Int
rHeightMax :: Int
rHeightMax :: RuleContent -> Int
rHeightMax}} <- (State -> COps) -> m COps
forall a. (State -> a) -> m a
forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
getsState State -> COps
scops
  Actor
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
  Level
lvl <- LevelId -> m Level
forall (m :: * -> *). MonadStateRead m => LevelId -> m Level
getLevel (Actor -> LevelId
blid Actor
b)
  let pbags :: [(Point, ItemBag)]
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
  [(Double, (Point, ItemBag))]
efeat <- FleeViaStairsOrEscape
-> ActorId -> [(Point, ItemBag)] -> m [(Double, (Point, ItemBag))]
forall (m :: * -> *).
MonadClientRead m =>
FleeViaStairsOrEscape
-> ActorId -> [(Point, ItemBag)] -> m [(Double, (Point, ItemBag))]
embedBenefit FleeViaStairsOrEscape
fleeVia ActorId
aid [(Point, ItemBag)]
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.
  Array BfsDistance
bfs <- ActorId -> m (Array BfsDistance)
forall (m :: * -> *).
MonadClient m =>
ActorId -> m (Array BfsDistance)
getCacheBfs ActorId
aid
  let vicTrigger :: (Double, (Point, ItemBag)) -> [(Double, (Point, (Point, ItemBag)))]
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, (Point, ItemBag)))]
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
  [(Int, (Point, (Point, ItemBag)))]
-> m [(Int, (Point, (Point, ItemBag)))]
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return ([(Int, (Point, (Point, ItemBag)))]
 -> m [(Int, (Point, (Point, ItemBag)))])
-> [(Int, (Point, (Point, ItemBag)))]
-> m [(Int, (Point, (Point, ItemBag)))]
forall a b. (a -> b) -> a -> b
$!
    let mix :: (Double, b) -> Int -> (a, b)
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 ((Double, (Point, (Point, ItemBag)))
 -> Maybe (Int, (Point, (Point, ItemBag))))
-> [(Double, (Point, (Point, ItemBag)))]
-> [(Int, (Point, (Point, ItemBag)))]
forall a b. (a -> Maybe b) -> [a] -> [b]
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) [(Double, (Point, (Point, ItemBag)))]
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
  Actor
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
  Faction
fact <- (State -> Faction) -> m Faction
forall a. (State -> a) -> m a
forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
getsState ((State -> Faction) -> m Faction)
-> (State -> Faction) -> m Faction
forall a b. (a -> b) -> a -> b
$ (EnumMap FactionId Faction -> FactionId -> Faction
forall k a. Enum k => EnumMap k a -> k -> a
EM.! Actor -> FactionId
bfid Actor
b) (EnumMap FactionId Faction -> Faction)
-> (State -> EnumMap FactionId Faction) -> State -> Faction
forall b c a. (b -> c) -> (a -> b) -> a -> c
. State -> EnumMap FactionId Faction
sfactionD
  let followDoctrine :: Bool
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]
  [(ItemId, ItemFull)]
eqpAssocs <- (State -> [(ItemId, ItemFull)]) -> m [(ItemId, ItemFull)]
forall a. (State -> a) -> m a
forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
getsState ((State -> [(ItemId, ItemFull)]) -> m [(ItemId, ItemFull)])
-> (State -> [(ItemId, ItemFull)]) -> m [(ItemId, ItemFull)]
forall a b. (a -> b) -> a -> b
$ ActorId -> [CStore] -> State -> [(ItemId, ItemFull)]
fullAssocs ActorId
aid [CStore
CEqp]
  Bool -> m Bool
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Bool -> m Bool) -> Bool -> m Bool
forall a b. (a -> b) -> a -> b
$ Bool -> Bool
not Bool
followDoctrine  -- keep it lazy
           Bool -> Bool -> Bool
&& (((ItemId, ItemFull) -> Bool) -> [(ItemId, ItemFull)] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (Flag -> AspectRecord -> Bool
IA.checkFlag Flag
Ability.Meleeable
                    (AspectRecord -> Bool)
-> ((ItemId, ItemFull) -> AspectRecord)
-> (ItemId, ItemFull)
-> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ItemFull -> AspectRecord
aspectRecordFull (ItemFull -> AspectRecord)
-> ((ItemId, ItemFull) -> ItemFull)
-> (ItemId, ItemFull)
-> AspectRecord
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ItemId, ItemFull) -> ItemFull
forall a b. (a, b) -> b
snd) [(ItemId, ItemFull)]
eqpAssocs
               Bool -> Bool -> Bool
|| [(ItemId, ItemFull)] -> Int
forall a. [a] -> Int
length [(ItemId, ItemFull)]
eqpAssocs Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
3)

unexploredDepth :: MonadClientRead m => Bool -> LevelId -> m Bool
unexploredDepth :: forall (m :: * -> *).
MonadClientRead m =>
Bool -> LevelId -> m Bool
unexploredDepth !Bool
up !LevelId
lidCurrent = do
  Dungeon
dungeon <- (State -> Dungeon) -> m Dungeon
forall a. (State -> a) -> m a
forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
getsState State -> Dungeon
sdungeon
  EnumSet LevelId
explored <- (StateClient -> EnumSet LevelId) -> m (EnumSet LevelId)
forall a. (StateClient -> a) -> m a
forall (m :: * -> *) a.
MonadClientRead m =>
(StateClient -> a) -> m a
getsClient StateClient -> EnumSet LevelId
sexplored
  let allExplored :: Bool
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 :: LevelId -> Bool
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
  Bool -> m Bool
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Bool -> m Bool) -> Bool -> m Bool
forall a b. (a -> b) -> a -> b
$ LevelId -> Bool
unexploredD LevelId
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
  Actor
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{EnumMap Point ItemBag
lfloor :: EnumMap Point ItemBag
lfloor :: Level -> EnumMap Point ItemBag
lfloor, EnumMap Point ActorId
lbig :: Level -> EnumMap Point ActorId
lbig :: EnumMap Point ActorId
lbig} <- 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
  EnumMap FactionId Faction
factionD <- (State -> EnumMap FactionId Faction)
-> m (EnumMap FactionId Faction)
forall a. (State -> a) -> m a
forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
getsState State -> EnumMap FactionId Faction
sfactionD
  Perception
per <- LevelId -> m Perception
forall (m :: * -> *). MonadClientRead m => LevelId -> m Perception
getPerFid (LevelId -> m Perception) -> LevelId -> m Perception
forall a b. (a -> b) -> a -> b
$ Actor -> LevelId
blid Actor
body
  let canSee :: Point -> Bool
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, Maybe (LevelId, Point))]
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, 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 :: EnumSet 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
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 EnumMap Point ItemBag -> Bool
forall k a. EnumMap k a -> Bool
EM.null EnumMap Point ItemBag
lfloorBarStashes then [(Int, (Point, ItemBag))] -> m [(Int, (Point, ItemBag))]
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return [] else do
    Array BfsDistance
bfs <- ActorId -> m (Array BfsDistance)
forall (m :: * -> *).
MonadClient m =>
ActorId -> m (Array BfsDistance)
getCacheBfs ActorId
aid
    let mix :: b -> Int -> (Int, b)
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)
    [(Int, (Point, ItemBag))] -> m [(Int, (Point, ItemBag))]
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return ([(Int, (Point, ItemBag))] -> m [(Int, (Point, ItemBag))])
-> [(Int, (Point, ItemBag))] -> m [(Int, (Point, ItemBag))]
forall a b. (a -> b) -> a -> b
$! ((Point, ItemBag) -> Maybe (Int, (Point, ItemBag)))
-> [(Point, ItemBag)] -> [(Int, (Point, ItemBag))]
forall a b. (a -> Maybe b) -> [a] -> [b]
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) (EnumMap Point ItemBag -> [(Point, ItemBag)]
forall k a. Enum k => EnumMap k a -> [(k, a)]
EM.assocs EnumMap Point ItemBag
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
      Array BfsDistance
bfs <- ActorId -> m (Array BfsDistance)
forall (m :: * -> *).
MonadClient m =>
ActorId -> m (Array BfsDistance)
getCacheBfs ActorId
aid
      let ds :: [(Int, (ActorId, Actor))]
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
      [(Int, (ActorId, Actor))] -> m [(Int, (ActorId, Actor))]
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return ([(Int, (ActorId, Actor))] -> m [(Int, (ActorId, Actor))])
-> [(Int, (ActorId, Actor))] -> m [(Int, (ActorId, Actor))]
forall a b. (a -> b) -> a -> b
$! ((Int, (ActorId, Actor)) -> (Int, (ActorId, Actor)) -> Ordering)
-> [(Int, (ActorId, Actor))] -> [(Int, (ActorId, Actor))]
forall a. (a -> a -> Ordering) -> [a] -> [a]
sortBy (((Int, (ActorId, Actor)) -> Int)
-> (Int, (ActorId, Actor)) -> (Int, (ActorId, Actor)) -> Ordering
forall a b. Ord a => (b -> a) -> b -> b -> Ordering
comparing (Int, (ActorId, Actor)) -> Int
forall a b. (a, b) -> a
fst) [(Int, (ActorId, Actor))]
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{ContentData CaveKind
cocave :: COps -> ContentData CaveKind
cocave :: ContentData CaveKind
cocave} <- (State -> COps) -> m COps
forall a. (State -> a) -> m a
forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
getsState State -> COps
scops
  EnumMap FactionId Faction
factionD <- (State -> EnumMap FactionId Faction)
-> m (EnumMap FactionId Faction)
forall a. (State -> a) -> m a
forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
getsState State -> EnumMap FactionId Faction
sfactionD
  Actor
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
  Level
lvl <- LevelId -> m Level
forall (m :: * -> *). MonadStateRead m => LevelId -> m Level
getLevel (Actor -> LevelId
blid Actor
b)
  [(ActorId, Actor)]
oursExploring <- (State -> [(ActorId, Actor)]) -> m [(ActorId, Actor)]
forall a. (State -> a) -> m a
forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
getsState ((State -> [(ActorId, Actor)]) -> m [(ActorId, Actor)])
-> (State -> [(ActorId, Actor)]) -> m [(ActorId, Actor)]
forall a b. (a -> b) -> a -> b
$ FactionId -> State -> [(ActorId, Actor)]
oursExploringAssocs (Actor -> FactionId
bfid Actor
b)
  let fact :: Faction
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 :: Freqs ItemKind
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 -> Bool
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 :: Bool
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, Faction) -> Maybe (FactionId, Point)
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 ((FactionId, Faction) -> Maybe (FactionId, Point))
-> [(FactionId, Faction)] -> [(FactionId, Point)]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe (FactionId, Faction) -> Maybe (FactionId, Point)
qualifyStash ([(FactionId, Faction)] -> [(FactionId, Point)])
-> [(FactionId, Faction)] -> [(FactionId, 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 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
      Array BfsDistance
bfs <- ActorId -> m (Array BfsDistance)
forall (m :: * -> *).
MonadClient m =>
ActorId -> m (Array BfsDistance)
getCacheBfs ActorId
aid
      let ds :: [(Int, (FactionId, Point))]
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
      [(Int, (FactionId, Point))] -> m [(Int, (FactionId, Point))]
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return ([(Int, (FactionId, Point))] -> m [(Int, (FactionId, Point))])
-> [(Int, (FactionId, Point))] -> m [(Int, (FactionId, Point))]
forall a b. (a -> b) -> a -> b
$! ((Int, (FactionId, Point))
 -> (Int, (FactionId, Point)) -> Ordering)
-> [(Int, (FactionId, Point))] -> [(Int, (FactionId, Point))]
forall a. (a -> a -> Ordering) -> [a] -> [a]
sortBy (((Int, (FactionId, Point)) -> Int)
-> (Int, (FactionId, Point))
-> (Int, (FactionId, Point))
-> Ordering
forall a b. Ord a => (b -> a) -> b -> b -> Ordering
comparing (Int, (FactionId, Point)) -> Int
forall a b. (a, b) -> a
fst) [(Int, (FactionId, Point))]
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{TileSpeedup
coTileSpeedup :: COps -> TileSpeedup
coTileSpeedup :: TileSpeedup
coTileSpeedup} <- (State -> COps) -> m COps
forall a. (State -> a) -> m a
forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
getsState State -> COps
scops
  Actor
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
  Level
lvl <- LevelId -> m Level
forall (m :: * -> *). MonadStateRead m => LevelId -> m Level
getLevel (Actor -> LevelId
blid Actor
b)
  Array BfsDistance
bfs <- ActorId -> m (Array BfsDistance)
forall (m :: * -> *).
MonadClient m =>
ActorId -> m (Array BfsDistance)
getCacheBfs ActorId
aid
  let minHideout :: (Point, BfsDistance) -> Point -> BfsDistance
                 -> (Point, BfsDistance)
      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)
      (Point
p1, BfsDistance
dist1) = ((Point, BfsDistance)
 -> Point -> BfsDistance -> (Point, BfsDistance))
-> (Point, BfsDistance)
-> Array BfsDistance
-> (Point, BfsDistance)
forall c a.
UnboxRepClass c =>
(a -> Point -> c -> a) -> a -> Array c -> a
PointArray.ifoldlA' (Point, BfsDistance)
-> Point -> BfsDistance -> (Point, BfsDistance)
minHideout (Actor -> Point
bpos Actor
b, BfsDistance
maxBfsDistance) Array BfsDistance
bfs
  Maybe (Point, Int) -> m (Maybe (Point, Int))
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe (Point, Int) -> m (Maybe (Point, Int)))
-> Maybe (Point, Int) -> m (Maybe (Point, Int))
forall a b. (a -> b) -> a -> b
$! if Point
p1 Point -> Point -> Bool
forall a. Eq a => a -> a -> Bool
== Actor -> Point
bpos Actor
b  -- possibly hideout underfoot; ignore
            then Maybe (Point, Int)
forall a. Maybe a
Nothing
            else (Point, Int) -> Maybe (Point, Int)
forall a. a -> Maybe a
Just (Point
p1, BfsDistance -> BfsDistance -> Int
subtractBfsDistance BfsDistance
dist1 BfsDistance
apartBfs)