{-# LANGUAGE TupleSections #-}
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
[(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
(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)
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)
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
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
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
| 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) =
(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
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)
(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
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
| Bool
otherwise = 0
(Bool, Word8) -> m (Bool, Word8)
forall (m :: * -> *) a. Monad m => a -> m a
return (Bool
canMove, Word8
skill)
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
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
Bool -> Bool -> Bool
|| BfsDistance
dist BfsDistance -> BfsDistance -> Bool
forall a. Ord a => a -> a -> Bool
>= BfsDistance
apartBfs
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
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
| 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]
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
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
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{} ->
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]
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
Just (IK.Ascend up :: Bool
up) ->
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
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)
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
_ ->
if FleeViaStairsOrEscape
fleeVia FleeViaStairsOrEscape -> [FleeViaStairsOrEscape] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [FleeViaStairsOrEscape
ViaNothing, FleeViaStairsOrEscape
ViaAnything]
then
let sacrificeForExperiment :: Double
sacrificeForExperiment = 101
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
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
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
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
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
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
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
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
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)
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