-- | Picking the AI actor to move and refreshing leader and non-leader targets.
module Game.LambdaHack.Client.AI.PickActorM
  ( pickActorToMove, setTargetFromDoctrines
  ) where

import Prelude ()

import Game.LambdaHack.Core.Prelude

import qualified Data.EnumMap.Strict as EM
import           Data.Ratio

import           Game.LambdaHack.Client.AI.ConditionM
import           Game.LambdaHack.Client.AI.PickTargetM
import           Game.LambdaHack.Client.Bfs
import           Game.LambdaHack.Client.BfsM
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.Kind
import           Game.LambdaHack.Common.Level
import           Game.LambdaHack.Common.Misc
import           Game.LambdaHack.Common.MonadStateRead
import           Game.LambdaHack.Common.Point
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.Content.FactionKind (fskillsOther)
import           Game.LambdaHack.Core.Frequency
import           Game.LambdaHack.Core.Random
import qualified Game.LambdaHack.Definition.Ability as Ability

-- | Pick a new leader from among the actors on the current level.
-- Refresh the target of the new leader, even if unchanged.
pickActorToMove :: MonadClient m
                => [(ActorId, Actor)] -> [(ActorId, Actor)] -> Maybe ActorId
                -> m ActorId
pickActorToMove :: forall (m :: * -> *).
MonadClient m =>
[(ActorId, Actor)]
-> [(ActorId, Actor)] -> Maybe ActorId -> m ActorId
pickActorToMove [(ActorId, Actor)]
foeAssocs [(ActorId, Actor)]
friendAssocs Maybe ActorId
maidToAvoid = do
  COps{coTileSpeedup} <- (State -> COps) -> m COps
forall a. (State -> a) -> m a
forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
getsState State -> COps
scops
  actorMaxSkills <- getsState sactorMaxSkills
  mleader <- getsClient sleader
  let oldAid = ActorId -> Maybe ActorId -> ActorId
forall a. a -> Maybe a -> a
fromMaybe ([Char] -> ActorId
forall a. HasCallStack => [Char] -> a
error ([Char] -> ActorId) -> [Char] -> ActorId
forall a b. (a -> b) -> a -> b
$ [Char]
"" [Char] -> Maybe ActorId -> [Char]
forall v. Show v => [Char] -> v -> [Char]
`showFailure` Maybe ActorId
maidToAvoid) Maybe ActorId
mleader
  oldBody <- getsState $ getActorBody oldAid
  let side = Actor -> FactionId
bfid Actor
oldBody
      arena = Actor -> LevelId
blid Actor
oldBody
  lvl <- getLevel arena
  localTime <- getsState $ getLocalTime arena
  condInMelee <- condInMeleeM arena
  fact <- getsState $ (EM.! side) . sfactionD
  -- Find our actors on the current level only.
  ours <- getsState $ fidActorRegularAssocs side arena
  let pickOld = do
        m (Maybe TgtAndPath) -> m ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (m (Maybe TgtAndPath) -> m ()) -> m (Maybe TgtAndPath) -> m ()
forall a b. (a -> b) -> a -> b
$ [(ActorId, Actor)]
-> [(ActorId, Actor)] -> (ActorId, Actor) -> m (Maybe TgtAndPath)
forall (m :: * -> *).
MonadClient m =>
[(ActorId, Actor)]
-> [(ActorId, Actor)] -> (ActorId, Actor) -> m (Maybe TgtAndPath)
refreshTarget [(ActorId, Actor)]
foeAssocs [(ActorId, Actor)]
friendAssocs (ActorId
oldAid, Actor
oldBody)
        ActorId -> m ActorId
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return ActorId
oldAid
      oursNotSleeping = ((ActorId, Actor) -> Bool)
-> [(ActorId, Actor)] -> [(ActorId, Actor)]
forall a. (a -> Bool) -> [a] -> [a]
filter (\(ActorId
_, Actor
b) -> Actor -> Watchfulness
bwatch Actor
b Watchfulness -> Watchfulness -> Bool
forall a. Eq a => a -> a -> Bool
/= Watchfulness
WSleep) [(ActorId, Actor)]
ours
      -- Faction discourages client leader change on level, because
      -- non-leader actors have the same skills as leader, so no point.
      -- Server is guaranteed to switch leader within a level occasionally,
      -- e.g., when the old leader dies, so this works fine.
      discouragedPointmanSwitchOnLevel =
        FactionKind -> Skills
fskillsOther (Faction -> FactionKind
gkind Faction
fact) Skills -> Skills -> Bool
forall a. Eq a => a -> a -> Bool
== Skills
Ability.zeroSkills
  case oursNotSleeping of
    [(ActorId, Actor)]
_ | -- Keep the leader: client is discouraged from leader switching,
        -- so it will only be changed if pointman waits (maidToAvoid)
        -- to avoid wasting his higher mobility.
        -- This is OK for monsters even if in melee, because both having
        -- a meleeing actor a leader (and higher DPS) and rescuing actor
        -- a leader (and so faster to get in melee range) is good.
        -- And we are guaranteed that only the two classes of actors are
        -- not waiting, with some exceptions (urgent unequip, flee via starts,
        -- melee-less trying to flee, first aid, etc.).
       Bool
discouragedPointmanSwitchOnLevel Bool -> Bool -> Bool
&& Maybe ActorId -> Bool
forall a. Maybe a -> Bool
isNothing Maybe ActorId
maidToAvoid -> m ActorId
pickOld
    [] -> m ActorId
pickOld
    [(ActorId
aidNotSleeping, Actor
bNotSleeping)] -> do
      -- Target of asleep actors won't change unless foe adjacent,
      -- which is caught without recourse to targeting.
      m (Maybe TgtAndPath) -> m ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (m (Maybe TgtAndPath) -> m ()) -> m (Maybe TgtAndPath) -> m ()
forall a b. (a -> b) -> a -> b
$ [(ActorId, Actor)]
-> [(ActorId, Actor)] -> (ActorId, Actor) -> m (Maybe TgtAndPath)
forall (m :: * -> *).
MonadClient m =>
[(ActorId, Actor)]
-> [(ActorId, Actor)] -> (ActorId, Actor) -> m (Maybe TgtAndPath)
refreshTarget [(ActorId, Actor)]
foeAssocs [(ActorId, Actor)]
friendAssocs (ActorId
aidNotSleeping, Actor
bNotSleeping)
      ActorId -> m ActorId
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return ActorId
aidNotSleeping
    [(ActorId, Actor)]
_ -> do
      -- At this point we almost forget who the old leader was
      -- and treat all party actors the same, eliminating candidates
      -- until we can't distinguish them any more, at which point we slightly
      -- prefer the old leader, if he is among the best candidates
      -- (to make the AI appear more human-like and easier to observe).
      let refresh :: (ActorId, Actor) -> m ((ActorId, Actor), Maybe TgtAndPath)
refresh (ActorId, Actor)
aidBody = do
            mtgt <- [(ActorId, Actor)]
-> [(ActorId, Actor)] -> (ActorId, Actor) -> m (Maybe TgtAndPath)
forall (m :: * -> *).
MonadClient m =>
[(ActorId, Actor)]
-> [(ActorId, Actor)] -> (ActorId, Actor) -> m (Maybe TgtAndPath)
refreshTarget [(ActorId, Actor)]
foeAssocs [(ActorId, Actor)]
friendAssocs (ActorId, Actor)
aidBody
            return (aidBody, mtgt)
      oursTgtRaw <- ((ActorId, Actor) -> m ((ActorId, Actor), Maybe TgtAndPath))
-> [(ActorId, Actor)] -> m [((ActorId, Actor), Maybe TgtAndPath)]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM (ActorId, Actor) -> m ((ActorId, Actor), Maybe TgtAndPath)
refresh [(ActorId, Actor)]
oursNotSleeping
      oldFleeD <- getsClient sfleeD
      let recentlyFled ActorId
aid = 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)
                                   (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)
oldFleeD)
          goodGeneric ((ActorId, Actor)
_, Maybe TgtAndPath
Nothing) = Maybe ((ActorId, Actor), TgtAndPath)
forall a. Maybe a
Nothing
          goodGeneric ((ActorId, Actor)
_, Just TgtAndPath{tapPath :: TgtAndPath -> Maybe AndPath
tapPath=Maybe AndPath
Nothing}) = Maybe ((ActorId, Actor), TgtAndPath)
forall a. Maybe a
Nothing
            -- this case means melee-less heroes adjacent to foes, etc.
            -- will never flee if melee is happening; but this is rare;
            -- this also ensures even if a lone actor melees and nobody
            -- can come to rescue, he will become and remain the leader,
            -- because otherwise an explorer would need to become a leader
            -- and fighter will be 1 clip slower for the whole fight,
            -- just for a few turns of exploration in return;
            --
            -- also note that when the fighter then becomes a leader
            -- he may gain quite a lot of time via @swapTime@,
            -- and so be able to get a double blow on opponents
            -- or a safe blow and a withdraw (but only once); this is a mild
            -- exploit that encourages ambush camping (with a non-leader),
            -- but it's also a rather fun exploit and a straightforward
            -- consequence of the game mechanics, so it's OK for now
          goodGeneric ((ActorId
aid, Actor
b), Just TgtAndPath
tgt) = case Maybe ActorId
maidToAvoid of
            Maybe ActorId
_ | ActorId
aid ActorId -> ActorId -> Bool
forall a. Eq a => a -> a -> Bool
== ActorId
oldAid Bool -> Bool -> Bool
&& Actor -> Bool
actorWaits Actor
b -> Maybe ((ActorId, Actor), TgtAndPath)
forall a. Maybe a
Nothing
                  -- Not the old leader that was stuck last turn
                  -- because he is likely to be still stuck.
            Maybe ActorId
Nothing -> ((ActorId, Actor), TgtAndPath)
-> Maybe ((ActorId, Actor), TgtAndPath)
forall a. a -> Maybe a
Just ((ActorId
aid, Actor
b), TgtAndPath
tgt)
            Just ActorId
aidToAvoid ->
              if ActorId
aid ActorId -> ActorId -> Bool
forall a. Eq a => a -> a -> Bool
== ActorId
aidToAvoid
              then Maybe ((ActorId, Actor), TgtAndPath)
forall a. Maybe a
Nothing  -- not an attempted leader stuck this turn
              else ((ActorId, Actor), TgtAndPath)
-> Maybe ((ActorId, Actor), TgtAndPath)
forall a. a -> Maybe a
Just ((ActorId
aid, Actor
b), TgtAndPath
tgt)
          oursTgt = (((ActorId, Actor), Maybe TgtAndPath)
 -> Maybe ((ActorId, Actor), TgtAndPath))
-> [((ActorId, Actor), Maybe TgtAndPath)]
-> [((ActorId, Actor), TgtAndPath)]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe ((ActorId, Actor), Maybe TgtAndPath)
-> Maybe ((ActorId, Actor), TgtAndPath)
goodGeneric [((ActorId, Actor), Maybe TgtAndPath)]
oursTgtRaw
          -- This should be kept in sync with @actionStrategy@,
          -- because it's a part of the condition for @flee@ in @PickActionM@.
          -- Comments are in the full copy.
          actorVulnerable ((ActorId
aid, Actor
body), TgtAndPath
_) = do
            let actorMaxSk :: Skills
actorMaxSk = ActorMaxSkills
actorMaxSkills ActorMaxSkills -> ActorId -> Skills
forall k a. Enum k => EnumMap k a -> k -> a
EM.! ActorId
aid
            condAnyHarmfulFoeAdj <-
              (State -> Bool) -> m Bool
forall a. (State -> a) -> m a
forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
getsState ((State -> Bool) -> m Bool) -> (State -> Bool) -> m Bool
forall a b. (a -> b) -> a -> b
$ ActorMaxSkills -> ActorId -> State -> Bool
anyHarmfulFoeAdj ActorMaxSkills
actorMaxSkills ActorId
aid
            threatDistL <- getsState $ meleeThreatDistList foeAssocs aid
            (fleeL, _) <- fleeList foeAssocs aid
            condSupport1 <- condSupport friendAssocs 1 aid
            condSolo <- condAloneM friendAssocs aid
            let condCanFlee = Bool -> Bool
not ([(Int, Point)] -> Bool
forall a. [a] -> Bool
null [(Int, Point)]
fleeL)
                heavilyDistressed =
                  ResDelta -> Bool
deltasSerious (Actor -> ResDelta
bcalmDelta Actor
body)
                speed1_5 = Rational -> Speed -> Speed
speedScale (Integer
3Integer -> Integer -> Rational
forall a. Integral a => a -> a -> Ratio a
%Integer
2) (Skills -> Speed
gearSpeed Skills
actorMaxSk)
                condCanMelee = ActorMaxSkills -> ActorId -> Actor -> Bool
actorCanMelee ActorMaxSkills
actorMaxSkills ActorId
aid Actor
body
                threatAdj = ((Int, (ActorId, Actor)) -> Bool)
-> [(Int, (ActorId, Actor))] -> [(Int, (ActorId, Actor))]
forall a. (a -> Bool) -> [a] -> [a]
takeWhile ((Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
1) (Int -> Bool)
-> ((Int, (ActorId, Actor)) -> Int)
-> (Int, (ActorId, Actor))
-> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Int, (ActorId, Actor)) -> Int
forall a b. (a, b) -> a
fst) [(Int, (ActorId, Actor))]
threatDistL
                condManyThreatAdj = [(Int, (ActorId, Actor))] -> Int
forall a. [a] -> Int
length [(Int, (ActorId, Actor))]
threatAdj Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
2
                condFastThreatAdj =
                  ((Int, (ActorId, Actor)) -> Bool)
-> [(Int, (ActorId, Actor))] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (\(Int
_, (ActorId
aid2, Actor
_)) ->
                        let ar2 :: Skills
ar2 = ActorMaxSkills
actorMaxSkills ActorMaxSkills -> ActorId -> Skills
forall k a. Enum k => EnumMap k a -> k -> a
EM.! ActorId
aid2
                        in Skills -> Speed
gearSpeed Skills
ar2 Speed -> Speed -> Bool
forall a. Ord a => a -> a -> Bool
> Speed
speed1_5)
                      [(Int, (ActorId, Actor))]
threatAdj
                condNonStealthyThreatAdj =
                  ((Int, (ActorId, Actor)) -> Bool)
-> [(Int, (ActorId, Actor))] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (\(Int
_, (ActorId
aid2, Actor
b2)) ->
                        let ar2 :: Skills
ar2 = ActorMaxSkills
actorMaxSkills ActorMaxSkills -> ActorId -> Skills
forall k a. Enum k => EnumMap k a -> k -> a
EM.! ActorId
aid2
                        in Skill -> Skills -> Int
Ability.getSk Skill
Ability.SkShine Skills
ar2 Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
0
                           Bool -> Bool -> Bool
|| Point -> Bool
isLit (Actor -> Point
bpos Actor
b2))
                      [(Int, (ActorId, Actor))]
threatAdj
                isLit Point
pos = TileSpeedup -> ContentId TileKind -> Bool
Tile.isLit TileSpeedup
coTileSpeedup (Level
lvl Level -> Point -> ContentId TileKind
`at` Point
pos)
                fleeingMakesSense =
                  Bool -> Bool
not Bool
condCanMelee
                  Bool -> Bool -> Bool
|| (Skill -> Skills -> Int
Ability.getSk Skill
Ability.SkSight Skills
actorMaxSk Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
2
                      Bool -> Bool -> Bool
|| Skill -> Skills -> Int
Ability.getSk Skill
Ability.SkNocto Skills
actorMaxSk Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
2)
                     Bool -> Bool -> Bool
&& (Skill -> Skills -> Int
Ability.getSk Skill
Ability.SkShine Skills
actorMaxSk Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
2
                         Bool -> Bool -> Bool
|| Bool
condNonStealthyThreatAdj Bool -> Bool -> Bool
|| [(Int, (ActorId, Actor))] -> Bool
forall a. [a] -> Bool
null [(Int, (ActorId, Actor))]
threatAdj)
            return $!
              not condFastThreatAdj
              && fleeingMakesSense
              && if | condAnyHarmfulFoeAdj ->
                      not condCanMelee
                      || condManyThreatAdj && not condSupport1 && not condSolo
                    | condInMelee -> False
                    | heavilyDistressed -> True
                        -- Different from @PickActionM@:
                        -- If under fire, do something quickly, always,
                        -- because the actor clearly vulnerable,
                        -- but don't make a leader only because threats close.
                    | otherwise -> False
              && condCanFlee
          actorFled ((ActorId
aid, Actor
_), TgtAndPath
_) = ActorId -> Bool
recentlyFled ActorId
aid
          actorHearning ((ActorId, Actor)
_, TgtAndPath{ tapTgt :: TgtAndPath -> Target
tapTgt=TPoint TEnemyPos{} LevelId
_ Point
_
                                      , tapPath :: TgtAndPath -> Maybe AndPath
tapPath=Maybe AndPath
Nothing }) =
            Bool -> m Bool
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
False
          actorHearning ((ActorId, Actor)
_, TgtAndPath{ tapTgt :: TgtAndPath -> Target
tapTgt=TPoint TEnemyPos{} LevelId
_ Point
_
                                      , tapPath :: TgtAndPath -> Maybe AndPath
tapPath=Just AndPath{Int
pathLen :: Int
pathLen :: AndPath -> Int
pathLen} })
            | Int
pathLen Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
2 =
            Bool -> m Bool
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
False  -- noise probably due to fleeing target
          actorHearning ((ActorId
_aid, Actor
b), TgtAndPath
_) = do
            let closeFoes :: [(ActorId, Actor)]
closeFoes = ((ActorId, Actor) -> Bool)
-> [(ActorId, Actor)] -> [(ActorId, Actor)]
forall a. (a -> Bool) -> [a] -> [a]
filter ((Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
3) (Int -> Bool)
-> ((ActorId, Actor) -> Int) -> (ActorId, Actor) -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Point -> Point -> Int
chessDist (Actor -> Point
bpos Actor
b) (Point -> Int)
-> ((ActorId, Actor) -> Point) -> (ActorId, Actor) -> Int
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)]
foeAssocs
                actorHears :: Bool
actorHears = ResDelta -> Bool
deltasHears (Actor -> ResDelta
bcalmDelta Actor
b)
            Bool -> m Bool
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Bool -> m Bool) -> Bool -> m Bool
forall a b. (a -> b) -> a -> b
$! Bool
actorHears  -- e.g., actor hears an enemy
                      Bool -> Bool -> Bool
&& [(ActorId, Actor)] -> Bool
forall a. [a] -> Bool
null [(ActorId, Actor)]
closeFoes  -- the enemy not visible; a trap!
          -- AI has to be prudent and not lightly waste leader for meleeing.
          actorMeleeing ((ActorId
aid, Actor
_), TgtAndPath
_) =
            (State -> Bool) -> m Bool
forall a. (State -> a) -> m a
forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
getsState ((State -> Bool) -> m Bool) -> (State -> Bool) -> m Bool
forall a b. (a -> b) -> a -> b
$ ActorMaxSkills -> ActorId -> State -> Bool
anyHarmfulFoeAdj ActorMaxSkills
actorMaxSkills ActorId
aid
      (oursVulnerable, oursSafe) <- partitionM actorVulnerable oursTgt
      let (oursFled, oursNotFled) = partition actorFled oursSafe
      (oursMeleeingRaw, oursNotMeleeingRaw) <-
         partitionM actorMeleeing oursNotFled
      let actorMeleeingCanDisplace ( (ActorId
aid, Actor
sb)
                                   , TgtAndPath{tapTgt :: TgtAndPath -> Target
tapTgt=TEnemy ActorId
target} ) = do
            tb <- (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
target
            let actorMaxSk = ActorMaxSkills
actorMaxSkills ActorMaxSkills -> ActorId -> Skills
forall k a. Enum k => EnumMap k a -> k -> a
EM.! ActorId
target
            dEnemy <- getsState $ dispEnemy aid target actorMaxSk
            -- Some usual conditions ignored, because transient or rare.
            return $! checkAdjacent sb tb && dEnemy
          actorMeleeingCanDisplace ((ActorId, Actor), TgtAndPath)
_ = Bool -> m Bool
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
False
      (oursMeleeingCanDisplace, oursMeleeing) <-
         partitionM actorMeleeingCanDisplace oursMeleeingRaw
      let adjStash
            ( (ActorId
_, Actor
b)
            , TgtAndPath{tapTgt :: TgtAndPath -> Target
tapTgt=TPoint TStash{} LevelId
lid Point
pos} ) =
                LevelId
lid LevelId -> LevelId -> Bool
forall a. Eq a => a -> a -> Bool
== LevelId
arena
                Bool -> Bool -> Bool
&& Point -> Point -> Bool
adjacent Point
pos (Actor -> Point
bpos Actor
b)
                Bool -> Bool -> Bool
&& Maybe ActorId -> Bool
forall a. Maybe a -> Bool
isNothing (Point -> Level -> Maybe ActorId
posToBigLvl Point
pos Level
lvl)
          adjStash ((ActorId, Actor), TgtAndPath)
_ = Bool
False
          (oursAdjStash, oursNotMeleeing) =
            partition adjStash oursNotMeleeingRaw
      (oursHearing, oursNotHearing) <- partitionM actorHearning oursNotMeleeing
      let actorRanged ((ActorId
aid, Actor
body), TgtAndPath
_) =
            Bool -> Bool
not (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$ ActorMaxSkills -> ActorId -> Actor -> Bool
actorCanMelee ActorMaxSkills
actorMaxSkills ActorId
aid Actor
body
          targetTEnemy ((ActorId, Actor)
_, TgtAndPath{tapTgt :: TgtAndPath -> Target
tapTgt=TEnemy ActorId
_}) = Bool
True
          targetTEnemy ((ActorId, Actor)
_, TgtAndPath{tapTgt :: TgtAndPath -> Target
tapTgt=TPoint TEnemyPos{} LevelId
lid Point
_}) =
            LevelId
lid LevelId -> LevelId -> Bool
forall a. Eq a => a -> a -> Bool
== LevelId
arena
          targetTEnemy ((ActorId
_, Actor
b), TgtAndPath{tapTgt :: TgtAndPath -> Target
tapTgt=TPoint TStash{} LevelId
lid Point
pos}) =
            LevelId
lid LevelId -> LevelId -> Bool
forall a. Eq a => a -> a -> Bool
== LevelId
arena Bool -> Bool -> Bool
&& Point
pos Point -> Point -> Bool
forall a. Eq a => a -> a -> Bool
/= Actor -> Point
bpos Actor
b
              -- stashes as crucial as enemies. except when guarding them
          targetTEnemy ((ActorId, Actor), TgtAndPath)
_ = Bool
False
          actorNoSupport ((ActorId
aid, Actor
_), TgtAndPath
_) = do
            threatDistL <- (State -> [(Int, (ActorId, Actor))]) -> m [(Int, (ActorId, Actor))]
forall a. (State -> a) -> m a
forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
getsState ((State -> [(Int, (ActorId, Actor))])
 -> m [(Int, (ActorId, Actor))])
-> (State -> [(Int, (ActorId, Actor))])
-> m [(Int, (ActorId, Actor))]
forall a b. (a -> b) -> a -> b
$ [(ActorId, Actor)] -> ActorId -> State -> [(Int, (ActorId, Actor))]
meleeThreatDistList [(ActorId, Actor)]
foeAssocs ActorId
aid
            condSupport2 <- condSupport friendAssocs 2 aid
            let condThreat Int
n = Bool -> Bool
not (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$ [(Int, (ActorId, Actor))] -> Bool
forall a. [a] -> Bool
null ([(Int, (ActorId, Actor))] -> Bool)
-> [(Int, (ActorId, Actor))] -> Bool
forall a b. (a -> b) -> a -> b
$ ((Int, (ActorId, Actor)) -> Bool)
-> [(Int, (ActorId, Actor))] -> [(Int, (ActorId, Actor))]
forall a. (a -> Bool) -> [a] -> [a]
takeWhile ((Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
n) (Int -> Bool)
-> ((Int, (ActorId, Actor)) -> Int)
-> (Int, (ActorId, Actor))
-> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Int, (ActorId, Actor)) -> Int
forall a b. (a, b) -> a
fst) [(Int, (ActorId, Actor))]
threatDistL
            -- If foes far, friends may still come, so we let him move.
            -- The net effect is that lone heroes close to foes freeze
            -- until support comes.
            return $! condThreat 5 && not condSupport2
          (oursRanged, oursNotRanged) = partition actorRanged oursNotHearing
          (oursTEnemyAll, oursOther) = partition targetTEnemy oursNotRanged
          notSwapReady ((ActorId
_, Actor
b), TgtAndPath{tapTgt :: TgtAndPath -> Target
tapTgt=TPoint TStash{} LevelId
lid Point
pos}) ((ActorId, Actor), Maybe TgtAndPath)
_ =
            LevelId
lid LevelId -> LevelId -> Bool
forall a. Eq a => a -> a -> Bool
== LevelId
arena Bool -> Bool -> Bool
&& Point
pos Point -> Point -> Bool
forall a. Eq a => a -> a -> Bool
== Actor -> Point
bpos Actor
b
              -- not ready to follow goal if already guarding the stash
          notSwapReady abt :: ((ActorId, Actor), TgtAndPath)
abt@((ActorId
_, Actor
b), TgtAndPath
_)
                       ((ActorId, Actor)
ab2, Just t2 :: TgtAndPath
t2@TgtAndPath{tapPath :: TgtAndPath -> Maybe AndPath
tapPath=
                                       Just AndPath{pathList :: AndPath -> [Point]
pathList=Point
q : [Point]
_}}) =
            let source :: Point
source = Actor -> Point
bpos Actor
b
                tenemy :: Bool
tenemy = ((ActorId, Actor), TgtAndPath) -> Bool
targetTEnemy ((ActorId, Actor), TgtAndPath)
abt
                tenemy2 :: Bool
tenemy2 = ((ActorId, Actor), TgtAndPath) -> Bool
targetTEnemy ((ActorId, Actor)
ab2, TgtAndPath
t2)
            -- Copied from 'displaceTowards':
            in Bool -> Bool
not (Point
q Point -> Point -> Bool
forall a. Eq a => a -> a -> Bool
== Point
source  -- friend wants to swap
                    Bool -> Bool -> Bool
|| Bool
tenemy Bool -> Bool -> Bool
&& Bool -> Bool
not Bool
tenemy2)
          notSwapReady ((ActorId, Actor), TgtAndPath)
_ ((ActorId, Actor), Maybe TgtAndPath)
_ = Bool
True
          -- These are not necessarily stuck (perhaps can go around),
          -- but their current path is blocked by friends.
          -- As soon as friends move, path is recalcuated and they may
          -- become unstuck.
          targetBlocked abt :: ((ActorId, Actor), TgtAndPath)
abt@((ActorId
aid, Actor
_), TgtAndPath{Maybe AndPath
tapPath :: TgtAndPath -> Maybe AndPath
tapPath :: Maybe AndPath
tapPath}) = case Maybe AndPath
tapPath of
            Just AndPath{pathList :: AndPath -> [Point]
pathList= Point
q : [Point]
_} ->
              (((ActorId, Actor), Maybe TgtAndPath) -> Bool)
-> [((ActorId, Actor), Maybe TgtAndPath)] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (\abt2 :: ((ActorId, Actor), Maybe TgtAndPath)
abt2@((ActorId
aid2, Actor
body2), Maybe TgtAndPath
_) ->
                     ActorId
aid2 ActorId -> ActorId -> Bool
forall a. Eq a => a -> a -> Bool
/= ActorId
aid  -- in case pushed on goal
                     Bool -> Bool -> Bool
&& Actor -> Point
bpos Actor
body2 Point -> Point -> Bool
forall a. Eq a => a -> a -> Bool
== Point
q
                     Bool -> Bool -> Bool
&& ((ActorId, Actor), TgtAndPath)
-> ((ActorId, Actor), Maybe TgtAndPath) -> Bool
notSwapReady ((ActorId, Actor), TgtAndPath)
abt ((ActorId, Actor), Maybe TgtAndPath)
abt2)
                  [((ActorId, Actor), Maybe TgtAndPath)]
oursTgtRaw
            Maybe AndPath
_ -> Bool
False
          (oursTEnemyBlocked, oursTEnemy) =
            partition targetBlocked oursTEnemyAll
      (oursNoSupportRaw, oursSupportRaw) <-
        if length oursTEnemy <= 2
        then return ([], oursTEnemy)
        else partitionM actorNoSupport oursTEnemy
      let (oursNoSupport, oursSupport) =
            if length oursSupportRaw <= 1  -- make sure picks random enough
            then ([], oursTEnemy)
            else (oursNoSupportRaw, oursSupportRaw)
          (oursBlocked, oursPos) =
            partition targetBlocked $ oursRanged ++ oursOther
          guarding ((ActorId
_, Actor
b), Just TgtAndPath{tapTgt :: TgtAndPath -> Target
tapTgt=TPoint TStash{} LevelId
lid Point
pos}) =
            LevelId
lid LevelId -> LevelId -> Bool
forall a. Eq a => a -> a -> Bool
== LevelId
arena Bool -> Bool -> Bool
&& Point
pos Point -> Point -> Bool
forall a. Eq a => a -> a -> Bool
== Actor -> Point
bpos Actor
b
          guarding ((ActorId, Actor), Maybe TgtAndPath)
_ = Bool
False
          -- Don't try to include a stash guard in formation, even if attacking
          -- or being attacked. Attackers would be targetted anyway.
          oursNotSleepingNorGuarding = (((ActorId, Actor), Maybe TgtAndPath) -> Bool)
-> [((ActorId, Actor), Maybe TgtAndPath)]
-> [((ActorId, Actor), Maybe TgtAndPath)]
forall a. (a -> Bool) -> [a] -> [a]
filter (Bool -> Bool
not (Bool -> Bool)
-> (((ActorId, Actor), Maybe TgtAndPath) -> Bool)
-> ((ActorId, Actor), Maybe TgtAndPath)
-> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((ActorId, Actor), Maybe TgtAndPath) -> Bool
guarding) [((ActorId, Actor), Maybe TgtAndPath)]
oursTgtRaw
          -- Lower overhead is better.
          overheadOurs :: ((ActorId, Actor), TgtAndPath) -> Int
          overheadOurs ((ActorId, Actor)
_, TgtAndPath{tapPath :: TgtAndPath -> Maybe AndPath
tapPath=Maybe AndPath
Nothing}) = Int
100
          overheadOurs ((ActorId
_, Actor
b), TgtAndPath{tapTgt :: TgtAndPath -> Target
tapTgt=TPoint TStash{} LevelId
lid Point
pos})
            | LevelId
lid LevelId -> LevelId -> Bool
forall a. Eq a => a -> a -> Bool
== LevelId
arena Bool -> Bool -> Bool
&& Point
pos Point -> Point -> Bool
forall a. Eq a => a -> a -> Bool
== Actor -> Point
bpos Actor
b = Int
200  -- guarding, poor choice
          overheadOurs abt :: ((ActorId, Actor), TgtAndPath)
abt@( (ActorId
aid, Actor
b)
                           , TgtAndPath{tapPath :: TgtAndPath -> Maybe AndPath
tapPath=Just AndPath{pathLen :: AndPath -> Int
pathLen=Int
d, [Point]
Point
pathList :: AndPath -> [Point]
pathSource :: Point
pathList :: [Point]
pathGoal :: Point
pathGoal :: AndPath -> Point
pathSource :: AndPath -> Point
..}} ) =
            -- Keep proper formation. Too dense and exploration takes
            -- too long; too sparse and actors fight alone.
            -- Note that right now, while we set targets separately for each
            -- hero, perhaps on opposite borders of the map,
            -- we can't help that sometimes heroes are separated.
            let maxSpread :: Int
maxSpread = Int
3 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ [((ActorId, Actor), Maybe TgtAndPath)] -> Int
forall a. [a] -> Int
length [((ActorId, Actor), Maybe TgtAndPath)]
oursNotSleepingNorGuarding
                lDist :: Point -> [Int]
lDist Point
p = [ Point -> Point -> Int
chessDist (Actor -> Point
bpos Actor
b2) Point
p
                          | ((ActorId
aid2, Actor
b2), Maybe TgtAndPath
_) <- [((ActorId, Actor), Maybe TgtAndPath)]
oursNotSleepingNorGuarding
                          , ActorId
aid2 ActorId -> ActorId -> Bool
forall a. Eq a => a -> a -> Bool
/= ActorId
aid ]
                pDist :: Point -> Int
pDist Point
p = let ld :: [Int]
ld = Point -> [Int]
lDist Point
p
                          in if [Int] -> Bool
forall a. [a] -> Bool
null [Int]
ld then Int
0 else [Int] -> Int
forall a. Ord a => [a] -> a
forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
minimum [Int]
ld
                aidDist :: Int
aidDist = Point -> Int
pDist (Actor -> Point
bpos Actor
b)
                -- Negative, if the goal gets us closer to the party.
                diffDist :: Int
diffDist = Point -> Int
pDist Point
pathGoal Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
aidDist
                -- If actor already at goal or equidistant, count it as closer.
                sign :: Int
sign = if Int
diffDist Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
0 then -Int
1 else Int
1
                formationValue :: Int
formationValue =
                  Int
sign Int -> Int -> Int
forall a. Num a => a -> a -> a
* (Int -> Int
forall a. Num a => a -> a
abs Int
diffDist Int -> Int -> Int
forall a. Ord a => a -> a -> a
`max` Int
maxSpread)
                  Int -> Int -> Int
forall a. Num a => a -> a -> a
* (Int
aidDist Int -> Int -> Int
forall a. Ord a => a -> a -> a
`max` Int
maxSpread) Int -> Int -> Int
forall a b. (Num a, Integral b) => a -> b -> a
^ (Int
2 :: Int)
                targetsEnemy :: Bool
targetsEnemy = ((ActorId, Actor), TgtAndPath) -> Bool
targetTEnemy ((ActorId, Actor), TgtAndPath)
abt
                fightValue :: Int
fightValue = if Bool
targetsEnemy
                             then - Int64 -> Int
forall a. Enum a => a -> Int
fromEnum (Actor -> Int64
bhp Actor
b Int64 -> Int64 -> Int64
forall a. Integral a => a -> a -> a
`div` (Int64
10 Int64 -> Int64 -> Int64
forall a. Num a => a -> a -> a
* Int64
oneM))
                             else Int
0
                isLit :: Point -> Bool
isLit Point
pos = TileSpeedup -> ContentId TileKind -> Bool
Tile.isLit TileSpeedup
coTileSpeedup (Level
lvl Level -> Point -> ContentId TileKind
`at` Point
pos)
                  -- solid tiles ignored, because not obvious if dark
                  -- after removed
                actorMaxSk :: Skills
actorMaxSk = ActorMaxSkills
actorMaxSkills ActorMaxSkills -> ActorId -> Skills
forall k a. Enum k => EnumMap k a -> k -> a
EM.! ActorId
aid
                actorShines :: Bool
actorShines = Skill -> Skills -> Int
Ability.getSk Skill
Ability.SkShine Skills
actorMaxSk Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
0
                stepsIntoLight :: Bool
stepsIntoLight =
                  Bool -> Bool
not Bool
actorShines
                  Bool -> Bool -> Bool
&& Bool -> Bool
not (Point -> Bool
isLit (Point -> Bool) -> Point -> Bool
forall a b. (a -> b) -> a -> b
$ Actor -> Point
bpos Actor
b)
                  Bool -> Bool -> Bool
&& case [Point]
pathList of
                    [] -> Bool
False
                    Point
q : [Point]
_ -> Point -> Bool
isLit Point
q
                      -- shortest path is through light even though may
                      -- sidestep through dark in @chase@ or @flee@
            in Int
formationValue Int -> Int -> Int
forall a. Integral a => a -> a -> a
`div` Int
3
               Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
fightValue
               Int -> Int -> Int
forall a. Num a => a -> a -> a
+ (case Int
d of
                    Int
0 -> -Int
400  -- do your thing ASAP and retarget
                    Int
1 | Bool -> Bool
not Bool
targetsEnemy -> -Int
200
                      -- prevent others from trying to occupy the tile;
                      -- TStash that obscures a foe correctly handled here
                    Int
_ -> if Int
d Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
8 then Int
d Int -> Int -> Int
forall a. Integral a => a -> a -> a
`div` Int
4 else Int
2 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
d Int -> Int -> Int
forall a. Integral a => a -> a -> a
`div` Int
10)
               Int -> Int -> Int
forall a. Num a => a -> a -> a
+ (if ActorId
aid ActorId -> ActorId -> Bool
forall a. Eq a => a -> a -> Bool
== ActorId
oldAid then Int
0 else Int
10)
               Int -> Int -> Int
forall a. Num a => a -> a -> a
+ (if Bool
stepsIntoLight then Int
30 else Int
0)
          -- Overheads above @maxBoundInt32@ are unlikely (and unsuppored in JS)
          -- and also capping the value does not distort the choice too much.
          positiveOverhead ((ActorId, Actor), TgtAndPath)
abt =
            Int -> Int -> Int
forall a. Ord a => a -> a -> a
min Int
maxBoundInt32 (Int -> Int) -> Int -> Int
forall a b. (a -> b) -> a -> b
$ Int -> Int -> Int
forall a. Ord a => a -> a -> a
max Int
1 (Int -> Int) -> Int -> Int
forall a b. (a -> b) -> a -> b
$ Int
200 Int -> Int -> Int
forall a. Num a => a -> a -> a
- ((ActorId, Actor), TgtAndPath) -> Int
overheadOurs ((ActorId, Actor), TgtAndPath)
abt
          candidates = [ [((ActorId, Actor), TgtAndPath)]
oursAdjStash
                       , [((ActorId, Actor), TgtAndPath)]
oursVulnerable
                       , [((ActorId, Actor), TgtAndPath)]
oursSupport
                       , [((ActorId, Actor), TgtAndPath)]
oursNoSupport
                       , [((ActorId, Actor), TgtAndPath)]
oursPos
                       , [((ActorId, Actor), TgtAndPath)]
oursFled  -- if just fled, but not vulnerable,
                                   -- keep him passive and safe, out of action
                       , [((ActorId, Actor), TgtAndPath)]
oursMeleeingCanDisplace
                           -- prefer melee actors displacing than blocked
                           -- actors trying to walk around them
                       , [((ActorId, Actor), TgtAndPath)]
oursTEnemyBlocked
                           -- prefer blocked actors trying to walk around
                           -- even if that causes overhead for the meleeing
                       , [((ActorId, Actor), TgtAndPath)]
oursMeleeing
                       , [((ActorId, Actor), TgtAndPath)]
oursHearing
                       , [((ActorId, Actor), TgtAndPath)]
oursBlocked
                       ]
      case filter (not . null) candidates of
        [((ActorId, Actor), TgtAndPath)]
l : [[((ActorId, Actor), TgtAndPath)]]
_ -> do
          let freq :: Frequency ((ActorId, Actor), TgtAndPath)
freq = Text
-> [(Int, ((ActorId, Actor), TgtAndPath))]
-> Frequency ((ActorId, Actor), TgtAndPath)
forall a. Text -> [(Int, a)] -> Frequency a
toFreq Text
"candidates for AI leader"
                     ([(Int, ((ActorId, Actor), TgtAndPath))]
 -> Frequency ((ActorId, Actor), TgtAndPath))
-> [(Int, ((ActorId, Actor), TgtAndPath))]
-> Frequency ((ActorId, Actor), TgtAndPath)
forall a b. (a -> b) -> a -> b
$ (((ActorId, Actor), TgtAndPath)
 -> (Int, ((ActorId, Actor), TgtAndPath)))
-> [((ActorId, Actor), TgtAndPath)]
-> [(Int, ((ActorId, Actor), TgtAndPath))]
forall a b. (a -> b) -> [a] -> [b]
map (((ActorId, Actor), TgtAndPath) -> Int
positiveOverhead (((ActorId, Actor), TgtAndPath) -> Int)
-> (((ActorId, Actor), TgtAndPath)
    -> ((ActorId, Actor), TgtAndPath))
-> ((ActorId, Actor), TgtAndPath)
-> (Int, ((ActorId, Actor), TgtAndPath))
forall b c c'. (b -> c) -> (b -> c') -> b -> (c, c')
forall (a :: * -> * -> *) b c c'.
Arrow a =>
a b c -> a b c' -> a b (c, c')
&&& ((ActorId, Actor), TgtAndPath) -> ((ActorId, Actor), TgtAndPath)
forall a. a -> a
id) [((ActorId, Actor), TgtAndPath)]
l
          ((aid, b), _) <- Rnd ((ActorId, Actor), TgtAndPath)
-> m ((ActorId, Actor), TgtAndPath)
forall (m :: * -> *) a. MonadClient m => Rnd a -> m a
rndToAction (Rnd ((ActorId, Actor), TgtAndPath)
 -> m ((ActorId, Actor), TgtAndPath))
-> Rnd ((ActorId, Actor), TgtAndPath)
-> m ((ActorId, Actor), TgtAndPath)
forall a b. (a -> b) -> a -> b
$ Frequency ((ActorId, Actor), TgtAndPath)
-> Rnd ((ActorId, Actor), TgtAndPath)
forall a. Show a => Frequency a -> Rnd a
frequency Frequency ((ActorId, Actor), TgtAndPath)
freq
          s <- getState
          modifyClient $ updateLeader aid s
          -- When you become a leader, stop following old leader, but follow
          -- his target, if still valid, to avoid distraction.
          when (gdoctrine fact `elem` [Ability.TFollow, Ability.TFollowNoItems]
                && not condInMelee) $
            void $ refreshTarget foeAssocs friendAssocs (aid, b)
          return aid
        [[((ActorId, Actor), TgtAndPath)]]
_ -> ActorId -> m ActorId
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return ActorId
oldAid

-- | Inspect the doctrines of the actor and set his target according to it.
setTargetFromDoctrines :: MonadClient m
                        => [(ActorId, Actor)] -> [(ActorId, Actor)] -> ActorId
                        -> m ()
setTargetFromDoctrines :: forall (m :: * -> *).
MonadClient m =>
[(ActorId, Actor)] -> [(ActorId, Actor)] -> ActorId -> m ()
setTargetFromDoctrines [(ActorId, Actor)]
foeAssocs [(ActorId, Actor)]
friendAssocs ActorId
oldAid = do
  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
  let !_A = Bool -> () -> ()
forall a. HasCallStack => Bool -> a -> a
assert (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
oldAid) ()
  oldBody <- getsState $ getActorBody oldAid
  moldTgt <- getsClient $ EM.lookup oldAid . stargetD
  let side = Actor -> FactionId
bfid Actor
oldBody
      arena = Actor -> LevelId
blid Actor
oldBody
  fact <- getsState $ (EM.! side) . sfactionD
  let explore = m (Maybe TgtAndPath) -> m ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (m (Maybe TgtAndPath) -> m ()) -> m (Maybe TgtAndPath) -> m ()
forall a b. (a -> b) -> a -> b
$ [(ActorId, Actor)]
-> [(ActorId, Actor)] -> (ActorId, Actor) -> m (Maybe TgtAndPath)
forall (m :: * -> *).
MonadClient m =>
[(ActorId, Actor)]
-> [(ActorId, Actor)] -> (ActorId, Actor) -> m (Maybe TgtAndPath)
refreshTarget [(ActorId, Actor)]
foeAssocs [(ActorId, Actor)]
friendAssocs (ActorId
oldAid, Actor
oldBody)
      setPath Maybe TgtAndPath
mtgt = case (Maybe TgtAndPath
mtgt, Maybe TgtAndPath
moldTgt) of
        (Maybe TgtAndPath
Nothing, Maybe TgtAndPath
_) -> Bool -> m Bool
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
False
        ( Just TgtAndPath{tapTgt :: TgtAndPath -> Target
tapTgt=Target
leaderTapTgt},
          Just TgtAndPath{tapTgt :: TgtAndPath -> Target
tapTgt=Target
oldTapTgt,tapPath :: TgtAndPath -> Maybe AndPath
tapPath=Just AndPath
oldTapPath} )
          | Target
leaderTapTgt Target -> Target -> Bool
forall a. Eq a => a -> a -> Bool
== Target
oldTapTgt  -- targets agree
            Bool -> Bool -> Bool
&& Actor -> Point
bpos Actor
oldBody Point -> Point -> Bool
forall a. Eq a => a -> a -> Bool
== AndPath -> Point
pathSource AndPath
oldTapPath -> do  -- nominal path
            m (Maybe TgtAndPath) -> m ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (m (Maybe TgtAndPath) -> m ()) -> m (Maybe TgtAndPath) -> m ()
forall a b. (a -> b) -> a -> b
$ [(ActorId, Actor)]
-> [(ActorId, Actor)] -> (ActorId, Actor) -> m (Maybe TgtAndPath)
forall (m :: * -> *).
MonadClient m =>
[(ActorId, Actor)]
-> [(ActorId, Actor)] -> (ActorId, Actor) -> m (Maybe TgtAndPath)
refreshTarget [(ActorId, Actor)]
foeAssocs [(ActorId, Actor)]
friendAssocs (ActorId
oldAid, Actor
oldBody)
            Bool -> m Bool
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
True  -- already on target
        (Just TgtAndPath{tapTgt :: TgtAndPath -> Target
tapTgt=Target
leaderTapTgt}, Maybe TgtAndPath
_) -> do
            tap <- ActorId -> Target -> m TgtAndPath
forall (m :: * -> *).
MonadClient m =>
ActorId -> Target -> m TgtAndPath
createPath ActorId
oldAid Target
leaderTapTgt
            case tap of
              TgtAndPath{tapPath :: TgtAndPath -> Maybe AndPath
tapPath=Maybe AndPath
Nothing} -> Bool -> m Bool
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
False
              TgtAndPath
_ -> do
                (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 oldAid tap (stargetD cli)}
                Bool -> m Bool
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
True
      follow = case Maybe ActorId
mleader of
        -- If no leader at all (forced @TFollow@ doctrine on an actor
        -- from a leaderless faction), fall back to @TExplore@.
        Maybe ActorId
Nothing -> m ()
explore
        Maybe ActorId
_ | Actor -> Watchfulness
bwatch Actor
oldBody Watchfulness -> Watchfulness -> Bool
forall a. Eq a => a -> a -> Bool
== Watchfulness
WSleep ->
          -- We could check skills, but it would be more complex.
          m ()
explore
        Just ActorId
leader -> do
          onLevel <- (State -> Bool) -> m Bool
forall a. (State -> a) -> m a
forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
getsState ((State -> Bool) -> m Bool) -> (State -> Bool) -> m Bool
forall a b. (a -> b) -> a -> b
$ ActorId -> LevelId -> State -> Bool
memActor ActorId
leader LevelId
arena
          condInMelee <- condInMeleeM arena
          -- If leader not on this level or if we are meleeing,
          -- and so following is not important, fall back to @TExplore@.
          if not onLevel || condInMelee then explore
          else do
            -- Copy over the leader's target, if any, or follow his position.
            mtgt <- getsClient $ EM.lookup leader . stargetD
            tgtPathSet <- setPath mtgt
            unless tgtPathSet $ do
              let nonEnemyPath = TgtAndPath -> Maybe TgtAndPath
forall a. a -> Maybe a
Just TgtAndPath { tapTgt :: Target
tapTgt = ActorId -> Target
TNonEnemy ActorId
leader
                                                 , tapPath :: Maybe AndPath
tapPath = Maybe AndPath
forall a. Maybe a
Nothing }
              nonEnemyPathSet <- setPath nonEnemyPath
              unless nonEnemyPathSet
                -- If no path even to the leader himself, explore.
                explore
  case gdoctrine fact of
    Doctrine
Ability.TExplore -> m ()
explore
    Doctrine
Ability.TFollow -> m ()
follow
    Doctrine
Ability.TFollowNoItems -> m ()
follow
    Doctrine
Ability.TMeleeAndRanged -> m ()
explore  -- needs to find ranged targets
    Doctrine
Ability.TMeleeAdjacent -> m ()
explore  -- probably not needed, but may change
    Doctrine
Ability.TBlock -> () -> m ()
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return ()  -- no point refreshing target
    Doctrine
Ability.TRoam -> m ()
explore  -- @TRoam@ is checked again inside @explore@
    Doctrine
Ability.TPatrol -> m ()
explore  -- WIP