-- | Picking the AI actor to move and refreshing leader and non-leader targets.
module Game.LambdaHack.Client.AI.PickActorM
  ( pickActorToMove, setTargetFromTactics
  ) 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.Misc
import           Game.LambdaHack.Common.MonadStateRead
import           Game.LambdaHack.Common.Point
import           Game.LambdaHack.Common.State
import           Game.LambdaHack.Common.Time
import           Game.LambdaHack.Common.Types
import           Game.LambdaHack.Content.ModeKind
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 => Maybe ActorId -> m ActorId
{-# INLINE pickActorToMove #-}
pickActorToMove :: Maybe ActorId -> m ActorId
pickActorToMove maidToAvoid :: Maybe ActorId
maidToAvoid = do
  ActorMaxSkills
actorMaxSkills <- (State -> ActorMaxSkills) -> m ActorMaxSkills
forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
getsState State -> ActorMaxSkills
sactorMaxSkills
  Maybe ActorId
mleader <- (StateClient -> Maybe ActorId) -> m (Maybe ActorId)
forall (m :: * -> *) a.
MonadClientRead m =>
(StateClient -> a) -> m a
getsClient StateClient -> Maybe ActorId
sleader
  let oldAid :: ActorId
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] -> Maybe ActorId -> [Char]
forall v. Show v => [Char] -> v -> [Char]
`showFailure` Maybe ActorId
maidToAvoid) Maybe ActorId
mleader
  Actor
oldBody <- (State -> Actor) -> m Actor
forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
getsState ((State -> Actor) -> m Actor) -> (State -> Actor) -> m Actor
forall a b. (a -> b) -> a -> b
$ ActorId -> State -> Actor
getActorBody ActorId
oldAid
  let side :: FactionId
side = Actor -> FactionId
bfid Actor
oldBody
      arena :: LevelId
arena = Actor -> LevelId
blid Actor
oldBody
  Faction
fact <- (State -> Faction) -> m Faction
forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
getsState ((State -> Faction) -> m Faction)
-> (State -> Faction) -> m Faction
forall a b. (a -> b) -> a -> b
$ (EnumMap FactionId Faction -> FactionId -> Faction
forall k a. Enum k => EnumMap k a -> k -> a
EM.! FactionId
side) (EnumMap FactionId Faction -> Faction)
-> (State -> EnumMap FactionId Faction) -> State -> Faction
forall b c a. (b -> c) -> (a -> b) -> a -> c
. State -> EnumMap FactionId Faction
sfactionD
  -- Find our actors on the current level only.
  [(ActorId, Actor)]
ours <- (State -> [(ActorId, Actor)]) -> m [(ActorId, Actor)]
forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
getsState ((State -> [(ActorId, Actor)]) -> m [(ActorId, Actor)])
-> (State -> [(ActorId, Actor)]) -> m [(ActorId, Actor)]
forall a b. (a -> b) -> a -> b
$ FactionId -> LevelId -> State -> [(ActorId, Actor)]
fidActorRegularAssocs FactionId
side LevelId
arena
  let pickOld :: m ActorId
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) -> m (Maybe TgtAndPath)
forall (m :: * -> *).
MonadClient m =>
(ActorId, Actor) -> m (Maybe TgtAndPath)
refreshTarget (ActorId
oldAid, Actor
oldBody)
        ActorId -> m ActorId
forall (m :: * -> *) a. Monad m => a -> m a
return ActorId
oldAid
      oursNotSleeping :: [(ActorId, Actor)]
oursNotSleeping = ((ActorId, Actor) -> Bool)
-> [(ActorId, Actor)] -> [(ActorId, Actor)]
forall a. (a -> Bool) -> [a] -> [a]
filter (\(_, b :: Actor
b) -> Actor -> Watchfulness
bwatch Actor
b Watchfulness -> Watchfulness -> Bool
forall a. Eq a => a -> a -> Bool
/= Watchfulness
WSleep) [(ActorId, Actor)]
ours
  case [(ActorId, Actor)]
oursNotSleeping of
    _ | -- Keep the leader: faction discourages client leader change on level,
        -- so will only be changed if 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, Bool) -> Bool
forall a b. (a, b) -> b
snd (Faction -> (Bool, Bool)
autoDungeonLevel Faction
fact) Bool -> Bool -> Bool
&& Maybe ActorId -> Bool
forall a. Maybe a -> Bool
isNothing Maybe ActorId
maidToAvoid -> m ActorId
pickOld
    [] -> m ActorId
pickOld
    [(aidNotSleeping :: ActorId
aidNotSleeping, bNotSleeping :: 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) -> m (Maybe TgtAndPath)
forall (m :: * -> *).
MonadClient m =>
(ActorId, Actor) -> m (Maybe TgtAndPath)
refreshTarget (ActorId
aidNotSleeping, Actor
bNotSleeping)
      ActorId -> m ActorId
forall (m :: * -> *) a. Monad m => a -> m a
return ActorId
aidNotSleeping
    _ -> 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 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 aidBody :: (ActorId, Actor)
aidBody = do
            Maybe TgtAndPath
mtgt <- (ActorId, Actor) -> m (Maybe TgtAndPath)
forall (m :: * -> *).
MonadClient m =>
(ActorId, Actor) -> m (Maybe TgtAndPath)
refreshTarget (ActorId, Actor)
aidBody
            ((ActorId, Actor), Maybe TgtAndPath)
-> m ((ActorId, Actor), Maybe TgtAndPath)
forall (m :: * -> *) a. Monad m => a -> m a
return ((ActorId, Actor)
aidBody, Maybe TgtAndPath
mtgt)
      [((ActorId, Actor), Maybe TgtAndPath)]
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)
mapM (ActorId, Actor) -> m ((ActorId, Actor), Maybe TgtAndPath)
forall (m :: * -> *).
MonadClient m =>
(ActorId, Actor) -> m ((ActorId, Actor), Maybe TgtAndPath)
refresh [(ActorId, Actor)]
oursNotSleeping
      EnumMap ActorId Point
fleeD <- (StateClient -> EnumMap ActorId Point) -> m (EnumMap ActorId Point)
forall (m :: * -> *) a.
MonadClientRead m =>
(StateClient -> a) -> m a
getsClient StateClient -> EnumMap ActorId Point
sfleeD
      let goodGeneric :: ((ActorId, Actor), Maybe TgtAndPath)
-> Maybe ((ActorId, Actor), TgtAndPath)
goodGeneric (_, Nothing) = Maybe ((ActorId, Actor), TgtAndPath)
forall a. Maybe a
Nothing
          goodGeneric (_, 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 ((aid :: ActorId
aid, b :: Actor
b), Just tgt :: TgtAndPath
tgt) = case Maybe ActorId
maidToAvoid of
            Nothing | Bool -> Bool
not (ActorId
aid ActorId -> ActorId -> Bool
forall a. Eq a => a -> a -> Bool
== ActorId
oldAid Bool -> Bool -> Bool
&& Actor -> Bool
actorWaits Actor
b) ->
              -- Not the old leader that was stuck last turn
              -- because he is likely to be still stuck.
              ((ActorId, Actor), TgtAndPath)
-> Maybe ((ActorId, Actor), TgtAndPath)
forall a. a -> Maybe a
Just ((ActorId
aid, Actor
b), TgtAndPath
tgt)
            Just aidToAvoid :: ActorId
aidToAvoid | ActorId
aid ActorId -> ActorId -> Bool
forall a. Eq a => a -> a -> Bool
/= ActorId
aidToAvoid ->
              -- Not an attempted leader stuck this turn.
              ((ActorId, Actor), TgtAndPath)
-> Maybe ((ActorId, Actor), TgtAndPath)
forall a. a -> Maybe a
Just ((ActorId
aid, Actor
b), TgtAndPath
tgt)
            _ -> Maybe ((ActorId, Actor), TgtAndPath)
forall a. Maybe a
Nothing
          oursTgt :: [((ActorId, Actor), TgtAndPath)]
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@.
          actorVulnerable :: ((ActorId, Actor), TgtAndPath) -> m Bool
actorVulnerable ((aid :: ActorId
aid, body :: Actor
body), _) = do
            Bool
condInMelee <- LevelId -> m Bool
forall (m :: * -> *). MonadClient m => LevelId -> m Bool
condInMeleeM (LevelId -> m Bool) -> LevelId -> m Bool
forall a b. (a -> b) -> a -> b
$ Actor -> LevelId
blid Actor
body
            let actorMaxSk :: Skills
actorMaxSk = ActorMaxSkills
actorMaxSkills ActorMaxSkills -> ActorId -> Skills
forall k a. Enum k => EnumMap k a -> k -> a
EM.! ActorId
aid
            [(Int, (ActorId, Actor))]
threatDistL <- (State -> [(Int, (ActorId, Actor))]) -> m [(Int, (ActorId, Actor))]
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 -> State -> [(Int, (ActorId, Actor))]
meleeThreatDistList ActorId
aid
            (fleeL :: [(Int, Point)]
fleeL, _) <- ActorId -> m ([(Int, Point)], [(Int, Point)])
forall (m :: * -> *).
MonadClient m =>
ActorId -> m ([(Int, Point)], [(Int, Point)])
fleeList ActorId
aid
            Bool
condSupport1 <- Int -> ActorId -> m Bool
forall (m :: * -> *). MonadClient m => Int -> ActorId -> m Bool
condSupport 1 ActorId
aid
            Bool
condSupport3 <- Int -> ActorId -> m Bool
forall (m :: * -> *). MonadClient m => Int -> ActorId -> m Bool
condSupport 3 ActorId
aid
            Bool
condSolo <- ActorId -> m Bool
forall (m :: * -> *). MonadClient m => ActorId -> m Bool
condSoloM ActorId
aid  -- solo fighters aggresive
            [Point]
canDeAmbientL <- (State -> [Point]) -> m [Point]
forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
getsState ((State -> [Point]) -> m [Point])
-> (State -> [Point]) -> m [Point]
forall a b. (a -> b) -> a -> b
$ Actor -> State -> [Point]
canDeAmbientList Actor
body
            let condCanFlee :: Bool
condCanFlee = Bool -> Bool
not ([(Int, Point)] -> Bool
forall a. [a] -> Bool
null [(Int, Point)]
fleeL)
                speed1_5 :: Speed
speed1_5 = Rational -> Speed -> Speed
speedScale (3Integer -> Integer -> Rational
forall a. Integral a => a -> a -> Ratio a
%2) (Skills -> Speed
gearSpeed Skills
actorMaxSk)
                condCanMelee :: Bool
condCanMelee = ActorMaxSkills -> ActorId -> Actor -> Bool
actorCanMelee ActorMaxSkills
actorMaxSkills ActorId
aid Actor
body
                condThreat :: Int -> Bool
condThreat n :: 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
                threatAdj :: [(Int, (ActorId, Actor))]
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
== 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 :: Bool
condManyThreatAdj = [(Int, (ActorId, Actor))] -> Int
forall a. [a] -> Int
length [(Int, (ActorId, Actor))]
threatAdj Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= 2
                condFastThreatAdj :: Bool
condFastThreatAdj =
                  ((Int, (ActorId, Actor)) -> Bool)
-> [(Int, (ActorId, Actor))] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (\(_, (aid2 :: ActorId
aid2, _)) ->
                    let actorMaxSk2 :: Skills
actorMaxSk2 = ActorMaxSkills
actorMaxSkills ActorMaxSkills -> ActorId -> Skills
forall k a. Enum k => EnumMap k a -> k -> a
EM.! ActorId
aid2
                    in Skills -> Speed
gearSpeed Skills
actorMaxSk2 Speed -> Speed -> Bool
forall a. Ord a => a -> a -> Bool
> Speed
speed1_5)
                  [(Int, (ActorId, Actor))]
threatAdj
                heavilyDistressed :: Bool
heavilyDistressed =
                  -- Actor hit by a projectile or similarly distressed.
                  ResDelta -> Bool
deltasSerious (Actor -> ResDelta
bcalmDelta Actor
body)
                actorShines :: Bool
actorShines = Skill -> Skills -> Int
Ability.getSk Skill
Ability.SkShine Skills
actorMaxSk Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> 0
                aCanDeLightL :: [Point]
aCanDeLightL | Bool
actorShines = []
                             | Bool
otherwise = [Point]
canDeAmbientL
                canFleeFromLight :: Bool
canFleeFromLight =
                  Bool -> Bool
not (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$ [Point] -> Bool
forall a. [a] -> Bool
null ([Point] -> Bool) -> [Point] -> Bool
forall a b. (a -> b) -> a -> b
$ [Point]
aCanDeLightL [Point] -> [Point] -> [Point]
forall a. Eq a => [a] -> [a] -> [a]
`intersect` ((Int, Point) -> Point) -> [(Int, Point)] -> [Point]
forall a b. (a -> b) -> [a] -> [b]
map (Int, Point) -> Point
forall a b. (a, b) -> b
snd [(Int, Point)]
fleeL
            Bool -> m Bool
forall (m :: * -> *) a. Monad m => a -> m a
return (Bool -> m Bool) -> Bool -> m Bool
forall a b. (a -> b) -> a -> b
$!
              -- This is a part of the condition for @flee@ in @PickActionM@.
              Bool -> Bool
not Bool
condFastThreatAdj
              Bool -> Bool -> Bool
&& if | Int -> Bool
condThreat 1 ->
                      Bool -> Bool
not Bool
condCanMelee
                      Bool -> Bool -> Bool
|| Bool
condManyThreatAdj Bool -> Bool -> Bool
&& Bool -> Bool
not Bool
condSupport1 Bool -> Bool -> Bool
&& Bool -> Bool
not Bool
condSolo
                    | Bool -> Bool
not Bool
condInMelee
                      Bool -> Bool -> Bool
&& (Int -> Bool
condThreat 2 Bool -> Bool -> Bool
|| Int -> Bool
condThreat 5 Bool -> Bool -> Bool
&& Bool
canFleeFromLight) ->
                      Bool -> Bool
not Bool
condCanMelee
                      Bool -> Bool -> Bool
|| Bool -> Bool
not Bool
condSupport3 Bool -> Bool -> Bool
&& Bool -> Bool
not Bool
condSolo
                         Bool -> Bool -> Bool
&& Bool -> Bool
not Bool
heavilyDistressed
                    -- Not used: | condThreat 5 ...
                    -- because actor should be picked anyway, to try to melee.
                    | Bool
otherwise ->
                      Bool -> Bool
not Bool
condInMelee
                      Bool -> Bool -> Bool
&& Bool
heavilyDistressed
                      -- Different from @PickActionM@:
                      Bool -> Bool -> Bool
&& Bool -> Bool
not (ActorId -> EnumMap ActorId Point -> Bool
forall k a. Enum k => k -> EnumMap k a -> Bool
EM.member ActorId
aid EnumMap ActorId Point
fleeD)
                        -- Make him a leader even if can't delight, etc.
                        -- because he may instead take off light or otherwise
                        -- cope with being pummeled by projectiles.
                        -- He is still vulnerable, just not necessarily needs
                        -- to flee, but may cover himself otherwise.
                        -- && (not condCanProject || canFleeFromLight)
              Bool -> Bool -> Bool
&& Bool
condCanFlee
          actorFled :: ((ActorId, Actor), TgtAndPath) -> Bool
actorFled ((aid :: ActorId
aid, _), _) = ActorId -> EnumMap ActorId Point -> Bool
forall k a. Enum k => k -> EnumMap k a -> Bool
EM.member ActorId
aid EnumMap ActorId Point
fleeD
          actorHearning :: ((ActorId, Actor), TgtAndPath) -> m Bool
actorHearning (_, TgtAndPath{ tapTgt :: TgtAndPath -> Target
tapTgt=TPoint TEnemyPos{} _ _
                                      , tapPath :: TgtAndPath -> Maybe AndPath
tapPath=Maybe AndPath
Nothing }) =
            Bool -> m Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
False
          actorHearning (_, TgtAndPath{ tapTgt :: TgtAndPath -> Target
tapTgt=TPoint TEnemyPos{} _ _
                                      , tapPath :: TgtAndPath -> Maybe AndPath
tapPath=Just AndPath{Int
pathLen :: AndPath -> Int
pathLen :: Int
pathLen} })
            | Int
pathLen Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= 2 =
            Bool -> m Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
False  -- noise probably due to fleeing target
          actorHearning ((_aid :: ActorId
_aid, b :: Actor
b), _) = do
            [Actor]
allFoes <- (State -> [Actor]) -> m [Actor]
forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
getsState ((State -> [Actor]) -> m [Actor])
-> (State -> [Actor]) -> m [Actor]
forall a b. (a -> b) -> a -> b
$ FactionId -> LevelId -> State -> [Actor]
foeRegularList FactionId
side (Actor -> LevelId
blid Actor
b)
            let closeFoes :: [Actor]
closeFoes = (Actor -> Bool) -> [Actor] -> [Actor]
forall a. (a -> Bool) -> [a] -> [a]
filter ((Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= 3) (Int -> Bool) -> (Actor -> Int) -> Actor -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Point -> Point -> Int
chessDist (Actor -> Point
bpos Actor
b) (Point -> Int) -> (Actor -> Point) -> Actor -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Actor -> Point
bpos) [Actor]
allFoes
                actorHears :: Bool
actorHears = ResDelta -> Bool
deltasHears (Actor -> ResDelta
bcalmDelta Actor
b)
            Bool -> m Bool
forall (m :: * -> *) a. Monad m => a -> m a
return (Bool -> m Bool) -> Bool -> m Bool
forall a b. (a -> b) -> a -> b
$! Bool
actorHears  -- e.g., actor hears an enemy
                      Bool -> Bool -> Bool
&& [Actor] -> Bool
forall a. [a] -> Bool
null [Actor]
closeFoes  -- the enemy not visible; a trap!
          -- AI has to be prudent and not lightly waste leader for meleeing,
          -- even if his target is distant
          actorMeleeing :: ((ActorId, b), b) -> m Bool
actorMeleeing ((aid :: ActorId
aid, _), _) = ActorId -> m Bool
forall (m :: * -> *). MonadStateRead m => ActorId -> m Bool
condAnyFoeAdjM ActorId
aid
      (oursVulnerable :: [((ActorId, Actor), TgtAndPath)]
oursVulnerable, oursSafe :: [((ActorId, Actor), TgtAndPath)]
oursSafe) <- (((ActorId, Actor), TgtAndPath) -> m Bool)
-> [((ActorId, Actor), TgtAndPath)]
-> m ([((ActorId, Actor), TgtAndPath)],
      [((ActorId, Actor), TgtAndPath)])
forall (m :: * -> *) a.
Applicative m =>
(a -> m Bool) -> [a] -> m ([a], [a])
partitionM ((ActorId, Actor), TgtAndPath) -> m Bool
actorVulnerable [((ActorId, Actor), TgtAndPath)]
oursTgt
      let (oursFled :: [((ActorId, Actor), TgtAndPath)]
oursFled, oursNotFled :: [((ActorId, Actor), TgtAndPath)]
oursNotFled) = (((ActorId, Actor), TgtAndPath) -> Bool)
-> [((ActorId, Actor), TgtAndPath)]
-> ([((ActorId, Actor), TgtAndPath)],
    [((ActorId, Actor), TgtAndPath)])
forall a. (a -> Bool) -> [a] -> ([a], [a])
partition ((ActorId, Actor), TgtAndPath) -> Bool
actorFled [((ActorId, Actor), TgtAndPath)]
oursSafe
      (oursMeleeing :: [((ActorId, Actor), TgtAndPath)]
oursMeleeing, oursNotMeleeing :: [((ActorId, Actor), TgtAndPath)]
oursNotMeleeing) <- (((ActorId, Actor), TgtAndPath) -> m Bool)
-> [((ActorId, Actor), TgtAndPath)]
-> m ([((ActorId, Actor), TgtAndPath)],
      [((ActorId, Actor), TgtAndPath)])
forall (m :: * -> *) a.
Applicative m =>
(a -> m Bool) -> [a] -> m ([a], [a])
partitionM ((ActorId, Actor), TgtAndPath) -> m Bool
forall (m :: * -> *) b b.
MonadStateRead m =>
((ActorId, b), b) -> m Bool
actorMeleeing [((ActorId, Actor), TgtAndPath)]
oursNotFled
      (oursHearing :: [((ActorId, Actor), TgtAndPath)]
oursHearing, oursNotHearing :: [((ActorId, Actor), TgtAndPath)]
oursNotHearing) <- (((ActorId, Actor), TgtAndPath) -> m Bool)
-> [((ActorId, Actor), TgtAndPath)]
-> m ([((ActorId, Actor), TgtAndPath)],
      [((ActorId, Actor), TgtAndPath)])
forall (m :: * -> *) a.
Applicative m =>
(a -> m Bool) -> [a] -> m ([a], [a])
partitionM ((ActorId, Actor), TgtAndPath) -> m Bool
actorHearning [((ActorId, Actor), TgtAndPath)]
oursNotMeleeing
      let actorRanged :: ((ActorId, Actor), TgtAndPath) -> Bool
actorRanged ((aid :: ActorId
aid, body :: Actor
body), _) =
            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 :: ((a, Actor), TgtAndPath) -> Bool
targetTEnemy (_, TgtAndPath{tapTgt :: TgtAndPath -> Target
tapTgt=TEnemy _}) = Bool
True
          targetTEnemy
            ( (_, b :: Actor
b)
            , TgtAndPath{tapTgt :: TgtAndPath -> Target
tapTgt=TPoint (TEnemyPos _) lid :: LevelId
lid _} ) =
              LevelId
lid LevelId -> LevelId -> Bool
forall a. Eq a => a -> a -> Bool
== Actor -> LevelId
blid Actor
b
          targetTEnemy _ = Bool
False
          actorNoSupport :: ((ActorId, b), b) -> m Bool
actorNoSupport ((aid :: ActorId
aid, _), _) = do
            [(Int, (ActorId, Actor))]
threatDistL <- (State -> [(Int, (ActorId, Actor))]) -> m [(Int, (ActorId, Actor))]
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 -> State -> [(Int, (ActorId, Actor))]
meleeThreatDistList ActorId
aid
            Bool
condSupport2 <- Int -> ActorId -> m Bool
forall (m :: * -> *). MonadClient m => Int -> ActorId -> m Bool
condSupport 2 ActorId
aid
            let condThreat :: Int -> Bool
condThreat n :: 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.
            Bool -> m Bool
forall (m :: * -> *) a. Monad m => a -> m a
return (Bool -> m Bool) -> Bool -> m Bool
forall a b. (a -> b) -> a -> b
$! Int -> Bool
condThreat 5 Bool -> Bool -> Bool
&& Bool -> Bool
not Bool
condSupport2
          (oursRanged :: [((ActorId, Actor), TgtAndPath)]
oursRanged, oursNotRanged :: [((ActorId, Actor), TgtAndPath)]
oursNotRanged) = (((ActorId, Actor), TgtAndPath) -> Bool)
-> [((ActorId, Actor), TgtAndPath)]
-> ([((ActorId, Actor), TgtAndPath)],
    [((ActorId, Actor), TgtAndPath)])
forall a. (a -> Bool) -> [a] -> ([a], [a])
partition ((ActorId, Actor), TgtAndPath) -> Bool
actorRanged [((ActorId, Actor), TgtAndPath)]
oursNotHearing
          (oursTEnemyAll :: [((ActorId, Actor), TgtAndPath)]
oursTEnemyAll, oursOther :: [((ActorId, Actor), TgtAndPath)]
oursOther) = (((ActorId, Actor), TgtAndPath) -> Bool)
-> [((ActorId, Actor), TgtAndPath)]
-> ([((ActorId, Actor), TgtAndPath)],
    [((ActorId, Actor), TgtAndPath)])
forall a. (a -> Bool) -> [a] -> ([a], [a])
partition ((ActorId, Actor), TgtAndPath) -> Bool
forall a. ((a, Actor), TgtAndPath) -> Bool
targetTEnemy [((ActorId, Actor), TgtAndPath)]
oursNotRanged
          notSwapReady :: ((a, Actor), TgtAndPath) -> ((a, Actor), Maybe TgtAndPath) -> Bool
notSwapReady abt :: ((a, Actor), TgtAndPath)
abt@((_, b :: Actor
b), _)
                       (ab2 :: (a, Actor)
ab2, Just t2 :: TgtAndPath
t2@TgtAndPath{tapPath :: TgtAndPath -> Maybe AndPath
tapPath=
                                       Just AndPath{pathList :: AndPath -> [Point]
pathList=q :: Point
q : _}}) =
            let source :: Point
source = Actor -> Point
bpos Actor
b
                tenemy :: Bool
tenemy = ((a, Actor), TgtAndPath) -> Bool
forall a. ((a, Actor), TgtAndPath) -> Bool
targetTEnemy ((a, Actor), TgtAndPath)
abt
                tenemy2 :: Bool
tenemy2 = ((a, Actor), TgtAndPath) -> Bool
forall a. ((a, Actor), TgtAndPath) -> Bool
targetTEnemy ((a, 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 _ _ = 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 :: ((ActorId, Actor), TgtAndPath) -> Bool
targetBlocked abt :: ((ActorId, Actor), TgtAndPath)
abt@((aid :: ActorId
aid, _), TgtAndPath{Maybe AndPath
tapPath :: Maybe AndPath
tapPath :: TgtAndPath -> Maybe AndPath
tapPath}) = case Maybe AndPath
tapPath of
            Just AndPath{pathList :: AndPath -> [Point]
pathList= q :: Point
q : _} ->
              (((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@((aid2 :: ActorId
aid2, body2 :: Actor
body2), _) ->
                     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
forall a a.
((a, Actor), TgtAndPath) -> ((a, Actor), Maybe TgtAndPath) -> Bool
notSwapReady ((ActorId, Actor), TgtAndPath)
abt ((ActorId, Actor), Maybe TgtAndPath)
abt2)
                  [((ActorId, Actor), Maybe TgtAndPath)]
oursTgtRaw
            _ -> Bool
False
          (oursTEnemyBlocked :: [((ActorId, Actor), TgtAndPath)]
oursTEnemyBlocked, oursTEnemy :: [((ActorId, Actor), TgtAndPath)]
oursTEnemy) =
            (((ActorId, Actor), TgtAndPath) -> Bool)
-> [((ActorId, Actor), TgtAndPath)]
-> ([((ActorId, Actor), TgtAndPath)],
    [((ActorId, Actor), TgtAndPath)])
forall a. (a -> Bool) -> [a] -> ([a], [a])
partition ((ActorId, Actor), TgtAndPath) -> Bool
targetBlocked [((ActorId, Actor), TgtAndPath)]
oursTEnemyAll
      (oursNoSupportRaw :: [((ActorId, Actor), TgtAndPath)]
oursNoSupportRaw, oursSupportRaw :: [((ActorId, Actor), TgtAndPath)]
oursSupportRaw) <-
        if [((ActorId, Actor), TgtAndPath)] -> Int
forall a. [a] -> Int
length [((ActorId, Actor), TgtAndPath)]
oursTEnemy Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= 2
        then ([((ActorId, Actor), TgtAndPath)],
 [((ActorId, Actor), TgtAndPath)])
-> m ([((ActorId, Actor), TgtAndPath)],
      [((ActorId, Actor), TgtAndPath)])
forall (m :: * -> *) a. Monad m => a -> m a
return ([], [((ActorId, Actor), TgtAndPath)]
oursTEnemy)
        else (((ActorId, Actor), TgtAndPath) -> m Bool)
-> [((ActorId, Actor), TgtAndPath)]
-> m ([((ActorId, Actor), TgtAndPath)],
      [((ActorId, Actor), TgtAndPath)])
forall (m :: * -> *) a.
Applicative m =>
(a -> m Bool) -> [a] -> m ([a], [a])
partitionM ((ActorId, Actor), TgtAndPath) -> m Bool
forall (m :: * -> *) b b.
MonadClient m =>
((ActorId, b), b) -> m Bool
actorNoSupport [((ActorId, Actor), TgtAndPath)]
oursTEnemy
      let (oursNoSupport :: [((ActorId, Actor), TgtAndPath)]
oursNoSupport, oursSupport :: [((ActorId, Actor), TgtAndPath)]
oursSupport) =
            if [((ActorId, Actor), TgtAndPath)] -> Int
forall a. [a] -> Int
length [((ActorId, Actor), TgtAndPath)]
oursSupportRaw Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= 1  -- make sure picks random enough
            then ([], [((ActorId, Actor), TgtAndPath)]
oursTEnemy)
            else ([((ActorId, Actor), TgtAndPath)]
oursNoSupportRaw, [((ActorId, Actor), TgtAndPath)]
oursSupportRaw)
          (oursBlocked :: [((ActorId, Actor), TgtAndPath)]
oursBlocked, oursPos :: [((ActorId, Actor), TgtAndPath)]
oursPos) =
            (((ActorId, Actor), TgtAndPath) -> Bool)
-> [((ActorId, Actor), TgtAndPath)]
-> ([((ActorId, Actor), TgtAndPath)],
    [((ActorId, Actor), TgtAndPath)])
forall a. (a -> Bool) -> [a] -> ([a], [a])
partition ((ActorId, Actor), TgtAndPath) -> Bool
targetBlocked ([((ActorId, Actor), TgtAndPath)]
 -> ([((ActorId, Actor), TgtAndPath)],
     [((ActorId, Actor), TgtAndPath)]))
-> [((ActorId, Actor), TgtAndPath)]
-> ([((ActorId, Actor), TgtAndPath)],
    [((ActorId, Actor), TgtAndPath)])
forall a b. (a -> b) -> a -> b
$ [((ActorId, Actor), TgtAndPath)]
oursRanged [((ActorId, Actor), TgtAndPath)]
-> [((ActorId, Actor), TgtAndPath)]
-> [((ActorId, Actor), TgtAndPath)]
forall a. [a] -> [a] -> [a]
++ [((ActorId, Actor), TgtAndPath)]
oursOther
          -- Lower overhead is better.
          overheadOurs :: ((ActorId, Actor), TgtAndPath) -> Int
          overheadOurs :: ((ActorId, Actor), TgtAndPath) -> Int
overheadOurs ((aid :: ActorId
aid, _), TgtAndPath{tapPath :: TgtAndPath -> Maybe AndPath
tapPath=Maybe AndPath
Nothing}) =
            100 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 1 else 0
          overheadOurs
            abt :: ((ActorId, Actor), TgtAndPath)
abt@( (aid :: ActorId
aid, b :: Actor
b)
                , TgtAndPath{tapPath :: TgtAndPath -> Maybe AndPath
tapPath=Just AndPath{pathLen :: AndPath -> Int
pathLen=Int
d,Point
pathGoal :: AndPath -> Point
pathGoal :: Point
pathGoal}} ) =
            -- 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 = 3 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ [(ActorId, Actor)] -> Int
forall a. [a] -> Int
length [(ActorId, Actor)]
oursNotSleeping
                lDist :: Point -> [Int]
lDist p :: Point
p = [ Point -> Point -> Int
chessDist (Actor -> Point
bpos Actor
b2) Point
p
                          | (aid2 :: ActorId
aid2, b2 :: Actor
b2) <- [(ActorId, Actor)]
oursNotSleeping, ActorId
aid2 ActorId -> ActorId -> Bool
forall a. Eq a => a -> a -> Bool
/= ActorId
aid]
                pDist :: Point -> Int
pDist p :: Point
p = let ld :: [Int]
ld = Point -> [Int]
lDist Point
p
                          in Bool -> Int -> Int
forall a. HasCallStack => Bool -> a -> a
assert (Bool -> Bool
not (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$ [Int] -> Bool
forall a. [a] -> Bool
null [Int]
ld) (Int -> Int) -> Int -> Int
forall a b. (a -> b) -> a -> b
$ [Int] -> Int
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
<= 0 then -1 else 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
^ (2 :: Int)
                fightValue :: Int
fightValue | ((ActorId, Actor), TgtAndPath) -> Bool
forall a. ((a, Actor), TgtAndPath) -> Bool
targetTEnemy ((ActorId, Actor), TgtAndPath)
abt =
                  - 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` (10 Int64 -> Int64 -> Int64
forall a. Num a => a -> a -> a
* Int64
oneM))
                           | Bool
otherwise = 0
            in Int
formationValue Int -> Int -> Int
forall a. Integral a => a -> a -> a
`div` 3 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
fightValue
               Int -> Int -> Int
forall a. Num a => a -> a -> a
+ (if ((ActorId, Actor), TgtAndPath) -> Bool
targetBlocked ((ActorId, Actor), TgtAndPath)
abt then 5 else 0)
               Int -> Int -> Int
forall a. Num a => a -> a -> a
+ (case Int
d of
                    0 -> -400 -- do your thing ASAP and retarget
                    1 -> -200 -- prevent others from occupying the tile
                    _ -> if Int
d Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< 8 then Int
d Int -> Int -> Int
forall a. Integral a => a -> a -> a
`div` 4 else 2 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
d Int -> Int -> Int
forall a. Integral a => a -> a -> a
`div` 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 1 else 0)
          positiveOverhead :: ((ActorId, Actor), TgtAndPath) -> Int
positiveOverhead sk :: ((ActorId, Actor), TgtAndPath)
sk =
            let ov :: Int
ov = 200 Int -> Int -> Int
forall a. Num a => a -> a -> a
- ((ActorId, Actor), TgtAndPath) -> Int
overheadOurs ((ActorId, Actor), TgtAndPath)
sk
            in if Int
ov Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= 0 then 1 else Int
ov
          candidates :: [[((ActorId, Actor), TgtAndPath)]]
candidates = [ [((ActorId, Actor), TgtAndPath)]
oursVulnerable
                       , [((ActorId, Actor), TgtAndPath)]
oursSupport
                       , [((ActorId, Actor), TgtAndPath)]
oursNoSupport
                       , [((ActorId, Actor), TgtAndPath)]
oursPos
                       , [((ActorId, Actor), TgtAndPath)]
oursFled  -- if just fled, keep him safe, out of action
                       , [((ActorId, Actor), TgtAndPath)]
oursMeleeing [((ActorId, Actor), TgtAndPath)]
-> [((ActorId, Actor), TgtAndPath)]
-> [((ActorId, Actor), TgtAndPath)]
forall a. [a] -> [a] -> [a]
++ [((ActorId, Actor), TgtAndPath)]
oursTEnemyBlocked
                           -- make melee a leader to displace or at least melee
                           -- without overhead if all others blocked
                       , [((ActorId, Actor), TgtAndPath)]
oursHearing
                       , [((ActorId, Actor), TgtAndPath)]
oursBlocked
                       ]
      case ([((ActorId, Actor), TgtAndPath)] -> Bool)
-> [[((ActorId, Actor), TgtAndPath)]]
-> [[((ActorId, Actor), TgtAndPath)]]
forall a. (a -> Bool) -> [a] -> [a]
filter (Bool -> Bool
not (Bool -> Bool)
-> ([((ActorId, Actor), TgtAndPath)] -> Bool)
-> [((ActorId, Actor), TgtAndPath)]
-> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [((ActorId, Actor), TgtAndPath)] -> Bool
forall a. [a] -> Bool
null) [[((ActorId, Actor), TgtAndPath)]]
candidates of
        l :: [((ActorId, Actor), TgtAndPath)]
l : _ -> 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 "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 (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 :: ActorId
aid, b :: Actor
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
          State
s <- m State
forall (m :: * -> *). MonadStateRead m => m State
getState
          (StateClient -> StateClient) -> m ()
forall (m :: * -> *).
MonadClient m =>
(StateClient -> StateClient) -> m ()
modifyClient ((StateClient -> StateClient) -> m ())
-> (StateClient -> StateClient) -> m ()
forall a b. (a -> b) -> a -> b
$ ActorId -> State -> StateClient -> StateClient
updateLeader ActorId
aid State
s
          -- When you become a leader, stop following old leader, but follow
          -- his target, if still valid, to avoid distraction.
          Bool
condInMelee <- LevelId -> m Bool
forall (m :: * -> *). MonadClient m => LevelId -> m Bool
condInMeleeM (LevelId -> m Bool) -> LevelId -> m Bool
forall a b. (a -> b) -> a -> b
$ Actor -> LevelId
blid Actor
b
          Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Player -> Tactic
ftactic (Faction -> Player
gplayer Faction
fact)
                Tactic -> [Tactic] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Tactic
Ability.TFollow, Tactic
Ability.TFollowNoItems]
                Bool -> Bool -> Bool
&& Bool -> Bool
not Bool
condInMelee) (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$
            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) -> m (Maybe TgtAndPath)
forall (m :: * -> *).
MonadClient m =>
(ActorId, Actor) -> m (Maybe TgtAndPath)
refreshTarget (ActorId
aid, Actor
b)
          ActorId -> m ActorId
forall (m :: * -> *) a. Monad m => a -> m a
return ActorId
aid
        _ -> ActorId -> m ActorId
forall (m :: * -> *) a. Monad m => a -> m a
return ActorId
oldAid

-- | Inspect the tactics of the actor and set his target according to it.
setTargetFromTactics :: MonadClient m => ActorId -> m ()
{-# INLINE setTargetFromTactics #-}
setTargetFromTactics :: ActorId -> m ()
setTargetFromTactics oldAid :: ActorId
oldAid = do
  Maybe ActorId
mleader <- (StateClient -> Maybe ActorId) -> m (Maybe ActorId)
forall (m :: * -> *) a.
MonadClientRead m =>
(StateClient -> a) -> m a
getsClient StateClient -> Maybe ActorId
sleader
  let !_A :: ()
_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) ()
  Actor
oldBody <- (State -> Actor) -> m Actor
forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
getsState ((State -> Actor) -> m Actor) -> (State -> Actor) -> m Actor
forall a b. (a -> b) -> a -> b
$ ActorId -> State -> Actor
getActorBody ActorId
oldAid
  Maybe TgtAndPath
moldTgt <- (StateClient -> Maybe TgtAndPath) -> m (Maybe TgtAndPath)
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
oldAid (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
  Bool
condInMelee <- LevelId -> m Bool
forall (m :: * -> *). MonadClient m => LevelId -> m Bool
condInMeleeM (LevelId -> m Bool) -> LevelId -> m Bool
forall a b. (a -> b) -> a -> b
$ Actor -> LevelId
blid Actor
oldBody
  let side :: FactionId
side = Actor -> FactionId
bfid Actor
oldBody
      arena :: LevelId
arena = Actor -> LevelId
blid Actor
oldBody
  Faction
fact <- (State -> Faction) -> m Faction
forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
getsState ((State -> Faction) -> m Faction)
-> (State -> Faction) -> m Faction
forall a b. (a -> b) -> a -> b
$ (EnumMap FactionId Faction -> FactionId -> Faction
forall k a. Enum k => EnumMap k a -> k -> a
EM.! FactionId
side) (EnumMap FactionId Faction -> Faction)
-> (State -> EnumMap FactionId Faction) -> State -> Faction
forall b c a. (b -> c) -> (a -> b) -> a -> c
. State -> EnumMap FactionId Faction
sfactionD
  let explore :: m ()
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) -> m (Maybe TgtAndPath)
forall (m :: * -> *).
MonadClient m =>
(ActorId, Actor) -> m (Maybe TgtAndPath)
refreshTarget (ActorId
oldAid, Actor
oldBody)
      setPath :: Maybe TgtAndPath -> m Bool
setPath mtgt :: Maybe TgtAndPath
mtgt = case (Maybe TgtAndPath
mtgt, Maybe TgtAndPath
moldTgt) of
        (Nothing, _) -> Bool -> m Bool
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 oldTapPath :: 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) -> m (Maybe TgtAndPath)
forall (m :: * -> *).
MonadClient m =>
(ActorId, Actor) -> m (Maybe TgtAndPath)
refreshTarget (ActorId
oldAid, Actor
oldBody)
            Bool -> m Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
True  -- already on target
        (Just TgtAndPath{tapTgt :: TgtAndPath -> Target
tapTgt=Target
leaderTapTgt}, _) -> do
            TgtAndPath
tap <- ActorId -> Target -> m TgtAndPath
forall (m :: * -> *).
MonadClient m =>
ActorId -> Target -> m TgtAndPath
createPath ActorId
oldAid Target
leaderTapTgt
            case TgtAndPath
tap of
              TgtAndPath{tapPath :: TgtAndPath -> Maybe AndPath
tapPath=Maybe AndPath
Nothing} -> Bool -> m Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
False
              _ -> 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
$ \cli :: StateClient
cli ->
                  StateClient
cli {stargetD :: EnumMap ActorId TgtAndPath
stargetD = ActorId
-> TgtAndPath
-> EnumMap ActorId TgtAndPath
-> EnumMap ActorId TgtAndPath
forall k a. Enum k => k -> a -> EnumMap k a -> EnumMap k a
EM.insert ActorId
oldAid TgtAndPath
tap (StateClient -> EnumMap ActorId TgtAndPath
stargetD StateClient
cli)}
                Bool -> m Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
True
      follow :: m ()
follow = case Maybe ActorId
mleader of
        -- If no leader at all (forced @TFollow@ tactic on an actor
        -- from a leaderless faction), fall back to @TExplore@.
        Nothing -> m ()
explore
        _ | 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 leader :: ActorId
leader -> do
          Bool
onLevel <- (State -> Bool) -> m Bool
forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
getsState ((State -> Bool) -> m Bool) -> (State -> Bool) -> m Bool
forall a b. (a -> b) -> a -> b
$ ActorId -> LevelId -> State -> Bool
memActor ActorId
leader LevelId
arena
          -- If leader not on this level, fall back to @TExplore@.
          if Bool -> Bool
not Bool
onLevel Bool -> Bool -> Bool
|| Bool
condInMelee then m ()
explore
          else do
            -- Copy over the leader's target, if any, or follow his position.
            Maybe TgtAndPath
mtgt <- (StateClient -> Maybe TgtAndPath) -> m (Maybe TgtAndPath)
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
leader (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
            Bool
tgtPathSet <- Maybe TgtAndPath -> m Bool
setPath Maybe TgtAndPath
mtgt
            Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless Bool
tgtPathSet (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$ do
              let nonEnemyPath :: Maybe TgtAndPath
nonEnemyPath = TgtAndPath -> Maybe TgtAndPath
forall a. a -> Maybe a
Just $WTgtAndPath :: Target -> Maybe AndPath -> TgtAndPath
TgtAndPath { tapTgt :: Target
tapTgt = ActorId -> Target
TNonEnemy ActorId
leader
                                                 , tapPath :: Maybe AndPath
tapPath = Maybe AndPath
forall a. Maybe a
Nothing }
              Bool
nonEnemyPathSet <- Maybe TgtAndPath -> m Bool
setPath Maybe TgtAndPath
nonEnemyPath
              Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless Bool
nonEnemyPathSet
                -- If no path even to the leader himself, explore.
                m ()
explore
  case Player -> Tactic
ftactic (Player -> Tactic) -> Player -> Tactic
forall a b. (a -> b) -> a -> b
$ Faction -> Player
gplayer Faction
fact of
    Ability.TExplore -> m ()
explore
    Ability.TFollow -> m ()
follow
    Ability.TFollowNoItems -> m ()
follow
    Ability.TMeleeAndRanged -> m ()
explore  -- needs to find ranged targets
    Ability.TMeleeAdjacent -> m ()
explore  -- probably not needed, but may change
    Ability.TBlock -> () -> m ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()  -- no point refreshing target
    Ability.TRoam -> m ()
explore  -- @TRoam@ is checked again inside @explore@
    Ability.TPatrol -> m ()
explore  -- WIP