{-# 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
#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.Ord
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.State
import qualified Game.LambdaHack.Common.Tile as Tile
import           Game.LambdaHack.Common.Time
import           Game.LambdaHack.Common.Types
import           Game.LambdaHack.Common.Vector
import qualified Game.LambdaHack.Content.ItemKind as IK
import           Game.LambdaHack.Content.ModeKind
import           Game.LambdaHack.Content.RuleKind
import           Game.LambdaHack.Content.TileKind (isUknownSpace)
import           Game.LambdaHack.Common.Point
import qualified Game.LambdaHack.Common.PointArray as PointArray
import           Game.LambdaHack.Core.Random
import qualified Game.LambdaHack.Definition.Ability as Ability
import           Game.LambdaHack.Definition.Defs

invalidateBfsAid :: MonadClient m => ActorId -> m ()
invalidateBfsAid :: ActorId -> m ()
invalidateBfsAid aid :: 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
$ \cli :: StateClient
cli -> StateClient
cli {sbfsD :: EnumMap ActorId BfsAndPath
sbfsD = ActorId
-> BfsAndPath
-> EnumMap ActorId BfsAndPath
-> EnumMap ActorId BfsAndPath
forall k a. Enum k => k -> a -> EnumMap k a -> EnumMap k a
EM.insert ActorId
aid BfsAndPath
BfsInvalid (StateClient -> EnumMap ActorId BfsAndPath
sbfsD StateClient
cli)}

invalidateBfsPathAid :: MonadClient m => ActorId -> m ()
invalidateBfsPathAid :: ActorId -> m ()
invalidateBfsPathAid aid :: ActorId
aid = do
  let f :: BfsAndPath -> BfsAndPath
f BfsInvalid = BfsAndPath
BfsInvalid
      f (BfsAndPath bfsArr :: Array BfsDistance
bfsArr _) = 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
$ \cli :: StateClient
cli -> StateClient
cli {sbfsD :: EnumMap ActorId BfsAndPath
sbfsD = (BfsAndPath -> BfsAndPath)
-> ActorId
-> EnumMap ActorId BfsAndPath
-> EnumMap ActorId BfsAndPath
forall k a. Enum k => (a -> a) -> k -> EnumMap k a -> EnumMap k a
EM.adjust BfsAndPath -> BfsAndPath
f ActorId
aid (StateClient -> EnumMap ActorId BfsAndPath
sbfsD StateClient
cli)}

invalidateBfsLid :: MonadClient m => LevelId -> m ()
invalidateBfsLid :: LevelId -> m ()
invalidateBfsLid lid :: LevelId
lid = do
  FactionId
side <- (StateClient -> FactionId) -> m FactionId
forall (m :: * -> *) a.
MonadClientRead m =>
(StateClient -> a) -> m a
getsClient StateClient -> FactionId
sside
  let f :: (ActorId, Actor) -> Bool
f (_, b :: Actor
b) = Actor -> LevelId
blid Actor
b LevelId -> LevelId -> Bool
forall a. Eq a => a -> a -> Bool
== LevelId
lid Bool -> Bool -> Bool
&& Actor -> FactionId
bfid Actor
b FactionId -> FactionId -> Bool
forall a. Eq a => a -> a -> Bool
== FactionId
side Bool -> Bool -> Bool
&& Bool -> Bool
not (Actor -> Bool
bproj Actor
b)
  [(ActorId, Actor)]
as <- (State -> [(ActorId, Actor)]) -> m [(ActorId, Actor)]
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, Actor) -> Bool)
-> [(ActorId, Actor)] -> [(ActorId, Actor)]
forall a. (a -> Bool) -> [a] -> [a]
filter (ActorId, Actor) -> Bool
f ([(ActorId, Actor)] -> [(ActorId, Actor)])
-> (State -> [(ActorId, Actor)]) -> State -> [(ActorId, Actor)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. EnumMap ActorId Actor -> [(ActorId, Actor)]
forall k a. Enum k => EnumMap k a -> [(k, a)]
EM.assocs (EnumMap ActorId Actor -> [(ActorId, Actor)])
-> (State -> EnumMap ActorId Actor) -> State -> [(ActorId, Actor)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. State -> EnumMap ActorId Actor
sactorD
  ((ActorId, Actor) -> m ()) -> [(ActorId, Actor)] -> m ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (ActorId -> m ()
forall (m :: * -> *). MonadClient m => ActorId -> m ()
invalidateBfsAid (ActorId -> m ())
-> ((ActorId, Actor) -> ActorId) -> (ActorId, Actor) -> m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ActorId, Actor) -> ActorId
forall a b. (a, b) -> a
fst) [(ActorId, Actor)]
as

invalidateBfsPathLid :: MonadClient m => LevelId -> Point -> m ()
invalidateBfsPathLid :: LevelId -> Point -> m ()
invalidateBfsPathLid lid :: LevelId
lid pos :: Point
pos = do
  FactionId
side <- (StateClient -> FactionId) -> m FactionId
forall (m :: * -> *) a.
MonadClientRead m =>
(StateClient -> a) -> m a
getsClient StateClient -> FactionId
sside
  let f :: (ActorId, Actor) -> Bool
f (_, b :: Actor
b) = Actor -> LevelId
blid Actor
b LevelId -> LevelId -> Bool
forall a. Eq a => a -> a -> Bool
== LevelId
lid Bool -> Bool -> Bool
&& Actor -> FactionId
bfid Actor
b FactionId -> FactionId -> Bool
forall a. Eq a => a -> a -> Bool
== FactionId
side Bool -> Bool -> Bool
&& Bool -> Bool
not (Actor -> Bool
bproj Actor
b)
                 Bool -> Bool -> Bool
&& Point -> Point -> Int
chessDist Point
pos (Actor -> Point
bpos Actor
b) Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
actorsAvoidedDist
                      -- rough approximation, but kicks in well before blockage
  [(ActorId, Actor)]
as <- (State -> [(ActorId, Actor)]) -> m [(ActorId, Actor)]
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, Actor) -> Bool)
-> [(ActorId, Actor)] -> [(ActorId, Actor)]
forall a. (a -> Bool) -> [a] -> [a]
filter (ActorId, Actor) -> Bool
f ([(ActorId, Actor)] -> [(ActorId, Actor)])
-> (State -> [(ActorId, Actor)]) -> State -> [(ActorId, Actor)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. EnumMap ActorId Actor -> [(ActorId, Actor)]
forall k a. Enum k => EnumMap k a -> [(k, a)]
EM.assocs (EnumMap ActorId Actor -> [(ActorId, Actor)])
-> (State -> EnumMap ActorId Actor) -> State -> [(ActorId, Actor)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. State -> EnumMap ActorId Actor
sactorD
  ((ActorId, Actor) -> m ()) -> [(ActorId, Actor)] -> m ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (ActorId -> m ()
forall (m :: * -> *). MonadClient m => ActorId -> m ()
invalidateBfsPathAid (ActorId -> m ())
-> ((ActorId, Actor) -> ActorId) -> (ActorId, Actor) -> m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ActorId, Actor) -> ActorId
forall a b. (a, b) -> a
fst) [(ActorId, Actor)]
as

invalidateBfsAll :: MonadClient m => m ()
invalidateBfsAll :: 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
$ \cli :: StateClient
cli -> StateClient
cli {sbfsD :: EnumMap ActorId BfsAndPath
sbfsD = (BfsAndPath -> BfsAndPath)
-> EnumMap ActorId BfsAndPath -> EnumMap ActorId BfsAndPath
forall a b k. (a -> b) -> EnumMap k a -> EnumMap k b
EM.map (BfsAndPath -> BfsAndPath -> BfsAndPath
forall a b. a -> b -> a
const BfsAndPath
BfsInvalid) (StateClient -> EnumMap ActorId BfsAndPath
sbfsD StateClient
cli)}

invalidateBfsPathAll :: MonadClient m => m ()
invalidateBfsPathAll :: m ()
invalidateBfsPathAll = do
  let f :: BfsAndPath -> BfsAndPath
f BfsInvalid = BfsAndPath
BfsInvalid
      f (BfsAndPath bfsArr :: Array BfsDistance
bfsArr _) = 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
$ \cli :: StateClient
cli -> StateClient
cli {sbfsD :: EnumMap ActorId BfsAndPath
sbfsD = (BfsAndPath -> BfsAndPath)
-> EnumMap ActorId BfsAndPath -> EnumMap ActorId BfsAndPath
forall a b k. (a -> b) -> EnumMap k a -> EnumMap k b
EM.map BfsAndPath -> BfsAndPath
f (StateClient -> EnumMap ActorId BfsAndPath
sbfsD StateClient
cli)}

createBfs :: MonadClientRead m
          => Bool -> Word8 -> ActorId -> m (PointArray.Array BfsDistance)
createBfs :: Bool -> Word8 -> ActorId -> m (Array BfsDistance)
createBfs canMove :: Bool
canMove alterSkill0 :: Word8
alterSkill0 aid :: ActorId
aid =
  if Bool
canMove then do
    Actor
b <- (State -> Actor) -> m Actor
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 (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 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 (m :: * -> *) a.
MonadClientRead m =>
(StateClient -> a) -> m a
getsClient StateClient -> (PrimArray Int, PrimArray Int)
stabs
    Array BfsDistance -> m (Array BfsDistance)
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 (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 :: Bool
-> BfsAndPath
-> ActorId
-> Point
-> m (Array BfsDistance, Maybe AndPath)
updatePathFromBfs canMove :: Bool
canMove bfsAndPathOld :: BfsAndPath
bfsAndPathOld aid :: ActorId
aid !Point
target = do
  COps{TileSpeedup
coTileSpeedup :: COps -> TileSpeedup
coTileSpeedup :: TileSpeedup
coTileSpeedup} <- (State -> COps) -> m COps
forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
getsState State -> COps
scops
  let (oldBfsArr :: Array BfsDistance
oldBfsArr, oldBfsPath :: EnumMap Point AndPath
oldBfsPath) = case BfsAndPath
bfsAndPathOld of
        (BfsAndPath bfsArr :: Array BfsDistance
bfsArr bfsPath :: EnumMap Point AndPath
bfsPath) -> (Array BfsDistance
bfsArr, EnumMap Point AndPath
bfsPath)
        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] -> (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 (m :: * -> *) a. Monad m => a -> m a
return (Array BfsDistance
bfsArr, Maybe AndPath
forall a. Maybe a
Nothing)
  else do
    Actor
b <- (State -> Actor) -> m Actor
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 lid :: LevelId
lid = Actor -> LevelId
blid Actor
b
    Int
seps <- (StateClient -> Int) -> m Int
forall (m :: * -> *) a.
MonadClientRead m =>
(StateClient -> a) -> m a
getsClient StateClient -> Int
seps
    AlterLid
salter <- (StateClient -> AlterLid) -> m AlterLid
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 LevelId
lid
    let !lalter :: Array Word8
lalter = AlterLid
salter AlterLid -> LevelId -> Array Word8
forall k a. Enum k => EnumMap k a -> k -> a
EM.! LevelId
lid
        fovLit :: Int -> Bool
fovLit p :: 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
        !source :: Point
source = Actor -> Point
bpos Actor
b
        !mpath :: Maybe AndPath
mpath =
          BigActorMap
-> Array Word8
-> (Int -> Bool)
-> Point
-> Point
-> Int
-> Array BfsDistance
-> Maybe AndPath
findPathBfs (Point -> BigActorMap -> BigActorMap
forall k a. Enum k => k -> EnumMap k a -> EnumMap k a
EM.delete Point
source (BigActorMap -> BigActorMap) -> BigActorMap -> BigActorMap
forall a b. (a -> b) -> a -> b
$ Level -> BigActorMap
lbig Level
lvl)  -- don't sidestep oneself
                      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 (\path :: 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
$ \cli :: StateClient
cli -> StateClient
cli {sbfsD :: EnumMap ActorId BfsAndPath
sbfsD = ActorId
-> BfsAndPath
-> EnumMap ActorId BfsAndPath
-> EnumMap ActorId BfsAndPath
forall k a. Enum k => k -> a -> EnumMap k a -> EnumMap k a
EM.insert ActorId
aid BfsAndPath
bap (EnumMap ActorId BfsAndPath -> EnumMap ActorId BfsAndPath)
-> EnumMap ActorId BfsAndPath -> EnumMap ActorId BfsAndPath
forall a b. (a -> b) -> a -> b
$ StateClient -> EnumMap ActorId BfsAndPath
sbfsD StateClient
cli}
    (Array BfsDistance, Maybe AndPath)
-> m (Array BfsDistance, Maybe AndPath)
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 :: ActorId -> Point -> m (Array BfsDistance, Maybe AndPath)
getCacheBfsAndPath aid :: ActorId
aid target :: Point
target = do
  Maybe BfsAndPath
mbfs <- (StateClient -> Maybe BfsAndPath) -> m (Maybe BfsAndPath)
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 bfsArr :: Array BfsDistance
bfsArr bfsPath :: 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
        Nothing -> do
          (!Bool
canMove, _) <- 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 (m :: * -> *) a. Monad m => a -> m a
return (Array BfsDistance
bfsArr, Maybe AndPath
mpath)
    _ -> do
      (canMove :: Bool
canMove, alterSkill :: 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 :: ActorId -> m (Array BfsDistance)
getCacheBfs aid :: ActorId
aid = do
  Maybe BfsAndPath
mbfs <- (StateClient -> Maybe BfsAndPath) -> m (Maybe BfsAndPath)
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 bfsArr :: Array BfsDistance
bfsArr _) -> Array BfsDistance -> m (Array BfsDistance)
forall (m :: * -> *) a. Monad m => a -> m a
return Array BfsDistance
bfsArr
    _ -> do
      (canMove :: Bool
canMove, alterSkill :: 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
$ \cli :: StateClient
cli ->
        StateClient
cli {sbfsD :: EnumMap ActorId BfsAndPath
sbfsD = ActorId
-> BfsAndPath
-> EnumMap ActorId BfsAndPath
-> EnumMap ActorId BfsAndPath
forall k a. Enum k => k -> a -> EnumMap k a -> EnumMap k a
EM.insert ActorId
aid (Array BfsDistance -> EnumMap Point AndPath -> BfsAndPath
BfsAndPath Array BfsDistance
bfsArr EnumMap Point AndPath
forall k a. EnumMap k a
bfsPath) (StateClient -> EnumMap ActorId BfsAndPath
sbfsD StateClient
cli)}
      Array BfsDistance -> m (Array BfsDistance)
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 :: ActorId -> Point -> m (Maybe AndPath)
getCachePath aid :: ActorId
aid target :: Point
target = do
  Actor
b <- (State -> Actor) -> m Actor
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 ->
       Maybe AndPath -> m (Maybe AndPath)
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 0  -- speedup
     | Bool
otherwise -> (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 :: ActorId -> Target -> m TgtAndPath
createPath aid :: ActorId
aid tapTgt :: Target
tapTgt = do
  COps{TileSpeedup
coTileSpeedup :: TileSpeedup
coTileSpeedup :: COps -> TileSpeedup
coTileSpeedup} <- (State -> COps) -> m COps
forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
getsState State -> COps
scops
  Actor
b <- (State -> Actor) -> m Actor
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{..}) =
        let (walkable :: [Point]
walkable, rest :: [Point]
rest) =
              -- Unknown tiles are not walkable, so path stops at first such.
              -- which is good, because by the time actor reaches the tile,
              -- it is known and target is recalculated with new info.
              (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
          [] -> $WTgtAndPath :: Target -> Maybe AndPath -> TgtAndPath
TgtAndPath{..}
          [g :: Point
g] | Point
g Point -> Point -> Bool
forall a. Eq a => a -> a -> Bool
== Point
pathGoal -> $WTgtAndPath :: Target -> Maybe AndPath -> TgtAndPath
TgtAndPath{..}
          newGoal :: Point
newGoal : _ ->
            let newTgt :: Target
newTgt = TGoal -> LevelId -> Point -> Target
TPoint TGoal
TBlock (Actor -> LevelId
blid Actor
b) Point
newGoal
                newPath :: AndPath
newPath = $WAndPath :: Point -> [Point] -> Point -> Int -> AndPath
AndPath{ pathSource :: Point
pathSource = Actor -> Point
bpos Actor
b
                                 , pathList :: [Point]
pathList = [Point]
walkable [Point] -> [Point] -> [Point]
forall a. [a] -> [a] -> [a]
++ [Point
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
+ 1 }
            in $WTgtAndPath :: Target -> Maybe AndPath -> TgtAndPath
TgtAndPath{tapTgt :: Target
tapTgt = Target
newTgt, tapPath :: Maybe AndPath
tapPath = AndPath -> Maybe AndPath
forall a. a -> Maybe a
Just AndPath
newPath}
      stopAtUnwalkable Nothing = $WTgtAndPath :: Target -> Maybe AndPath -> TgtAndPath
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 (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
$ ActorId -> LevelId -> Maybe Target -> State -> Maybe Point
aidTgtToPos ActorId
aid (Actor -> LevelId
blid Actor
b) (Target -> Maybe Target
forall a. a -> Maybe a
Just Target
tapTgt)
  case Maybe Point
mpos of
    Nothing -> TgtAndPath -> m TgtAndPath
forall (m :: * -> *) a. Monad m => a -> m a
return $WTgtAndPath :: Target -> Maybe AndPath -> TgtAndPath
TgtAndPath{Target
tapTgt :: Target
tapTgt :: Target
tapTgt, tapPath :: Maybe AndPath
tapPath=Maybe AndPath
forall a. Maybe a
Nothing}
    Just p :: 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 (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 :: ActorId -> m (Bool, Word8)
condBFS aid :: ActorId
aid = do
  FactionId
side <- (StateClient -> FactionId) -> m FactionId
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 (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
- 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 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
> 0
                Bool -> Bool -> Bool
|| Skill -> Skills -> Int
Ability.getSk Skill
Ability.SkDisplace Skills
actorMaxSk Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> 0
                Bool -> Bool -> Bool
|| Skill -> Skills -> Int
Ability.getSk Skill
Ability.SkProject Skills
actorMaxSk Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> 0
  Int
smarkSuspect <- (StateClient -> Int) -> m Int
forall (m :: * -> *) a.
MonadClientRead m =>
(StateClient -> a) -> m a
getsClient StateClient -> Int
smarkSuspect
  Faction
fact <- (State -> Faction) -> m Faction
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 underAI :: Bool
underAI = Faction -> Bool
isAIFact Faction
fact
      -- Under UI, playing a hero party, we let AI set our target each
      -- turn for henchmen 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
> 0 Bool -> Bool -> Bool
|| Bool
underAI
      skill :: Word8
skill | Bool
enterSuspect = Word8
alterSkill  -- dig and search as skill allows
            | Bool
otherwise = 0  -- only walkable tiles
  (Bool, Word8) -> m (Bool, Word8)
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 :: ActorId -> m Point
furthestKnown aid :: 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 (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 a. Show a => Bool -> a -> 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 marked 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 targetting
-- 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 :: ActorId -> m (Maybe Point)
closestUnknown aid :: ActorId
aid = do
  Actor
body <- (State -> Actor) -> m Actor
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. [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 (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 pos :: Point
pos =
               let vic :: [Point]
vic = Point -> [Point]
vicinityUnsafe Point
pos
                   countUnknown :: Int -> Point -> Int
                   countUnknown :: Int -> Point -> Int
countUnknown c :: Int
c p :: 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
+ 1 else Int
c
               in (Int -> Point -> Int) -> Int -> [Point] -> Int
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' Int -> Point -> Int
countUnknown 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 :: ActorId -> m [(Int, (Point, Time))]
closestSmell aid :: ActorId
aid = do
  Actor
body <- (State -> Actor) -> m Actor
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 :: Level -> SmellMap
lsmell :: SmellMap
lsmell, Time
ltime :: Level -> Time
ltime :: 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 (\(p :: Point
p, sm :: 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 (m :: * -> *) a. Monad m => a -> m a
return []
    _ -> 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@(p :: Point
p, _) -> (Int -> (Int, (Point, Time)))
-> Maybe Int -> Maybe (Int, (Point, Time))
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 (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, (Point, Time)) -> Ordering)
-> [(Int, (Point, Time))] -> [(Int, (Point, Time))]
forall a. (a -> a -> Ordering) -> [a] -> [a]
sortBy (((Int, (Point, Time)) -> (Int, Time))
-> (Int, (Point, Time)) -> (Int, (Point, Time)) -> Ordering
forall a b. Ord a => (b -> a) -> b -> b -> Ordering
comparing ((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 (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
showList :: [FleeViaStairsOrEscape] -> ShowS
$cshowList :: [FleeViaStairsOrEscape] -> ShowS
show :: FleeViaStairsOrEscape -> [Char]
$cshow :: FleeViaStairsOrEscape -> [Char]
showsPrec :: Int -> FleeViaStairsOrEscape -> ShowS
$cshowsPrec :: Int -> FleeViaStairsOrEscape -> ShowS
Show, FleeViaStairsOrEscape -> FleeViaStairsOrEscape -> Bool
(FleeViaStairsOrEscape -> FleeViaStairsOrEscape -> Bool)
-> (FleeViaStairsOrEscape -> FleeViaStairsOrEscape -> Bool)
-> Eq FleeViaStairsOrEscape
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: FleeViaStairsOrEscape -> FleeViaStairsOrEscape -> Bool
$c/= :: FleeViaStairsOrEscape -> FleeViaStairsOrEscape -> Bool
== :: FleeViaStairsOrEscape -> FleeViaStairsOrEscape -> Bool
$c== :: FleeViaStairsOrEscape -> FleeViaStairsOrEscape -> Bool
Eq)

embedBenefit :: MonadClientRead m
             => FleeViaStairsOrEscape -> ActorId
             -> [(Point, ItemBag)]
             -> m [(Double, (Point, ItemBag))]
embedBenefit :: FleeViaStairsOrEscape
-> ActorId -> [(Point, ItemBag)] -> m [(Double, (Point, ItemBag))]
embedBenefit fleeVia :: FleeViaStairsOrEscape
fleeVia aid :: ActorId
aid pbags :: [(Point, ItemBag)]
pbags = do
  COps{TileSpeedup
coTileSpeedup :: TileSpeedup
coTileSpeedup :: COps -> TileSpeedup
coTileSpeedup} <- (State -> COps) -> m COps
forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
getsState State -> COps
scops
  Dungeon
dungeon <- (State -> Dungeon) -> m Dungeon
forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
getsState State -> Dungeon
sdungeon
  EnumSet LevelId
explored <- (StateClient -> EnumSet LevelId) -> m (EnumSet LevelId)
forall (m :: * -> *) a.
MonadClientRead m =>
(StateClient -> a) -> m a
getsClient StateClient -> EnumSet LevelId
sexplored
  Actor
b <- (State -> Actor) -> m Actor
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
  Skills
actorSk <- if FleeViaStairsOrEscape
fleeVia FleeViaStairsOrEscape -> [FleeViaStairsOrEscape] -> 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 (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
  Faction
fact <- (State -> Faction) -> m Faction
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)
  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 (m :: * -> *) a.
MonadClientRead m =>
(StateClient -> a) -> m a
getsClient StateClient -> DiscoveryBenefit
sdiscoBenefit
  ItemId -> ItemKind
getKind <- (State -> ItemId -> ItemKind) -> m (ItemId -> ItemKind)
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 p :: 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 iid :: 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 bag :: 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 (_, bag :: 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 =
                Player -> Bool
fcanEscape (Faction -> Player
gplayer Faction
fact)
                Bool -> Bool -> Bool
|| FleeViaStairsOrEscape
fleeVia FleeViaStairsOrEscape -> [FleeViaStairsOrEscape] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [FleeViaStairsOrEscape
ViaExit]  -- target to guard after explored
          in if FleeViaStairsOrEscape
fleeVia FleeViaStairsOrEscape -> [FleeViaStairsOrEscape] -> 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 10
             else 0  -- don't escape prematurely
        Just (IK.Ascend up :: 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
> 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
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 10 else 1 else 0
          in case FleeViaStairsOrEscape
fleeVia of
            ViaStairsUp | Bool
up -> 1
            ViaStairsDown | Bool -> Bool
not Bool
up -> 1
            ViaStairs -> Double
v
            ViaExit -> Double
v
            ViaAnything -> Double
v
            _ -> 0  -- don't ascend prematurely
        _ ->
          if FleeViaStairsOrEscape
fleeVia FleeViaStairsOrEscape -> [FleeViaStairsOrEscape] -> 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 = 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 (\iid :: 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 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 0
      underFeet :: Point -> Bool
underFeet p :: 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.
      -- If apply skill not high enough for embedded items, AI will only
      -- guard such tiles, assuming they must be advanced and so crucial.
      f :: (Point, ItemBag) -> Bool
f (p :: Point
p, _) = 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)
      benFeats :: [(Double, (Point, ItemBag))]
benFeats = ((Point, ItemBag) -> (Double, (Point, ItemBag)))
-> [(Point, ItemBag)] -> [(Double, (Point, ItemBag))]
forall a b. (a -> b) -> [a] -> [b]
map (\pbag :: (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 (benefitAndSacrifice :: Double
benefitAndSacrifice, (p :: Point
p, _bag :: ItemBag
_bag)) =
        Double
benefitAndSacrifice Double -> Double -> Bool
forall a. Ord a => a -> a -> Bool
> 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 (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 :: FleeViaStairsOrEscape
-> ActorId -> m [(Int, (Point, (Point, ItemBag)))]
closestTriggers fleeVia :: FleeViaStairsOrEscape
fleeVia aid :: ActorId
aid = do
  COps{corule :: COps -> RuleContent
corule=RuleContent{Int
rXmax :: RuleContent -> Int
rXmax :: Int
rXmax, Int
rYmax :: RuleContent -> Int
rYmax :: Int
rYmax}} <- (State -> COps) -> m COps
forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
getsState State -> COps
scops
  Actor
b <- (State -> Actor) -> m Actor
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 (cid :: Double
cid, (p0 :: Point
p0, bag :: ItemBag
bag)) =
        (Point -> (Double, (Point, (Point, ItemBag))))
-> [Point] -> [(Double, (Point, (Point, ItemBag)))]
forall a b. (a -> b) -> [a] -> [b]
map (\p :: Point
p -> (Double
cid, (Point
p, (Point
p0, ItemBag
bag)))) ([Point] -> [(Double, (Point, (Point, ItemBag)))])
-> [Point] -> [(Double, (Point, (Point, ItemBag)))]
forall a b. (a -> b) -> a -> b
$ Int -> Int -> Point -> [Point]
vicinityBounded Int
rXmax Int
rYmax 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 (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 :: (a, b) -> Int -> (a, b)
mix (benefit :: a
benefit, ppbag :: b
ppbag) dist :: Int
dist =
          let maxd :: Int
maxd = BfsDistance -> BfsDistance -> Int
subtractBfsDistance BfsDistance
maxBfsDistance BfsDistance
apartBfs
              v :: a
v = Int -> a
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> a) -> Int -> a
forall a b. (a -> b) -> a -> b
$ (1 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
maxd Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
dist) Int -> Int -> Int
forall a b. (Num a, Integral b) => a -> b -> a
^ (2 :: Int)
          in (a -> a
forall a b. (RealFrac a, Integral b) => a -> b
ceiling (a -> a) -> a -> a
forall a b. (a -> b) -> a -> b
$ a
benefit a -> a -> a
forall a. Num a => a -> a -> a
* a
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@(_, (p :: Point
p, _)) ->
         (Double, (Point, (Point, ItemBag)))
-> Int -> (Int, (Point, (Point, ItemBag)))
forall a a b. (RealFrac a, Integral a) => (a, 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 tactic, actors follow leader and so would
-- repeatedly move towards and away form 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 :: ActorId -> m Bool
condEnoughGearM aid :: ActorId
aid = do
  Actor
b <- (State -> Actor) -> m Actor
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 (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 followTactic :: Bool
followTactic = Player -> Tactic
ftactic (Faction -> Player
gplayer Faction
fact)
                     Tactic -> [Tactic] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Tactic
Ability.TFollow, Tactic
Ability.TFollowNoItems]
  [(ItemId, ItemFull)]
eqpAssocs <- (State -> [(ItemId, ItemFull)]) -> m [(ItemId, ItemFull)]
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]
  [(ItemId, Item)]
invAssocs <- (State -> [(ItemId, Item)]) -> m [(ItemId, Item)]
forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
getsState ((State -> [(ItemId, Item)]) -> m [(ItemId, Item)])
-> (State -> [(ItemId, Item)]) -> m [(ItemId, Item)]
forall a b. (a -> b) -> a -> b
$ ActorId -> CStore -> State -> [(ItemId, Item)]
getActorAssocs ActorId
aid CStore
CInv
  Bool -> m Bool
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
followTactic  -- 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 -> Int
forall a. Num a => a -> a -> a
+ [(ItemId, Item)] -> Int
forall a. [a] -> Int
length [(ItemId, Item)]
invAssocs Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= 5)

unexploredDepth :: MonadClientRead m => Bool -> LevelId -> m Bool
unexploredDepth :: Bool -> LevelId -> m Bool
unexploredDepth !Bool
up !LevelId
lidCurrent = do
  Dungeon
dungeon <- (State -> Dungeon) -> m Dungeon
forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
getsState State -> Dungeon
sdungeon
  EnumSet LevelId
explored <- (StateClient -> EnumSet LevelId) -> m (EnumSet LevelId)
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 (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 :: ActorId -> m [(Int, (Point, ItemBag))]
closestItems aid :: ActorId
aid = do
  Skills
actorMaxSk <- (State -> Skills) -> m Skills
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
  if Skill -> Skills -> Int
Ability.getSk Skill
Ability.SkMoveItem Skills
actorMaxSk Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= 0 then [(Int, (Point, ItemBag))] -> m [(Int, (Point, ItemBag))]
forall (m :: * -> *) a. Monad m => a -> m a
return []
  else do
    Actor
body <- (State -> Actor) -> m Actor
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 :: Level -> EnumMap Point ItemBag
lfloor :: EnumMap Point ItemBag
lfloor} <- 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
    if EnumMap Point ItemBag -> Bool
forall k a. EnumMap k a -> Bool
EM.null EnumMap Point ItemBag
lfloor then [(Int, (Point, ItemBag))] -> m [(Int, (Point, ItemBag))]
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 pbag :: b
pbag dist :: 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
* 10) Int -> Int -> Int
forall a. Integral a => a -> a -> a
`div` (Int
dist Int -> Int -> Int
forall a. Num a => a -> a -> a
+ 1)
            in (Int
v, b
pbag)
      [(Int, (Point, ItemBag))] -> m [(Int, (Point, ItemBag))]
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 (\(p :: Point
p, bag :: 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
lfloor)

-- | Closest (wrt paths) enemy actors.
closestFoes :: MonadClient m
            => [(ActorId, Actor)] -> ActorId -> m [(Int, (ActorId, Actor))]
closestFoes :: [(ActorId, Actor)] -> ActorId -> m [(Int, (ActorId, Actor))]
closestFoes foes :: [(ActorId, Actor)]
foes aid :: ActorId
aid =
  case [(ActorId, Actor)]
foes of
    [] -> [(Int, (ActorId, Actor))] -> m [(Int, (ActorId, Actor))]
forall (m :: * -> *) a. Monad m => a -> m a
return []
    _ -> 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@(_, b :: Actor
b) -> (Int -> (Int, (ActorId, Actor)))
-> Maybe Int -> Maybe (Int, (ActorId, Actor))
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 (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