{-# 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
, closestStashes, oursExploringAssocs, closestHideout
#ifdef EXPOSE_INTERNAL
, unexploredDepth, updatePathFromBfs
#endif
) where
import Prelude ()
import Game.LambdaHack.Core.Prelude
import qualified Data.EnumMap.Strict as EM
import qualified Data.EnumSet as ES
import Data.Word
import Game.LambdaHack.Client.Bfs
import Game.LambdaHack.Client.CommonM
import Game.LambdaHack.Client.MonadClient
import Game.LambdaHack.Client.State
import Game.LambdaHack.Common.Actor
import Game.LambdaHack.Common.ActorState
import Game.LambdaHack.Common.Faction
import Game.LambdaHack.Common.Item
import qualified Game.LambdaHack.Common.ItemAspect as IA
import Game.LambdaHack.Common.Kind
import Game.LambdaHack.Common.Level
import Game.LambdaHack.Common.MonadStateRead
import Game.LambdaHack.Common.Perception
import Game.LambdaHack.Common.Point
import qualified Game.LambdaHack.Common.PointArray as PointArray
import Game.LambdaHack.Common.State
import qualified Game.LambdaHack.Common.Tile as Tile
import Game.LambdaHack.Common.Time
import Game.LambdaHack.Common.Types
import Game.LambdaHack.Common.Vector
import qualified Game.LambdaHack.Content.CaveKind as CK
import 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.Core.Random
import qualified Game.LambdaHack.Definition.Ability as Ability
import Game.LambdaHack.Definition.Defs
invalidateBfsAid :: MonadClient m => ActorId -> m ()
invalidateBfsAid :: ActorId -> m ()
invalidateBfsAid ActorId
aid =
(StateClient -> StateClient) -> m ()
forall (m :: * -> *).
MonadClient m =>
(StateClient -> StateClient) -> m ()
modifyClient ((StateClient -> StateClient) -> m ())
-> (StateClient -> StateClient) -> m ()
forall a b. (a -> b) -> a -> b
$ \StateClient
cli ->
StateClient
cli {sbfsD :: 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 -> BfsAndPath
forall a b. a -> b -> a
const BfsAndPath
BfsInvalid) ActorId
aid (StateClient -> EnumMap ActorId BfsAndPath
sbfsD StateClient
cli)}
invalidateBfsPathAid :: MonadClient m => ActorId -> m ()
invalidateBfsPathAid :: ActorId -> m ()
invalidateBfsPathAid ActorId
aid = do
let f :: BfsAndPath -> BfsAndPath
f BfsAndPath
BfsInvalid = BfsAndPath
BfsInvalid
f (BfsAndPath Array BfsDistance
bfsArr EnumMap Point AndPath
_) = Array BfsDistance -> EnumMap Point AndPath -> BfsAndPath
BfsAndPath Array BfsDistance
bfsArr EnumMap Point AndPath
forall k a. EnumMap k a
EM.empty
(StateClient -> StateClient) -> m ()
forall (m :: * -> *).
MonadClient m =>
(StateClient -> StateClient) -> m ()
modifyClient ((StateClient -> StateClient) -> m ())
-> (StateClient -> StateClient) -> m ()
forall a b. (a -> b) -> a -> b
$ \StateClient
cli -> StateClient
cli {sbfsD :: 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 LevelId
lid = do
Level
lvl <- LevelId -> m Level
forall (m :: * -> *). MonadStateRead m => LevelId -> m Level
getLevel LevelId
lid
(ActorId -> m ()) -> [ActorId] -> m ()
forall (t :: * -> *) (m :: * -> *) a.
(Foldable t, Monad m) =>
(a -> m ()) -> t a -> m ()
mapM_ ActorId -> m ()
forall (m :: * -> *). MonadClient m => ActorId -> m ()
invalidateBfsAid ([ActorId] -> m ()) -> [ActorId] -> m ()
forall a b. (a -> b) -> a -> b
$ EnumMap Point ActorId -> [ActorId]
forall k a. EnumMap k a -> [a]
EM.elems (EnumMap Point ActorId -> [ActorId])
-> EnumMap Point ActorId -> [ActorId]
forall a b. (a -> b) -> a -> b
$ Level -> EnumMap Point ActorId
lbig Level
lvl
invalidateBfsPathLid :: MonadClient m => Actor -> m ()
invalidateBfsPathLid :: Actor -> m ()
invalidateBfsPathLid Actor
body = do
Level
lvl <- LevelId -> m Level
forall (m :: * -> *). MonadStateRead m => LevelId -> m Level
getLevel (LevelId -> m Level) -> LevelId -> m Level
forall a b. (a -> b) -> a -> b
$ Actor -> LevelId
blid Actor
body
let close :: (Point, ActorId) -> Bool
close (Point
p, ActorId
_) = Point -> Point -> Int
chessDist Point
p (Actor -> Point
bpos Actor
body) Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
3
((Point, ActorId) -> m ()) -> [(Point, ActorId)] -> m ()
forall (t :: * -> *) (m :: * -> *) a.
(Foldable t, Monad m) =>
(a -> m ()) -> t a -> m ()
mapM_ (ActorId -> m ()
forall (m :: * -> *). MonadClient m => ActorId -> m ()
invalidateBfsPathAid (ActorId -> m ())
-> ((Point, ActorId) -> ActorId) -> (Point, ActorId) -> m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Point, ActorId) -> ActorId
forall a b. (a, b) -> b
snd) ([(Point, ActorId)] -> m ()) -> [(Point, ActorId)] -> m ()
forall a b. (a -> b) -> a -> b
$ ((Point, ActorId) -> Bool)
-> [(Point, ActorId)] -> [(Point, ActorId)]
forall a. (a -> Bool) -> [a] -> [a]
filter (Point, ActorId) -> Bool
close ([(Point, ActorId)] -> [(Point, ActorId)])
-> [(Point, ActorId)] -> [(Point, ActorId)]
forall a b. (a -> b) -> a -> b
$ EnumMap Point ActorId -> [(Point, ActorId)]
forall k a. Enum k => EnumMap k a -> [(k, a)]
EM.assocs (EnumMap Point ActorId -> [(Point, ActorId)])
-> EnumMap Point ActorId -> [(Point, ActorId)]
forall a b. (a -> b) -> a -> b
$ Level -> EnumMap Point ActorId
lbig Level
lvl
invalidateBfsAll :: MonadClient m => m ()
invalidateBfsAll :: m ()
invalidateBfsAll =
(StateClient -> StateClient) -> m ()
forall (m :: * -> *).
MonadClient m =>
(StateClient -> StateClient) -> m ()
modifyClient ((StateClient -> StateClient) -> m ())
-> (StateClient -> StateClient) -> m ()
forall a b. (a -> b) -> a -> b
$ \StateClient
cli -> StateClient
cli {sbfsD :: 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 BfsAndPath
BfsInvalid = BfsAndPath
BfsInvalid
f (BfsAndPath Array BfsDistance
bfsArr EnumMap Point AndPath
_) = Array BfsDistance -> EnumMap Point AndPath -> BfsAndPath
BfsAndPath Array BfsDistance
bfsArr EnumMap Point AndPath
forall k a. EnumMap k a
EM.empty
(StateClient -> StateClient) -> m ()
forall (m :: * -> *).
MonadClient m =>
(StateClient -> StateClient) -> m ()
modifyClient ((StateClient -> StateClient) -> m ())
-> (StateClient -> StateClient) -> m ()
forall a b. (a -> b) -> a -> b
$ \StateClient
cli -> StateClient
cli {sbfsD :: 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 Bool
canMove Word8
alterSkill0 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 Word8
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 Bool
canMove BfsAndPath
bfsAndPathOld 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 (Array BfsDistance
oldBfsArr, EnumMap Point AndPath
oldBfsPath) = case BfsAndPath
bfsAndPathOld of
(BfsAndPath Array BfsDistance
bfsArr EnumMap Point AndPath
bfsPath) -> (Array BfsDistance
bfsArr, EnumMap Point AndPath
bfsPath)
BfsAndPath
BfsInvalid -> [Char] -> (Array BfsDistance, EnumMap Point AndPath)
forall a. HasCallStack => [Char] -> a
error ([Char] -> (Array BfsDistance, EnumMap Point AndPath))
-> [Char] -> (Array BfsDistance, EnumMap Point AndPath)
forall a b. (a -> b) -> a -> b
$ [Char]
"" [Char] -> (BfsAndPath, ActorId, Point) -> [Char]
forall v. Show v => [Char] -> v -> [Char]
`showFailure` (BfsAndPath
bfsAndPathOld, ActorId
aid, Point
target)
let bfsArr :: Array BfsDistance
bfsArr = Array BfsDistance
oldBfsArr
if Bool -> Bool
not Bool
canMove
then (Array BfsDistance, Maybe AndPath)
-> m (Array BfsDistance, Maybe AndPath)
forall (m :: * -> *) a. Monad m => a -> m a
return (Array BfsDistance
bfsArr, Maybe AndPath
forall a. Maybe a
Nothing)
else do
ActorId -> Actor
getActorB <- (State -> ActorId -> Actor) -> m (ActorId -> Actor)
forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
getsState ((State -> ActorId -> Actor) -> m (ActorId -> Actor))
-> (State -> ActorId -> Actor) -> m (ActorId -> Actor)
forall a b. (a -> b) -> a -> b
$ (ActorId -> State -> Actor) -> State -> ActorId -> Actor
forall a b c. (a -> b -> c) -> b -> a -> c
flip ActorId -> State -> Actor
getActorBody
let b :: Actor
b = ActorId -> Actor
getActorB ActorId
aid
Faction
fact <- (State -> Faction) -> m Faction
forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
getsState ((State -> Faction) -> m Faction)
-> (State -> Faction) -> m Faction
forall a b. (a -> b) -> a -> b
$ (EnumMap FactionId Faction -> FactionId -> Faction
forall k a. Enum k => EnumMap k a -> k -> a
EM.! Actor -> FactionId
bfid Actor
b) (EnumMap FactionId Faction -> Faction)
-> (State -> EnumMap FactionId Faction) -> State -> Faction
forall b c a. (b -> c) -> (a -> b) -> a -> c
. State -> EnumMap FactionId Faction
sfactionD
Int
seps <- (StateClient -> Int) -> m Int
forall (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 (Actor -> LevelId
blid Actor
b)
let !lalter :: Array Word8
lalter = AlterLid
salter AlterLid -> LevelId -> Array Word8
forall k a. Enum k => EnumMap k a -> k -> a
EM.! Actor -> LevelId
blid Actor
b
fovLit :: Int -> Bool
fovLit Int
p = TileSpeedup -> ContentId TileKind -> Bool
Tile.isLit TileSpeedup
coTileSpeedup (ContentId TileKind -> Bool) -> ContentId TileKind -> Bool
forall a b. (a -> b) -> a -> b
$ UnboxRep (ContentId TileKind) -> ContentId TileKind
forall c. UnboxRepClass c => UnboxRep c -> c
PointArray.fromUnboxRep
(UnboxRep (ContentId TileKind) -> ContentId TileKind)
-> UnboxRep (ContentId TileKind) -> ContentId TileKind
forall a b. (a -> b) -> a -> b
$ Level -> TileMap
ltile Level
lvl TileMap -> Int -> UnboxRep (ContentId TileKind)
forall c. UnboxRepClass c => Array c -> Int -> UnboxRep c
`PointArray.accessI` Int
p
addFoeVicinity :: (Point, ActorId) -> [Point]
addFoeVicinity (Point
p, ActorId
aid2) =
let b2 :: Actor
b2 = ActorId -> Actor
getActorB ActorId
aid2
in if FactionId -> Faction -> FactionId -> Bool
isFoe (Actor -> FactionId
bfid Actor
b) Faction
fact (Actor -> FactionId
bfid Actor
b2)
then Point
p Point -> [Point] -> [Point]
forall a. a -> [a] -> [a]
: Point -> [Point]
vicinityUnsafe Point
p
else [Point
p]
bigAdj :: EnumSet Point
bigAdj = [Point] -> EnumSet Point
forall k. Enum k => [k] -> EnumSet k
ES.fromList ([Point] -> EnumSet Point) -> [Point] -> EnumSet Point
forall a b. (a -> b) -> a -> b
$ ((Point, ActorId) -> [Point]) -> [(Point, ActorId)] -> [Point]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (Point, ActorId) -> [Point]
addFoeVicinity ([(Point, ActorId)] -> [Point]) -> [(Point, ActorId)] -> [Point]
forall a b. (a -> b) -> a -> b
$ EnumMap Point ActorId -> [(Point, ActorId)]
forall k a. Enum k => EnumMap k a -> [(k, a)]
EM.assocs
(EnumMap Point ActorId -> [(Point, ActorId)])
-> EnumMap Point ActorId -> [(Point, ActorId)]
forall a b. (a -> b) -> a -> b
$ Point -> EnumMap Point ActorId -> EnumMap Point ActorId
forall k a. Enum k => k -> EnumMap k a -> EnumMap k a
EM.delete Point
source (EnumMap Point ActorId -> EnumMap Point ActorId)
-> EnumMap Point ActorId -> EnumMap Point ActorId
forall a b. (a -> b) -> a -> b
$ Level -> EnumMap Point ActorId
lbig Level
lvl
!source :: Point
source = Actor -> Point
bpos Actor
b
!mpath :: Maybe AndPath
mpath = EnumSet Point
-> Array Word8
-> (Int -> Bool)
-> Point
-> Point
-> Int
-> Array BfsDistance
-> Maybe AndPath
findPathBfs EnumSet Point
bigAdj Array Word8
lalter Int -> Bool
fovLit Point
source Point
target Int
seps Array BfsDistance
bfsArr
!bfsPath :: EnumMap Point AndPath
bfsPath =
EnumMap Point AndPath
-> (AndPath -> EnumMap Point AndPath)
-> Maybe AndPath
-> EnumMap Point AndPath
forall b a. b -> (a -> b) -> Maybe a -> b
maybe EnumMap Point AndPath
oldBfsPath (\AndPath
path -> Point -> AndPath -> EnumMap Point AndPath -> EnumMap Point AndPath
forall k a. Enum k => k -> a -> EnumMap k a -> EnumMap k a
EM.insert Point
target AndPath
path EnumMap Point AndPath
oldBfsPath) Maybe AndPath
mpath
bap :: BfsAndPath
bap = Array BfsDistance -> EnumMap Point AndPath -> BfsAndPath
BfsAndPath Array BfsDistance
bfsArr EnumMap Point AndPath
bfsPath
(StateClient -> StateClient) -> m ()
forall (m :: * -> *).
MonadClient m =>
(StateClient -> StateClient) -> m ()
modifyClient ((StateClient -> StateClient) -> m ())
-> (StateClient -> StateClient) -> m ()
forall a b. (a -> b) -> a -> b
$ \StateClient
cli -> StateClient
cli {sbfsD :: 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 ActorId
aid 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 Array BfsDistance
bfsArr EnumMap Point AndPath
bfsPath) ->
case Point -> EnumMap Point AndPath -> Maybe AndPath
forall k a. Enum k => k -> EnumMap k a -> Maybe a
EM.lookup Point
target EnumMap Point AndPath
bfsPath of
Maybe AndPath
Nothing -> do
(!Bool
canMove, Word8
_) <- ActorId -> m (Bool, Word8)
forall (m :: * -> *).
MonadClientRead m =>
ActorId -> m (Bool, Word8)
condBFS ActorId
aid
Bool
-> BfsAndPath
-> ActorId
-> Point
-> m (Array BfsDistance, Maybe AndPath)
forall (m :: * -> *).
MonadClient m =>
Bool
-> BfsAndPath
-> ActorId
-> Point
-> m (Array BfsDistance, Maybe AndPath)
updatePathFromBfs Bool
canMove BfsAndPath
bap ActorId
aid Point
target
mpath :: Maybe AndPath
mpath@Just{} -> (Array BfsDistance, Maybe AndPath)
-> m (Array BfsDistance, Maybe AndPath)
forall (m :: * -> *) a. Monad m => a -> m a
return (Array BfsDistance
bfsArr, Maybe AndPath
mpath)
Maybe BfsAndPath
_ -> do
(Bool
canMove, Word8
alterSkill) <- ActorId -> m (Bool, Word8)
forall (m :: * -> *).
MonadClientRead m =>
ActorId -> m (Bool, Word8)
condBFS ActorId
aid
!Array BfsDistance
bfsArr <- Bool -> Word8 -> ActorId -> m (Array BfsDistance)
forall (m :: * -> *).
MonadClientRead m =>
Bool -> Word8 -> ActorId -> m (Array BfsDistance)
createBfs Bool
canMove Word8
alterSkill ActorId
aid
let bfsPath :: EnumMap k a
bfsPath = EnumMap k a
forall k a. EnumMap k a
EM.empty
Bool
-> BfsAndPath
-> ActorId
-> Point
-> m (Array BfsDistance, Maybe AndPath)
forall (m :: * -> *).
MonadClient m =>
Bool
-> BfsAndPath
-> ActorId
-> Point
-> m (Array BfsDistance, Maybe AndPath)
updatePathFromBfs Bool
canMove (Array BfsDistance -> EnumMap Point AndPath -> BfsAndPath
BfsAndPath Array BfsDistance
bfsArr EnumMap Point AndPath
forall k a. EnumMap k a
bfsPath) ActorId
aid Point
target
getCacheBfs :: MonadClient m => ActorId -> m (PointArray.Array BfsDistance)
getCacheBfs :: ActorId -> m (Array BfsDistance)
getCacheBfs 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 Array BfsDistance
bfsArr EnumMap Point AndPath
_) -> Array BfsDistance -> m (Array BfsDistance)
forall (m :: * -> *) a. Monad m => a -> m a
return Array BfsDistance
bfsArr
Maybe BfsAndPath
_ -> do
(Bool
canMove, Word8
alterSkill) <- ActorId -> m (Bool, Word8)
forall (m :: * -> *).
MonadClientRead m =>
ActorId -> m (Bool, Word8)
condBFS ActorId
aid
!Array BfsDistance
bfsArr <- Bool -> Word8 -> ActorId -> m (Array BfsDistance)
forall (m :: * -> *).
MonadClientRead m =>
Bool -> Word8 -> ActorId -> m (Array BfsDistance)
createBfs Bool
canMove Word8
alterSkill ActorId
aid
let bfsPath :: EnumMap k a
bfsPath = EnumMap k a
forall k a. EnumMap k a
EM.empty
(StateClient -> StateClient) -> m ()
forall (m :: * -> *).
MonadClient m =>
(StateClient -> StateClient) -> m ()
modifyClient ((StateClient -> StateClient) -> m ())
-> (StateClient -> StateClient) -> m ()
forall a b. (a -> b) -> a -> b
$ \StateClient
cli ->
StateClient
cli {sbfsD :: 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 ActorId
aid 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 Int
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 ActorId
aid 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{Int
[Point]
Point
pathLen :: AndPath -> Int
pathGoal :: AndPath -> Point
pathList :: AndPath -> [Point]
pathSource :: AndPath -> Point
pathLen :: Int
pathGoal :: Point
pathList :: [Point]
pathSource :: Point
..}) =
let ([Point]
walkable, [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
[Point]
_ | [Point] -> Bool
forall a. [a] -> Bool
null [Point]
walkable -> TgtAndPath :: Target -> Maybe AndPath -> TgtAndPath
TgtAndPath{Maybe AndPath
Target
tapPath :: Maybe AndPath
tapTgt :: Target
tapPath :: Maybe AndPath
tapTgt :: Target
..}
[] -> TgtAndPath :: Target -> Maybe AndPath -> TgtAndPath
TgtAndPath{Maybe AndPath
Target
tapPath :: Maybe AndPath
tapTgt :: Target
tapPath :: Maybe AndPath
tapTgt :: Target
..}
[Point
g] | Point
g Point -> Point -> Bool
forall a. Eq a => a -> a -> Bool
== Point
pathGoal -> TgtAndPath :: Target -> Maybe AndPath -> TgtAndPath
TgtAndPath{Maybe AndPath
Target
tapPath :: Maybe AndPath
tapTgt :: Target
tapPath :: Maybe AndPath
tapTgt :: Target
..}
Point
newGoal : [Point]
_ ->
let newTgt :: Target
newTgt = TGoal -> LevelId -> Point -> Target
TPoint TGoal
TBlock (Actor -> LevelId
blid Actor
b) Point
newGoal
newPath :: AndPath
newPath = AndPath :: Point -> [Point] -> Point -> Int -> AndPath
AndPath{ pathSource :: Point
pathSource = Actor -> Point
bpos Actor
b
, pathList :: [Point]
pathList = [Point]
walkable
, pathGoal :: Point
pathGoal = Point
newGoal
, pathLen :: Int
pathLen = [Point] -> Int
forall a. [a] -> Int
length [Point]
walkable Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1 }
in TgtAndPath :: 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 Maybe AndPath
Nothing = TgtAndPath :: 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
$ Maybe ActorId -> LevelId -> Maybe Target -> State -> Maybe Point
aidTgtToPos (ActorId -> Maybe ActorId
forall a. a -> Maybe a
Just ActorId
aid) (Actor -> LevelId
blid Actor
b) (Target -> Maybe Target
forall a. a -> Maybe a
Just Target
tapTgt)
case Maybe Point
mpos of
Maybe Point
Nothing -> TgtAndPath -> m TgtAndPath
forall (m :: * -> *) a. Monad m => a -> m a
return TgtAndPath :: Target -> Maybe AndPath -> TgtAndPath
TgtAndPath{Target
tapTgt :: Target
tapTgt :: Target
tapTgt, tapPath :: Maybe AndPath
tapPath=Maybe AndPath
forall a. Maybe a
Nothing}
Just Point
p -> do
Maybe AndPath
path <- ActorId -> Point -> m (Maybe AndPath)
forall (m :: * -> *).
MonadClient m =>
ActorId -> Point -> m (Maybe AndPath)
getCachePath ActorId
aid Point
p
TgtAndPath -> m TgtAndPath
forall (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 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
- Word8
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 Int
0 (Int -> Int) -> Int -> Int
forall a b. (a -> b) -> a -> b
$ Skill -> Skills -> Int
Ability.getSk Skill
Ability.SkAlter Skills
actorMaxSk)
canMove :: Bool
canMove = Skill -> Skills -> Int
Ability.getSk Skill
Ability.SkMove Skills
actorMaxSk Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
0
Bool -> Bool -> Bool
|| Skill -> Skills -> Int
Ability.getSk Skill
Ability.SkDisplace Skills
actorMaxSk Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
0
Bool -> Bool -> Bool
|| Skill -> Skills -> Int
Ability.getSk Skill
Ability.SkProject Skills
actorMaxSk Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
0
Int
smarkSuspect <- (StateClient -> Int) -> m Int
forall (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
> Int
0 Bool -> Bool -> Bool
|| Bool
underAI
skill :: Word8
skill | Bool
enterSuspect = Word8
alterSkill
| Bool
otherwise = Word8
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 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 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 Point
pos =
let vic :: [Point]
vic = Point -> [Point]
vicinityUnsafe Point
pos
countUnknown :: Int -> Point -> Int
countUnknown :: Int -> Point -> Int
countUnknown Int
c Point
p =
if ContentId TileKind -> Bool
isUknownSpace (ContentId TileKind -> Bool) -> ContentId TileKind -> Bool
forall a b. (a -> b) -> a -> b
$ Level
lvl Level -> Point -> ContentId TileKind
`at` Point
p then Int
c Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1 else Int
c
in (Int -> Point -> Int) -> Int -> [Point] -> Int
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' Int -> Point -> Int
countUnknown Int
0 [Point]
vic
cmp :: Point -> Point -> Ordering
cmp = (Point -> Int) -> Point -> Point -> Ordering
forall a b. Ord a => (b -> a) -> b -> b -> Ordering
comparing Point -> Int
unknownAround
in Point -> Maybe Point
forall a. a -> Maybe a
Just (Point -> Maybe Point) -> Point -> Maybe Point
forall a b. (a -> b) -> a -> b
$ (Point -> Point -> Ordering) -> [Point] -> Point
forall (t :: * -> *) a.
Foldable t =>
(a -> a -> Ordering) -> t a -> a
maximumBy Point -> Point -> Ordering
cmp [Point]
closestPoss
closestSmell :: MonadClient m => ActorId -> m [(Int, (Point, Time))]
closestSmell :: ActorId -> m [(Int, (Point, Time))]
closestSmell 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 (\(Point
p, Time
sm) -> Time
sm Time -> Time -> Bool
forall a. Ord a => a -> a -> Bool
> Time
ltime Bool -> Bool -> Bool
&& Point
p Point -> Point -> Bool
forall a. Eq a => a -> a -> Bool
/= Actor -> Point
bpos Actor
body)
(SmellMap -> [(Point, Time)]
forall k a. Enum k => EnumMap k a -> [(k, a)]
EM.assocs SmellMap
lsmell)
case [(Point, Time)]
smells of
[] -> [(Int, (Point, Time))] -> m [(Int, (Point, Time))]
forall (m :: * -> *) a. Monad m => a -> m a
return []
[(Point, Time)]
_ -> do
Array BfsDistance
bfs <- ActorId -> m (Array BfsDistance)
forall (m :: * -> *).
MonadClient m =>
ActorId -> m (Array BfsDistance)
getCacheBfs ActorId
aid
let ts :: [(Int, (Point, Time))]
ts = ((Point, Time) -> Maybe (Int, (Point, Time)))
-> [(Point, Time)] -> [(Int, (Point, Time))]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe (\x :: (Point, Time)
x@(Point
p, Time
_) -> (Int -> (Int, (Point, Time)))
-> Maybe Int -> Maybe (Int, (Point, Time))
forall (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, Time))
-> [(Int, (Point, Time))] -> [(Int, (Point, Time))]
forall b a. Ord b => (a -> b) -> [a] -> [a]
sortOn ((Int, (Point, Time)) -> Int
forall a b. (a, b) -> a
fst ((Int, (Point, Time)) -> Int)
-> ((Int, (Point, Time)) -> Time)
-> (Int, (Point, Time))
-> (Int, Time)
forall (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 FleeViaStairsOrEscape
fleeVia ActorId
aid [(Point, ItemBag)]
pbags = do
COps{ContentData CaveKind
cocave :: COps -> ContentData CaveKind
cocave :: ContentData CaveKind
cocave, 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
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)
[(ActorId, Actor)]
oursExploring <- (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
$ FactionId -> State -> [(ActorId, Actor)]
oursExploringAssocs (Actor -> FactionId
bfid Actor
b)
let oursExploringLid :: [(ActorId, Actor)]
oursExploringLid =
((ActorId, Actor) -> Bool)
-> [(ActorId, Actor)] -> [(ActorId, Actor)]
forall a. (a -> Bool) -> [a] -> [a]
filter (\(ActorId
_, Actor
body) -> Actor -> LevelId
blid Actor
body LevelId -> LevelId -> Bool
forall a. Eq a => a -> a -> Bool
== Actor -> LevelId
blid Actor
b) [(ActorId, Actor)]
oursExploring
spawnFreqs :: Freqs ItemKind
spawnFreqs = CaveKind -> Freqs ItemKind
CK.cactorFreq (CaveKind -> Freqs ItemKind) -> CaveKind -> Freqs ItemKind
forall a b. (a -> b) -> a -> b
$ ContentData CaveKind -> ContentId CaveKind -> CaveKind
forall a. ContentData a -> ContentId a -> a
okind ContentData CaveKind
cocave (ContentId CaveKind -> CaveKind) -> ContentId CaveKind -> CaveKind
forall a b. (a -> b) -> a -> b
$ Level -> ContentId CaveKind
lkind Level
lvl
hasGroup :: GroupName ItemKind -> Bool
hasGroup GroupName ItemKind
grp = Int -> Maybe Int -> Int
forall a. a -> Maybe a -> a
fromMaybe Int
0 (GroupName ItemKind -> Freqs ItemKind -> Maybe Int
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup GroupName ItemKind
grp Freqs ItemKind
spawnFreqs) Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
0
lvlSpawnsUs :: Bool
lvlSpawnsUs = (GroupName ItemKind -> Bool) -> [GroupName ItemKind] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any GroupName ItemKind -> Bool
hasGroup ([GroupName ItemKind] -> Bool) -> [GroupName ItemKind] -> Bool
forall a b. (a -> b) -> a -> b
$ Player -> [GroupName ItemKind]
fgroups (Faction -> Player
gplayer Faction
fact)
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
Bool
condOurAdj <- (State -> Bool) -> m Bool
forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
getsState ((State -> Bool) -> m Bool) -> (State -> Bool) -> m Bool
forall a b. (a -> b) -> a -> b
$ ((ActorId, Actor) -> Bool) -> [(ActorId, Actor)] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (\(ActorId
_, Actor
b2) -> FactionId -> Faction -> FactionId -> Bool
isFriend (Actor -> FactionId
bfid Actor
b) Faction
fact (Actor -> FactionId
bfid Actor
b2))
([(ActorId, Actor)] -> Bool)
-> (State -> [(ActorId, Actor)]) -> State -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Actor -> State -> [(ActorId, Actor)]
adjacentBigAssocs Actor
b
Bool
unexploredTrue <- Bool -> LevelId -> m Bool
forall (m :: * -> *).
MonadClientRead m =>
Bool -> LevelId -> m Bool
unexploredDepth Bool
True (Actor -> LevelId
blid Actor
b)
Bool
unexploredFalse <- Bool -> LevelId -> m Bool
forall (m :: * -> *).
MonadClientRead m =>
Bool -> LevelId -> m Bool
unexploredDepth Bool
False (Actor -> LevelId
blid Actor
b)
Bool
condEnoughGear <- ActorId -> m Bool
forall (m :: * -> *). MonadClientRead m => ActorId -> m Bool
condEnoughGearM ActorId
aid
DiscoveryBenefit
discoBenefit <- (StateClient -> DiscoveryBenefit) -> m DiscoveryBenefit
forall (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 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 ItemId
iid = ItemKind -> [Effect]
IK.ieffects (ItemKind -> [Effect]) -> ItemKind -> [Effect]
forall a b. (a -> b) -> a -> b
$ ItemId -> ItemKind
getKind ItemId
iid
feats :: ItemBag -> [Effect]
feats ItemBag
bag = (ItemId -> [Effect]) -> [ItemId] -> [Effect]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap ItemId -> [Effect]
iidToEffs ([ItemId] -> [Effect]) -> [ItemId] -> [Effect]
forall a b. (a -> b) -> a -> b
$ ItemBag -> [ItemId]
forall k a. Enum k => EnumMap k a -> [k]
EM.keys ItemBag
bag
bens :: (Point, ItemBag) -> Double
bens (Point
_, ItemBag
bag) = case (Effect -> Bool) -> [Effect] -> Maybe Effect
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Maybe a
find Effect -> Bool
IK.isEffEscapeOrAscend ([Effect] -> Maybe Effect) -> [Effect] -> Maybe Effect
forall a b. (a -> b) -> a -> b
$ ItemBag -> [Effect]
feats ItemBag
bag of
Just IK.Escape{} ->
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 Double
10
else Double
0
Just (IK.Ascend 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
> Int
0)
unexpForth :: Bool
unexpForth = if Bool
up then Bool
unexploredTrue else Bool
unexploredFalse
unexpBack :: Bool
unexpBack = if Bool -> Bool
not Bool
up then Bool
unexploredTrue else Bool
unexploredFalse
aiCond :: Bool
aiCond = if Bool
unexpForth
then Bool
easier Bool -> Bool -> Bool
&& Bool
condEnoughGear
Bool -> Bool -> Bool
|| (Bool -> Bool
not Bool
unexpBack Bool -> Bool -> Bool
|| Bool
easier) Bool -> Bool -> Bool
&& Bool
lidExplored
else Bool -> Bool
not Bool
unexpBack Bool -> Bool -> Bool
&& Bool
easier Bool -> Bool -> Bool
&& Bool
allExplored
Bool -> Bool -> Bool
&& [Point] -> Bool
forall a. [a] -> Bool
null (Level -> [Point]
lescape Level
lvl)
v :: Double
v = if Bool
aiCond then if Bool
easier then Double
10 else Double
1 else Double
0
guardingStash :: Bool
guardingStash = case Faction -> Maybe (LevelId, Point)
gstash Faction
fact of
Maybe (LevelId, Point)
Nothing -> Bool
False
Just (LevelId
lid, Point
p) ->
LevelId
lid LevelId -> LevelId -> Bool
forall a. Eq a => a -> a -> Bool
== Actor -> LevelId
blid Actor
b
Bool -> Bool -> Bool
&& ([(ActorId, Actor)] -> Int
forall a. [a] -> Int
length [(ActorId, Actor)]
oursExploring Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
1
Bool -> Bool -> Bool
|| Bool
lvlSpawnsUs)
Bool -> Bool -> Bool
&& ([(ActorId, Actor)] -> Int
forall a. [a] -> Int
length [(ActorId, Actor)]
oursExploringLid Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
1
Bool -> Bool -> Bool
|| Point
p Point -> Point -> Bool
forall a. Eq a => a -> a -> Bool
== Actor -> Point
bpos Actor
b Bool -> Bool -> Bool
&& Bool -> Bool
not Bool
condOurAdj)
in case FleeViaStairsOrEscape
fleeVia of
FleeViaStairsOrEscape
_ | Bool
guardingStash -> Double
0
FleeViaStairsOrEscape
ViaStairsUp | Bool
up -> Double
1
FleeViaStairsOrEscape
ViaStairsDown | Bool -> Bool
not Bool
up -> Double
1
FleeViaStairsOrEscape
ViaStairs -> Double
v
FleeViaStairsOrEscape
ViaExit -> Double
v
FleeViaStairsOrEscape
ViaAnything -> Double
v
FleeViaStairsOrEscape
_ -> Double
0
Maybe Effect
_ ->
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 = Double
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 (\ItemId
iid ->
Benefit -> Double
benApply (Benefit -> Double) -> Benefit -> Double
forall a b. (a -> b) -> a -> b
$ DiscoveryBenefit
discoBenefit DiscoveryBenefit -> ItemId -> Benefit
forall k a. Enum k => EnumMap k a -> k -> a
EM.! ItemId
iid) (ItemBag -> [ItemId]
forall k a. Enum k => EnumMap k a -> [k]
EM.keys ItemBag
bag)
in Double -> Double -> Double
forall a. Ord a => a -> a -> a
min Double
1000 (Double -> Double) -> Double -> Double
forall a b. (a -> b) -> a -> b
$ Double
sacrificeForExperiment Double -> Double -> Double
forall a. Num a => a -> a -> a
+ Double
sumBen
else Double
0
underFeet :: Point -> Bool
underFeet Point
p = Point
p Point -> Point -> Bool
forall a. Eq a => a -> a -> Bool
== Actor -> Point
bpos Actor
b
f :: (Point, ItemBag) -> Bool
f (Point
p, ItemBag
_) = Point -> Bool
underFeet Point
p
Bool -> Bool -> Bool
|| Int
alterSkill Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int -> Int
forall a. Enum a => a -> Int
fromEnum (Point -> Int
alterMinSkill Point
p)
Bool -> Bool -> Bool
|| TileSpeedup -> ContentId TileKind -> Bool
Tile.isSuspect TileSpeedup
coTileSpeedup (Level
lvl Level -> Point -> ContentId TileKind
`at` Point
p)
Bool -> Bool -> Bool
&& Int
alterSkill Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
2
benFeats :: [(Double, (Point, ItemBag))]
benFeats = ((Point, ItemBag) -> (Double, (Point, ItemBag)))
-> [(Point, ItemBag)] -> [(Double, (Point, ItemBag))]
forall a b. (a -> b) -> [a] -> [b]
map (\(Point, ItemBag)
pbag -> ((Point, ItemBag) -> Double
bens (Point, ItemBag)
pbag, (Point, ItemBag)
pbag)) ([(Point, ItemBag)] -> [(Double, (Point, ItemBag))])
-> [(Point, ItemBag)] -> [(Double, (Point, ItemBag))]
forall a b. (a -> b) -> a -> b
$ ((Point, ItemBag) -> Bool)
-> [(Point, ItemBag)] -> [(Point, ItemBag)]
forall a. (a -> Bool) -> [a] -> [a]
filter (Point, ItemBag) -> Bool
f [(Point, ItemBag)]
pbags
considered :: (Double, (Point, ItemBag)) -> Bool
considered (Double
benefitAndSacrifice, (Point
p, ItemBag
_bag)) =
Double
benefitAndSacrifice Double -> Double -> Bool
forall a. Ord a => a -> a -> Bool
> Double
0
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 FleeViaStairsOrEscape
fleeVia ActorId
aid = do
COps{corule :: COps -> RuleContent
corule=RuleContent{Int
rWidthMax :: RuleContent -> Int
rWidthMax :: Int
rWidthMax, Int
rHeightMax :: RuleContent -> Int
rHeightMax :: Int
rHeightMax}} <- (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 (Double
cid, (Point
p0, ItemBag
bag)) =
(Point -> (Double, (Point, (Point, ItemBag))))
-> [Point] -> [(Double, (Point, (Point, ItemBag)))]
forall a b. (a -> b) -> [a] -> [b]
map (\Point
p -> (Double
cid, (Point
p, (Point
p0, ItemBag
bag))))
(Int -> Int -> Point -> [Point]
vicinityBounded Int
rWidthMax Int
rHeightMax Point
p0)
vicAll :: [(Double, (Point, (Point, ItemBag)))]
vicAll = ((Double, (Point, ItemBag))
-> [(Double, (Point, (Point, ItemBag)))])
-> [(Double, (Point, ItemBag))]
-> [(Double, (Point, (Point, ItemBag)))]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (Double, (Point, ItemBag)) -> [(Double, (Point, (Point, ItemBag)))]
vicTrigger [(Double, (Point, ItemBag))]
efeat
[(Int, (Point, (Point, ItemBag)))]
-> m [(Int, (Point, (Point, ItemBag)))]
forall (m :: * -> *) a. Monad m => a -> m a
return ([(Int, (Point, (Point, ItemBag)))]
-> m [(Int, (Point, (Point, ItemBag)))])
-> [(Int, (Point, (Point, ItemBag)))]
-> m [(Int, (Point, (Point, ItemBag)))]
forall a b. (a -> b) -> a -> b
$!
let mix :: (Double, b) -> Int -> (a, b)
mix (Double
benefit, b
ppbag) Int
dist =
let maxd :: Int
maxd = BfsDistance -> BfsDistance -> Int
subtractBfsDistance BfsDistance
maxBfsDistance BfsDistance
apartBfs
v :: Double
v = Int -> Double
intToDouble (Int -> Double) -> Int -> Double
forall a b. (a -> b) -> a -> b
$ Int
maxd Int -> Int -> Int
forall a. Integral a => a -> a -> a
`div` (Int
dist Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1)
in (Double -> a
forall a b. (RealFrac a, Integral b) => a -> b
ceiling (Double -> a) -> Double -> a
forall a b. (a -> b) -> a -> b
$ Double
benefit Double -> Double -> Double
forall a. Num a => a -> a -> a
* Double
v, b
ppbag)
in ((Double, (Point, (Point, ItemBag)))
-> Maybe (Int, (Point, (Point, ItemBag))))
-> [(Double, (Point, (Point, ItemBag)))]
-> [(Int, (Point, (Point, ItemBag)))]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe (\bpp :: (Double, (Point, (Point, ItemBag)))
bpp@(Double
_, (Point
p, (Point, ItemBag)
_)) ->
(Double, (Point, (Point, ItemBag)))
-> Int -> (Int, (Point, (Point, ItemBag)))
forall a b. Integral a => (Double, b) -> Int -> (a, b)
mix (Double, (Point, (Point, ItemBag)))
bpp (Int -> (Int, (Point, (Point, ItemBag))))
-> Maybe Int -> Maybe (Int, (Point, (Point, ItemBag)))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Array BfsDistance -> Point -> Maybe Int
accessBfs Array BfsDistance
bfs Point
p) [(Double, (Point, (Point, ItemBag)))]
vicAll
condEnoughGearM :: MonadClientRead m => ActorId -> m Bool
condEnoughGearM :: ActorId -> m Bool
condEnoughGearM 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 followDoctrine :: Bool
followDoctrine = Player -> Doctrine
fdoctrine (Faction -> Player
gplayer Faction
fact)
Doctrine -> [Doctrine] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Doctrine
Ability.TFollow, Doctrine
Ability.TFollowNoItems]
[(ItemId, ItemFull)]
eqpAssocs <- (State -> [(ItemId, ItemFull)]) -> m [(ItemId, ItemFull)]
forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
getsState ((State -> [(ItemId, ItemFull)]) -> m [(ItemId, ItemFull)])
-> (State -> [(ItemId, ItemFull)]) -> m [(ItemId, ItemFull)]
forall a b. (a -> b) -> a -> b
$ ActorId -> [CStore] -> State -> [(ItemId, ItemFull)]
fullAssocs ActorId
aid [CStore
CEqp]
Bool -> m Bool
forall (m :: * -> *) a. Monad m => a -> m a
return (Bool -> m Bool) -> Bool -> m Bool
forall a b. (a -> b) -> a -> b
$ Bool -> Bool
not Bool
followDoctrine
Bool -> Bool -> Bool
&& (((ItemId, ItemFull) -> Bool) -> [(ItemId, ItemFull)] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (Flag -> AspectRecord -> Bool
IA.checkFlag Flag
Ability.Meleeable
(AspectRecord -> Bool)
-> ((ItemId, ItemFull) -> AspectRecord)
-> (ItemId, ItemFull)
-> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ItemFull -> AspectRecord
aspectRecordFull (ItemFull -> AspectRecord)
-> ((ItemId, ItemFull) -> ItemFull)
-> (ItemId, ItemFull)
-> AspectRecord
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ItemId, ItemFull) -> ItemFull
forall a b. (a, b) -> b
snd) [(ItemId, ItemFull)]
eqpAssocs
Bool -> Bool -> Bool
|| [(ItemId, ItemFull)] -> Int
forall a. [a] -> Int
length [(ItemId, ItemFull)]
eqpAssocs Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
3)
unexploredDepth :: MonadClientRead m => Bool -> LevelId -> m Bool
unexploredDepth :: 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 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{EnumMap Point ItemBag
lfloor :: Level -> EnumMap Point ItemBag
lfloor :: EnumMap Point ItemBag
lfloor, EnumMap Point ActorId
lbig :: EnumMap Point ActorId
lbig :: Level -> EnumMap Point ActorId
lbig} <- LevelId -> m Level
forall (m :: * -> *). MonadStateRead m => LevelId -> m Level
getLevel (LevelId -> m Level) -> LevelId -> m Level
forall a b. (a -> b) -> a -> b
$ Actor -> LevelId
blid Actor
body
EnumMap FactionId Faction
factionD <- (State -> EnumMap FactionId Faction)
-> m (EnumMap FactionId Faction)
forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
getsState State -> EnumMap FactionId Faction
sfactionD
Perception
per <- LevelId -> m Perception
forall (m :: * -> *). MonadClientRead m => LevelId -> m Perception
getPerFid (LevelId -> m Perception) -> LevelId -> m Perception
forall a b. (a -> b) -> a -> b
$ Actor -> LevelId
blid Actor
body
let canSee :: Point -> Bool
canSee Point
p = Point -> EnumSet Point -> Bool
forall k. Enum k => k -> EnumSet k -> Bool
ES.member Point
p (Perception -> EnumSet Point
totalVisible Perception
per)
let stashes :: [(FactionId, Maybe (LevelId, Point))]
stashes = ((FactionId, Faction) -> (FactionId, Maybe (LevelId, Point)))
-> [(FactionId, Faction)] -> [(FactionId, Maybe (LevelId, Point))]
forall a b. (a -> b) -> [a] -> [b]
map ((Faction -> Maybe (LevelId, Point))
-> (FactionId, Faction) -> (FactionId, Maybe (LevelId, Point))
forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> a (d, b) (d, c)
second Faction -> Maybe (LevelId, Point)
gstash) ([(FactionId, Faction)] -> [(FactionId, Maybe (LevelId, Point))])
-> [(FactionId, Faction)] -> [(FactionId, Maybe (LevelId, Point))]
forall a b. (a -> b) -> a -> b
$ EnumMap FactionId Faction -> [(FactionId, Faction)]
forall k a. Enum k => EnumMap k a -> [(k, a)]
EM.assocs EnumMap FactionId Faction
factionD
stashToRemove :: (FactionId, Maybe (LevelId, Point)) -> [Point]
stashToRemove :: (FactionId, Maybe (LevelId, Point)) -> [Point]
stashToRemove (FactionId
fid, Just (LevelId
lid, Point
pos))
| LevelId
lid LevelId -> LevelId -> Bool
forall a. Eq a => a -> a -> Bool
== Actor -> LevelId
blid Actor
body
Bool -> Bool -> Bool
&& (FactionId
fid FactionId -> FactionId -> Bool
forall a. Eq a => a -> a -> Bool
== Actor -> FactionId
bfid Actor
body Bool -> Bool -> Bool
|| Point
pos Point -> EnumMap Point ActorId -> Bool
forall k a. Enum k => k -> EnumMap k a -> Bool
`EM.member` EnumMap Point ActorId
lbig Bool -> Bool -> Bool
|| Bool -> Bool
not (Point -> Bool
canSee Point
pos)) =
[Point
pos]
stashToRemove (FactionId, Maybe (LevelId, Point))
_ = []
stashesToRemove :: EnumSet Point
stashesToRemove = [Point] -> EnumSet Point
forall k. Enum k => [k] -> EnumSet k
ES.fromList ([Point] -> EnumSet Point) -> [Point] -> EnumSet Point
forall a b. (a -> b) -> a -> b
$ ((FactionId, Maybe (LevelId, Point)) -> [Point])
-> [(FactionId, Maybe (LevelId, Point))] -> [Point]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (FactionId, Maybe (LevelId, Point)) -> [Point]
stashToRemove [(FactionId, Maybe (LevelId, Point))]
stashes
lfloorBarStashes :: EnumMap Point ItemBag
lfloorBarStashes = EnumMap Point ItemBag -> EnumSet Point -> EnumMap Point ItemBag
forall k a. Enum k => EnumMap k a -> EnumSet k -> EnumMap k a
EM.withoutKeys EnumMap Point ItemBag
lfloor EnumSet Point
stashesToRemove
if EnumMap Point ItemBag -> Bool
forall k a. EnumMap k a -> Bool
EM.null EnumMap Point ItemBag
lfloorBarStashes then [(Int, (Point, ItemBag))] -> m [(Int, (Point, ItemBag))]
forall (m :: * -> *) a. Monad m => a -> m a
return [] else do
Array BfsDistance
bfs <- ActorId -> m (Array BfsDistance)
forall (m :: * -> *).
MonadClient m =>
ActorId -> m (Array BfsDistance)
getCacheBfs ActorId
aid
let mix :: b -> Int -> (Int, b)
mix b
pbag Int
dist =
let maxd :: Int
maxd = BfsDistance -> BfsDistance -> Int
subtractBfsDistance BfsDistance
maxBfsDistance BfsDistance
apartBfs
v :: Int
v = (Int
maxd Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
10) Int -> Int -> Int
forall a. Integral a => a -> a -> a
`div` (Int
dist Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1)
in (Int
v, b
pbag)
[(Int, (Point, ItemBag))] -> m [(Int, (Point, ItemBag))]
forall (m :: * -> *) a. Monad m => a -> m a
return ([(Int, (Point, ItemBag))] -> m [(Int, (Point, ItemBag))])
-> [(Int, (Point, ItemBag))] -> m [(Int, (Point, ItemBag))]
forall a b. (a -> b) -> a -> b
$! ((Point, ItemBag) -> Maybe (Int, (Point, ItemBag)))
-> [(Point, ItemBag)] -> [(Int, (Point, ItemBag))]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe (\(Point
p, ItemBag
bag) ->
(Point, ItemBag) -> Int -> (Int, (Point, ItemBag))
forall b. b -> Int -> (Int, b)
mix (Point
p, ItemBag
bag) (Int -> (Int, (Point, ItemBag)))
-> Maybe Int -> Maybe (Int, (Point, ItemBag))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Array BfsDistance -> Point -> Maybe Int
accessBfs Array BfsDistance
bfs Point
p) (EnumMap Point ItemBag -> [(Point, ItemBag)]
forall k a. Enum k => EnumMap k a -> [(k, a)]
EM.assocs EnumMap Point ItemBag
lfloorBarStashes)
closestFoes :: MonadClient m
=> [(ActorId, Actor)] -> ActorId -> m [(Int, (ActorId, Actor))]
closestFoes :: [(ActorId, Actor)] -> ActorId -> m [(Int, (ActorId, Actor))]
closestFoes [(ActorId, Actor)]
foes ActorId
aid =
case [(ActorId, Actor)]
foes of
[] -> [(Int, (ActorId, Actor))] -> m [(Int, (ActorId, Actor))]
forall (m :: * -> *) a. Monad m => a -> m a
return []
[(ActorId, Actor)]
_ -> do
Array BfsDistance
bfs <- ActorId -> m (Array BfsDistance)
forall (m :: * -> *).
MonadClient m =>
ActorId -> m (Array BfsDistance)
getCacheBfs ActorId
aid
let ds :: [(Int, (ActorId, Actor))]
ds = ((ActorId, Actor) -> Maybe (Int, (ActorId, Actor)))
-> [(ActorId, Actor)] -> [(Int, (ActorId, Actor))]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe (\x :: (ActorId, Actor)
x@(ActorId
_, Actor
b) -> (Int -> (Int, (ActorId, Actor)))
-> Maybe Int -> Maybe (Int, (ActorId, Actor))
forall (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
closestStashes :: MonadClient m => ActorId -> m [(Int, (FactionId, Point))]
closestStashes :: ActorId -> m [(Int, (FactionId, Point))]
closestStashes ActorId
aid = do
COps{ContentData CaveKind
cocave :: ContentData CaveKind
cocave :: COps -> ContentData CaveKind
cocave} <- (State -> COps) -> m COps
forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
getsState State -> COps
scops
EnumMap FactionId Faction
factionD <- (State -> EnumMap FactionId Faction)
-> m (EnumMap FactionId Faction)
forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
getsState State -> EnumMap FactionId Faction
sfactionD
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)
[(ActorId, Actor)]
oursExploring <- (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
$ FactionId -> State -> [(ActorId, Actor)]
oursExploringAssocs (Actor -> FactionId
bfid Actor
b)
let fact :: Faction
fact = EnumMap FactionId Faction
factionD EnumMap FactionId Faction -> FactionId -> Faction
forall k a. Enum k => EnumMap k a -> k -> a
EM.! Actor -> FactionId
bfid Actor
b
spawnFreqs :: Freqs ItemKind
spawnFreqs = CaveKind -> Freqs ItemKind
CK.cactorFreq (CaveKind -> Freqs ItemKind) -> CaveKind -> Freqs ItemKind
forall a b. (a -> b) -> a -> b
$ ContentData CaveKind -> ContentId CaveKind -> CaveKind
forall a. ContentData a -> ContentId a -> a
okind ContentData CaveKind
cocave (ContentId CaveKind -> CaveKind) -> ContentId CaveKind -> CaveKind
forall a b. (a -> b) -> a -> b
$ Level -> ContentId CaveKind
lkind Level
lvl
hasGroup :: GroupName ItemKind -> Bool
hasGroup GroupName ItemKind
grp = Int -> Maybe Int -> Int
forall a. a -> Maybe a -> a
fromMaybe Int
0 (GroupName ItemKind -> Freqs ItemKind -> Maybe Int
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup GroupName ItemKind
grp Freqs ItemKind
spawnFreqs) Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
0
lvlSpawnsUs :: Bool
lvlSpawnsUs = (GroupName ItemKind -> Bool) -> [GroupName ItemKind] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any GroupName ItemKind -> Bool
hasGroup ([GroupName ItemKind] -> Bool) -> [GroupName ItemKind] -> Bool
forall a b. (a -> b) -> a -> b
$ Player -> [GroupName ItemKind]
fgroups (Faction -> Player
gplayer Faction
fact)
qualifyStash :: (FactionId, Faction) -> Maybe (FactionId, Point)
qualifyStash (FactionId
fid2, Faction{Maybe (LevelId, Point)
gstash :: Maybe (LevelId, Point)
gstash :: Faction -> Maybe (LevelId, Point)
gstash}) = case Maybe (LevelId, Point)
gstash of
Maybe (LevelId, Point)
Nothing -> Maybe (FactionId, Point)
forall a. Maybe a
Nothing
Just (LevelId
lid, Point
pos) ->
if LevelId
lid LevelId -> LevelId -> Bool
forall a. Eq a => a -> a -> Bool
== Actor -> LevelId
blid Actor
b
Bool -> Bool -> Bool
&& (FactionId
fid2 FactionId -> FactionId -> Bool
forall a. Eq a => a -> a -> Bool
== Actor -> FactionId
bfid Actor
b
Bool -> Bool -> Bool
&& Maybe ActorId -> Bool
forall a. Maybe a -> Bool
isNothing (Point -> Level -> Maybe ActorId
posToBigLvl Point
pos Level
lvl)
Bool -> Bool -> Bool
&& ([(ActorId, Actor)] -> Int
forall a. [a] -> Int
length [(ActorId, Actor)]
oursExploring Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
1
Bool -> Bool -> Bool
|| Bool
lvlSpawnsUs)
Bool -> Bool -> Bool
|| FactionId -> Faction -> FactionId -> Bool
isFoe (Actor -> FactionId
bfid Actor
b) Faction
fact FactionId
fid2)
then (FactionId, Point) -> Maybe (FactionId, Point)
forall a. a -> Maybe a
Just (FactionId
fid2, Point
pos)
else Maybe (FactionId, Point)
forall a. Maybe a
Nothing
case ((FactionId, Faction) -> Maybe (FactionId, Point))
-> [(FactionId, Faction)] -> [(FactionId, Point)]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe (FactionId, Faction) -> Maybe (FactionId, Point)
qualifyStash ([(FactionId, Faction)] -> [(FactionId, Point)])
-> [(FactionId, Faction)] -> [(FactionId, Point)]
forall a b. (a -> b) -> a -> b
$ EnumMap FactionId Faction -> [(FactionId, Faction)]
forall k a. Enum k => EnumMap k a -> [(k, a)]
EM.assocs EnumMap FactionId Faction
factionD of
[] -> [(Int, (FactionId, Point))] -> m [(Int, (FactionId, Point))]
forall (m :: * -> *) a. Monad m => a -> m a
return []
[(FactionId, Point)]
stashes -> do
Array BfsDistance
bfs <- ActorId -> m (Array BfsDistance)
forall (m :: * -> *).
MonadClient m =>
ActorId -> m (Array BfsDistance)
getCacheBfs ActorId
aid
let ds :: [(Int, (FactionId, Point))]
ds = ((FactionId, Point) -> Maybe (Int, (FactionId, Point)))
-> [(FactionId, Point)] -> [(Int, (FactionId, Point))]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe (\x :: (FactionId, Point)
x@(FactionId
_, Point
pos) -> (Int -> (Int, (FactionId, Point)))
-> Maybe Int -> Maybe (Int, (FactionId, Point))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (,(FactionId, Point)
x) (Array BfsDistance -> Point -> Maybe Int
accessBfs Array BfsDistance
bfs Point
pos)) [(FactionId, Point)]
stashes
[(Int, (FactionId, Point))] -> m [(Int, (FactionId, Point))]
forall (m :: * -> *) a. Monad m => a -> m a
return ([(Int, (FactionId, Point))] -> m [(Int, (FactionId, Point))])
-> [(Int, (FactionId, Point))] -> m [(Int, (FactionId, Point))]
forall a b. (a -> b) -> a -> b
$! ((Int, (FactionId, Point))
-> (Int, (FactionId, Point)) -> Ordering)
-> [(Int, (FactionId, Point))] -> [(Int, (FactionId, Point))]
forall a. (a -> a -> Ordering) -> [a] -> [a]
sortBy (((Int, (FactionId, Point)) -> Int)
-> (Int, (FactionId, Point))
-> (Int, (FactionId, Point))
-> Ordering
forall a b. Ord a => (b -> a) -> b -> b -> Ordering
comparing (Int, (FactionId, Point)) -> Int
forall a b. (a, b) -> a
fst) [(Int, (FactionId, Point))]
ds
oursExploringAssocs :: FactionId -> State -> [(ActorId, Actor)]
oursExploringAssocs :: FactionId -> State -> [(ActorId, Actor)]
oursExploringAssocs FactionId
fid State
s =
let f :: (ActorId, Actor) -> Bool
f (!ActorId
aid, !Actor
b) = Actor -> FactionId
bfid Actor
b FactionId -> FactionId -> Bool
forall a. Eq a => a -> a -> Bool
== FactionId
fid
Bool -> Bool -> Bool
&& Bool -> Bool
not (Actor -> Bool
bproj Actor
b)
Bool -> Bool -> Bool
&& Actor -> Int64
bhp Actor
b Int64 -> Int64 -> Bool
forall a. Ord a => a -> a -> Bool
> Int64
0
Bool -> Bool -> Bool
&& (Actor -> Watchfulness
bwatch Actor
b Watchfulness -> [Watchfulness] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Watchfulness
WSleep, Watchfulness
WWake]
Bool -> Bool -> Bool
|| let actorMaxSk :: Skills
actorMaxSk = State -> ActorMaxSkills
sactorMaxSkills State
s ActorMaxSkills -> ActorId -> Skills
forall k a. Enum k => EnumMap k a -> k -> a
EM.! ActorId
aid
in Skill -> Skills -> Int
Ability.getSk Skill
Ability.SkMove Skills
actorMaxSk Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
0
Bool -> Bool -> Bool
|| Skill -> Skills -> Int
Ability.getSk Skill
Ability.SkMove Skills
actorMaxSk Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< -Int
50)
in ((ActorId, Actor) -> Bool)
-> [(ActorId, Actor)] -> [(ActorId, Actor)]
forall a. (a -> Bool) -> [a] -> [a]
filter (ActorId, Actor) -> Bool
f ([(ActorId, Actor)] -> [(ActorId, Actor)])
-> [(ActorId, Actor)] -> [(ActorId, Actor)]
forall a b. (a -> b) -> a -> b
$ EnumMap ActorId Actor -> [(ActorId, Actor)]
forall k a. Enum k => EnumMap k a -> [(k, a)]
EM.assocs (EnumMap ActorId Actor -> [(ActorId, Actor)])
-> EnumMap ActorId Actor -> [(ActorId, Actor)]
forall a b. (a -> b) -> a -> b
$ State -> EnumMap ActorId Actor
sactorD State
s
closestHideout :: MonadClient m => ActorId -> m (Maybe (Point, Int))
closestHideout :: ActorId -> m (Maybe (Point, Int))
closestHideout ActorId
aid = 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 (Actor -> LevelId
blid Actor
b)
Array BfsDistance
bfs <- ActorId -> m (Array BfsDistance)
forall (m :: * -> *).
MonadClient m =>
ActorId -> m (Array BfsDistance)
getCacheBfs ActorId
aid
let minHideout :: (Point, BfsDistance) -> Point -> BfsDistance
-> (Point, BfsDistance)
minHideout :: (Point, BfsDistance)
-> Point -> BfsDistance -> (Point, BfsDistance)
minHideout (Point
pMin, BfsDistance
distMin) Point
p BfsDistance
dist =
if BfsDistance
dist BfsDistance -> BfsDistance -> Bool
forall a. Ord a => a -> a -> Bool
> BfsDistance
minKnownBfs Bool -> Bool -> Bool
&& BfsDistance
dist BfsDistance -> BfsDistance -> Bool
forall a. Ord a => a -> a -> Bool
< BfsDistance
distMin
Bool -> Bool -> Bool
&& TileSpeedup -> ContentId TileKind -> Bool
Tile.isHideout TileSpeedup
coTileSpeedup (Level
lvl Level -> Point -> ContentId TileKind
`at` Point
p)
then (Point
p, BfsDistance
dist)
else (Point
pMin, BfsDistance
distMin)
(Point
p1, BfsDistance
dist1) = ((Point, BfsDistance)
-> Point -> BfsDistance -> (Point, BfsDistance))
-> (Point, BfsDistance)
-> Array BfsDistance
-> (Point, BfsDistance)
forall c a.
UnboxRepClass c =>
(a -> Point -> c -> a) -> a -> Array c -> a
PointArray.ifoldlA' (Point, BfsDistance)
-> Point -> BfsDistance -> (Point, BfsDistance)
minHideout (Actor -> Point
bpos Actor
b, BfsDistance
maxBfsDistance) Array BfsDistance
bfs
Maybe (Point, Int) -> m (Maybe (Point, Int))
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe (Point, Int) -> m (Maybe (Point, Int)))
-> Maybe (Point, Int) -> m (Maybe (Point, Int))
forall a b. (a -> b) -> a -> b
$! if Point
p1 Point -> Point -> Bool
forall a. Eq a => a -> a -> Bool
== Actor -> Point
bpos Actor
b
then Maybe (Point, Int)
forall a. Maybe a
Nothing
else (Point, Int) -> Maybe (Point, Int)
forall a. a -> Maybe a
Just (Point
p1, BfsDistance -> BfsDistance -> Int
subtractBfsDistance BfsDistance
dist1 BfsDistance
apartBfs)