{-# LANGUAGE TupleSections #-}
-- | Let AI pick the best target for an actor.
module Game.LambdaHack.Client.AI.PickTargetM
  ( refreshTarget
#ifdef EXPOSE_INTERNAL
    -- * Internal operations
  , computeTarget
#endif
  ) where

import Prelude ()

import Game.LambdaHack.Core.Prelude

import qualified Data.EnumMap.Strict as EM
import qualified Data.EnumSet as ES

import           Game.LambdaHack.Client.AI.ConditionM
import           Game.LambdaHack.Client.Bfs
import           Game.LambdaHack.Client.BfsM
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           Game.LambdaHack.Common.Kind
import           Game.LambdaHack.Common.Level
import           Game.LambdaHack.Common.MonadStateRead
import           Game.LambdaHack.Common.Point
import qualified Game.LambdaHack.Common.PointArray as PointArray
import           Game.LambdaHack.Common.State
import qualified Game.LambdaHack.Common.Tile as Tile
import           Game.LambdaHack.Common.Time
import           Game.LambdaHack.Common.Types
import           Game.LambdaHack.Common.Vector
import qualified Game.LambdaHack.Content.CaveKind as CK
import           Game.LambdaHack.Content.FactionKind
import           Game.LambdaHack.Content.RuleKind
import           Game.LambdaHack.Content.TileKind (isUknownSpace)
import           Game.LambdaHack.Core.Frequency
import           Game.LambdaHack.Core.Random
import qualified Game.LambdaHack.Definition.Ability as Ability

-- | Verify and possibly change the target of an actor. This function both
-- updates the target in the client state and returns the new target explicitly.
refreshTarget :: MonadClient m
              => [(ActorId, Actor)] -> [(ActorId, Actor)] -> (ActorId, Actor)
              -> m (Maybe TgtAndPath)
refreshTarget :: forall (m :: * -> *).
MonadClient m =>
[(ActorId, Actor)]
-> [(ActorId, Actor)] -> (ActorId, Actor) -> m (Maybe TgtAndPath)
refreshTarget [(ActorId, Actor)]
foeAssocs [(ActorId, Actor)]
friendAssocs (ActorId
aid, Actor
body) = do
  FactionId
side <- (StateClient -> FactionId) -> m FactionId
forall a. (StateClient -> a) -> m a
forall (m :: * -> *) a.
MonadClientRead m =>
(StateClient -> a) -> m a
getsClient StateClient -> FactionId
sside
  let !_A :: ()
_A = Bool -> () -> ()
forall a. (?callStack::CallStack) => Bool -> a -> a
assert (Actor -> FactionId
bfid Actor
body FactionId -> FactionId -> Bool
forall a. Eq a => a -> a -> Bool
== FactionId
side
                    Bool -> (String, (ActorId, Actor, FactionId)) -> Bool
forall v. Show v => Bool -> v -> Bool
`blame` String
"AI tries to move an enemy actor"
                    String
-> (ActorId, Actor, FactionId)
-> (String, (ActorId, Actor, FactionId))
forall v. String -> v -> (String, v)
`swith` (ActorId
aid, Actor
body, FactionId
side)) ()
  let !_A :: ()
_A = Bool -> () -> ()
forall a. (?callStack::CallStack) => Bool -> a -> a
assert (Bool -> Bool
not (Actor -> Bool
bproj Actor
body)
                    Bool -> (String, (ActorId, Actor, FactionId)) -> Bool
forall v. Show v => Bool -> v -> Bool
`blame` String
"AI gets to manually move its projectiles"
                    String
-> (ActorId, Actor, FactionId)
-> (String, (ActorId, Actor, FactionId))
forall v. String -> v -> (String, v)
`swith` (ActorId
aid, Actor
body, FactionId
side)) ()
  Maybe TgtAndPath
mtarget <- [(ActorId, Actor)]
-> [(ActorId, Actor)] -> ActorId -> m (Maybe TgtAndPath)
forall (m :: * -> *).
MonadClient m =>
[(ActorId, Actor)]
-> [(ActorId, Actor)] -> ActorId -> m (Maybe TgtAndPath)
computeTarget [(ActorId, Actor)]
foeAssocs [(ActorId, Actor)]
friendAssocs ActorId
aid
  case Maybe TgtAndPath
mtarget of
    Maybe TgtAndPath
Nothing -> do
      -- Melee in progress and the actor can't contribute
      -- and would slow down others if he acted.
      -- Or he's just asleep.
      (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 {stargetD = EM.delete aid (stargetD cli)}
      Maybe TgtAndPath -> m (Maybe TgtAndPath)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe TgtAndPath
forall a. Maybe a
Nothing
    Just TgtAndPath
tgtMPath -> do
      -- _debugoldTgt <- getsClient $ EM.lookup aid . stargetD
      (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 {stargetD = EM.insert aid tgtMPath (stargetD cli)}
      Maybe TgtAndPath -> m (Maybe TgtAndPath)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe TgtAndPath
mtarget
      -- let _debug = T.unpack
      --       $ "\nHandleAI symbol:"    <+> tshow (bsymbol body)
      --       <> ", aid:"               <+> tshow aid
      --       <> ", pos:"               <+> tshow (bpos body)
      --       <> "\nHandleAI oldTgt:"   <+> tshow _debugoldTgt
      --       <> "\nHandleAI strTgt:"   <+> tshow stratTarget
      --       <> "\nHandleAI target:"   <+> tshow tgtMPath
      -- trace _debug $ return $ Just tgtMPath

computeTarget :: forall m. MonadClient m
              => [(ActorId, Actor)] -> [(ActorId, Actor)] -> ActorId
              -> m (Maybe TgtAndPath)
computeTarget :: forall (m :: * -> *).
MonadClient m =>
[(ActorId, Actor)]
-> [(ActorId, Actor)] -> ActorId -> m (Maybe TgtAndPath)
computeTarget [(ActorId, Actor)]
foeAssocs [(ActorId, Actor)]
friendAssocs ActorId
aid = do
  cops :: COps
cops@COps{ContentData CaveKind
cocave :: ContentData CaveKind
cocave :: COps -> ContentData CaveKind
cocave, corule :: COps -> RuleContent
corule=RuleContent{Int
rWidthMax :: Int
rWidthMax :: RuleContent -> Int
rWidthMax, Int
rHeightMax :: Int
rHeightMax :: RuleContent -> Int
rHeightMax, Int
rnearby :: Int
rnearby :: RuleContent -> Int
rnearby}, TileSpeedup
coTileSpeedup :: TileSpeedup
coTileSpeedup :: COps -> TileSpeedup
coTileSpeedup}
    <- (State -> COps) -> m COps
forall a. (State -> a) -> m a
forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
getsState State -> COps
scops
  Actor
b <- (State -> Actor) -> m Actor
forall a. (State -> a) -> m a
forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
getsState ((State -> Actor) -> m Actor) -> (State -> Actor) -> m Actor
forall a b. (a -> b) -> a -> b
$ ActorId -> State -> Actor
getActorBody ActorId
aid
  Maybe ActorId
mleader <- (StateClient -> Maybe ActorId) -> m (Maybe ActorId)
forall a. (StateClient -> a) -> m a
forall (m :: * -> *) a.
MonadClientRead m =>
(StateClient -> a) -> m a
getsClient StateClient -> Maybe ActorId
sleader
  AlterLid
salter <- (StateClient -> AlterLid) -> m AlterLid
forall a. (StateClient -> a) -> m a
forall (m :: * -> *) a.
MonadClientRead m =>
(StateClient -> a) -> m a
getsClient StateClient -> AlterLid
salter
  -- We assume the actor eventually becomes a leader (or has the same
  -- set of skills as the leader, anyway) and set his target accordingly.
  ActorMaxSkills
actorMaxSkills <- (State -> ActorMaxSkills) -> m ActorMaxSkills
forall a. (State -> a) -> m a
forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
getsState State -> ActorMaxSkills
sactorMaxSkills
  Bool
condInMelee <- LevelId -> m Bool
forall (m :: * -> *). MonadClientRead m => LevelId -> m Bool
condInMeleeM (LevelId -> m Bool) -> LevelId -> m Bool
forall a b. (a -> b) -> a -> b
$ 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
      actorMaxSk :: Skills
actorMaxSk = ActorMaxSkills
actorMaxSkills ActorMaxSkills -> ActorId -> Skills
forall k a. Enum k => EnumMap k a -> k -> a
EM.! ActorId
aid
      alterSkill :: Int
alterSkill = Skill -> Skills -> Int
Ability.getSk Skill
Ability.SkAlter Skills
actorMaxSk
  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
  Time
localTime <- (State -> Time) -> m Time
forall a. (State -> a) -> m a
forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
getsState ((State -> Time) -> m Time) -> (State -> Time) -> m Time
forall a b. (a -> b) -> a -> b
$ LevelId -> State -> Time
getLocalTime (Actor -> LevelId
blid Actor
b)
  let stepAccesible :: [Point] -> Bool
      stepAccesible :: [Point] -> Bool
stepAccesible (Point
q : [Point]
_) =
        -- Effectively, only @alterMinWalk@ is checked, because real altering
        -- is not done via target path, but action after end of path.
        Int
alterSkill Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Word8 -> Int
forall a. Enum a => a -> Int
fromEnum (Array Word8
lalter Array Word8 -> Point -> Word8
forall c. UnboxRepClass c => Array c -> Point -> c
PointArray.! Point
q)
      stepAccesible [] = Bool
False
  Maybe TgtAndPath
mtgtMPath <- (StateClient -> Maybe TgtAndPath) -> m (Maybe TgtAndPath)
forall a. (StateClient -> a) -> m a
forall (m :: * -> *) a.
MonadClientRead m =>
(StateClient -> a) -> m a
getsClient ((StateClient -> Maybe TgtAndPath) -> m (Maybe TgtAndPath))
-> (StateClient -> Maybe TgtAndPath) -> m (Maybe TgtAndPath)
forall a b. (a -> b) -> a -> b
$ ActorId -> EnumMap ActorId TgtAndPath -> Maybe TgtAndPath
forall k a. Enum k => k -> EnumMap k a -> Maybe a
EM.lookup ActorId
aid (EnumMap ActorId TgtAndPath -> Maybe TgtAndPath)
-> (StateClient -> EnumMap ActorId TgtAndPath)
-> StateClient
-> Maybe TgtAndPath
forall b c a. (b -> c) -> (a -> b) -> a -> c
. StateClient -> EnumMap ActorId TgtAndPath
stargetD
  Maybe TgtAndPath
oldTgtUpdatedPath <- case Maybe TgtAndPath
mtgtMPath of
    Just TgtAndPath{Target
tapTgt :: Target
tapTgt :: TgtAndPath -> Target
tapTgt,tapPath :: TgtAndPath -> Maybe AndPath
tapPath=Maybe AndPath
Nothing} ->
      -- This case is especially for TEnemyPos that would be lost otherwise.
      -- This is also triggered by @UpdLeadFaction@.
      TgtAndPath -> Maybe TgtAndPath
forall a. a -> Maybe a
Just (TgtAndPath -> Maybe TgtAndPath)
-> m TgtAndPath -> m (Maybe TgtAndPath)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ActorId -> Target -> m TgtAndPath
forall (m :: * -> *).
MonadClient m =>
ActorId -> Target -> m TgtAndPath
createPath ActorId
aid Target
tapTgt
    Just tap :: TgtAndPath
tap@TgtAndPath{Target
tapTgt :: TgtAndPath -> Target
tapTgt :: Target
tapTgt,tapPath :: TgtAndPath -> Maybe AndPath
tapPath=Just AndPath{Int
[Point]
Point
pathSource :: Point
pathList :: [Point]
pathGoal :: Point
pathLen :: Int
pathSource :: AndPath -> Point
pathList :: AndPath -> [Point]
pathGoal :: AndPath -> Point
pathLen :: AndPath -> Int
..}} -> do
      Maybe Point
mvalidPos <- (State -> Maybe Point) -> m (Maybe Point)
forall a. (State -> a) -> m a
forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
getsState ((State -> Maybe Point) -> m (Maybe Point))
-> (State -> Maybe Point) -> m (Maybe Point)
forall a b. (a -> b) -> a -> b
$ Maybe ActorId -> LevelId -> Maybe Target -> State -> Maybe Point
aidTgtToPos (ActorId -> Maybe ActorId
forall a. a -> Maybe a
Just ActorId
aid) (Actor -> LevelId
blid Actor
b) (Target -> Maybe Target
forall a. a -> Maybe a
Just Target
tapTgt)
      Maybe TgtAndPath -> m (Maybe TgtAndPath)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe TgtAndPath -> m (Maybe TgtAndPath))
-> Maybe TgtAndPath -> m (Maybe TgtAndPath)
forall a b. (a -> b) -> a -> b
$!
        if | Maybe Point -> Bool
forall a. Maybe a -> Bool
isNothing Maybe Point
mvalidPos -> Maybe TgtAndPath
forall a. Maybe a
Nothing  -- wrong level
           | Actor -> Point
bpos Actor
b Point -> Point -> Bool
forall a. Eq a => a -> a -> Bool
== Point
pathGoal ->
               Maybe TgtAndPath
mtgtMPath  -- goal reached; stay there picking up items
                          -- or hiding in ambush or in panic
           | Point
pathSource Point -> Point -> Bool
forall a. Eq a => a -> a -> Bool
== Actor -> Point
bpos Actor
b ->  -- no move
               -- If next step not accessible, something serious happened,
               -- so reconsider the target, not only path.
               if [Point] -> Bool
stepAccesible [Point]
pathList then Maybe TgtAndPath
mtgtMPath else Maybe TgtAndPath
forall a. Maybe a
Nothing
           | Bool
otherwise -> case (Point -> Bool) -> [Point] -> ([Point], [Point])
forall a. (a -> Bool) -> [a] -> ([a], [a])
break (Point -> Point -> Bool
forall a. Eq a => a -> a -> Bool
== Actor -> Point
bpos Actor
b) [Point]
pathList of
               ([Point]
crossed, Point
_ : [Point]
rest) ->  -- step or many steps along path
                 if [Point] -> Bool
forall a. [a] -> Bool
null [Point]
rest
                 then Maybe TgtAndPath
forall a. Maybe a
Nothing  -- path to the goal was partial, so tiles
                               -- discovered or altered, so reconsider target
                 else let newPath :: AndPath
newPath =
                            AndPath{ pathSource :: Point
pathSource = Actor -> Point
bpos Actor
b
                                   , pathList :: [Point]
pathList = [Point]
rest
                                   , Point
pathGoal :: Point
pathGoal :: Point
pathGoal
                                   , pathLen :: Int
pathLen = Int
pathLen Int -> Int -> Int
forall a. Num a => a -> a -> a
- [Point] -> Int
forall a. [a] -> Int
length [Point]
crossed Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1 }
                      in if [Point] -> Bool
stepAccesible [Point]
rest
                         then TgtAndPath -> Maybe TgtAndPath
forall a. a -> Maybe a
Just TgtAndPath
tap{tapPath=Just newPath}
                         else Maybe TgtAndPath
forall a. Maybe a
Nothing
               ([Point]
_, []) -> Maybe TgtAndPath
forall a. Maybe a
Nothing  -- veered off the path, e.g., due to push
                                   -- by enemy or congestion, so serious,
                                   -- so reconsider target, not only path
    Maybe TgtAndPath
Nothing -> Maybe TgtAndPath -> m (Maybe TgtAndPath)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe TgtAndPath
forall a. Maybe a
Nothing  -- no target assigned yet
  FactionDict
factionD <- (State -> FactionDict) -> m FactionDict
forall a. (State -> a) -> m a
forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
getsState State -> FactionDict
sfactionD
  Int
seps <- (StateClient -> Int) -> m Int
forall a. (StateClient -> a) -> m a
forall (m :: * -> *) a.
MonadClientRead m =>
(StateClient -> a) -> m a
getsClient StateClient -> Int
seps
  let fact :: Faction
fact = FactionDict
factionD FactionDict -> FactionId -> Faction
forall k a. Enum k => EnumMap k a -> k -> a
EM.! Actor -> FactionId
bfid Actor
b
      slackDoctrine :: Bool
slackDoctrine = Faction -> Doctrine
gdoctrine Faction
fact
                      Doctrine -> [Doctrine] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [ Doctrine
Ability.TMeleeAndRanged, Doctrine
Ability.TMeleeAdjacent
                             , Doctrine
Ability.TBlock, Doctrine
Ability.TRoam, Doctrine
Ability.TPatrol ]
      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
      canReach :: Bool
canReach = Bool
canMove
                 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
                 -- Needed for now, because AI targets and shoots enemies
                 -- based on the path to them, not LOS to them:
                 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
      canAlter :: Bool
canAlter = Skill -> Skills -> Int
Ability.getSk Skill
Ability.SkAlter Skills
actorMaxSk
                 Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= if Bool
slackDoctrine then Int
2 else Int
4
      canMoveItem :: Bool
canMoveItem = Skill -> Skills -> Int
Ability.getSk Skill
Ability.SkMoveItem Skills
actorMaxSk Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
0
      calmE :: Bool
calmE = Actor -> Skills -> Bool
calmEnough Actor
b Skills
actorMaxSk
      heavilyDistressed :: Bool
heavilyDistressed =  -- actor hit by a proj or similarly distressed
        ResDelta -> Bool
deltasSerious (Actor -> ResDelta
bcalmDelta Actor
b)
  -- Speedup compared to @currentSkillsClient@.
  Skills
actorMinSk <- (State -> Skills) -> m Skills
forall a. (State -> a) -> m a
forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
getsState ((State -> Skills) -> m Skills) -> (State -> Skills) -> m Skills
forall a b. (a -> b) -> a -> b
$ Maybe ActorId -> ActorId -> State -> Skills
actorCurrentSkills Maybe ActorId
forall a. Maybe a
Nothing ActorId
aid
  Bool
condCanProject <-
    Int -> ActorId -> m Bool
forall (m :: * -> *). MonadClientRead m => Int -> ActorId -> m Bool
condCanProjectM (Skill -> Skills -> Int
Ability.getSk Skill
Ability.SkProject Skills
actorMaxSk) ActorId
aid
  EnumMap ActorId (Point, Time)
fleeD <- (StateClient -> EnumMap ActorId (Point, Time))
-> m (EnumMap ActorId (Point, Time))
forall a. (StateClient -> a) -> m a
forall (m :: * -> *) a.
MonadClientRead m =>
(StateClient -> a) -> m a
getsClient StateClient -> EnumMap ActorId (Point, Time)
sfleeD
  let condCanMelee :: Bool
condCanMelee = ActorMaxSkills -> ActorId -> Actor -> Bool
actorCanMelee ActorMaxSkills
actorMaxSkills ActorId
aid Actor
b
      condHpTooLow :: Bool
condHpTooLow = Actor -> Skills -> Bool
hpTooLow Actor
b Skills
actorMaxSk
      mfled :: Maybe (Point, Time)
mfled = ActorId
aid ActorId -> EnumMap ActorId (Point, Time) -> Maybe (Point, Time)
forall k a. Enum k => k -> EnumMap k a -> Maybe a
`EM.lookup` EnumMap ActorId (Point, Time)
fleeD
      recentlyFled :: Bool
recentlyFled =
        Bool -> ((Point, Time) -> Bool) -> Maybe (Point, Time) -> Bool
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Bool
False (\(Point
_, Time
time) -> Time -> Time -> Bool
timeRecent5 Time
localTime Time
time) Maybe (Point, Time)
mfled
      recentlyFled20 :: Bool
recentlyFled20 =
        Bool -> ((Point, Time) -> Bool) -> Maybe (Point, Time) -> Bool
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Bool
False (\(Point
_, Time
time) -> Time -> Time -> Bool
timeRecent5 Time
localTime Time
time) Maybe (Point, Time)
mfled
      actorTurn :: Delta Time
actorTurn = Speed -> Delta Time
ticksPerMeter (Speed -> Delta Time) -> Speed -> Delta Time
forall a b. (a -> b) -> a -> b
$ Skills -> Speed
gearSpeed Skills
actorMaxSk
  let canEscape :: Bool
canEscape = FactionKind -> Bool
fcanEscape (Faction -> FactionKind
gkind Faction
fact)
      canSmell :: Bool
canSmell = Skill -> Skills -> Int
Ability.getSk Skill
Ability.SkSmell Skills
actorMaxSk Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
0
      meleeNearby :: Int
meleeNearby | Bool
canEscape = Int
rnearby Int -> Int -> Int
forall a. Integral a => a -> a -> a
`div` Int
2
                  | Bool
otherwise = Int
rnearby
      rangedNearby :: Int
rangedNearby = Int
2 Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
meleeNearby
      -- We do target foes that already attack ours or have benign weapons.
      -- We assume benign weapons run out if they are the sole cause
      -- of targeting, to avoid stalemate.
      worthTargeting :: ActorId -> Actor -> Bool
worthTargeting ActorId
aidE Actor
body =
        let attacksFriends :: Bool
attacksFriends =
              ((ActorId, Actor) -> Bool) -> [(ActorId, Actor)] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (Point -> Point -> Bool
adjacent (Actor -> Point
bpos Actor
body) (Point -> Bool)
-> ((ActorId, Actor) -> Point) -> (ActorId, Actor) -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Actor -> Point
bpos (Actor -> Point)
-> ((ActorId, Actor) -> Actor) -> (ActorId, Actor) -> Point
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ActorId, Actor) -> Actor
forall a b. (a, b) -> b
snd) [(ActorId, Actor)]
friendAssocs
              Bool -> Bool -> Bool
&& ActorMaxSkills -> ActorId -> Actor -> Bool
actorCanMeleeToHarm ActorMaxSkills
actorMaxSkills ActorId
aidE Actor
body
        in Bool
attacksFriends
           Bool -> Bool -> Bool
|| Actor -> Int
bweapBenign Actor
body Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
0
           Bool -> Bool -> Bool
|| ActorMaxSkills -> ActorId -> Actor -> Bool
actorWorthChasing ActorMaxSkills
actorMaxSkills ActorId
aidE Actor
body
      targetableMelee :: Actor -> Bool
targetableMelee Actor
body =
        let attacksFriends :: Bool
attacksFriends =
              ((ActorId, Actor) -> Bool) -> [(ActorId, Actor)] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (Point -> Point -> Bool
adjacent (Actor -> Point
bpos Actor
body) (Point -> Bool)
-> ((ActorId, Actor) -> Point) -> (ActorId, Actor) -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Actor -> Point
bpos (Actor -> Point)
-> ((ActorId, Actor) -> Actor) -> (ActorId, Actor) -> Point
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ActorId, Actor) -> Actor
forall a b. (a, b) -> b
snd) [(ActorId, Actor)]
friendAssocs
            -- 3 is
            -- 1 from condSupport1
            -- + 2 from foe being 2 away from friend before he closed in
            -- + 1 for as a margin for ambush, given than actors exploring
            -- can't physically keep adjacent all the time
            n :: Int
n | Skill -> Skills -> Int
Ability.getSk Skill
Ability.SkAggression Skills
actorMaxSk Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
2
              = Int
rangedNearby
                  -- boss never waits
              | Bool
condInMelee = if Bool
attacksFriends then Int
8 else Int
4
                  -- attack even if foe not in melee, to create another
                  -- skirmish and perhaps overwhelm them in this one;
                  -- also, this looks more natural; also sometimes the foe
                  -- would attack our friend in a couple of turns anyway,
                  -- but we may be too far from him at that time
              | Bool
otherwise = Int
meleeNearby
        in Bool
canMove
           Bool -> Bool -> Bool
&& Bool
condCanMelee
           Bool -> Bool -> Bool
&& Point -> Point -> Int
chessDist (Actor -> Point
bpos Actor
body) (Actor -> Point
bpos Actor
b) Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
n
      -- Even when missiles run out, the non-moving foe will still be
      -- targeted, which is fine, since he is weakened by ranged, so should be
      -- meleed ASAP, even if without friends.
      targetableRanged :: Actor -> Bool
targetableRanged Actor
body =
        (Bool -> Bool
not Bool
condInMelee Bool -> Bool -> Bool
|| Skill -> Skills -> Int
Ability.getSk Skill
Ability.SkAggression Skills
actorMaxSk Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
2)
          -- boss fires at will
        Bool -> Bool -> Bool
&& Point -> Point -> Int
chessDist (Actor -> Point
bpos Actor
body) (Actor -> Point
bpos Actor
b) Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
rangedNearby
        Bool -> Bool -> Bool
&& Bool
condCanProject
        Bool -> Bool -> Bool
&& (Bool
canMove Bool -> Bool -> Bool
|| Actor -> Bool
targetableLine Actor
body)
              -- prevent the exploit of using cover against non-moving shooters
              -- causing them to ignore any other distant foes
      targetableLine :: Actor -> Bool
targetableLine Actor
body = Maybe Int -> Bool
forall a. Maybe a -> Bool
isJust (Maybe Int -> Bool) -> Maybe Int -> Bool
forall a b. (a -> b) -> a -> b
$ Bool -> Actor -> Point -> Int -> COps -> Level -> Maybe Int
makeLine Bool
False Actor
b (Actor -> Point
bpos Actor
body) Int
seps COps
cops Level
lvl
      targetableEnemy :: (ActorId, Actor) -> Bool
targetableEnemy (ActorId
aidE, Actor
body) = ActorId -> Actor -> Bool
worthTargeting ActorId
aidE Actor
body
                                     Bool -> Bool -> Bool
&& (Point -> Point -> Bool
adjacent (Actor -> Point
bpos Actor
body) (Actor -> Point
bpos Actor
b)
                                            -- target regardless of anything,
                                            -- e.g., to flee if helpless
                                         Bool -> Bool -> Bool
|| Actor -> Bool
targetableMelee Actor
body
                                         Bool -> Bool -> Bool
|| Actor -> Bool
targetableRanged Actor
body)
      targetableFoes :: [(ActorId, Actor)]
targetableFoes = ((ActorId, Actor) -> Bool)
-> [(ActorId, Actor)] -> [(ActorId, Actor)]
forall a. (a -> Bool) -> [a] -> [a]
filter (ActorId, Actor) -> Bool
targetableEnemy [(ActorId, Actor)]
foeAssocs
      canMeleeEnemy :: (ActorId, Actor) -> Bool
canMeleeEnemy (ActorId
aidE, Actor
body) = ActorMaxSkills -> ActorId -> Actor -> Bool
actorCanMeleeToHarm ActorMaxSkills
actorMaxSkills ActorId
aidE Actor
body
      nearbyFoes :: [(ActorId, Actor)]
nearbyFoes = if Bool
recentlyFled Bool -> Bool -> Bool
&& Bool -> Bool
not Bool
condInMelee
                   then ((ActorId, Actor) -> Bool)
-> [(ActorId, Actor)] -> [(ActorId, Actor)]
forall a. (a -> Bool) -> [a] -> [a]
filter (Bool -> Bool
not (Bool -> Bool)
-> ((ActorId, Actor) -> Bool) -> (ActorId, Actor) -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ActorId, Actor) -> Bool
canMeleeEnemy) [(ActorId, Actor)]
targetableFoes
                   else [(ActorId, Actor)]
targetableFoes
  DiscoveryBenefit
discoBenefit <- (StateClient -> DiscoveryBenefit) -> m DiscoveryBenefit
forall a. (StateClient -> a) -> m a
forall (m :: * -> *) a.
MonadClientRead m =>
(StateClient -> a) -> m a
getsClient StateClient -> DiscoveryBenefit
sdiscoBenefit
  ItemId -> ItemKind
getKind <- (State -> ItemId -> ItemKind) -> m (ItemId -> ItemKind)
forall a. (State -> a) -> m a
forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
getsState ((State -> ItemId -> ItemKind) -> m (ItemId -> ItemKind))
-> (State -> ItemId -> ItemKind) -> m (ItemId -> ItemKind)
forall a b. (a -> b) -> a -> b
$ (ItemId -> State -> ItemKind) -> State -> ItemId -> ItemKind
forall a b c. (a -> b -> c) -> b -> a -> c
flip ItemId -> State -> ItemKind
getIidKind
  ItemId -> AspectRecord
getArItem <- (State -> ItemId -> AspectRecord) -> m (ItemId -> AspectRecord)
forall a. (State -> a) -> m a
forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
getsState ((State -> ItemId -> AspectRecord) -> m (ItemId -> AspectRecord))
-> (State -> ItemId -> AspectRecord) -> m (ItemId -> AspectRecord)
forall a b. (a -> b) -> a -> b
$ (ItemId -> State -> AspectRecord)
-> State -> ItemId -> AspectRecord
forall a b c. (a -> b -> c) -> b -> a -> c
flip ItemId -> State -> AspectRecord
aspectRecordFromIid
  [(Int, (FactionId, Point))]
cstashes <- if Bool
canMove
                 Bool -> Bool -> Bool
&& (Bool
calmE Bool -> Bool -> Bool
|| [(ActorId, Actor)] -> Bool
forall a. [a] -> Bool
null [(ActorId, Actor)]
nearbyFoes) -- danger or risk of defecting
                 Bool -> Bool -> Bool
&& Bool -> Bool
not Bool
heavilyDistressed
                 Bool -> Bool -> Bool
&& Faction -> Bool
gunderAI Faction
fact  -- humans target any stashes explicitly
              then ActorId -> m [(Int, (FactionId, Point))]
forall (m :: * -> *).
MonadClient m =>
ActorId -> m [(Int, (FactionId, Point))]
closestStashes ActorId
aid
              else [(Int, (FactionId, Point))] -> m [(Int, (FactionId, Point))]
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return []
  let desirableIid :: (ItemId, (Int, ItemTimers)) -> Bool
desirableIid (ItemId
iid, (Int
k, ItemTimers
_)) =
        let Benefit{Double
benPickup :: Double
benPickup :: Benefit -> Double
benPickup} = DiscoveryBenefit
discoBenefit DiscoveryBenefit -> ItemId -> Benefit
forall k a. Enum k => EnumMap k a -> k -> a
EM.! ItemId
iid
        in COps -> Bool -> Double -> AspectRecord -> ItemKind -> Int -> Bool
desirableItem COps
cops Bool
canEscape Double
benPickup
                         (ItemId -> AspectRecord
getArItem ItemId
iid) (ItemId -> ItemKind
getKind ItemId
iid) Int
k
      desirableBagFloor :: ItemBag -> Bool
desirableBagFloor ItemBag
bag = ((ItemId, (Int, ItemTimers)) -> Bool)
-> [(ItemId, (Int, ItemTimers))] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (ItemId, (Int, ItemTimers)) -> Bool
desirableIid ([(ItemId, (Int, ItemTimers))] -> Bool)
-> [(ItemId, (Int, ItemTimers))] -> Bool
forall a b. (a -> b) -> a -> b
$ ItemBag -> [(ItemId, (Int, ItemTimers))]
forall k a. Enum k => EnumMap k a -> [(k, a)]
EM.assocs ItemBag
bag
      desirableFloor :: (Int, (Point, ItemBag)) -> Bool
desirableFloor (Int
_, (Point
_, ItemBag
bag)) = ItemBag -> Bool
desirableBagFloor ItemBag
bag
      focused :: Bool
focused = Skills -> Speed
gearSpeed Skills
actorMaxSk Speed -> Speed -> Bool
forall a. Ord a => a -> a -> Bool
< Speed
speedWalk Bool -> Bool -> Bool
|| Bool
condHpTooLow
      couldMoveLastTurn :: Bool
couldMoveLastTurn =  -- approximated; could have changed
        let actorSk :: Skills
actorSk = if Maybe ActorId
mleader Maybe ActorId -> Maybe ActorId -> Bool
forall a. Eq a => a -> a -> Bool
== ActorId -> Maybe ActorId
forall a. a -> Maybe a
Just ActorId
aid then Skills
actorMaxSk else Skills
actorMinSk
        in Skill -> Skills -> Int
Ability.getSk Skill
Ability.SkMove Skills
actorSk Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
0
      isStuck :: Bool
isStuck = Actor -> Bool
actorWaits Actor
b Bool -> Bool -> Bool
&& Bool
couldMoveLastTurn
      setPath :: Target -> m (Maybe TgtAndPath)
      setPath :: Target -> m (Maybe TgtAndPath)
setPath Target
tgt = do
        let take6 :: TgtAndPath -> TgtAndPath
take6 tap :: TgtAndPath
tap@TgtAndPath{tapTgt :: TgtAndPath -> Target
tapTgt=TEnemy{}} = TgtAndPath
tap
              -- @TEnemy@ needed for projecting, even by roaming actors;
              -- however, CStash not as binding, so excursions possible
            take6 TgtAndPath{tapPath :: TgtAndPath -> Maybe AndPath
tapPath=Just AndPath{Int
[Point]
Point
pathSource :: AndPath -> Point
pathList :: AndPath -> [Point]
pathGoal :: AndPath -> Point
pathLen :: AndPath -> Int
pathSource :: Point
pathList :: [Point]
pathGoal :: Point
pathLen :: Int
..}} =
              -- Path followed for up to 6 moves regardless if the target valid
              -- and then target forgot and a new one picked.
              let path6 :: [Point]
path6 = Int -> [Point] -> [Point]
forall a. Int -> [a] -> [a]
take Int
6 [Point]
pathList
                  vOld :: Vector
vOld = if Actor -> Point
bpos Actor
b Point -> Point -> Bool
forall a. Eq a => a -> a -> Bool
/= Point
pathGoal
                         then Point -> Point -> Vector
towards (Actor -> Point
bpos Actor
b) Point
pathGoal
                         else Int -> Int -> Vector
Vector Int
0 Int
0
                  tapTgt :: Target
tapTgt = Vector -> Target
TVector Vector
vOld
                  tapPath :: Maybe AndPath
tapPath = AndPath -> Maybe AndPath
forall a. a -> Maybe a
Just AndPath{pathList :: [Point]
pathList=[Point]
path6, Int
Point
pathSource :: Point
pathGoal :: Point
pathLen :: Int
pathSource :: Point
pathGoal :: Point
pathLen :: Int
..}
              in TgtAndPath{Maybe AndPath
Target
tapTgt :: Target
tapPath :: Maybe AndPath
tapTgt :: Target
tapPath :: Maybe AndPath
..}
            take6 TgtAndPath
tap = TgtAndPath
tap
        TgtAndPath
tgtpath <- ActorId -> Target -> m TgtAndPath
forall (m :: * -> *).
MonadClient m =>
ActorId -> Target -> m TgtAndPath
createPath ActorId
aid Target
tgt
        Maybe TgtAndPath -> m (Maybe TgtAndPath)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe TgtAndPath -> m (Maybe TgtAndPath))
-> Maybe TgtAndPath -> m (Maybe TgtAndPath)
forall a b. (a -> b) -> a -> b
$ TgtAndPath -> Maybe TgtAndPath
forall a. a -> Maybe a
Just (TgtAndPath -> Maybe TgtAndPath) -> TgtAndPath -> Maybe TgtAndPath
forall a b. (a -> b) -> a -> b
$ if Bool
slackDoctrine then TgtAndPath -> TgtAndPath
take6 TgtAndPath
tgtpath else TgtAndPath
tgtpath
      pickNewTarget :: m (Maybe TgtAndPath)
pickNewTarget = Maybe ActorId -> m (Maybe TgtAndPath)
pickNewTargetIgnore Maybe ActorId
forall a. Maybe a
Nothing
      pickNewTargetIgnore :: Maybe ActorId -> m (Maybe TgtAndPath)
      pickNewTargetIgnore :: Maybe ActorId -> m (Maybe TgtAndPath)
pickNewTargetIgnore Maybe ActorId
maidToIgnore =
        case [(Int, (FactionId, Point))]
cstashes of
          (Int
_, (FactionId
fid2, Point
pos2)) : [(Int, (FactionId, Point))]
_ -> Target -> m (Maybe TgtAndPath)
setPath (Target -> m (Maybe TgtAndPath)) -> Target -> m (Maybe TgtAndPath)
forall a b. (a -> b) -> a -> b
$ TGoal -> LevelId -> Point -> Target
TPoint (FactionId -> TGoal
TStash FactionId
fid2) (Actor -> LevelId
blid Actor
b) Point
pos2
          [] -> do
            let f :: ActorId -> [(ActorId, Actor)]
f ActorId
aidToIgnore = ((ActorId, Actor) -> Bool)
-> [(ActorId, Actor)] -> [(ActorId, Actor)]
forall a. (a -> Bool) -> [a] -> [a]
filter ((ActorId -> ActorId -> Bool
forall a. Eq a => a -> a -> Bool
/= ActorId
aidToIgnore) (ActorId -> Bool)
-> ((ActorId, Actor) -> ActorId) -> (ActorId, Actor) -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ActorId, Actor) -> ActorId
forall a b. (a, b) -> a
fst) [(ActorId, Actor)]
nearbyFoes
                notIgnoredFoes :: [(ActorId, Actor)]
notIgnoredFoes = [(ActorId, Actor)]
-> (ActorId -> [(ActorId, Actor)])
-> Maybe ActorId
-> [(ActorId, Actor)]
forall b a. b -> (a -> b) -> Maybe a -> b
maybe [(ActorId, Actor)]
nearbyFoes ActorId -> [(ActorId, Actor)]
f Maybe ActorId
maidToIgnore
            [(Int, (ActorId, Actor))]
cfoes <- [(ActorId, Actor)] -> ActorId -> m [(Int, (ActorId, Actor))]
forall (m :: * -> *).
MonadClient m =>
[(ActorId, Actor)] -> ActorId -> m [(Int, (ActorId, Actor))]
closestFoes [(ActorId, Actor)]
notIgnoredFoes ActorId
aid
            case [(Int, (ActorId, Actor))]
cfoes of
             (Int
_, (ActorId
aid2, Actor
_)) : [(Int, (ActorId, Actor))]
_ -> Target -> m (Maybe TgtAndPath)
setPath (Target -> m (Maybe TgtAndPath)) -> Target -> m (Maybe TgtAndPath)
forall a b. (a -> b) -> a -> b
$ ActorId -> Target
TEnemy ActorId
aid2
             [] | Bool
condInMelee -> Maybe TgtAndPath -> m (Maybe TgtAndPath)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe TgtAndPath
forall a. Maybe a
Nothing  -- don't slow down fighters
               -- this looks a bit strange, because teammates stop
               -- in their tracks all around the map (unless very close
               -- to the combatant), but the intuition is, not being able
               -- to help immediately, and not being too friendly
               -- to each other, they just wait and see and also shout
               -- to the teammate to flee and lure foes into ambush
             [] -> do
              Maybe (Point, Int)
mhideout <- if Bool
recentlyFled20
                          then ActorId -> m (Maybe (Point, Int))
forall (m :: * -> *).
MonadClient m =>
ActorId -> m (Maybe (Point, Int))
closestHideout ActorId
aid
                          else Maybe (Point, Int) -> m (Maybe (Point, Int))
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe (Point, Int)
forall a. Maybe a
Nothing
              case (Maybe (Point, Int)
mhideout, Maybe (Point, Time)
mfled) of
               (Just (Point
p, Int
dist), Just (Point
_, Time
time))
                 | Time -> Time -> Delta Time
timeDeltaToFrom Time
localTime Time
time
                   Delta Time -> Delta Time -> Bool
forall a. Ord a => a -> a -> Bool
<= Delta Time -> Int -> Delta Time
timeDeltaScale Delta Time
actorTurn (Int
20 Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
dist) ->
                -- Only target if can reach the hideout 20 turns from fleeing
                -- start, given the actor speed as a leader.
                Target -> m (Maybe TgtAndPath)
setPath (Target -> m (Maybe TgtAndPath)) -> Target -> m (Maybe TgtAndPath)
forall a b. (a -> b) -> a -> b
$ TGoal -> LevelId -> Point -> Target
TPoint TGoal
THideout (Actor -> LevelId
blid Actor
b) Point
p
               (Maybe (Point, Int), Maybe (Point, Time))
_ -> do
                [(Int, (Point, ItemBag))]
citemsRaw <- if Bool
canMoveItem Bool -> Bool -> Bool
&& Bool
canMove
                             then ActorId -> m [(Int, (Point, ItemBag))]
forall (m :: * -> *).
MonadClient m =>
ActorId -> m [(Int, (Point, ItemBag))]
closestItems ActorId
aid
                             else [(Int, (Point, ItemBag))] -> m [(Int, (Point, ItemBag))]
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return []
                let citems :: Frequency (Point, ItemBag)
citems = Text -> [(Int, (Point, ItemBag))] -> Frequency (Point, ItemBag)
forall a. Text -> [(Int, a)] -> Frequency a
toFreq Text
"closestItems"
                             ([(Int, (Point, ItemBag))] -> Frequency (Point, ItemBag))
-> [(Int, (Point, ItemBag))] -> Frequency (Point, ItemBag)
forall a b. (a -> b) -> a -> b
$ ((Int, (Point, ItemBag)) -> Bool)
-> [(Int, (Point, ItemBag))] -> [(Int, (Point, ItemBag))]
forall a. (a -> Bool) -> [a] -> [a]
filter (Int, (Point, ItemBag)) -> Bool
desirableFloor [(Int, (Point, ItemBag))]
citemsRaw
                if Frequency (Point, ItemBag) -> Bool
forall a. Frequency a -> Bool
nullFreq Frequency (Point, ItemBag)
citems then do
                  -- Tracking enemies is more important than exploring,
                  -- but smell is unreliable and may lead to allies,
                  -- not foes, so avoid it. However, let's keep smell
                  -- more imporant than getting to stairs, to let smelling
                  -- monsters follow cues even on explored levels.
                  [(Int, (Point, Time))]
smpos <- if Bool
canSmell
                           then ActorId -> m [(Int, (Point, Time))]
forall (m :: * -> *).
MonadClient m =>
ActorId -> m [(Int, (Point, Time))]
closestSmell ActorId
aid
                           else [(Int, (Point, Time))] -> m [(Int, (Point, Time))]
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return []
                  case [(Int, (Point, Time))]
smpos of
                    [] -> do
                      [(Int, (Point, (Point, ItemBag)))]
ctriggersRaw <- FleeViaStairsOrEscape
-> ActorId -> m [(Int, (Point, (Point, ItemBag)))]
forall (m :: * -> *).
MonadClient m =>
FleeViaStairsOrEscape
-> ActorId -> m [(Int, (Point, (Point, ItemBag)))]
closestTriggers FleeViaStairsOrEscape
ViaAnything ActorId
aid
                      let ctriggers :: Frequency (Point, (Point, ItemBag))
ctriggers = Text
-> [(Int, (Point, (Point, ItemBag)))]
-> Frequency (Point, (Point, ItemBag))
forall a. Text -> [(Int, a)] -> Frequency a
toFreq Text
"ctriggers" [(Int, (Point, (Point, ItemBag)))]
ctriggersRaw
                      if Frequency (Point, (Point, ItemBag)) -> Bool
forall a. Frequency a -> Bool
nullFreq Frequency (Point, (Point, ItemBag))
ctriggers then do
                        let oldpos :: Point
oldpos = Point -> Maybe Point -> Point
forall a. a -> Maybe a -> a
fromMaybe (Actor -> Point
bpos Actor
b) (Actor -> Maybe Point
boldpos Actor
b)
                            vOld :: Vector
vOld = Actor -> Point
bpos Actor
b Point -> Point -> Vector
`vectorToFrom` Point
oldpos
                            pNew :: Point
pNew = Int -> Int -> Point -> Vector -> Point
shiftBounded Int
rWidthMax Int
rHeightMax (Actor -> Point
bpos Actor
b) Vector
vOld
                        if Bool
slackDoctrine Bool -> Bool -> Bool
&& Bool -> Bool
not Bool
isStuck Bool -> Bool -> Bool
&& Bool
calmE Bool -> Bool -> Bool
&& Bool -> Bool
not Bool
focused
                           Bool -> Bool -> Bool
&& Vector -> Bool
isUnit Vector
vOld Bool -> Bool -> Bool
&& Actor -> Point
bpos Actor
b Point -> Point -> Bool
forall a. Eq a => a -> a -> Bool
/= Point
pNew
                                -- both are needed, e.g., when just teleported
                                -- or when the shift bounded by level borders
                        then do
                          let vFreq :: Frequency Vector
vFreq = Text -> [(Int, Vector)] -> Frequency Vector
forall a. Text -> [(Int, a)] -> Frequency a
toFreq Text
"vFreq"
                                      ([(Int, Vector)] -> Frequency Vector)
-> [(Int, Vector)] -> Frequency Vector
forall a b. (a -> b) -> a -> b
$ (Int
20, Vector
vOld) (Int, Vector) -> [(Int, Vector)] -> [(Int, Vector)]
forall a. a -> [a] -> [a]
: (Vector -> (Int, Vector)) -> [Vector] -> [(Int, Vector)]
forall a b. (a -> b) -> [a] -> [b]
map (Int
1,) [Vector]
moves
                          Vector
v <- Rnd Vector -> m Vector
forall (m :: * -> *) a. MonadClient m => Rnd a -> m a
rndToAction (Rnd Vector -> m Vector) -> Rnd Vector -> m Vector
forall a b. (a -> b) -> a -> b
$ Frequency Vector -> Rnd Vector
forall a. Show a => Frequency a -> Rnd a
frequency Frequency Vector
vFreq
                          -- Once the most pressing targets exhaused,
                          -- wander around for 7 steps and only then,
                          -- or if blocked or derailed, consider again
                          -- the old and new targets.
                          --
                          -- Together with depending on heroes or aliens
                          -- to keep arean, sleepiness, inability to displace
                          -- and chasing random smells, this makes it very hard
                          -- to fully explore and change levels for, e.g.,
                          -- animals. Heroes idling on the level help a lot.
                          let pathSource :: Point
pathSource = Actor -> Point
bpos Actor
b
                              traSlack7 :: [Point]
traSlack7 = Int -> Int -> Point -> [Vector] -> [Point]
trajectoryToPathBounded
                                            Int
rWidthMax Int
rHeightMax Point
pathSource
                                            (Int -> Vector -> [Vector]
forall a. Int -> a -> [a]
replicate Int
7 Vector
v)  -- > 6 from take6
                              pathList :: [Point]
pathList = ([Point] -> Point) -> [[Point]] -> [Point]
forall a b. (a -> b) -> [a] -> [b]
map [Point] -> Point
forall a. (?callStack::CallStack) => [a] -> a
head ([[Point]] -> [Point]) -> [[Point]] -> [Point]
forall a b. (a -> b) -> a -> b
$ [Point] -> [[Point]]
forall a. Eq a => [a] -> [[a]]
group [Point]
traSlack7
                              pathGoal :: Point
pathGoal = [Point] -> Point
forall a. (?callStack::CallStack) => [a] -> a
last [Point]
pathList
                              pathLen :: Int
pathLen = [Point] -> Int
forall a. [a] -> Int
length [Point]
pathList
                              tapTgt :: Target
tapTgt = Vector -> Target
TVector Vector
v
                              tapPath :: Maybe AndPath
tapPath = AndPath -> Maybe AndPath
forall a. a -> Maybe a
Just AndPath{Int
[Point]
Point
pathSource :: Point
pathList :: [Point]
pathGoal :: Point
pathLen :: Int
pathSource :: Point
pathList :: [Point]
pathGoal :: Point
pathLen :: Int
..}
                          Maybe TgtAndPath -> m (Maybe TgtAndPath)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe TgtAndPath -> m (Maybe TgtAndPath))
-> Maybe TgtAndPath -> m (Maybe TgtAndPath)
forall a b. (a -> b) -> a -> b
$ TgtAndPath -> Maybe TgtAndPath
forall a. a -> Maybe a
Just TgtAndPath {Maybe AndPath
Target
tapTgt :: Target
tapPath :: Maybe AndPath
tapTgt :: Target
tapPath :: Maybe AndPath
..}
                        else do
                          Maybe Point
upos <- if Bool
canMove
                                  then ActorId -> m (Maybe Point)
forall (m :: * -> *). MonadClient m => ActorId -> m (Maybe Point)
closestUnknown ActorId
aid
                                  else Maybe Point -> m (Maybe Point)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe Point
forall a. Maybe a
Nothing
                          case Maybe Point
upos of
                            Maybe Point
Nothing -> do
                              -- If can't move (and so no BFS data),
                              -- no info gained. Or if can't open doors.
                              -- If stuck among ice pillars, we can't help it.
                              Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Bool
canMove Bool -> Bool -> Bool
&& Bool
canAlter) (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$
                                (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 {sexplored =
                                  ES.insert (blid b) (sexplored cli)}
                              [(Int, (Point, (Point, ItemBag)))]
ctriggersRaw2 <- FleeViaStairsOrEscape
-> ActorId -> m [(Int, (Point, (Point, ItemBag)))]
forall (m :: * -> *).
MonadClient m =>
FleeViaStairsOrEscape
-> ActorId -> m [(Int, (Point, (Point, ItemBag)))]
closestTriggers FleeViaStairsOrEscape
ViaExit ActorId
aid
                              let ctriggers2 :: Frequency (Point, (Point, ItemBag))
ctriggers2 = Text
-> [(Int, (Point, (Point, ItemBag)))]
-> Frequency (Point, (Point, ItemBag))
forall a. Text -> [(Int, a)] -> Frequency a
toFreq Text
"ctriggers2" [(Int, (Point, (Point, ItemBag)))]
ctriggersRaw2
                              if Frequency (Point, (Point, ItemBag)) -> Bool
forall a. Frequency a -> Bool
nullFreq Frequency (Point, (Point, ItemBag))
ctriggers2 then do
                                let toKill :: ActorId -> Actor -> Bool
toKill = ActorMaxSkills -> ActorId -> Actor -> Bool
actorWorthKilling ActorMaxSkills
actorMaxSkills
                                    worthyFoes :: [(ActorId, Actor)]
worthyFoes = ((ActorId, Actor) -> Bool)
-> [(ActorId, Actor)] -> [(ActorId, Actor)]
forall a. (a -> Bool) -> [a] -> [a]
filter ((ActorId -> Actor -> Bool) -> (ActorId, Actor) -> Bool
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry ActorId -> Actor -> Bool
toKill)
                                                        [(ActorId, Actor)]
foeAssocs
                                [(Int, (ActorId, Actor))]
afoes <- [(ActorId, Actor)] -> ActorId -> m [(Int, (ActorId, Actor))]
forall (m :: * -> *).
MonadClient m =>
[(ActorId, Actor)] -> ActorId -> m [(Int, (ActorId, Actor))]
closestFoes [(ActorId, Actor)]
worthyFoes ActorId
aid
                                case [(Int, (ActorId, Actor))]
afoes of
                                  (Int
_, (ActorId
aid2, Actor
_)) : [(Int, (ActorId, Actor))]
_ ->
                                    -- All stones turned, time to win or die.
                                    Target -> m (Maybe TgtAndPath)
setPath (Target -> m (Maybe TgtAndPath)) -> Target -> m (Maybe TgtAndPath)
forall a b. (a -> b) -> a -> b
$ ActorId -> Target
TEnemy ActorId
aid2
                                  [] -> do
                                    Point
furthest <- ActorId -> m Point
forall (m :: * -> *). MonadClient m => ActorId -> m Point
furthestKnown ActorId
aid
                                    Target -> m (Maybe TgtAndPath)
setPath (Target -> m (Maybe TgtAndPath)) -> Target -> m (Maybe TgtAndPath)
forall a b. (a -> b) -> a -> b
$ TGoal -> LevelId -> Point -> Target
TPoint TGoal
TKnown (Actor -> LevelId
blid Actor
b) Point
furthest
                              else do
                                (Point
p, (Point
p0, ItemBag
bag)) <-
                                  Rnd (Point, (Point, ItemBag)) -> m (Point, (Point, ItemBag))
forall (m :: * -> *) a. MonadClient m => Rnd a -> m a
rndToAction (Rnd (Point, (Point, ItemBag)) -> m (Point, (Point, ItemBag)))
-> Rnd (Point, (Point, ItemBag)) -> m (Point, (Point, ItemBag))
forall a b. (a -> b) -> a -> b
$ Frequency (Point, (Point, ItemBag))
-> Rnd (Point, (Point, ItemBag))
forall a. Show a => Frequency a -> Rnd a
frequency Frequency (Point, (Point, ItemBag))
ctriggers2
                                Target -> m (Maybe TgtAndPath)
setPath (Target -> m (Maybe TgtAndPath)) -> Target -> m (Maybe TgtAndPath)
forall a b. (a -> b) -> a -> b
$ TGoal -> LevelId -> Point -> Target
TPoint (ItemBag -> Point -> TGoal
TEmbed ItemBag
bag Point
p0) (Actor -> LevelId
blid Actor
b) Point
p
                            Just Point
p -> Target -> m (Maybe TgtAndPath)
setPath (Target -> m (Maybe TgtAndPath)) -> Target -> m (Maybe TgtAndPath)
forall a b. (a -> b) -> a -> b
$ TGoal -> LevelId -> Point -> Target
TPoint TGoal
TUnknown (Actor -> LevelId
blid Actor
b) Point
p
                      else do
                        (Point
p, (Point
p0, ItemBag
bag)) <- Rnd (Point, (Point, ItemBag)) -> m (Point, (Point, ItemBag))
forall (m :: * -> *) a. MonadClient m => Rnd a -> m a
rndToAction (Rnd (Point, (Point, ItemBag)) -> m (Point, (Point, ItemBag)))
-> Rnd (Point, (Point, ItemBag)) -> m (Point, (Point, ItemBag))
forall a b. (a -> b) -> a -> b
$ Frequency (Point, (Point, ItemBag))
-> Rnd (Point, (Point, ItemBag))
forall a. Show a => Frequency a -> Rnd a
frequency Frequency (Point, (Point, ItemBag))
ctriggers
                        Target -> m (Maybe TgtAndPath)
setPath (Target -> m (Maybe TgtAndPath)) -> Target -> m (Maybe TgtAndPath)
forall a b. (a -> b) -> a -> b
$ TGoal -> LevelId -> Point -> Target
TPoint (ItemBag -> Point -> TGoal
TEmbed ItemBag
bag Point
p0) (Actor -> LevelId
blid Actor
b) Point
p
                    (Int
_, (Point
p, Time
_)) : [(Int, (Point, Time))]
_ -> Target -> m (Maybe TgtAndPath)
setPath (Target -> m (Maybe TgtAndPath)) -> Target -> m (Maybe TgtAndPath)
forall a b. (a -> b) -> a -> b
$ TGoal -> LevelId -> Point -> Target
TPoint TGoal
TSmell (Actor -> LevelId
blid Actor
b) Point
p
                else do
                  (Point
p, ItemBag
bag) <- Rnd (Point, ItemBag) -> m (Point, ItemBag)
forall (m :: * -> *) a. MonadClient m => Rnd a -> m a
rndToAction (Rnd (Point, ItemBag) -> m (Point, ItemBag))
-> Rnd (Point, ItemBag) -> m (Point, ItemBag)
forall a b. (a -> b) -> a -> b
$ Frequency (Point, ItemBag) -> Rnd (Point, ItemBag)
forall a. Show a => Frequency a -> Rnd a
frequency Frequency (Point, ItemBag)
citems
                  Target -> m (Maybe TgtAndPath)
setPath (Target -> m (Maybe TgtAndPath)) -> Target -> m (Maybe TgtAndPath)
forall a b. (a -> b) -> a -> b
$ TGoal -> LevelId -> Point -> Target
TPoint (ItemBag -> TGoal
TItem ItemBag
bag) (Actor -> LevelId
blid Actor
b) Point
p
      tellOthersNothingHere :: m (Maybe TgtAndPath)
tellOthersNothingHere = do
        let f :: TgtAndPath -> Bool
f TgtAndPath{Target
tapTgt :: TgtAndPath -> Target
tapTgt :: Target
tapTgt} = case Target
tapTgt of
              TPoint TGoal
_ LevelId
lid Point
p -> Point
p Point -> Point -> Bool
forall a. Eq a => a -> a -> Bool
/= Actor -> Point
bpos Actor
b Bool -> Bool -> Bool
|| LevelId
lid LevelId -> LevelId -> Bool
forall a. Eq a => a -> a -> Bool
/= Actor -> LevelId
blid Actor
b
              Target
_ -> Bool
True
        (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 {stargetD = EM.filter f (stargetD cli)}
        m (Maybe TgtAndPath)
pickNewTarget
      updateTgt :: TgtAndPath -> m (Maybe TgtAndPath)
      updateTgt :: TgtAndPath -> m (Maybe TgtAndPath)
updateTgt TgtAndPath{tapPath :: TgtAndPath -> Maybe AndPath
tapPath=Maybe AndPath
Nothing} = m (Maybe TgtAndPath)
pickNewTarget
      updateTgt tap :: TgtAndPath
tap@TgtAndPath{tapPath :: TgtAndPath -> Maybe AndPath
tapPath=Just AndPath{Int
[Point]
Point
pathSource :: AndPath -> Point
pathList :: AndPath -> [Point]
pathGoal :: AndPath -> Point
pathLen :: AndPath -> Int
pathSource :: Point
pathList :: [Point]
pathGoal :: Point
pathLen :: Int
..},Target
tapTgt :: TgtAndPath -> Target
tapTgt :: Target
tapTgt} = case Target
tapTgt of
        TEnemy ActorId
a -> do
          Actor
body <- (State -> Actor) -> m Actor
forall a. (State -> a) -> m a
forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
getsState ((State -> Actor) -> m Actor) -> (State -> Actor) -> m Actor
forall a b. (a -> b) -> a -> b
$ ActorId -> State -> Actor
getActorBody ActorId
a
          if   (Bool
condInMelee  -- fight close foes or nobody at all
                Bool -> Bool -> Bool
|| Actor -> Int
bweapon Actor
body Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
0  -- not dangerous
                Bool -> Bool -> Bool
|| Bool -> Bool
not Bool
focused Bool -> Bool -> Bool
&& Bool -> Bool
not ([(ActorId, Actor)] -> Bool
forall a. [a] -> Bool
null [(ActorId, Actor)]
nearbyFoes))  -- prefers closer foes
               Bool -> Bool -> Bool
&& ActorId
a ActorId -> [ActorId] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`notElem` ((ActorId, Actor) -> ActorId) -> [(ActorId, Actor)] -> [ActorId]
forall a b. (a -> b) -> [a] -> [b]
map (ActorId, Actor) -> ActorId
forall a b. (a, b) -> a
fst [(ActorId, Actor)]
nearbyFoes  -- old one not close enough
               Bool -> Bool -> Bool
|| Actor -> LevelId
blid Actor
body LevelId -> LevelId -> Bool
forall a. Eq a => a -> a -> Bool
/= Actor -> LevelId
blid Actor
b  -- wrong level
               Bool -> Bool -> Bool
|| Actor -> Bool
actorDying Actor
body  -- foe already dying
               Bool -> Bool -> Bool
|| Bool -> Bool
not (ActorId -> Actor -> Bool
worthTargeting ActorId
a Actor
body)
               Bool -> Bool -> Bool
|| Bool
recentlyFled
          then
                    -- forget enemy positions to prevent attacking them
                    -- again soon after flight
               m (Maybe TgtAndPath)
pickNewTarget
          else do
               -- If there are no unwalkable tiles on the path to enemy,
               -- he gets target @TEnemy@ and then, even if such tiles emerge,
               -- the target updated by his moves remains @TEnemy@.
               -- Conversely, he is stuck with @TBlock@ if initial target had
               -- unwalkable tiles, for as long as they remain. Harmless quirk.
               Maybe AndPath
mpath <- ActorId -> Point -> m (Maybe AndPath)
forall (m :: * -> *).
MonadClient m =>
ActorId -> Point -> m (Maybe AndPath)
getCachePath ActorId
aid (Point -> m (Maybe AndPath)) -> Point -> m (Maybe AndPath)
forall a b. (a -> b) -> a -> b
$ Actor -> Point
bpos Actor
body
               case Maybe AndPath
mpath of
                 Maybe AndPath
Nothing -> Maybe ActorId -> m (Maybe TgtAndPath)
pickNewTargetIgnore (ActorId -> Maybe ActorId
forall a. a -> Maybe a
Just ActorId
a)
                   -- enemy became unreachable
                 Just AndPath{pathList :: AndPath -> [Point]
pathList=[]} -> m (Maybe TgtAndPath)
pickNewTarget
                   -- he is his own enemy
                 Just AndPath{pathList :: AndPath -> [Point]
pathList= Point
q : [Point]
_} ->
                   -- If in melee and path blocked by actors (even proj.)
                   -- change target for this turn due to urgency.
                   -- Because of @condInMelee@ new target will be stash
                   -- or enemy if any other is left, or empty target.
                   -- If not in melee, keep target and consider your options
                   -- (wait until blocking actors move or displace or melee
                   -- or sidestep). We don't want to wander away
                   -- in search of loot, only to turn around next turn
                   -- when the enemy is again considered.
                   if Bool -> Bool
not Bool
condInMelee
                      Bool -> Bool -> Bool
|| Point
q Point -> Point -> Bool
forall a. Eq a => a -> a -> Bool
== Actor -> Point
bpos Actor
body  -- blocked by the enemy, great!
                      Bool -> Bool -> Bool
|| Bool -> Bool
not (Point -> Level -> Bool
occupiedBigLvl Point
q Level
lvl)
                         Bool -> Bool -> Bool
&& Bool -> Bool
not (Point -> Level -> Bool
occupiedProjLvl Point
q Level
lvl)
                   then Maybe TgtAndPath -> m (Maybe TgtAndPath)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe TgtAndPath -> m (Maybe TgtAndPath))
-> Maybe TgtAndPath -> m (Maybe TgtAndPath)
forall a b. (a -> b) -> a -> b
$ TgtAndPath -> Maybe TgtAndPath
forall a. a -> Maybe a
Just TgtAndPath
tap{tapPath=mpath}
                   else Maybe ActorId -> m (Maybe TgtAndPath)
pickNewTargetIgnore (ActorId -> Maybe ActorId
forall a. a -> Maybe a
Just ActorId
a)
        TPoint TGoal
_ LevelId
lid Point
_ | LevelId
lid LevelId -> LevelId -> Bool
forall a. Eq a => a -> a -> Bool
/= Actor -> LevelId
blid Actor
b -> m (Maybe TgtAndPath)
pickNewTarget  -- wrong level
        TPoint TGoal
tgoal LevelId
lid Point
pos -> case TGoal
tgoal of
          TStash FactionId
fid2 -> do
            [(ActorId, Actor)]
oursExploring <- (State -> [(ActorId, Actor)]) -> m [(ActorId, Actor)]
forall a. (State -> a) -> m a
forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
getsState ((State -> [(ActorId, Actor)]) -> m [(ActorId, Actor)])
-> (State -> [(ActorId, Actor)]) -> m [(ActorId, Actor)]
forall a b. (a -> b) -> a -> b
$ FactionId -> State -> [(ActorId, Actor)]
oursExploringAssocs (Actor -> FactionId
bfid Actor
b)
            let oursExploringLid :: [(ActorId, Actor)]
oursExploringLid =
                  ((ActorId, Actor) -> Bool)
-> [(ActorId, Actor)] -> [(ActorId, Actor)]
forall a. (a -> Bool) -> [a] -> [a]
filter (\(ActorId
_, Actor
body) -> Actor -> LevelId
blid Actor
body LevelId -> LevelId -> Bool
forall a. Eq a => a -> a -> Bool
== LevelId
lid) [(ActorId, Actor)]
oursExploring
                spawnFreqs :: Freqs ItemKind
spawnFreqs = CaveKind -> Freqs ItemKind
CK.cactorFreq (CaveKind -> Freqs ItemKind) -> CaveKind -> Freqs ItemKind
forall a b. (a -> b) -> a -> b
$ ContentData CaveKind -> ContentId CaveKind -> CaveKind
forall a. ContentData a -> ContentId a -> a
okind ContentData CaveKind
cocave (ContentId CaveKind -> CaveKind) -> ContentId CaveKind -> CaveKind
forall a b. (a -> b) -> a -> b
$ Level -> ContentId CaveKind
lkind Level
lvl
                hasGroup :: GroupName ItemKind -> Bool
hasGroup GroupName ItemKind
grp = Int -> Maybe Int -> Int
forall a. a -> Maybe a -> a
fromMaybe Int
0 (GroupName ItemKind -> Freqs ItemKind -> Maybe Int
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup GroupName ItemKind
grp Freqs ItemKind
spawnFreqs) Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
0
                lvlSpawnsUs :: Bool
lvlSpawnsUs = ((GroupName ItemKind, Int) -> Bool) -> Freqs ItemKind -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (GroupName ItemKind -> Bool
hasGroup (GroupName ItemKind -> Bool)
-> ((GroupName ItemKind, Int) -> GroupName ItemKind)
-> (GroupName ItemKind, Int)
-> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (GroupName ItemKind, Int) -> GroupName ItemKind
forall a b. (a, b) -> a
fst) (Freqs ItemKind -> Bool) -> Freqs ItemKind -> Bool
forall a b. (a -> b) -> a -> b
$ ((GroupName ItemKind, Int) -> Bool)
-> Freqs ItemKind -> Freqs ItemKind
forall a. (a -> Bool) -> [a] -> [a]
filter ((Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
0) (Int -> Bool)
-> ((GroupName ItemKind, Int) -> Int)
-> (GroupName ItemKind, Int)
-> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (GroupName ItemKind, Int) -> Int
forall a b. (a, b) -> b
snd)
                                                   (Freqs ItemKind -> Freqs ItemKind)
-> Freqs ItemKind -> Freqs ItemKind
forall a b. (a -> b) -> a -> b
$ FactionKind -> Freqs ItemKind
fgroups (Faction -> FactionKind
gkind Faction
fact)
           -- Even if made peace with the faction, loot stash one last time.
            if (Bool
calmE Bool -> Bool -> Bool
|| [(ActorId, Actor)] -> Bool
forall a. [a] -> Bool
null [(ActorId, Actor)]
nearbyFoes)  -- no risk or can't defend anyway
               Bool -> Bool -> Bool
&& Bool -> Bool
not Bool
heavilyDistressed  -- not under heavy fire
               Bool -> Bool -> Bool
&& Faction -> Maybe (LevelId, Point)
gstash (FactionDict
factionD FactionDict -> FactionId -> Faction
forall k a. Enum k => EnumMap k a -> k -> a
EM.! FactionId
fid2) Maybe (LevelId, Point) -> Maybe (LevelId, Point) -> Bool
forall a. Eq a => a -> a -> Bool
== (LevelId, Point) -> Maybe (LevelId, Point)
forall a. a -> Maybe a
Just (LevelId
lid, Point
pos)
               -- The condition below is more lenient than in @closestStashes@
               -- to avoid wasting time on guard's movement.
               Bool -> Bool -> Bool
&& (FactionId
fid2 FactionId -> FactionId -> Bool
forall a. Eq a => a -> a -> Bool
== Actor -> FactionId
bfid Actor
b
                   Bool -> Bool -> Bool
&& (Point
pos Point -> Point -> Bool
forall a. Eq a => a -> a -> Bool
== Actor -> Point
bpos Actor
b  -- guarded by me, so keep guarding
                       Bool -> Bool -> Bool
&& ([(ActorId, Actor)] -> Bool
forall a. [a] -> Bool
null [(ActorId, Actor)]
nearbyFoes  -- if no foes nearby
                           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) -- or buddies nearby
                       Bool -> Bool -> Bool
|| Maybe ActorId -> Bool
forall a. Maybe a -> Bool
isNothing (Point -> Level -> Maybe ActorId
posToBigLvl Point
pos Level
lvl))  -- or unguarded
                   Bool -> Bool -> Bool
&& ([(ActorId, Actor)] -> Int
forall a. [a] -> Int
length [(ActorId, Actor)]
oursExploring Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
1  -- other actors able to explore
                       Bool -> Bool -> Bool
|| Bool
lvlSpawnsUs)  -- or future spawned will be able
                   Bool -> Bool -> Bool
|| FactionId -> Faction -> FactionId -> Bool
isFoe (Actor -> FactionId
bfid Actor
b) Faction
fact FactionId
fid2)
            then Maybe TgtAndPath -> m (Maybe TgtAndPath)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe TgtAndPath -> m (Maybe TgtAndPath))
-> Maybe TgtAndPath -> m (Maybe TgtAndPath)
forall a b. (a -> b) -> a -> b
$ TgtAndPath -> Maybe TgtAndPath
forall a. a -> Maybe a
Just TgtAndPath
tap
            else m (Maybe TgtAndPath)
pickNewTarget
          -- In this case, need to retarget, to focus on foes that melee ours
          -- and not, e.g., on remembered foes or items.
          TGoal
_ | Bool
condInMelee Bool -> Bool -> Bool
|| Bool -> Bool
not ([(Int, (FactionId, Point))] -> Bool
forall a. [a] -> Bool
null [(Int, (FactionId, Point))]
cstashes) -> m (Maybe TgtAndPath)
pickNewTarget
          TEnemyPos ActorId
_  -- chase last position even if foe hides
            | Actor -> Point
bpos Actor
b Point -> Point -> Bool
forall a. Eq a => a -> a -> Bool
== Point
pos -> m (Maybe TgtAndPath)
tellOthersNothingHere
            | Bool
recentlyFled -> m (Maybe TgtAndPath)
pickNewTarget
                -- forget enemy positions to prevent attacking them again soon
            | Bool -> Bool
not (Bool
couldMoveLastTurn Bool -> Bool -> Bool
|| [(ActorId, Actor)] -> Bool
forall a. [a] -> Bool
null [(ActorId, Actor)]
nearbyFoes) -> m (Maybe TgtAndPath)
pickNewTarget
                -- if only, possibly, shooting, forget hotspots, target foes;
                -- this results in only pointman humans chasing old foes
                -- in preference of new visible ones, but it's fine
            | Bool
otherwise -> do
              -- Here pick the closer enemy, the remembered or seen, to avoid
              -- loops when approaching new enemy obscures him behind obstacle
              -- but reveals the previously remembered one, etc.
              let remainingDist :: Int
remainingDist = Point -> Point -> Int
chessDist (Actor -> Point
bpos Actor
b) Point
pos
              if ((ActorId, Actor) -> Bool) -> [(ActorId, Actor)] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (\(ActorId
_, Actor
b3) -> Point -> Point -> Int
chessDist (Actor -> Point
bpos Actor
b) (Actor -> Point
bpos Actor
b3) Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
remainingDist)
                     [(ActorId, Actor)]
nearbyFoes
              then m (Maybe TgtAndPath)
pickNewTarget
              else Maybe TgtAndPath -> m (Maybe TgtAndPath)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe TgtAndPath -> m (Maybe TgtAndPath))
-> Maybe TgtAndPath -> m (Maybe TgtAndPath)
forall a b. (a -> b) -> a -> b
$ TgtAndPath -> Maybe TgtAndPath
forall a. a -> Maybe a
Just TgtAndPath
tap
          -- Don't stop fleeing into hideout after 5 turns even if foes appear.
          TGoal
THideout ->
            -- Approach or stay in the hideout until 20 turns pass.
            if Bool -> Bool
not Bool
recentlyFled20
            then m (Maybe TgtAndPath)
pickNewTarget
            else Maybe TgtAndPath -> m (Maybe TgtAndPath)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe TgtAndPath -> m (Maybe TgtAndPath))
-> Maybe TgtAndPath -> m (Maybe TgtAndPath)
forall a b. (a -> b) -> a -> b
$ TgtAndPath -> Maybe TgtAndPath
forall a. a -> Maybe a
Just TgtAndPath
tap
          -- Prefer close foes to anything else below.
          TGoal
_ | Bool -> Bool
not ([(ActorId, Actor)] -> Bool
forall a. [a] -> Bool
null [(ActorId, Actor)]
nearbyFoes) -> m (Maybe TgtAndPath)
pickNewTarget
          -- Below we check the target could not be picked again in
          -- pickNewTarget (e.g., an item got picked up by our teammate)
          -- and only in this case it is invalidated.
          -- This ensures targets are eventually reached (unless a foe
          -- shows up) and not changed all the time mid-route
          -- to equally interesting, but perhaps a bit closer targets,
          -- most probably already targeted by other actors.
          TEmbed ItemBag
bag Point
p -> Bool -> m (Maybe TgtAndPath) -> m (Maybe TgtAndPath)
forall a. (?callStack::CallStack) => Bool -> a -> a
assert (Point -> Point -> Bool
adjacent Point
pos Point
p) (m (Maybe TgtAndPath) -> m (Maybe TgtAndPath))
-> m (Maybe TgtAndPath) -> m (Maybe TgtAndPath)
forall a b. (a -> b) -> a -> b
$ do
            -- First, stairs and embedded items from @closestTriggers@.
            -- We don't check skills, because they normally don't change
            -- or we can put some equipment back and recover them.
            -- We don't determine if the stairs or embed are interesting
            -- (this changes with time), but allow the actor
            -- to reach them and then retarget. The two things we check
            -- is whether the embedded bag is still there, or used up
            -- and whether we happen to be already adjacent to @p@,
            -- even though not necessarily at @pos@.
            ItemBag
bag2 <- (State -> ItemBag) -> m ItemBag
forall a. (State -> a) -> m a
forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
getsState ((State -> ItemBag) -> m ItemBag)
-> (State -> ItemBag) -> m ItemBag
forall a b. (a -> b) -> a -> b
$ LevelId -> Point -> State -> ItemBag
getEmbedBag LevelId
lid Point
p  -- not @pos@
            if | ItemBag
bag ItemBag -> ItemBag -> Bool
forall a. Eq a => a -> a -> Bool
/= ItemBag
bag2 -> m (Maybe TgtAndPath)
pickNewTarget  -- others will notice soon enough
               | Point -> Point -> Bool
adjacent (Actor -> Point
bpos Actor
b) Point
p ->  -- regardless if at @pos@ or not
                   Target -> m (Maybe TgtAndPath)
setPath (Target -> m (Maybe TgtAndPath)) -> Target -> m (Maybe TgtAndPath)
forall a b. (a -> b) -> a -> b
$ TGoal -> LevelId -> Point -> Target
TPoint TGoal
TKnown LevelId
lid (Actor -> Point
bpos Actor
b)
                     -- stay there one turn (high chance to become leader)
                     -- to enable triggering; if trigger fails
                     -- (e.g, changed skills), will retarget next turn (@TAny@)
               | Bool
otherwise -> Maybe TgtAndPath -> m (Maybe TgtAndPath)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe TgtAndPath -> m (Maybe TgtAndPath))
-> Maybe TgtAndPath -> m (Maybe TgtAndPath)
forall a b. (a -> b) -> a -> b
$ TgtAndPath -> Maybe TgtAndPath
forall a. a -> Maybe a
Just TgtAndPath
tap
          TItem ItemBag
bag -> do
            ItemBag
bag2 <- (State -> ItemBag) -> m ItemBag
forall a. (State -> a) -> m a
forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
getsState ((State -> ItemBag) -> m ItemBag)
-> (State -> ItemBag) -> m ItemBag
forall a b. (a -> b) -> a -> b
$ LevelId -> Point -> State -> ItemBag
getFloorBag LevelId
lid Point
pos
            if | ItemBag
bag ItemBag -> ItemBag -> Bool
forall a. Eq a => a -> a -> Bool
/= ItemBag
bag2 -> m (Maybe TgtAndPath)
pickNewTarget  -- others will notice soon enough
               | Actor -> Point
bpos Actor
b Point -> Point -> Bool
forall a. Eq a => a -> a -> Bool
== Point
pos ->
                   Target -> m (Maybe TgtAndPath)
setPath (Target -> m (Maybe TgtAndPath)) -> Target -> m (Maybe TgtAndPath)
forall a b. (a -> b) -> a -> b
$ TGoal -> LevelId -> Point -> Target
TPoint TGoal
TKnown LevelId
lid (Actor -> Point
bpos Actor
b)
                     -- stay there one turn (high chance to become leader)
                     -- to enable pickup; if pickup fails, will retarget
               | Bool
otherwise -> Maybe TgtAndPath -> m (Maybe TgtAndPath)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe TgtAndPath -> m (Maybe TgtAndPath))
-> Maybe TgtAndPath -> m (Maybe TgtAndPath)
forall a b. (a -> b) -> a -> b
$ TgtAndPath -> Maybe TgtAndPath
forall a. a -> Maybe a
Just TgtAndPath
tap
          TGoal
TSmell ->
            if Bool -> Bool
not Bool
canSmell
               Bool -> Bool -> Bool
|| let sml :: Time
sml = Time -> Point -> EnumMap Point Time -> Time
forall k a. Enum k => a -> k -> EnumMap k a -> a
EM.findWithDefault Time
timeZero Point
pos (Level -> EnumMap Point Time
lsmell Level
lvl)
                  in Time
sml Time -> Time -> Bool
forall a. Ord a => a -> a -> Bool
<= Level -> Time
ltime Level
lvl
            then m (Maybe TgtAndPath)
pickNewTarget  -- others will notice soon enough
            else Maybe TgtAndPath -> m (Maybe TgtAndPath)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe TgtAndPath -> m (Maybe TgtAndPath))
-> Maybe TgtAndPath -> m (Maybe TgtAndPath)
forall a b. (a -> b) -> a -> b
$ TgtAndPath -> Maybe TgtAndPath
forall a. a -> Maybe a
Just TgtAndPath
tap
          TGoal
TBlock -> do  -- e.g., door or first unknown tile of an area
            let t :: ContentId TileKind
t = Level
lvl Level -> Point -> ContentId TileKind
`at` Point
pos
            if Bool
isStuck  -- not a very important target, because blocked
               Bool -> Bool -> Bool
|| Int
alterSkill Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Word8 -> Int
forall a. Enum a => a -> Int
fromEnum (Array Word8
lalter Array Word8 -> Point -> Word8
forall c. UnboxRepClass c => Array c -> Point -> c
PointArray.! Point
pos)
                    -- tile was searched or altered or skill lowered
               Bool -> Bool -> Bool
|| TileSpeedup -> ContentId TileKind -> Bool
Tile.isWalkable TileSpeedup
coTileSpeedup ContentId TileKind
t
                    -- tile is no longer unwalkable, so was explored
                    -- so time to recalculate target
            then m (Maybe TgtAndPath)
pickNewTarget  -- others will notice soon enough
            else Maybe TgtAndPath -> m (Maybe TgtAndPath)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe TgtAndPath -> m (Maybe TgtAndPath))
-> Maybe TgtAndPath -> m (Maybe TgtAndPath)
forall a b. (a -> b) -> a -> b
$ TgtAndPath -> Maybe TgtAndPath
forall a. a -> Maybe a
Just TgtAndPath
tap
          TGoal
TUnknown ->
            let t :: ContentId TileKind
t = Level
lvl Level -> Point -> ContentId TileKind
`at` Point
pos
            in if Level -> Int
lexpl Level
lvl Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Level -> Int
lseen Level
lvl
                  Bool -> Bool -> Bool
|| Bool -> Bool
not (ContentId TileKind -> Bool
isUknownSpace ContentId TileKind
t)
               then m (Maybe TgtAndPath)
pickNewTarget  -- others will notice soon enough
               else Maybe TgtAndPath -> m (Maybe TgtAndPath)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe TgtAndPath -> m (Maybe TgtAndPath))
-> Maybe TgtAndPath -> m (Maybe TgtAndPath)
forall a b. (a -> b) -> a -> b
$ TgtAndPath -> Maybe TgtAndPath
forall a. a -> Maybe a
Just TgtAndPath
tap
          TGoal
TKnown ->
            if Actor -> Point
bpos Actor
b Point -> Point -> Bool
forall a. Eq a => a -> a -> Bool
== Point
pos
               Bool -> Bool -> Bool
|| Bool
isStuck
               Bool -> Bool -> Bool
|| Int
alterSkill Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Word8 -> Int
forall a. Enum a => a -> Int
fromEnum (Array Word8
lalter Array Word8 -> Point -> Word8
forall c. UnboxRepClass c => Array c -> Point -> c
PointArray.! Point
pos)
                    -- tile was searched or altered or skill lowered
            then m (Maybe TgtAndPath)
pickNewTarget  -- others unconcerned
            else Maybe TgtAndPath -> m (Maybe TgtAndPath)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe TgtAndPath -> m (Maybe TgtAndPath))
-> Maybe TgtAndPath -> m (Maybe TgtAndPath)
forall a b. (a -> b) -> a -> b
$ TgtAndPath -> Maybe TgtAndPath
forall a. a -> Maybe a
Just TgtAndPath
tap
        Target
_ | Bool
condInMelee Bool -> Bool -> Bool
|| Bool -> Bool
not ([(ActorId, Actor)] -> Bool
forall a. [a] -> Bool
null [(ActorId, Actor)]
nearbyFoes Bool -> Bool -> Bool
&& [(Int, (FactionId, Point))] -> Bool
forall a. [a] -> Bool
null [(Int, (FactionId, Point))]
cstashes) ->
            m (Maybe TgtAndPath)
pickNewTarget
        TNonEnemy ActorId
_ | Maybe ActorId
mleader Maybe ActorId -> Maybe ActorId -> Bool
forall a. Eq a => a -> a -> Bool
== ActorId -> Maybe ActorId
forall a. a -> Maybe a
Just ActorId
aid ->  -- a leader, never follow
          m (Maybe TgtAndPath)
pickNewTarget
        TNonEnemy ActorId
a -> do
          Actor
body <- (State -> Actor) -> m Actor
forall a. (State -> a) -> m a
forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
getsState ((State -> Actor) -> m Actor) -> (State -> Actor) -> m Actor
forall a b. (a -> b) -> a -> b
$ ActorId -> State -> Actor
getActorBody ActorId
a
          if Actor -> LevelId
blid Actor
body LevelId -> LevelId -> Bool
forall a. Eq a => a -> a -> Bool
/= Actor -> LevelId
blid Actor
b  -- wrong level
          then m (Maybe TgtAndPath)
pickNewTarget
          else do
            -- Update path. If impossible, pick another target.
            Maybe AndPath
mpath <- ActorId -> Point -> m (Maybe AndPath)
forall (m :: * -> *).
MonadClient m =>
ActorId -> Point -> m (Maybe AndPath)
getCachePath ActorId
aid (Point -> m (Maybe AndPath)) -> Point -> m (Maybe AndPath)
forall a b. (a -> b) -> a -> b
$ Actor -> Point
bpos Actor
body
            case Maybe AndPath
mpath of
              Maybe AndPath
Nothing -> m (Maybe TgtAndPath)
pickNewTarget
              Just AndPath{pathList :: AndPath -> [Point]
pathList=[]} -> m (Maybe TgtAndPath)
pickNewTarget
              Maybe AndPath
_ -> Maybe TgtAndPath -> m (Maybe TgtAndPath)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe TgtAndPath -> m (Maybe TgtAndPath))
-> Maybe TgtAndPath -> m (Maybe TgtAndPath)
forall a b. (a -> b) -> a -> b
$ TgtAndPath -> Maybe TgtAndPath
forall a. a -> Maybe a
Just TgtAndPath
tap{tapPath=mpath}
        TVector{} -> if Actor -> Point
bpos Actor
b Point -> Point -> Bool
forall a. Eq a => a -> a -> Bool
/= Point
pathGoal
                     then Maybe TgtAndPath -> m (Maybe TgtAndPath)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe TgtAndPath -> m (Maybe TgtAndPath))
-> Maybe TgtAndPath -> m (Maybe TgtAndPath)
forall a b. (a -> b) -> a -> b
$ TgtAndPath -> Maybe TgtAndPath
forall a. a -> Maybe a
Just TgtAndPath
tap
                     else m (Maybe TgtAndPath)
pickNewTarget
  if Bool
canReach
  then m (Maybe TgtAndPath)
-> (TgtAndPath -> m (Maybe TgtAndPath))
-> Maybe TgtAndPath
-> m (Maybe TgtAndPath)
forall b a. b -> (a -> b) -> Maybe a -> b
maybe m (Maybe TgtAndPath)
pickNewTarget TgtAndPath -> m (Maybe TgtAndPath)
updateTgt Maybe TgtAndPath
oldTgtUpdatedPath
  else Maybe TgtAndPath -> m (Maybe TgtAndPath)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe TgtAndPath
forall a. Maybe a
Nothing