-- | AI procedure for picking the best action for an actor.
module Game.LambdaHack.Client.AI.PickActionM
  ( pickAction
#ifdef EXPOSE_INTERNAL
    -- * Internal operations
  , actionStrategy, waitBlockNow, yellNow
  , pickup, equipItems, yieldUnneeded, unEquipItems
  , groupByEqpSlot, bestByEqpSlot, harmful, meleeBlocker, meleeAny
  , trigger, projectItem, ApplyItemGroup, applyItem, flee
  , displaceFoe, displaceBlocker, displaceTgt
  , chase, moveTowards, moveOrRunAid
#endif
  ) where

import Prelude ()

import Game.LambdaHack.Core.Prelude

import           Data.Either
import qualified Data.EnumMap.Strict as EM
import qualified Data.EnumSet as ES
import           Data.Function
import           Data.Ratio

import           Game.LambdaHack.Client.AI.ConditionM
import           Game.LambdaHack.Client.AI.Strategy
import           Game.LambdaHack.Client.Bfs
import           Game.LambdaHack.Client.BfsM
import           Game.LambdaHack.Client.CommonM
import           Game.LambdaHack.Client.MonadClient
import           Game.LambdaHack.Client.Request
import           Game.LambdaHack.Client.State
import           Game.LambdaHack.Common.Actor
import           Game.LambdaHack.Common.ActorState
import           Game.LambdaHack.Common.Faction
import           Game.LambdaHack.Common.Item
import qualified Game.LambdaHack.Common.ItemAspect as IA
import           Game.LambdaHack.Common.Kind
import           Game.LambdaHack.Common.Level
import           Game.LambdaHack.Common.Misc
import           Game.LambdaHack.Common.MonadStateRead
import           Game.LambdaHack.Common.Point
import qualified Game.LambdaHack.Common.PointArray as PointArray
import           Game.LambdaHack.Common.ReqFailure
import           Game.LambdaHack.Common.State
import qualified Game.LambdaHack.Common.Tile as Tile
import           Game.LambdaHack.Common.Time
import           Game.LambdaHack.Common.Types
import           Game.LambdaHack.Common.Vector
import           Game.LambdaHack.Content.FactionKind
import qualified Game.LambdaHack.Content.ItemKind as IK
import           Game.LambdaHack.Core.Frequency
import           Game.LambdaHack.Core.Random
import           Game.LambdaHack.Definition.Ability
import qualified Game.LambdaHack.Definition.Ability as Ability
import           Game.LambdaHack.Definition.Defs
import qualified Game.LambdaHack.Definition.DefsInternal as DefsInternal

-- | Pick the most desirable AI ation for the actor.
pickAction :: MonadClient m
           => [(ActorId, Actor)] -> [(ActorId, Actor)] -> ActorId -> Bool
           -> m RequestTimed
pickAction :: [(ActorId, Actor)]
-> [(ActorId, Actor)] -> ActorId -> Bool -> m RequestTimed
pickAction [(ActorId, Actor)]
foeAssocs [(ActorId, Actor)]
friendAssocs ActorId
aid Bool
retry = do
  FactionId
side <- (StateClient -> FactionId) -> m FactionId
forall (m :: * -> *) a.
MonadClientRead m =>
(StateClient -> a) -> m a
getsClient StateClient -> FactionId
sside
  Actor
body <- (State -> Actor) -> m Actor
forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
getsState ((State -> Actor) -> m Actor) -> (State -> Actor) -> m Actor
forall a b. (a -> b) -> a -> b
$ ActorId -> State -> Actor
getActorBody ActorId
aid
  let !_A :: ()
_A = Bool -> () -> ()
forall a. (?callStack::CallStack) => Bool -> a -> a
assert (Actor -> FactionId
bfid Actor
body FactionId -> FactionId -> Bool
forall a. Eq a => a -> a -> Bool
== FactionId
side
                    Bool -> (String, (ActorId, FactionId, FactionId)) -> Bool
forall a. Show a => Bool -> a -> Bool
`blame` String
"AI tries to move enemy actor"
                    String
-> (ActorId, FactionId, FactionId)
-> (String, (ActorId, FactionId, FactionId))
forall v. String -> v -> (String, v)
`swith` (ActorId
aid, Actor -> FactionId
bfid Actor
body, FactionId
side)) ()
  let !_A :: ()
_A = Bool -> () -> ()
forall a. (?callStack::CallStack) => Bool -> a -> a
assert (Bool -> Bool
not (Actor -> Bool
bproj Actor
body)
                    Bool -> (String, (ActorId, FactionId, FactionId)) -> Bool
forall a. Show a => Bool -> a -> Bool
`blame` String
"AI gets to manually move its projectiles"
                    String
-> (ActorId, FactionId, FactionId)
-> (String, (ActorId, FactionId, FactionId))
forall v. String -> v -> (String, v)
`swith` (ActorId
aid, Actor -> FactionId
bfid Actor
body, FactionId
side)) ()
  Strategy RequestTimed
stratAction <- [(ActorId, Actor)]
-> [(ActorId, Actor)]
-> LevelId
-> ActorId
-> Bool
-> m (Strategy RequestTimed)
forall (m :: * -> *).
MonadClient m =>
[(ActorId, Actor)]
-> [(ActorId, Actor)]
-> LevelId
-> ActorId
-> Bool
-> m (Strategy RequestTimed)
actionStrategy [(ActorId, Actor)]
foeAssocs [(ActorId, Actor)]
friendAssocs (Actor -> LevelId
blid Actor
body) ActorId
aid Bool
retry
  let bestAction :: Frequency RequestTimed
bestAction = Strategy RequestTimed -> Frequency RequestTimed
forall a. Strategy a -> Frequency a
bestVariant Strategy RequestTimed
stratAction
      !_A :: ()
_A = Bool -> () -> ()
forall a. (?callStack::CallStack) => Bool -> a -> a
assert (Bool -> Bool
not (Frequency RequestTimed -> Bool
forall a. Frequency a -> Bool
nullFreq Frequency RequestTimed
bestAction)  -- equiv to nullStrategy
                    Bool -> (String, (Strategy RequestTimed, ActorId, Actor)) -> Bool
forall a. Show a => Bool -> a -> Bool
`blame` String
"no AI action for actor"
                    String
-> (Strategy RequestTimed, ActorId, Actor)
-> (String, (Strategy RequestTimed, ActorId, Actor))
forall v. String -> v -> (String, v)
`swith` (Strategy RequestTimed
stratAction, ActorId
aid, Actor
body)) ()
  -- Run the AI: chose an action from those given by the AI strategy.
  Rnd RequestTimed -> m RequestTimed
forall (m :: * -> *) a. MonadClient m => Rnd a -> m a
rndToAction (Rnd RequestTimed -> m RequestTimed)
-> Rnd RequestTimed -> m RequestTimed
forall a b. (a -> b) -> a -> b
$ Frequency RequestTimed -> Rnd RequestTimed
forall a. Show a => Frequency a -> Rnd a
frequency Frequency RequestTimed
bestAction

-- AI strategy based on actor's sight, smell, etc.
-- Never empty.
actionStrategy :: MonadClient m
               => [(ActorId, Actor)] -> [(ActorId, Actor)]
               -> LevelId -> ActorId -> Bool
               -> m (Strategy RequestTimed)
actionStrategy :: [(ActorId, Actor)]
-> [(ActorId, Actor)]
-> LevelId
-> ActorId
-> Bool
-> m (Strategy RequestTimed)
actionStrategy [(ActorId, Actor)]
foeAssocs [(ActorId, Actor)]
friendAssocs LevelId
lid ActorId
aid Bool
retry = do
  Bool
condInMelee <- LevelId -> m Bool
forall (m :: * -> *). MonadClientRead m => LevelId -> m Bool
condInMeleeM LevelId
lid
  Int
randomAggressionThreshold <- Rnd Int -> m Int
forall (m :: * -> *) a. MonadClient m => Rnd a -> m a
rndToAction (Rnd Int -> m Int) -> Rnd Int -> m Int
forall a b. (a -> b) -> a -> b
$ Int -> Rnd Int
forall a. Integral a => a -> Rnd a
randomR0 Int
10
  Bool
-> [(ActorId, Actor)]
-> [(ActorId, Actor)]
-> Int
-> LevelId
-> ActorId
-> Bool
-> m (Strategy RequestTimed)
forall (m :: * -> *).
MonadClient m =>
Bool
-> [(ActorId, Actor)]
-> [(ActorId, Actor)]
-> Int
-> LevelId
-> ActorId
-> Bool
-> m (Strategy RequestTimed)
actionStrategyRead Bool
condInMelee [(ActorId, Actor)]
foeAssocs [(ActorId, Actor)]
friendAssocs
                     Int
randomAggressionThreshold LevelId
lid ActorId
aid Bool
retry

-- This is close to being in @MonadClientRead@, but not quite, due to
-- random numbers used explicitly in a couple of places (e.g., weapon choice),
-- which should be fixed and expressed via @Strategy@ instead,
-- and due to recoding the fleeing preference, which should be
-- factored out and done in the @actionStrategy@ wrapper.
--
-- After the AI code is totally rewritten soon, this should be revisited.
actionStrategyRead :: forall m. MonadClient m
                   => Bool
                   -> [(ActorId, Actor)] -> [(ActorId, Actor)]
                   -> Int -> LevelId -> ActorId -> Bool
                   -> m (Strategy RequestTimed)
actionStrategyRead :: Bool
-> [(ActorId, Actor)]
-> [(ActorId, Actor)]
-> Int
-> LevelId
-> ActorId
-> Bool
-> m (Strategy RequestTimed)
actionStrategyRead Bool
condInMelee [(ActorId, Actor)]
foeAssocs [(ActorId, Actor)]
friendAssocs
                   Int
randomAggressionThreshold LevelId
lid ActorId
aid Bool
retry = do
  COps{TileSpeedup
coTileSpeedup :: COps -> TileSpeedup
coTileSpeedup :: TileSpeedup
coTileSpeedup} <- (State -> COps) -> m COps
forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
getsState State -> COps
scops
  Maybe ActorId
mleader <- (StateClient -> Maybe ActorId) -> m (Maybe ActorId)
forall (m :: * -> *) a.
MonadClientRead m =>
(StateClient -> a) -> m a
getsClient StateClient -> Maybe ActorId
sleader
  Actor
body <- (State -> Actor) -> m Actor
forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
getsState ((State -> Actor) -> m Actor) -> (State -> Actor) -> m Actor
forall a b. (a -> b) -> a -> b
$ ActorId -> State -> Actor
getActorBody ActorId
aid
  let !_A :: ()
_A = Bool -> () -> ()
forall a. (?callStack::CallStack) => Bool -> a -> a
assert (Actor -> LevelId
blid Actor
body LevelId -> LevelId -> Bool
forall a. Eq a => a -> a -> Bool
== LevelId
lid) ()
  Level
lvl <- LevelId -> m Level
forall (m :: * -> *). MonadStateRead m => LevelId -> m Level
getLevel LevelId
lid
  Time
localTime <- (State -> Time) -> m Time
forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
getsState ((State -> Time) -> m Time) -> (State -> Time) -> m Time
forall a b. (a -> b) -> a -> b
$ LevelId -> State -> Time
getLocalTime LevelId
lid
  Bool
condAimEnemyTargeted <- ActorId -> m Bool
forall (m :: * -> *). MonadClientRead m => ActorId -> m Bool
condAimEnemyTargetedM ActorId
aid
  Bool
condAimEnemyOrStash <- ActorId -> m Bool
forall (m :: * -> *). MonadClientRead m => ActorId -> m Bool
condAimEnemyOrStashM ActorId
aid
  Bool
condAimEnemyOrRemembered <- ActorId -> m Bool
forall (m :: * -> *). MonadClientRead m => ActorId -> m Bool
condAimEnemyOrRememberedM ActorId
aid
  Bool
condAimNonEnemyPresent <- ActorId -> m Bool
forall (m :: * -> *). MonadClientRead m => ActorId -> m Bool
condAimNonEnemyPresentM ActorId
aid
  Bool
condAimCrucial <- ActorId -> m Bool
forall (m :: * -> *). MonadClientRead m => ActorId -> m Bool
condAimCrucialM ActorId
aid
  ActorMaxSkills
actorMaxSkills <- (State -> ActorMaxSkills) -> m ActorMaxSkills
forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
getsState State -> ActorMaxSkills
sactorMaxSkills
  Bool
condAnyFoeAdj <- (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 -> State -> Bool
anyFoeAdj ActorId
aid
  Faction
fact <- (State -> Faction) -> m Faction
forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
getsState ((State -> Faction) -> m Faction)
-> (State -> Faction) -> m Faction
forall a b. (a -> b) -> a -> b
$ (EnumMap FactionId Faction -> FactionId -> Faction
forall k a. Enum k => EnumMap k a -> k -> a
EM.! Actor -> FactionId
bfid Actor
body) (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
  Bool
condOurAdj <- (State -> Bool) -> m Bool
forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
getsState ((State -> Bool) -> m Bool) -> (State -> Bool) -> m Bool
forall a b. (a -> b) -> a -> b
$ ((ActorId, Actor) -> Bool) -> [(ActorId, Actor)] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (\(ActorId
_, Actor
b) -> FactionId -> Faction -> FactionId -> Bool
isFriend (Actor -> FactionId
bfid Actor
body) Faction
fact (Actor -> FactionId
bfid Actor
b))
                            ([(ActorId, Actor)] -> Bool)
-> (State -> [(ActorId, Actor)]) -> State -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Actor -> State -> [(ActorId, Actor)]
adjacentBigAssocs Actor
body
  [(ActorId, Actor)]
oursExploring <- (State -> [(ActorId, Actor)]) -> m [(ActorId, Actor)]
forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
getsState ((State -> [(ActorId, Actor)]) -> m [(ActorId, Actor)])
-> (State -> [(ActorId, Actor)]) -> m [(ActorId, Actor)]
forall a b. (a -> b) -> a -> b
$ FactionId -> State -> [(ActorId, Actor)]
oursExploringAssocs (Actor -> FactionId
bfid Actor
body)
  Bool
condAnyHarmfulFoeAdj <- (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
$ ActorMaxSkills -> ActorId -> State -> Bool
anyHarmfulFoeAdj ActorMaxSkills
actorMaxSkills 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, Actor)] -> ActorId -> State -> [(Int, (ActorId, Actor))]
meleeThreatDistList [(ActorId, Actor)]
foeAssocs ActorId
aid
  ([(Int, Point)]
fleeL, [(Int, Point)]
badVic) <- [(ActorId, Actor)] -> ActorId -> m ([(Int, Point)], [(Int, Point)])
forall (m :: * -> *).
MonadClientRead m =>
[(ActorId, Actor)] -> ActorId -> m ([(Int, Point)], [(Int, Point)])
fleeList [(ActorId, Actor)]
foeAssocs ActorId
aid
  EnumMap ActorId (Point, Time)
oldFleeD <- (StateClient -> EnumMap ActorId (Point, Time))
-> m (EnumMap ActorId (Point, Time))
forall (m :: * -> *) a.
MonadClientRead m =>
(StateClient -> a) -> m a
getsClient StateClient -> EnumMap ActorId (Point, Time)
sfleeD
  Bool
condSupport1 <- [(ActorId, Actor)] -> Int -> ActorId -> m Bool
forall (m :: * -> *).
MonadClientRead m =>
[(ActorId, Actor)] -> Int -> ActorId -> m Bool
condSupport [(ActorId, Actor)]
friendAssocs Int
1 ActorId
aid
  Bool
condSupport3 <- [(ActorId, Actor)] -> Int -> ActorId -> m Bool
forall (m :: * -> *).
MonadClientRead m =>
[(ActorId, Actor)] -> Int -> ActorId -> m Bool
condSupport [(ActorId, Actor)]
friendAssocs Int
3 ActorId
aid
  Bool
condSolo <- [(ActorId, Actor)] -> ActorId -> m Bool
forall (m :: * -> *).
MonadStateRead m =>
[(ActorId, Actor)] -> ActorId -> m Bool
condAloneM [(ActorId, Actor)]
friendAssocs ActorId
aid  -- solo fighters aggresive
  Skills
actorSk <- ActorId -> m Skills
forall (m :: * -> *). MonadClientRead m => ActorId -> m Skills
currentSkillsClient ActorId
aid
  Bool
condCanProject <- Int -> ActorId -> m Bool
forall (m :: * -> *). MonadClientRead m => Int -> ActorId -> m Bool
condCanProjectM (Skill -> Skills -> Int
getSk Skill
SkProject Skills
actorSk) ActorId
aid
  Bool
condAdjTriggerable <- Skills -> ActorId -> m Bool
forall (m :: * -> *).
MonadStateRead m =>
Skills -> ActorId -> m Bool
condAdjTriggerableM Skills
actorSk ActorId
aid
  Bool
condBlocksFriends <- ActorId -> m Bool
forall (m :: * -> *). MonadClientRead m => ActorId -> m Bool
condBlocksFriendsM ActorId
aid
  Bool
condNoEqpWeapon <- ActorId -> m Bool
forall (m :: * -> *). MonadStateRead m => ActorId -> m Bool
condNoEqpWeaponM ActorId
aid
  Bool
condEnoughGear <- ActorId -> m Bool
forall (m :: * -> *). MonadClientRead m => ActorId -> m Bool
condEnoughGearM ActorId
aid
  Bool
condFloorWeapon <- ActorId -> m Bool
forall (m :: * -> *). MonadStateRead m => ActorId -> m Bool
condFloorWeaponM ActorId
aid
  Bool
condDesirableFloorItem <- ActorId -> m Bool
forall (m :: * -> *). MonadClientRead m => ActorId -> m Bool
condDesirableFloorItemM ActorId
aid
  Bool
condTgtNonmovingEnemy <- ActorId -> m Bool
forall (m :: * -> *). MonadClientRead m => ActorId -> m Bool
condTgtNonmovingEnemyM ActorId
aid
  EnumSet LevelId
explored <- (StateClient -> EnumSet LevelId) -> m (EnumSet LevelId)
forall (m :: * -> *) a.
MonadClientRead m =>
(StateClient -> a) -> m a
getsClient StateClient -> EnumSet LevelId
sexplored
  -- This doesn't treat actors guarding stash specially, so on such levels
  -- man sleeping actors may reside for a long time. Variety, OK.
  let awakeAndNotGuarding :: (ActorId, Actor) -> Bool
awakeAndNotGuarding (ActorId
_, Actor
b) =
        Actor -> Point
bpos Actor
b Point -> Point -> Bool
forall a. Eq a => a -> a -> Bool
/= Actor -> Point
bpos Actor
body
        Bool -> Bool -> Bool
&& Actor -> Watchfulness
bwatch Actor
b Watchfulness -> Watchfulness -> Bool
forall a. Eq a => a -> a -> Bool
/= Watchfulness
WSleep
        Bool -> Bool -> Bool
&& (LevelId, Point) -> Maybe (LevelId, Point)
forall a. a -> Maybe a
Just (LevelId
lid, Actor -> Point
bpos Actor
b) Maybe (LevelId, Point) -> Maybe (LevelId, Point) -> Bool
forall a. Eq a => a -> a -> Bool
/= Faction -> Maybe (LevelId, Point)
gstash Faction
fact
      anyFriendOnLevelAwake :: Bool
anyFriendOnLevelAwake = ((ActorId, Actor) -> Bool) -> [(ActorId, Actor)] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (ActorId, Actor) -> Bool
awakeAndNotGuarding [(ActorId, Actor)]
friendAssocs
      actorMaxSk :: Skills
actorMaxSk = ActorMaxSkills
actorMaxSkills ActorMaxSkills -> ActorId -> Skills
forall k a. Enum k => EnumMap k a -> k -> a
EM.! ActorId
aid
      recentlyFled :: Bool
recentlyFled = Bool -> ((Point, Time) -> Bool) -> Maybe (Point, Time) -> Bool
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Bool
False (\(Point
_, Time
time) -> Time -> Time -> Bool
timeRecent5 Time
localTime Time
time)
                           (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)
      prefersSleepWhenAwake :: Bool
prefersSleepWhenAwake = case Actor -> Watchfulness
bwatch Actor
body of
        Watchfulness
WSleep -> Skill -> Skills -> Int
Ability.getSk Skill
Ability.SkMoveItem Skills
actorMaxSk Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= -Int
10
        Watchfulness
_ -> Skills -> Bool
prefersSleep Skills
actorMaxSk  -- nm @WWake@
      mayFallAsleep :: Bool
mayFallAsleep = Bool -> Bool
not Bool
condAimEnemyOrRemembered
                      Bool -> Bool -> Bool
&& Actor -> Skills -> Bool
calmFull Actor
body Skills
actorMaxSk  -- only when fully relaxed
                      Bool -> Bool -> Bool
&& Bool
mayContinueSleep
                      Bool -> Bool -> Bool
&& Skills -> Bool
canSleep Skills
actorSk
      mayContinueSleep :: Bool
mayContinueSleep = Bool -> Bool
not Bool
condAimEnemyOrStash
                         Bool -> Bool -> Bool
&& Bool -> Bool
not (Actor -> Skills -> Bool
hpFull Actor
body Skills
actorSk)
                         Bool -> Bool -> Bool
&& Bool -> Bool
not Bool
uneasy
                         Bool -> Bool -> Bool
&& Bool -> Bool
not Bool
condAnyFoeAdj
                         Bool -> Bool -> Bool
&& (Bool
anyFriendOnLevelAwake  -- friend guards the sleeper
                             Bool -> Bool -> Bool
|| Bool
prefersSleepWhenAwake)  -- or he doesn't care
      dozes :: Bool
dozes = case Actor -> Watchfulness
bwatch Actor
body of
                WWait Int
n -> Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
0
                Watchfulness
_ -> Bool
False
              Bool -> Bool -> Bool
&& Bool
mayFallAsleep
              Bool -> Bool -> Bool
&& ActorId -> Maybe ActorId
forall a. a -> Maybe a
Just ActorId
aid Maybe ActorId -> Maybe ActorId -> Bool
forall a. Eq a => a -> a -> Bool
/= Maybe ActorId
mleader  -- best teammate for a task so stop dozing
      lidExplored :: Bool
lidExplored = LevelId -> EnumSet LevelId -> Bool
forall k. Enum k => k -> EnumSet k -> Bool
ES.member LevelId
lid EnumSet LevelId
explored
      panicFleeL :: [(Int, Point)]
panicFleeL = [(Int, Point)]
fleeL [(Int, Point)] -> [(Int, Point)] -> [(Int, Point)]
forall a. [a] -> [a] -> [a]
++ [(Int, Point)]
badVic
      condHpTooLow :: Bool
condHpTooLow = Actor -> Skills -> Bool
hpTooLow Actor
body Skills
actorMaxSk
      heavilyDistressed :: Bool
heavilyDistressed =  -- actor hit by a proj or similarly distressed
        ResDelta -> Bool
deltasSerious (Actor -> ResDelta
bcalmDelta Actor
body)
      heavilyDistressedThisTurn :: Bool
heavilyDistressedThisTurn =  -- if far from melee, almost sure hit by proj
        ResDelta -> Bool
deltasSeriousThisTurn (Actor -> ResDelta
bcalmDelta Actor
body)
      condNotCalmEnough :: Bool
condNotCalmEnough = Bool -> Bool
not (Actor -> Skills -> Bool
calmEnough Actor
body Skills
actorMaxSk)
      uneasy :: Bool
uneasy = Bool
heavilyDistressed Bool -> Bool -> Bool
|| Bool
condNotCalmEnough Bool -> Bool -> Bool
|| Bool
recentlyFled
      speed :: Speed
speed = Skills -> Speed
gearSpeed Skills
actorMaxSk
      speed1_5 :: Speed
speed1_5 = Rational -> Speed -> Speed
speedScale (Integer
3Integer -> Integer -> Rational
forall a. Integral a => a -> a -> Ratio a
%Integer
2) Speed
speed
      -- Max skills used, because we need to know if can melee as leader.
      condCanMelee :: Bool
condCanMelee = ActorMaxSkills -> ActorId -> Actor -> Bool
actorCanMelee ActorMaxSkills
actorMaxSkills ActorId
aid Actor
body
      condMeleeBad :: Bool
condMeleeBad = Bool -> Bool
not ((Bool
condSolo Bool -> Bool -> Bool
|| Bool
condSupport1) Bool -> Bool -> Bool
&& Bool
condCanMelee)
      -- These are only melee threats.
      condThreat :: Int -> Bool
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
      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
== 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
      condManyThreatsAdj :: Bool
condManyThreatsAdj = [(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 :: Bool
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 :: Bool
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
      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
      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
      canFleeIntoDark :: Bool
canFleeIntoDark = Bool -> Bool
not (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$ Bool
actorShines Bool -> Bool -> Bool
|| ((Int, Point) -> Bool) -> [(Int, Point)] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all (Point -> Bool
isLit (Point -> Bool) -> ((Int, Point) -> Point) -> (Int, Point) -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Int, Point) -> Point
forall a b. (a, b) -> b
snd) [(Int, Point)]
fleeL
      avoidAmbient :: Bool
avoidAmbient = Bool -> Bool
not Bool
condInMelee Bool -> Bool -> Bool
&& Bool
uneasy Bool -> Bool -> Bool
&& Bool -> Bool
not Bool
actorShines
  Maybe TgtAndPath
mtgtMPath <- (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
aid (EnumMap ActorId TgtAndPath -> Maybe TgtAndPath)
-> (StateClient -> EnumMap ActorId TgtAndPath)
-> StateClient
-> Maybe TgtAndPath
forall b c a. (b -> c) -> (a -> b) -> a -> c
. StateClient -> EnumMap ActorId TgtAndPath
stargetD
  let condGoalIsLit :: Bool
condGoalIsLit = case Maybe TgtAndPath
mtgtMPath of
        Just TgtAndPath{tapPath :: TgtAndPath -> Maybe AndPath
tapPath=Just AndPath{Point
pathGoal :: AndPath -> Point
pathGoal :: Point
pathGoal}} -> Point -> Bool
isLit Point
pathGoal
        Maybe TgtAndPath
_ -> Bool
False
      -- Fleeing makes sense, because either actor can't melee,
      -- or at least won't flee without scoring a hit and return next turn,
      -- due to threat no longer seen (due to blindness or dark).
      fleeingMakesSense :: Bool
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)
      abInSkill :: Skill -> Bool
abInSkill Skill
sk = Skill -> Skills -> Int
getSk Skill
sk Skills
actorSk Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
0
      abInMaxSkill :: Skill -> Bool
abInMaxSkill Skill
sk = Skill -> Skills -> Int
getSk Skill
sk Skills
actorMaxSk Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
0
      runSkills :: [Skill]
runSkills = [Skill
SkMove, Skill
SkDisplace]  -- not @SkAlter@, to ground sleepers
      stratToFreq :: Int
                  -> m (Strategy RequestTimed)
                  -> m (Frequency RequestTimed)
      stratToFreq :: Int -> m (Strategy RequestTimed) -> m (Frequency RequestTimed)
stratToFreq Int
scale m (Strategy RequestTimed)
mstrat = do
        Strategy RequestTimed
st <- m (Strategy RequestTimed)
mstrat
        Frequency RequestTimed -> m (Frequency RequestTimed)
forall (m :: * -> *) a. Monad m => a -> m a
return (Frequency RequestTimed -> m (Frequency RequestTimed))
-> Frequency RequestTimed -> m (Frequency RequestTimed)
forall a b. (a -> b) -> a -> b
$! if Int
scale Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0
                  then Frequency RequestTimed
forall (m :: * -> *) a. MonadPlus m => m a
mzero
                  else Int -> Frequency RequestTimed -> Frequency RequestTimed
forall a. Show a => Int -> Frequency a -> Frequency a
scaleFreq Int
scale (Frequency RequestTimed -> Frequency RequestTimed)
-> Frequency RequestTimed -> Frequency RequestTimed
forall a b. (a -> b) -> a -> b
$ Strategy RequestTimed -> Frequency RequestTimed
forall a. Strategy a -> Frequency a
bestVariant Strategy RequestTimed
st
      -- Order matters within the list, because it's summed with .| after
      -- filtering. Also, the results of prefix, distant and suffix
      -- are summed with .| at the end.
      prefix, suffix:: [([Skill], m (Strategy RequestTimed), Bool)]
      prefix :: [([Skill], m (Strategy RequestTimed), Bool)]
prefix =
        [ ( [Skill
SkApply]
          , Skills -> ActorId -> ApplyItemGroup -> m (Strategy RequestTimed)
forall (m :: * -> *).
MonadClientRead m =>
Skills -> ActorId -> ApplyItemGroup -> m (Strategy RequestTimed)
applyItem Skills
actorSk ActorId
aid ApplyItemGroup
ApplyFirstAid
          , Bool -> Bool
not Bool
condAnyHarmfulFoeAdj Bool -> Bool -> Bool
&& Bool
condHpTooLow)
        , ( [Skill
SkAlter]
          , ActorId -> FleeViaStairsOrEscape -> m (Strategy RequestTimed)
forall (m :: * -> *).
MonadClientRead m =>
ActorId -> FleeViaStairsOrEscape -> m (Strategy RequestTimed)
trigger ActorId
aid FleeViaStairsOrEscape
ViaStairs
              -- explore next or flee via stairs, even if to wrong level;
              -- in the latter case, may return via different stairs later on
          , Bool
condAdjTriggerable Bool -> Bool -> Bool
&& Bool -> Bool
not Bool
condAimEnemyOrStash
            Bool -> Bool -> Bool
&& ((Bool
condNotCalmEnough Bool -> Bool -> Bool
|| Bool
condHpTooLow)  -- flee
                Bool -> Bool -> Bool
&& Bool
condMeleeBad Bool -> Bool -> Bool
&& Bool
condAnyHarmfulFoeAdj
                Bool -> Bool -> Bool
|| (Bool
lidExplored Bool -> Bool -> Bool
|| Bool
condEnoughGear)  -- explore
                   Bool -> Bool -> Bool
&& Bool -> Bool
not Bool
condDesirableFloorItem) )
        , ( [Skill
SkDisplace]
          , ActorId -> m (Strategy RequestTimed)
forall (m :: * -> *).
MonadClientRead m =>
ActorId -> m (Strategy RequestTimed)
displaceFoe ActorId
aid  -- only swap with an enemy to expose him
                             -- and only if a friend is blocked by us
          , Bool
condAnyFoeAdj Bool -> Bool -> Bool
&& Bool
condBlocksFriends)  -- later checks foe eligible
        , ( [Skill
SkMoveItem]
          , ActorId -> Bool -> m (Strategy RequestTimed)
forall (m :: * -> *).
MonadClientRead m =>
ActorId -> Bool -> m (Strategy RequestTimed)
pickup ActorId
aid Bool
True
          , Bool
condNoEqpWeapon  -- we assume organ weapons usually inferior
            Bool -> Bool -> Bool
&& Bool
condDesirableFloorItem Bool -> Bool -> Bool
&& Bool
condFloorWeapon Bool -> Bool -> Bool
&& Bool -> Bool
not Bool
condHpTooLow
            Bool -> Bool -> Bool
&& Skill -> Bool
abInMaxSkill Skill
SkMelee )
        , ( [Skill
SkAlter]
          , ActorId -> FleeViaStairsOrEscape -> m (Strategy RequestTimed)
forall (m :: * -> *).
MonadClientRead m =>
ActorId -> FleeViaStairsOrEscape -> m (Strategy RequestTimed)
trigger ActorId
aid FleeViaStairsOrEscape
ViaEscape
          , Bool
condAdjTriggerable Bool -> Bool -> Bool
&& Bool -> Bool
not Bool
condAimEnemyTargeted
            Bool -> Bool -> Bool
&& Bool -> Bool
not Bool
condDesirableFloorItem )  -- collect the last loot
        , ( [Skill]
runSkills
          , Skills
-> ActorId -> Bool -> [(Int, Point)] -> m (Strategy RequestTimed)
forall (m :: * -> *).
MonadClient m =>
Skills
-> ActorId -> Bool -> [(Int, Point)] -> m (Strategy RequestTimed)
flee Skills
actorSk ActorId
aid (Bool -> Bool
not Bool
actorShines) [(Int, Point)]
fleeL
          , -- Flee either from melee, if our melee is bad and enemy close,
            -- or from missiles, if we can hide in the dark in one step.
            -- Note that we don't know how far ranged threats are or if,
            -- in fact, they hit from all sides or are hidden. Hence we can't
            -- do much except hide in darkness or take off light (elsewhere).
            -- We tend to flee even when over stash (on lit terrain at least),
            -- but only if we can't fling at enemy (e.g., not visible).
            -- This is OK, since otherwise we'd be killed for free
            -- and the stash would be taken just a little later on.
            -- Note: a part of this condition appears in @actorVulnerable@.
            Bool -> Bool
not Bool
condFastThreatAdj
            Bool -> Bool -> Bool
&& Bool
fleeingMakesSense
            Bool -> Bool -> Bool
&& if | Bool
condAnyHarmfulFoeAdj ->
                    -- Here we don't check @condInMelee@ because regardless
                    -- of whether our team melees (including the fleeing ones),
                    -- endangered actors should flee from very close foes.
                    Bool -> Bool
not Bool
condCanMelee
                    Bool -> Bool -> Bool
|| Bool
condManyThreatsAdj Bool -> Bool -> Bool
&& Bool -> Bool
not Bool
condSupport1 Bool -> Bool -> Bool
&& Bool -> Bool
not Bool
condSolo
                  | case Faction -> Maybe (LevelId, Point)
gstash Faction
fact of
                      Maybe (LevelId, Point)
Nothing -> Bool
False
                      Just (LevelId
lid2, Point
pos) ->
                        LevelId
lid2 LevelId -> LevelId -> Bool
forall a. Eq a => a -> a -> Bool
== LevelId
lid Bool -> Bool -> Bool
&& Point -> Point -> Int
chessDist Point
pos (Actor -> Point
bpos Actor
body) Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
2
                        -> Bool
False
                  | Bool
condInMelee -> Bool
False
                      -- No fleeing when others melee and no critical threat
                      -- (otherwise no target nor action would be possible).
                  | Bool
heavilyDistressedThisTurn  -- and no adj melee
                    Bool -> Bool -> Bool
|| (Bool
heavilyDistressed Bool -> Bool -> Bool
&& Bool -> Bool
not (Int -> Bool
condThreat Int
2)) ->
                    Bool -> Bool
not Bool
condCanMelee Bool -> Bool -> Bool
|| Bool
canFleeIntoDark
                      -- Almost surely hit by projectile. So, if can melee,
                      -- don't escape except into the dark.
                      -- Note that even when in dark now, the projectile hit
                      -- might have been enabled by dynamic light
                      -- or light from lying items, so fleeing still needed.
                      -- If heroes stay in the light when under fire,
                      -- they are pummeled by fast ranged foes and can neither
                      -- flee (too slow) nor force them to flee nor kill them.
                      -- Also AI monsters need predictable behaviour to avoid
                      -- having to chase them forever. Ranged aggravating helps
                      -- and melee-less ranged always fleeing when hit helps
                      -- and makes them evading ambushers, perfect for swarms.
                  | Int -> Bool
condThreat Int
2  -- melee enemies near
                    Bool -> Bool -> Bool
|| Int -> Bool
condThreat Int
5 Bool -> Bool -> Bool
&& Bool
heavilyDistressed ->
                         -- enemies not near but maintain fleeing hysteresis,
                         -- but not if due to lack of support, which changes,
                         -- hence @heavilyDistressed@ and not @recentlyFled@
                    Bool -> Bool
not Bool
condCanMelee  -- can't melee, flee
                    Bool -> Bool -> Bool
|| -- No support, not alone, either not aggressive
                       -- or can safely project from afar instead. Flee.
                       Bool -> Bool
not Bool
condSupport3
                       Bool -> Bool -> Bool
&& Bool -> Bool
not Bool
condSolo
                       -- Don't flee if can spend time productively, killing
                       -- an enemy that blocks projecting or walking.
                       Bool -> Bool -> Bool
&& Bool -> Bool
not Bool
condAnyFoeAdj
                       -- Extra random aggressiveness if can't project
                       -- and didn't flee recently and so undecided.
                       -- This is hacky; the randomness is outside @Strategy@.
                       Bool -> Bool -> Bool
&& (Bool
condCanProject
                           Bool -> Bool -> Bool
|| Bool
recentlyFled  -- still no support, keep fleeing
                           Bool -> Bool -> Bool
|| Skill -> Skills -> Int
Ability.getSk Skill
Ability.SkAggression Skills
actorMaxSk
                              Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
randomAggressionThreshold)
                  | Bool
otherwise -> Bool
False )  -- melee threats too far
        , ( [Skill]
runSkills  -- no blockers if can't move right now
          , Skills -> ActorId -> m (Strategy RequestTimed)
forall (m :: * -> *).
MonadClient m =>
Skills -> ActorId -> m (Strategy RequestTimed)
meleeBlocker Skills
actorSk ActorId
aid  -- only melee blocker
          , Skill -> Bool
abInSkill Skill
SkMelee
            Bool -> Bool -> Bool
&& (Bool
condAnyFoeAdj  -- if foes, don't displace, otherwise friends:
                Bool -> Bool -> Bool
|| Bool -> Bool
not (Skill -> Bool
abInSkill Skill
SkDisplace)  -- displace friends, if can
                   Bool -> Bool -> Bool
&& Bool
condAimEnemyOrStash) )  -- excited
                        -- So that animals block each other until hero comes
                        -- and then the stronger makes a show for him
                        -- and kills the weaker.
        , ( [Skill
SkAlter]
          , ActorId -> FleeViaStairsOrEscape -> m (Strategy RequestTimed)
forall (m :: * -> *).
MonadClientRead m =>
ActorId -> FleeViaStairsOrEscape -> m (Strategy RequestTimed)
trigger ActorId
aid FleeViaStairsOrEscape
ViaNothing
          , Bool -> Bool
not Bool
condInMelee  -- don't incur overhead
            Bool -> Bool -> Bool
&& Bool
condAdjTriggerable
            Bool -> Bool -> Bool
&& Bool -> Bool
not Bool
condAimEnemyTargeted )  -- targeting stash is OK, to unblock
                                           -- dungeons if party has only one key
        , ( [Skill
SkDisplace]  -- prevents some looping movement
          , ActorId -> Bool -> m (Strategy RequestTimed)
forall (m :: * -> *).
MonadClientRead m =>
ActorId -> Bool -> m (Strategy RequestTimed)
displaceBlocker ActorId
aid Bool
retry  -- fires up only when path blocked
          , Bool
retry Bool -> Bool -> Bool
|| Bool -> Bool
not Bool
condDesirableFloorItem )
        , ( [Skill
SkMelee]
          , ActorId -> m (Strategy RequestTimed)
forall (m :: * -> *).
MonadClient m =>
ActorId -> m (Strategy RequestTimed)
meleeAny ActorId
aid
          , Bool
condAnyFoeAdj )  -- won't flee nor displace, so let it melee
        , ( [Skill]
runSkills
          , Skills
-> ActorId -> Bool -> [(Int, Point)] -> m (Strategy RequestTimed)
forall (m :: * -> *).
MonadClient m =>
Skills
-> ActorId -> Bool -> [(Int, Point)] -> m (Strategy RequestTimed)
flee Skills
actorSk
                 ActorId
aid  -- rattlesnakes and hornets flee and return when charging
                 ((Bool
heavilyDistressedThisTurn Bool -> Bool -> Bool
&& Bool -> Bool
not Bool
condAnyHarmfulFoeAdj
                   Bool -> Bool -> Bool
|| (Bool
heavilyDistressed Bool -> Bool -> Bool
&& Bool -> Bool
not (Int -> Bool
condThreat Int
2)))
                     -- prefer bad but dark spots if under fire
                  Bool -> Bool -> Bool
&& Bool -> Bool
not Bool
actorShines)
                 [(Int, Point)]
panicFleeL  -- ultimate panic mode; open tiles, if needed
          , Bool
condAnyHarmfulFoeAdj )
        ]
      -- Order doesn't matter, scaling does.
      -- These are flattened in @stratToFreq@ (taking only the best variant)
      -- and then summed, so if any of these can fire, it will.
      -- If none can, @suffix@ is tried.
      -- Only the best variant of @chase@ is taken, but it's almost always
      -- good, and if not, the @chase@ in @suffix@ may fix that.
      -- The scaling values for @stratToFreq@ need to be so low-resolution
      -- or we get 32bit @Freqency@ overflows, which would bite us in JS.
      --
      -- Note that all monadic actions here are performed when the strategy
      -- is being chosen so, e.g., none of them can be @flee@ or the actor
      -- would be marked in state as fleeing even when the strategy is
      -- not chosen.
      distant :: [([Skill], m (Frequency RequestTimed), Bool)]
      distant :: [([Skill], m (Frequency RequestTimed), Bool)]
distant =
        [ ( [Skill
SkMoveItem]
          , Int -> m (Strategy RequestTimed) -> m (Frequency RequestTimed)
stratToFreq (if Bool
condInMelee then Int
20 else Int
20000)
            (m (Strategy RequestTimed) -> m (Frequency RequestTimed))
-> m (Strategy RequestTimed) -> m (Frequency RequestTimed)
forall a b. (a -> b) -> a -> b
$ ActorId -> m (Strategy RequestTimed)
forall (m :: * -> *).
MonadClientRead m =>
ActorId -> m (Strategy RequestTimed)
yieldUnneeded ActorId
aid  -- 20000 to unequip ASAP, unless is thrown
          , Bool
True )
        , ( [Skill
SkMoveItem]
          , Int -> m (Strategy RequestTimed) -> m (Frequency RequestTimed)
stratToFreq Int
10
            (m (Strategy RequestTimed) -> m (Frequency RequestTimed))
-> m (Strategy RequestTimed) -> m (Frequency RequestTimed)
forall a b. (a -> b) -> a -> b
$ ActorId -> m (Strategy RequestTimed)
forall (m :: * -> *).
MonadClientRead m =>
ActorId -> m (Strategy RequestTimed)
equipItems ActorId
aid  -- doesn't take long, very useful if safe
          , Bool -> Bool
not (Bool
condInMelee
                 Bool -> Bool -> Bool
|| Bool
condDesirableFloorItem
                 Bool -> Bool -> Bool
|| Bool
uneasy) )
        , ( [Skill
SkProject]
          , Int -> m (Strategy RequestTimed) -> m (Frequency RequestTimed)
stratToFreq (if Bool
condTgtNonmovingEnemy then Int
100 else Int
30)
              -- not too common, to leave missiles for pre-melee dance
            (m (Strategy RequestTimed) -> m (Frequency RequestTimed))
-> m (Strategy RequestTimed) -> m (Frequency RequestTimed)
forall a b. (a -> b) -> a -> b
$ Skills -> ActorId -> m (Strategy RequestTimed)
forall (m :: * -> *).
MonadClientRead m =>
Skills -> ActorId -> m (Strategy RequestTimed)
projectItem Skills
actorSk ActorId
aid
          , Bool
condAimEnemyTargeted Bool -> Bool -> Bool
&& Bool -> Bool
not Bool
condInMelee Bool -> Bool -> Bool
&& Bool
condCanProject )
        , ( [Skill
SkApply]  -- common, because animals have that
          , Int -> m (Strategy RequestTimed) -> m (Frequency RequestTimed)
stratToFreq Int
10
            (m (Strategy RequestTimed) -> m (Frequency RequestTimed))
-> m (Strategy RequestTimed) -> m (Frequency RequestTimed)
forall a b. (a -> b) -> a -> b
$ Skills -> ActorId -> ApplyItemGroup -> m (Strategy RequestTimed)
forall (m :: * -> *).
MonadClientRead m =>
Skills -> ActorId -> ApplyItemGroup -> m (Strategy RequestTimed)
applyItem Skills
actorSk ActorId
aid ApplyItemGroup
ApplyAll  -- use any potion or scroll
          , Bool
condAimEnemyTargeted Bool -> Bool -> Bool
|| Int -> Bool
condThreat Int
9 )  -- can buff against enemies
        , ( [Skill]
runSkills
          , Int -> m (Strategy RequestTimed) -> m (Frequency RequestTimed)
stratToFreq (if | Bool
condInMelee ->
                              Int
4000  -- friends pummeled by target, go to help
                            | Bool -> Bool
not Bool
condAimEnemyOrStash ->
                              Int
20  -- if enemy only remembered investigate anyway
                            | Bool -> Bool
not (Point -> Bool
isLit (Actor -> Point
bpos Actor
body))  -- would need to leave
                              Bool -> Bool -> Bool
&& Bool -> Bool
not Bool
actorShines       -- dark, most probably
                              Bool -> Bool -> Bool
&& Bool
condGoalIsLit -> Int
1
                            | Bool
otherwise ->
                              Int
200)
            (m (Strategy RequestTimed) -> m (Frequency RequestTimed))
-> m (Strategy RequestTimed) -> m (Frequency RequestTimed)
forall a b. (a -> b) -> a -> b
$ Skills -> ActorId -> Bool -> Bool -> m (Strategy RequestTimed)
forall (m :: * -> *).
MonadClientRead m =>
Skills -> ActorId -> Bool -> Bool -> m (Strategy RequestTimed)
chase Skills
actorSk ActorId
aid Bool
avoidAmbient Bool
retry
          , Bool
condCanMelee
            Bool -> Bool -> Bool
&& (LevelId, Point) -> Maybe (LevelId, Point)
forall a. a -> Maybe a
Just (LevelId
lid, Actor -> Point
bpos Actor
body) Maybe (LevelId, Point) -> Maybe (LevelId, Point) -> Bool
forall a. Eq a => a -> a -> Bool
/= Faction -> Maybe (LevelId, Point)
gstash Faction
fact
            Bool -> Bool -> Bool
&& (if Bool
condInMelee then Bool
condAimEnemyOrStash
                else (Bool
condAimEnemyOrRemembered
                      Bool -> Bool -> Bool
|| Bool
condAimNonEnemyPresent)
                     Bool -> Bool -> Bool
&& (Bool -> Bool
not (Int -> Bool
condThreat Int
2)
                         Bool -> Bool -> Bool
|| Bool
heavilyDistressed  -- if under fire, do something!
                         Bool -> Bool -> Bool
|| Speed
speed Speed -> Speed -> Bool
forall a. Ord a => a -> a -> Bool
>= Speed -> Speed -> Speed
speedAdd Speed
speedWalk Speed
speedWalk
                              -- low risk of getting hit first
                         Bool -> Bool -> Bool
|| Bool -> Bool
not Bool
condMeleeBad)
                       -- this results in animals in corridor never attacking
                       -- (unless distressed by, e.g., being hit by missiles),
                       -- because they can't swarm opponent, which is logical,
                       -- and in rooms they do attack, so not too boring;
                       -- two aliens attack always, because more aggressive
                     Bool -> Bool -> Bool
&& Bool -> Bool
not Bool
condDesirableFloorItem) )
        ]
      suffix :: [([Skill], m (Strategy RequestTimed), Bool)]
suffix =
        [ ( [Skill
SkMoveItem]
          , ActorId -> Bool -> m (Strategy RequestTimed)
forall (m :: * -> *).
MonadClientRead m =>
ActorId -> Bool -> m (Strategy RequestTimed)
pickup ActorId
aid Bool
False  -- e.g., to give to other party members
          , Bool -> Bool
not Bool
condInMelee Bool -> Bool -> Bool
&& Bool
condDesirableFloorItem Bool -> Bool -> Bool
&& Bool -> Bool
not Bool
dozes )
        , ( [Skill
SkMoveItem]
          , ActorId -> m (Strategy RequestTimed)
forall (m :: * -> *).
MonadClientRead m =>
ActorId -> m (Strategy RequestTimed)
unEquipItems ActorId
aid  -- late, because these items not bad
          , Bool -> Bool
not Bool
condInMelee Bool -> Bool -> Bool
&& Bool -> Bool
not Bool
dozes )
        , ( [Skill
SkWait]
          , m (Strategy RequestTimed)
forall (m :: * -> *).
MonadClientRead m =>
m (Strategy RequestTimed)
waitBlockNow  -- try to fall asleep, rarely
          , Actor -> Watchfulness
bwatch Actor
body Watchfulness -> [Watchfulness] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`notElem` [Watchfulness
WSleep, Watchfulness
WWake]
            Bool -> Bool -> Bool
&& Bool
mayFallAsleep
            Bool -> Bool -> Bool
&& Skills -> Bool
prefersSleep Skills
actorMaxSk
            Bool -> Bool -> Bool
&& Bool -> Bool
not Bool
condAimCrucial)
        , ( [Skill]
runSkills
          , Skills -> ActorId -> Bool -> Bool -> m (Strategy RequestTimed)
forall (m :: * -> *).
MonadClientRead m =>
Skills -> ActorId -> Bool -> Bool -> m (Strategy RequestTimed)
chase Skills
actorSk ActorId
aid Bool
avoidAmbient Bool
retry
          , Bool -> Bool
not Bool
dozes
            Bool -> Bool -> Bool
&& if Bool
condInMelee
               then Bool
condCanMelee Bool -> Bool -> Bool
&& Bool
condAimEnemyOrStash
               else (Bool -> Bool
not (Int -> Bool
condThreat Int
2) Bool -> Bool -> Bool
|| Bool -> Bool
not Bool
condMeleeBad)
                    Bool -> Bool -> Bool
&& ((LevelId, Point) -> Maybe (LevelId, Point)
forall a. a -> Maybe a
Just (LevelId
lid, Actor -> Point
bpos Actor
body) Maybe (LevelId, Point) -> Maybe (LevelId, Point) -> Bool
forall a. Eq a => a -> a -> Bool
/= Faction -> Maybe (LevelId, Point)
gstash Faction
fact
                        Bool -> Bool -> Bool
|| Bool
heavilyDistressed  -- guard strictly, until harmed
                        Bool -> Bool -> Bool
|| [(ActorId, Actor)] -> Int
forall a. [a] -> Int
length [(ActorId, Actor)]
oursExploring Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
1
                        Bool -> Bool -> Bool
|| Bool
condOurAdj  -- or if teammates adjacent
                        Bool -> Bool -> Bool
|| Actor -> Int64
bcalm Actor
body Int64 -> Int64 -> Bool
forall a. Ord a => a -> a -> Bool
< Int64
10) )  -- break loop, avoid domination
        ]
      fallback :: [([Skill], m (Strategy RequestTimed), Bool)]
fallback =  -- Wait until friends sidestep; ensures strategy never empty.
                  -- Also, this is what non-leader heroes do, unless they melee.
        [ ( [Skill
SkWait]
          , case Actor -> Watchfulness
bwatch Actor
body of
              Watchfulness
WSleep -> m (Strategy RequestTimed)
forall (m :: * -> *).
MonadClientRead m =>
m (Strategy RequestTimed)
yellNow  -- we know actor doesn't want to sleep,
                                 -- so celebrate wake up with a bang
              Watchfulness
_ -> m (Strategy RequestTimed)
forall (m :: * -> *).
MonadClientRead m =>
m (Strategy RequestTimed)
waitBlockNow  -- block, etc.
          , Bool
True )
        , ( [Skill]
runSkills  -- if can't block, at least change something
          , Skills -> ActorId -> Bool -> Bool -> m (Strategy RequestTimed)
forall (m :: * -> *).
MonadClientRead m =>
Skills -> ActorId -> Bool -> Bool -> m (Strategy RequestTimed)
chase Skills
actorSk ActorId
aid Bool
avoidAmbient Bool
True
          , Bool -> Bool
not Bool
condInMelee Bool -> Bool -> Bool
|| Bool
condCanMelee Bool -> Bool -> Bool
&& Bool
condAimEnemyTargeted )
        , ( [Skill
SkDisplace]  -- if can't brace, at least change something
          , ActorId -> Bool -> m (Strategy RequestTimed)
forall (m :: * -> *).
MonadClientRead m =>
ActorId -> Bool -> m (Strategy RequestTimed)
displaceBlocker ActorId
aid Bool
True
          , Bool
True )
        , ( []
          , m (Strategy RequestTimed)
forall (m :: * -> *).
MonadClientRead m =>
m (Strategy RequestTimed)
yellNow  -- desperate fallback
          , Bool
True )
       ]
  -- Check current, not maximal skills, since this can be a leader as well
  -- as non-leader action.
  let checkAction :: ([Skill], m a, Bool) -> Bool
      checkAction :: ([Skill], m a, Bool) -> Bool
checkAction ([Skill]
abts, m a
_, Bool
cond) = ([Skill] -> Bool
forall a. [a] -> Bool
null [Skill]
abts Bool -> Bool -> Bool
|| (Skill -> Bool) -> [Skill] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any Skill -> Bool
abInSkill [Skill]
abts) Bool -> Bool -> Bool
&& Bool
cond
      sumS :: [([Skill], m a, Bool)] -> [m a]
      sumS :: [([Skill], m a, Bool)] -> [m a]
sumS [([Skill], m a, Bool)]
abAction =
        let as :: [([Skill], m a, Bool)]
as = (([Skill], m a, Bool) -> Bool)
-> [([Skill], m a, Bool)] -> [([Skill], m a, Bool)]
forall a. (a -> Bool) -> [a] -> [a]
filter ([Skill], m a, Bool) -> Bool
forall a. ([Skill], m a, Bool) -> Bool
checkAction [([Skill], m a, Bool)]
abAction
        in (([Skill], m a, Bool) -> m a) -> [([Skill], m a, Bool)] -> [m a]
forall a b. (a -> b) -> [a] -> [b]
map (\([Skill]
_, m a
m, Bool
_) -> m a
m) [([Skill], m a, Bool)]
as
      sumF :: [([Skill], m (Frequency RequestTimed), Bool)]
           -> m (Frequency RequestTimed)
      sumF :: [([Skill], m (Frequency RequestTimed), Bool)]
-> m (Frequency RequestTimed)
sumF [([Skill], m (Frequency RequestTimed), Bool)]
abFreq = do
        let as :: [([Skill], m (Frequency RequestTimed), Bool)]
as = (([Skill], m (Frequency RequestTimed), Bool) -> Bool)
-> [([Skill], m (Frequency RequestTimed), Bool)]
-> [([Skill], m (Frequency RequestTimed), Bool)]
forall a. (a -> Bool) -> [a] -> [a]
filter ([Skill], m (Frequency RequestTimed), Bool) -> Bool
forall a. ([Skill], m a, Bool) -> Bool
checkAction [([Skill], m (Frequency RequestTimed), Bool)]
abFreq
        -- This is costly: the monadic side-effects are evaluated.
        -- If we roll an unevaluated one until we find one that is permitted,
        -- keeping track of those aready checked might outweigh the savings.
        -- Even worse, without evaluating per-item frequencies,
        -- applying an amazing item may be disregarded in favour of throwing
        -- a mediocre one.
        [Frequency RequestTimed]
strats <- (([Skill], m (Frequency RequestTimed), Bool)
 -> m (Frequency RequestTimed))
-> [([Skill], m (Frequency RequestTimed), Bool)]
-> m [Frequency RequestTimed]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (\([Skill]
_, m (Frequency RequestTimed)
m, Bool
_) -> m (Frequency RequestTimed)
m) [([Skill], m (Frequency RequestTimed), Bool)]
as
        Frequency RequestTimed -> m (Frequency RequestTimed)
forall (m :: * -> *) a. Monad m => a -> m a
return (Frequency RequestTimed -> m (Frequency RequestTimed))
-> Frequency RequestTimed -> m (Frequency RequestTimed)
forall a b. (a -> b) -> a -> b
$! [Frequency RequestTimed] -> Frequency RequestTimed
forall (t :: * -> *) (m :: * -> *) a.
(Foldable t, MonadPlus m) =>
t (m a) -> m a
msum [Frequency RequestTimed]
strats
      combineWeighted :: [([Skill], m (Frequency RequestTimed), Bool)]
-> m (Strategy RequestTimed)
combineWeighted [([Skill], m (Frequency RequestTimed), Bool)]
as = Frequency RequestTimed -> Strategy RequestTimed
forall a. Frequency a -> Strategy a
liftFrequency (Frequency RequestTimed -> Strategy RequestTimed)
-> m (Frequency RequestTimed) -> m (Strategy RequestTimed)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [([Skill], m (Frequency RequestTimed), Bool)]
-> m (Frequency RequestTimed)
sumF [([Skill], m (Frequency RequestTimed), Bool)]
as
      sumPrefix :: [m (Strategy RequestTimed)]
sumPrefix = [([Skill], m (Strategy RequestTimed), Bool)]
-> [m (Strategy RequestTimed)]
forall a. [([Skill], m a, Bool)] -> [m a]
sumS [([Skill], m (Strategy RequestTimed), Bool)]
prefix
      comDistant :: m (Strategy RequestTimed)
comDistant = [([Skill], m (Frequency RequestTimed), Bool)]
-> m (Strategy RequestTimed)
combineWeighted [([Skill], m (Frequency RequestTimed), Bool)]
distant
      sumSuffix :: [m (Strategy RequestTimed)]
sumSuffix = [([Skill], m (Strategy RequestTimed), Bool)]
-> [m (Strategy RequestTimed)]
forall a. [([Skill], m a, Bool)] -> [m a]
sumS [([Skill], m (Strategy RequestTimed), Bool)]
suffix
      sumFallback :: [m (Strategy RequestTimed)]
sumFallback = [([Skill], m (Strategy RequestTimed), Bool)]
-> [m (Strategy RequestTimed)]
forall a. [([Skill], m a, Bool)] -> [m a]
sumS [([Skill], m (Strategy RequestTimed), Bool)]
fallback
      -- TODO: should be: sumPrefix .| comDistant .| sumSuffix .| sumFallback
      -- but then all side-effects have to be computed beforehand,
      -- breaking the state, e.g., marking actor as fleeing, always.
      sums :: [m (Strategy RequestTimed)]
sums = [m (Strategy RequestTimed)]
sumPrefix [m (Strategy RequestTimed)]
-> [m (Strategy RequestTimed)] -> [m (Strategy RequestTimed)]
forall a. [a] -> [a] -> [a]
++ [m (Strategy RequestTimed)
comDistant] [m (Strategy RequestTimed)]
-> [m (Strategy RequestTimed)] -> [m (Strategy RequestTimed)]
forall a. [a] -> [a] -> [a]
++ [m (Strategy RequestTimed)]
sumSuffix [m (Strategy RequestTimed)]
-> [m (Strategy RequestTimed)] -> [m (Strategy RequestTimed)]
forall a. [a] -> [a] -> [a]
++ [m (Strategy RequestTimed)]
sumFallback
      tryStrategies :: [m (Strategy RequestTimed)] -> m (Strategy RequestTimed)
      tryStrategies :: [m (Strategy RequestTimed)] -> m (Strategy RequestTimed)
tryStrategies [] = Strategy RequestTimed -> m (Strategy RequestTimed)
forall (m :: * -> *) a. Monad m => a -> m a
return Strategy RequestTimed
forall (m :: * -> *) a. MonadPlus m => m a
mzero
      tryStrategies (m (Strategy RequestTimed)
m : [m (Strategy RequestTimed)]
rest) = do
        Strategy RequestTimed
str <- m (Strategy RequestTimed)
m
        if Strategy RequestTimed -> Bool
forall a. Strategy a -> Bool
nullStrategy Strategy RequestTimed
str
        then [m (Strategy RequestTimed)] -> m (Strategy RequestTimed)
tryStrategies [m (Strategy RequestTimed)]
rest
        else Strategy RequestTimed -> m (Strategy RequestTimed)
forall (m :: * -> *) a. Monad m => a -> m a
return Strategy RequestTimed
str  -- don't perform the remaining monadic actions
  if Actor -> Watchfulness
bwatch Actor
body Watchfulness -> Watchfulness -> Bool
forall a. Eq a => a -> a -> Bool
== Watchfulness
WSleep
     Bool -> Bool -> Bool
&& Skill -> Bool
abInSkill Skill
SkWait
     Bool -> Bool -> Bool
&& Bool
mayContinueSleep
       -- no check of @canSleep@, because sight lowered by sleeping
  then Strategy RequestTimed -> m (Strategy RequestTimed)
forall (m :: * -> *) a. Monad m => a -> m a
return (Strategy RequestTimed -> m (Strategy RequestTimed))
-> Strategy RequestTimed -> m (Strategy RequestTimed)
forall a b. (a -> b) -> a -> b
$! Text -> RequestTimed -> Strategy RequestTimed
forall a. Text -> a -> Strategy a
returN Text
"sleep" RequestTimed
ReqWait
  else [m (Strategy RequestTimed)] -> m (Strategy RequestTimed)
tryStrategies [m (Strategy RequestTimed)]
sums

waitBlockNow :: MonadClientRead m => m (Strategy RequestTimed)
waitBlockNow :: m (Strategy RequestTimed)
waitBlockNow = Strategy RequestTimed -> m (Strategy RequestTimed)
forall (m :: * -> *) a. Monad m => a -> m a
return (Strategy RequestTimed -> m (Strategy RequestTimed))
-> Strategy RequestTimed -> m (Strategy RequestTimed)
forall a b. (a -> b) -> a -> b
$! Text -> RequestTimed -> Strategy RequestTimed
forall a. Text -> a -> Strategy a
returN Text
"wait" RequestTimed
ReqWait

yellNow :: MonadClientRead m => m (Strategy RequestTimed)
yellNow :: m (Strategy RequestTimed)
yellNow = Strategy RequestTimed -> m (Strategy RequestTimed)
forall (m :: * -> *) a. Monad m => a -> m a
return (Strategy RequestTimed -> m (Strategy RequestTimed))
-> Strategy RequestTimed -> m (Strategy RequestTimed)
forall a b. (a -> b) -> a -> b
$! Text -> RequestTimed -> Strategy RequestTimed
forall a. Text -> a -> Strategy a
returN Text
"yell" RequestTimed
ReqYell

pickup :: MonadClientRead m => ActorId -> Bool -> m (Strategy RequestTimed)
pickup :: ActorId -> Bool -> m (Strategy RequestTimed)
pickup ActorId
aid Bool
onlyWeapon = do
  [(Benefit, CStore, ItemId, ItemFull, ItemQuant)]
benItemL <- ActorId -> m [(Benefit, CStore, ItemId, ItemFull, ItemQuant)]
forall (m :: * -> *).
MonadClientRead m =>
ActorId -> m [(Benefit, CStore, ItemId, ItemFull, ItemQuant)]
benGroundItems ActorId
aid
  Actor
b <- (State -> Actor) -> m Actor
forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
getsState ((State -> Actor) -> m Actor) -> (State -> Actor) -> m Actor
forall a b. (a -> b) -> a -> b
$ ActorId -> State -> Actor
getActorBody ActorId
aid
  -- This calmE is outdated when one of the items increases max Calm
  -- (e.g., in pickup, which handles many items at once), but this is OK,
  -- the server accepts item movement based on calm at the start, not end
  -- or in the middle.
  -- The calmE is inaccurate also if an item not IDed, but that's intended
  -- and the server will ignore and warn (and content may avoid that,
  -- e.g., making all rings identified)
  Skills
actorMaxSk <- (State -> Skills) -> m Skills
forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
getsState ((State -> Skills) -> m Skills) -> (State -> Skills) -> m Skills
forall a b. (a -> b) -> a -> b
$ ActorId -> State -> Skills
getActorMaxSkills ActorId
aid
  let calmE :: Bool
calmE = Actor -> Skills -> Bool
calmEnough Actor
b Skills
actorMaxSk
      isWeapon :: (a, b, c, ItemFull, e) -> Bool
isWeapon (a
_, b
_, c
_, ItemFull
itemFull, e
_) =
        Flag -> AspectRecord -> Bool
IA.checkFlag Flag
Ability.Meleeable (AspectRecord -> Bool) -> AspectRecord -> Bool
forall a b. (a -> b) -> a -> b
$ ItemFull -> AspectRecord
aspectRecordFull ItemFull
itemFull
      filterWeapon :: [(Benefit, CStore, ItemId, ItemFull, ItemQuant)]
-> [(Benefit, CStore, ItemId, ItemFull, ItemQuant)]
filterWeapon | Bool
onlyWeapon = ((Benefit, CStore, ItemId, ItemFull, ItemQuant) -> Bool)
-> [(Benefit, CStore, ItemId, ItemFull, ItemQuant)]
-> [(Benefit, CStore, ItemId, ItemFull, ItemQuant)]
forall a. (a -> Bool) -> [a] -> [a]
filter (Benefit, CStore, ItemId, ItemFull, ItemQuant) -> Bool
forall a b c e. (a, b, c, ItemFull, e) -> Bool
isWeapon
                   | Bool
otherwise = [(Benefit, CStore, ItemId, ItemFull, ItemQuant)]
-> [(Benefit, CStore, ItemId, ItemFull, ItemQuant)]
forall a. a -> a
id
      prepareOne :: (Int, [(ItemId, Int, CStore, CStore)])
-> (Benefit, CStore, ItemId, ItemFull, ItemQuant)
-> (Int, [(ItemId, Int, CStore, CStore)])
prepareOne (Int
oldN, [(ItemId, Int, CStore, CStore)]
l4)
                 (Benefit{Bool
benInEqp :: Benefit -> Bool
benInEqp :: Bool
benInEqp}, CStore
_, ItemId
iid, ItemFull
_, (Int
itemK, ItemTimers
_)) =
        let prep :: Int -> CStore -> (Int, [(ItemId, Int, CStore, CStore)])
prep Int
newN CStore
toCStore = (Int
newN, (ItemId
iid, Int
itemK, CStore
CGround, CStore
toCStore) (ItemId, Int, CStore, CStore)
-> [(ItemId, Int, CStore, CStore)]
-> [(ItemId, Int, CStore, CStore)]
forall a. a -> [a] -> [a]
: [(ItemId, Int, CStore, CStore)]
l4)
            n :: Int
n = Int
oldN Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
itemK
        in if | Bool
benInEqp Bool -> Bool -> Bool
&& Bool
calmE Bool -> Bool -> Bool
&& Bool -> Bool
not (Actor -> Int -> Bool
eqpOverfull Actor
b Int
n) -> Int -> CStore -> (Int, [(ItemId, Int, CStore, CStore)])
prep Int
n CStore
CEqp
              | Bool
onlyWeapon -> (Int
oldN, [(ItemId, Int, CStore, CStore)]
l4)
              | Bool
otherwise -> Int -> CStore -> (Int, [(ItemId, Int, CStore, CStore)])
prep Int
n CStore
CStash
      (Int
_, [(ItemId, Int, CStore, CStore)]
prepared) = ((Int, [(ItemId, Int, CStore, CStore)])
 -> (Benefit, CStore, ItemId, ItemFull, ItemQuant)
 -> (Int, [(ItemId, Int, CStore, CStore)]))
-> (Int, [(ItemId, Int, CStore, CStore)])
-> [(Benefit, CStore, ItemId, ItemFull, ItemQuant)]
-> (Int, [(ItemId, Int, CStore, CStore)])
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' (Int, [(ItemId, Int, CStore, CStore)])
-> (Benefit, CStore, ItemId, ItemFull, ItemQuant)
-> (Int, [(ItemId, Int, CStore, CStore)])
prepareOne (Int
0, []) ([(Benefit, CStore, ItemId, ItemFull, ItemQuant)]
 -> (Int, [(ItemId, Int, CStore, CStore)]))
-> [(Benefit, CStore, ItemId, ItemFull, ItemQuant)]
-> (Int, [(ItemId, Int, CStore, CStore)])
forall a b. (a -> b) -> a -> b
$ [(Benefit, CStore, ItemId, ItemFull, ItemQuant)]
-> [(Benefit, CStore, ItemId, ItemFull, ItemQuant)]
filterWeapon [(Benefit, CStore, ItemId, ItemFull, ItemQuant)]
benItemL
  Strategy RequestTimed -> m (Strategy RequestTimed)
forall (m :: * -> *) a. Monad m => a -> m a
return (Strategy RequestTimed -> m (Strategy RequestTimed))
-> Strategy RequestTimed -> m (Strategy RequestTimed)
forall a b. (a -> b) -> a -> b
$! if [(ItemId, Int, CStore, CStore)] -> Bool
forall a. [a] -> Bool
null [(ItemId, Int, CStore, CStore)]
prepared then Strategy RequestTimed
forall a. Strategy a
reject
            else Text -> RequestTimed -> Strategy RequestTimed
forall a. Text -> a -> Strategy a
returN Text
"pickup" (RequestTimed -> Strategy RequestTimed)
-> RequestTimed -> Strategy RequestTimed
forall a b. (a -> b) -> a -> b
$ [(ItemId, Int, CStore, CStore)] -> RequestTimed
ReqMoveItems [(ItemId, Int, CStore, CStore)]
prepared

-- This only concerns items that can be equipped, that is with a slot
-- and with @benInEqp@ (which implies @goesIntoEqp@).
-- Such items are moved between any stores, as needed. In this case,
-- from stash to eqp.
equipItems :: MonadClientRead m => ActorId -> m (Strategy RequestTimed)
equipItems :: ActorId -> m (Strategy RequestTimed)
equipItems ActorId
aid = do
  Actor
body <- (State -> Actor) -> m Actor
forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
getsState ((State -> Actor) -> m Actor) -> (State -> Actor) -> m Actor
forall a b. (a -> b) -> a -> b
$ ActorId -> State -> Actor
getActorBody ActorId
aid
  Skills
actorMaxSk <- (State -> Skills) -> m Skills
forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
getsState ((State -> Skills) -> m Skills) -> (State -> Skills) -> m Skills
forall a b. (a -> b) -> a -> b
$ ActorId -> State -> Skills
getActorMaxSkills ActorId
aid
  let calmE :: Bool
calmE = Actor -> Skills -> Bool
calmEnough Actor
body Skills
actorMaxSk
  Faction
fact <- (State -> Faction) -> m Faction
forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
getsState ((State -> Faction) -> m Faction)
-> (State -> Faction) -> m Faction
forall a b. (a -> b) -> a -> b
$ (EnumMap FactionId Faction -> FactionId -> Faction
forall k a. Enum k => EnumMap k a -> k -> a
EM.! Actor -> FactionId
bfid Actor
body) (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
  [(ItemId, ItemFullKit)]
eqpAssocs <- (State -> [(ItemId, ItemFullKit)]) -> m [(ItemId, ItemFullKit)]
forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
getsState ((State -> [(ItemId, ItemFullKit)]) -> m [(ItemId, ItemFullKit)])
-> (State -> [(ItemId, ItemFullKit)]) -> m [(ItemId, ItemFullKit)]
forall a b. (a -> b) -> a -> b
$ ActorId -> [CStore] -> State -> [(ItemId, ItemFullKit)]
kitAssocs ActorId
aid [CStore
CEqp]
  [(ItemId, ItemFullKit)]
stashAssocs <- (State -> [(ItemId, ItemFullKit)]) -> m [(ItemId, ItemFullKit)]
forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
getsState ((State -> [(ItemId, ItemFullKit)]) -> m [(ItemId, ItemFullKit)])
-> (State -> [(ItemId, ItemFullKit)]) -> m [(ItemId, ItemFullKit)]
forall a b. (a -> b) -> a -> b
$ ActorId -> [CStore] -> State -> [(ItemId, ItemFullKit)]
kitAssocs ActorId
aid [CStore
CStash]
  Bool
condShineWouldBetray <- ActorId -> m Bool
forall (m :: * -> *). MonadStateRead m => ActorId -> m Bool
condShineWouldBetrayM ActorId
aid
  Bool
condAimEnemyOrRemembered <- ActorId -> m Bool
forall (m :: * -> *). MonadClientRead m => ActorId -> m Bool
condAimEnemyOrRememberedM ActorId
aid
  DiscoveryBenefit
discoBenefit <- (StateClient -> DiscoveryBenefit) -> m DiscoveryBenefit
forall (m :: * -> *) a.
MonadClientRead m =>
(StateClient -> a) -> m a
getsClient StateClient -> DiscoveryBenefit
sdiscoBenefit
  Time
localTime <- (State -> Time) -> m Time
forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
getsState ((State -> Time) -> m Time) -> (State -> Time) -> m Time
forall a b. (a -> b) -> a -> b
$ LevelId -> State -> Time
getLocalTime (Actor -> LevelId
blid Actor
body)
  EnumMap ActorId (Point, Time)
fleeD <- (StateClient -> EnumMap ActorId (Point, Time))
-> m (EnumMap ActorId (Point, Time))
forall (m :: * -> *) a.
MonadClientRead m =>
(StateClient -> a) -> m a
getsClient StateClient -> EnumMap ActorId (Point, Time)
sfleeD
  -- In general, AI always equips the best item in stash if it's better
  -- than the best in equipment. Additionally, if there is space left
  -- in equipment for a future good item, an item from stash may be
  -- equipped if it's not much worse than in equipment.
  -- If the item in question is the best item in stash.
  -- at least one copy must remain in stash.
  let improve :: (Int, [(ItemId, Int, CStore, CStore)])
              -> ( [(Int, (ItemId, ItemFullKit))]
                 , [(Int, (ItemId, ItemFullKit))] )
              -> (Int, [(ItemId, Int, CStore, CStore)])
      improve :: (Int, [(ItemId, Int, CStore, CStore)])
-> ([(Int, (ItemId, ItemFullKit))], [(Int, (ItemId, ItemFullKit))])
-> (Int, [(ItemId, Int, CStore, CStore)])
improve (Int
oldN, [(ItemId, Int, CStore, CStore)]
l4) ([(Int, (ItemId, ItemFullKit))]
bestStash, [(Int, (ItemId, ItemFullKit))]
bestEqp) =
        let n :: Int
n = Int
1 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
oldN
        in if Actor -> Int -> Bool
eqpOverfull Actor
body Int
n then (Int
oldN, [(ItemId, Int, CStore, CStore)]
l4)
           else case ([(Int, (ItemId, ItemFullKit))]
bestStash, [(Int, (ItemId, ItemFullKit))]
bestEqp) of
             ((Int
_, (ItemId
iidStash, ItemFullKit
_)) : [(Int, (ItemId, ItemFullKit))]
_, []) ->
               (Int
n, (ItemId
iidStash, Int
1, CStore
CStash, CStore
CEqp) (ItemId, Int, CStore, CStore)
-> [(ItemId, Int, CStore, CStore)]
-> [(ItemId, Int, CStore, CStore)]
forall a. a -> [a] -> [a]
: [(ItemId, Int, CStore, CStore)]
l4)
             ((Int
vStash, (ItemId
iidStash, ItemFullKit
_)) : [(Int, (ItemId, ItemFullKit))]
_, (Int
vEqp, (ItemId, ItemFullKit)
_) : [(Int, (ItemId, ItemFullKit))]
_) | Int
vStash Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
vEqp ->
               (Int
n, (ItemId
iidStash, Int
1, CStore
CStash, CStore
CEqp) (ItemId, Int, CStore, CStore)
-> [(ItemId, Int, CStore, CStore)]
-> [(ItemId, Int, CStore, CStore)]
forall a. a -> [a] -> [a]
: [(ItemId, Int, CStore, CStore)]
l4)
             ([(Int, (ItemId, ItemFullKit))], [(Int, (ItemId, ItemFullKit))])
_ -> case ([(Int, (ItemId, ItemFullKit))] -> [(Int, (ItemId, ItemFullKit))]
forall a a a a b.
(Ord a, Num a) =>
[(a, (a, (a, (a, b))))] -> [(a, (a, (a, (a, b))))]
pluralCopiesOfBest [(Int, (ItemId, ItemFullKit))]
bestStash, [(Int, (ItemId, ItemFullKit))]
bestEqp) of
               ((Int
vStash, (ItemId
iidStash, ItemFullKit
_)) : [(Int, (ItemId, ItemFullKit))]
_, (Int
vEqp, (ItemId, ItemFullKit)
_) : [(Int, (ItemId, ItemFullKit))]
_)
                 | Bool -> Bool
not (Actor -> Int -> Bool
eqpOverfull Actor
body (Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1))  -- 9 items in equipment
                   Bool -> Bool -> Bool
&& Int
vStash Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
vEqp Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
20 Bool -> Bool -> Bool
&& Int
vStash Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
20 ->
                     -- within 2 damage of the best and not too bad absolutely
                     (Int
n, (ItemId
iidStash, Int
1, CStore
CStash, CStore
CEqp) (ItemId, Int, CStore, CStore)
-> [(ItemId, Int, CStore, CStore)]
-> [(ItemId, Int, CStore, CStore)]
forall a. a -> [a] -> [a]
: [(ItemId, Int, CStore, CStore)]
l4)
               ([(Int, (ItemId, ItemFullKit))], [(Int, (ItemId, ItemFullKit))])
_ -> (Int
oldN, [(ItemId, Int, CStore, CStore)]
l4)
      getK :: (a, (a, b)) -> a
getK (a
_, (a
itemK, b
_)) = a
itemK
      pluralCopiesOfBest :: [(a, (a, (a, (a, b))))] -> [(a, (a, (a, (a, b))))]
pluralCopiesOfBest bestStash :: [(a, (a, (a, (a, b))))]
bestStash@((a
_, (a
_, (a, (a, b))
itemFullKit)) : [(a, (a, (a, (a, b))))]
rest) =
        if (a, (a, b)) -> a
forall a a b. (a, (a, b)) -> a
getK (a, (a, b))
itemFullKit a -> a -> Bool
forall a. Ord a => a -> a -> Bool
> a
1 then [(a, (a, (a, (a, b))))]
bestStash else [(a, (a, (a, (a, b))))]
rest
      pluralCopiesOfBest [] = []
      heavilyDistressed :: Bool
heavilyDistressed =  -- Actor hit by a projectile or similarly distressed.
        ResDelta -> Bool
deltasSerious (Actor -> ResDelta
bcalmDelta Actor
body)
      recentlyFled :: Bool
recentlyFled = Bool -> ((Point, Time) -> Bool) -> Maybe (Point, Time) -> Bool
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Bool
False (\(Point
_, Time
time) -> Time -> Time -> Bool
timeRecent5 Time
localTime Time
time)
                           (ActorId
aid ActorId -> EnumMap ActorId (Point, Time) -> Maybe (Point, Time)
forall k a. Enum k => k -> EnumMap k a -> Maybe a
`EM.lookup` EnumMap ActorId (Point, Time)
fleeD)
      uneasy :: Bool
uneasy = Bool
condAimEnemyOrRemembered
               Bool -> Bool -> Bool
|| Bool -> Bool
not Bool
calmE
               Bool -> Bool -> Bool
|| Bool
heavilyDistressed
               Bool -> Bool -> Bool
|| Bool
recentlyFled
      canEsc :: Bool
canEsc = FactionKind -> Bool
fcanEscape (Faction -> FactionKind
gkind Faction
fact)
      -- We filter out unneeded items. In particular, we ignore them in eqp
      -- when comparing to items we may want to equip, so that the unneeded
      -- but powerful items don't fool us.
      -- In any case, the unneeded items should be removed from equip
      -- in @yieldUnneeded@ earlier or soon after this check.
      -- In other stores we need to filter, for otherwise we'd have
      -- a loop of equip/yield.
      filterNeeded :: (ItemId, ItemFullKit) -> Bool
filterNeeded (ItemId
_, (ItemFull
itemFull, ItemQuant
_)) =
        Bool -> Bool
not (Bool -> Bool -> Skills -> ItemFull -> Bool
hinders Bool
condShineWouldBetray Bool
uneasy Skills
actorMaxSk ItemFull
itemFull
             Bool -> Bool -> Bool
|| Bool -> Bool
not Bool
canEsc Bool -> Bool -> Bool
&& ItemKind -> Bool
IA.isHumanTrinket (ItemFull -> ItemKind
itemKind ItemFull
itemFull))
                  -- don't equip items that block progress, e.g., blowtorch
      bestTwo :: [([(Int, (ItemId, ItemFullKit))], [(Int, (ItemId, ItemFullKit))])]
bestTwo = DiscoveryBenefit
-> [(ItemId, ItemFullKit)]
-> [(ItemId, ItemFullKit)]
-> [([(Int, (ItemId, ItemFullKit))],
     [(Int, (ItemId, ItemFullKit))])]
bestByEqpSlot DiscoveryBenefit
discoBenefit
                              (((ItemId, ItemFullKit) -> Bool)
-> [(ItemId, ItemFullKit)] -> [(ItemId, ItemFullKit)]
forall a. (a -> Bool) -> [a] -> [a]
filter (ItemId, ItemFullKit) -> Bool
filterNeeded [(ItemId, ItemFullKit)]
stashAssocs)
                              (((ItemId, ItemFullKit) -> Bool)
-> [(ItemId, ItemFullKit)] -> [(ItemId, ItemFullKit)]
forall a. (a -> Bool) -> [a] -> [a]
filter (ItemId, ItemFullKit) -> Bool
filterNeeded [(ItemId, ItemFullKit)]
eqpAssocs)
      bEqpStash :: (Int, [(ItemId, Int, CStore, CStore)])
bEqpStash = ((Int, [(ItemId, Int, CStore, CStore)])
 -> ([(Int, (ItemId, ItemFullKit))], [(Int, (ItemId, ItemFullKit))])
 -> (Int, [(ItemId, Int, CStore, CStore)]))
-> (Int, [(ItemId, Int, CStore, CStore)])
-> [([(Int, (ItemId, ItemFullKit))],
     [(Int, (ItemId, ItemFullKit))])]
-> (Int, [(ItemId, Int, CStore, CStore)])
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' (Int, [(ItemId, Int, CStore, CStore)])
-> ([(Int, (ItemId, ItemFullKit))], [(Int, (ItemId, ItemFullKit))])
-> (Int, [(ItemId, Int, CStore, CStore)])
improve (Int
0, []) [([(Int, (ItemId, ItemFullKit))], [(Int, (ItemId, ItemFullKit))])]
bestTwo
      (Int
_, [(ItemId, Int, CStore, CStore)]
prepared) = (Int, [(ItemId, Int, CStore, CStore)])
bEqpStash
  Strategy RequestTimed -> m (Strategy RequestTimed)
forall (m :: * -> *) a. Monad m => a -> m a
return (Strategy RequestTimed -> m (Strategy RequestTimed))
-> Strategy RequestTimed -> m (Strategy RequestTimed)
forall a b. (a -> b) -> a -> b
$! if Bool -> Bool
not Bool
calmE Bool -> Bool -> Bool
|| [(ItemId, Int, CStore, CStore)] -> Bool
forall a. [a] -> Bool
null [(ItemId, Int, CStore, CStore)]
prepared
            then Strategy RequestTimed
forall a. Strategy a
reject
            else Text -> RequestTimed -> Strategy RequestTimed
forall a. Text -> a -> Strategy a
returN Text
"equipItems" (RequestTimed -> Strategy RequestTimed)
-> RequestTimed -> Strategy RequestTimed
forall a b. (a -> b) -> a -> b
$ [(ItemId, Int, CStore, CStore)] -> RequestTimed
ReqMoveItems [(ItemId, Int, CStore, CStore)]
prepared

yieldUnneeded :: MonadClientRead m => ActorId -> m (Strategy RequestTimed)
yieldUnneeded :: ActorId -> m (Strategy RequestTimed)
yieldUnneeded ActorId
aid = do
  Actor
body <- (State -> Actor) -> m Actor
forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
getsState ((State -> Actor) -> m Actor) -> (State -> Actor) -> m Actor
forall a b. (a -> b) -> a -> b
$ ActorId -> State -> Actor
getActorBody ActorId
aid
  Skills
actorMaxSk <- (State -> Skills) -> m Skills
forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
getsState ((State -> Skills) -> m Skills) -> (State -> Skills) -> m Skills
forall a b. (a -> b) -> a -> b
$ ActorId -> State -> Skills
getActorMaxSkills ActorId
aid
  let calmE :: Bool
calmE = Actor -> Skills -> Bool
calmEnough Actor
body Skills
actorMaxSk
  [(ItemId, ItemFullKit)]
eqpAssocs <- (State -> [(ItemId, ItemFullKit)]) -> m [(ItemId, ItemFullKit)]
forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
getsState ((State -> [(ItemId, ItemFullKit)]) -> m [(ItemId, ItemFullKit)])
-> (State -> [(ItemId, ItemFullKit)]) -> m [(ItemId, ItemFullKit)]
forall a b. (a -> b) -> a -> b
$ ActorId -> [CStore] -> State -> [(ItemId, ItemFullKit)]
kitAssocs ActorId
aid [CStore
CEqp]
  Bool
condShineWouldBetray <- ActorId -> m Bool
forall (m :: * -> *). MonadStateRead m => ActorId -> m Bool
condShineWouldBetrayM ActorId
aid
  Bool
condAimEnemyOrRemembered <- ActorId -> m Bool
forall (m :: * -> *). MonadClientRead m => ActorId -> m Bool
condAimEnemyOrRememberedM ActorId
aid
  DiscoveryBenefit
discoBenefit <- (StateClient -> DiscoveryBenefit) -> m DiscoveryBenefit
forall (m :: * -> *) a.
MonadClientRead m =>
(StateClient -> a) -> m a
getsClient StateClient -> DiscoveryBenefit
sdiscoBenefit
  Time
localTime <- (State -> Time) -> m Time
forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
getsState ((State -> Time) -> m Time) -> (State -> Time) -> m Time
forall a b. (a -> b) -> a -> b
$ LevelId -> State -> Time
getLocalTime (Actor -> LevelId
blid Actor
body)
  EnumMap ActorId (Point, Time)
fleeD <- (StateClient -> EnumMap ActorId (Point, Time))
-> m (EnumMap ActorId (Point, Time))
forall (m :: * -> *) a.
MonadClientRead m =>
(StateClient -> a) -> m a
getsClient StateClient -> EnumMap ActorId (Point, Time)
sfleeD
  -- Here and in @unEquipItems@ AI may hide from the human player,
  -- in shared stash, the Ring of Speed And Bleeding,
  -- which is a bit harsh, but fair. However any subsequent such
  -- rings will not be picked up at all, so the human player
  -- doesn't lose much fun. Additionally, if AI learns alchemy later on,
  -- they can repair the ring, wield it, drop at death and it's
  -- in play again.
  let heavilyDistressed :: Bool
heavilyDistressed =  -- Actor hit by a projectile or similarly distressed.
        ResDelta -> Bool
deltasSerious (Actor -> ResDelta
bcalmDelta Actor
body)
      recentlyFled :: Bool
recentlyFled = Bool -> ((Point, Time) -> Bool) -> Maybe (Point, Time) -> Bool
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Bool
False (\(Point
_, Time
time) -> Time -> Time -> Bool
timeRecent5 Time
localTime Time
time)
                           (ActorId
aid ActorId -> EnumMap ActorId (Point, Time) -> Maybe (Point, Time)
forall k a. Enum k => k -> EnumMap k a -> Maybe a
`EM.lookup` EnumMap ActorId (Point, Time)
fleeD)
      uneasy :: Bool
uneasy = Bool
condAimEnemyOrRemembered
               Bool -> Bool -> Bool
|| Bool -> Bool
not Bool
calmE
               Bool -> Bool -> Bool
|| Bool
heavilyDistressed
               Bool -> Bool -> Bool
|| Bool
recentlyFled
      yieldSingleUnneeded :: (ItemId, ItemFullKit) -> [(ItemId, Int, CStore, CStore)]
yieldSingleUnneeded (ItemId
iidEqp, (ItemFull
itemEqp, (Int
itemK, ItemTimers
_))) =
        [ (ItemId
iidEqp, Int
itemK, CStore
CEqp, CStore
CStash)
        | DiscoveryBenefit -> ItemId -> Bool
harmful DiscoveryBenefit
discoBenefit ItemId
iidEqp  -- harmful not shared
          Bool -> Bool -> Bool
|| Bool -> Bool -> Skills -> ItemFull -> Bool
hinders Bool
condShineWouldBetray Bool
uneasy Skills
actorMaxSk ItemFull
itemEqp ]
      yieldAllUnneeded :: [(ItemId, Int, CStore, CStore)]
yieldAllUnneeded = ((ItemId, ItemFullKit) -> [(ItemId, Int, CStore, CStore)])
-> [(ItemId, ItemFullKit)] -> [(ItemId, Int, CStore, CStore)]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (ItemId, ItemFullKit) -> [(ItemId, Int, CStore, CStore)]
yieldSingleUnneeded [(ItemId, ItemFullKit)]
eqpAssocs
  Strategy RequestTimed -> m (Strategy RequestTimed)
forall (m :: * -> *) a. Monad m => a -> m a
return (Strategy RequestTimed -> m (Strategy RequestTimed))
-> Strategy RequestTimed -> m (Strategy RequestTimed)
forall a b. (a -> b) -> a -> b
$! if Bool -> Bool
not Bool
calmE Bool -> Bool -> Bool
|| [(ItemId, Int, CStore, CStore)] -> Bool
forall a. [a] -> Bool
null [(ItemId, Int, CStore, CStore)]
yieldAllUnneeded
            then Strategy RequestTimed
forall a. Strategy a
reject
            else Text -> RequestTimed -> Strategy RequestTimed
forall a. Text -> a -> Strategy a
returN Text
"yieldUnneeded" (RequestTimed -> Strategy RequestTimed)
-> RequestTimed -> Strategy RequestTimed
forall a b. (a -> b) -> a -> b
$ [(ItemId, Int, CStore, CStore)] -> RequestTimed
ReqMoveItems [(ItemId, Int, CStore, CStore)]
yieldAllUnneeded

-- This only concerns items that @equipItems@ handles, that is
-- with a slot and with @benInEqp@ (which implies @goesIntoEqp@).
unEquipItems :: MonadClientRead m => ActorId -> m (Strategy RequestTimed)
unEquipItems :: ActorId -> m (Strategy RequestTimed)
unEquipItems ActorId
aid = do
  Actor
body <- (State -> Actor) -> m Actor
forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
getsState ((State -> Actor) -> m Actor) -> (State -> Actor) -> m Actor
forall a b. (a -> b) -> a -> b
$ ActorId -> State -> Actor
getActorBody ActorId
aid
  Skills
actorMaxSk <- (State -> Skills) -> m Skills
forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
getsState ((State -> Skills) -> m Skills) -> (State -> Skills) -> m Skills
forall a b. (a -> b) -> a -> b
$ ActorId -> State -> Skills
getActorMaxSkills ActorId
aid
  let calmE :: Bool
calmE = Actor -> Skills -> Bool
calmEnough Actor
body Skills
actorMaxSk
  [(ItemId, ItemFullKit)]
eqpAssocs <- (State -> [(ItemId, ItemFullKit)]) -> m [(ItemId, ItemFullKit)]
forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
getsState ((State -> [(ItemId, ItemFullKit)]) -> m [(ItemId, ItemFullKit)])
-> (State -> [(ItemId, ItemFullKit)]) -> m [(ItemId, ItemFullKit)]
forall a b. (a -> b) -> a -> b
$ ActorId -> [CStore] -> State -> [(ItemId, ItemFullKit)]
kitAssocs ActorId
aid [CStore
CEqp]
  [(ItemId, ItemFullKit)]
stashAssocs <- (State -> [(ItemId, ItemFullKit)]) -> m [(ItemId, ItemFullKit)]
forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
getsState ((State -> [(ItemId, ItemFullKit)]) -> m [(ItemId, ItemFullKit)])
-> (State -> [(ItemId, ItemFullKit)]) -> m [(ItemId, ItemFullKit)]
forall a b. (a -> b) -> a -> b
$ ActorId -> [CStore] -> State -> [(ItemId, ItemFullKit)]
kitAssocs ActorId
aid [CStore
CStash]
  Bool
condShineWouldBetray <- ActorId -> m Bool
forall (m :: * -> *). MonadStateRead m => ActorId -> m Bool
condShineWouldBetrayM ActorId
aid
  Bool
condAimEnemyOrRemembered <- ActorId -> m Bool
forall (m :: * -> *). MonadClientRead m => ActorId -> m Bool
condAimEnemyOrRememberedM ActorId
aid
  DiscoveryBenefit
discoBenefit <- (StateClient -> DiscoveryBenefit) -> m DiscoveryBenefit
forall (m :: * -> *) a.
MonadClientRead m =>
(StateClient -> a) -> m a
getsClient StateClient -> DiscoveryBenefit
sdiscoBenefit
  Time
localTime <- (State -> Time) -> m Time
forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
getsState ((State -> Time) -> m Time) -> (State -> Time) -> m Time
forall a b. (a -> b) -> a -> b
$ LevelId -> State -> Time
getLocalTime (Actor -> LevelId
blid Actor
body)
  EnumMap ActorId (Point, Time)
fleeD <- (StateClient -> EnumMap ActorId (Point, Time))
-> m (EnumMap ActorId (Point, Time))
forall (m :: * -> *) a.
MonadClientRead m =>
(StateClient -> a) -> m a
getsClient StateClient -> EnumMap ActorId (Point, Time)
sfleeD
  -- In general, AI unequips only if equipment is full and better stash item
  -- for another slot is likely to come or if the best (or second best)
  -- item in stash is worse than in equipment and at least one better
  -- item remains in equipment.
  let improve :: ( [(Int, (ItemId, ItemFullKit))]
                 , [(Int, (ItemId, ItemFullKit))] )
              -> [(ItemId, Int, CStore, CStore)]
      improve :: ([(Int, (ItemId, ItemFullKit))], [(Int, (ItemId, ItemFullKit))])
-> [(ItemId, Int, CStore, CStore)]
improve ([(Int, (ItemId, ItemFullKit))]
bestStash, [(Int, (ItemId, ItemFullKit))]
bestEqp) =
        case [(Int, (ItemId, ItemFullKit))]
bestEqp of
          ((Int
_, (ItemId
iidEqp, ItemFullKit
itemEqp)) : [(Int, (ItemId, ItemFullKit))]
_) | ItemFullKit -> Int
forall a a b. (a, (a, b)) -> a
getK ItemFullKit
itemEqp Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
1
                                         Bool -> Bool -> Bool
&& [(Int, (ItemId, ItemFullKit))]
bestStash [(Int, (ItemId, ItemFullKit))]
-> [(Int, (ItemId, ItemFullKit))] -> Bool
forall a b b. Ord a => [(a, b)] -> [(a, b)] -> Bool
`worseThanEqp` [(Int, (ItemId, ItemFullKit))]
bestEqp ->
            -- To share the best items with others, if they care
            -- and if a better or equal item is not already in stash.
            -- The effect is that after each party member has a copy,
            -- a single copy is permanently kept in stash, to quickly
            -- equip a new-joiner.
            [(ItemId
iidEqp, Int
1, CStore
CEqp, CStore
CStash)]
          (Int, (ItemId, ItemFullKit))
_ : bestEqp2 :: [(Int, (ItemId, ItemFullKit))]
bestEqp2@((Int
_, (ItemId
iidEqp, ItemFullKit
itemEqp)) : [(Int, (ItemId, ItemFullKit))]
_)
            | ItemFullKit -> Int
forall a a b. (a, (a, b)) -> a
getK ItemFullKit
itemEqp Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
1
              Bool -> Bool -> Bool
&& [(Int, (ItemId, ItemFullKit))]
bestStash [(Int, (ItemId, ItemFullKit))]
-> [(Int, (ItemId, ItemFullKit))] -> Bool
forall a b b. Ord a => [(a, b)] -> [(a, b)] -> Bool
`worseThanEqp` [(Int, (ItemId, ItemFullKit))]
bestEqp2 ->
            -- To share the second best items with others, if they care
            -- and if a better or equal item is not already in stash.
            -- The effect is the same as with the rule above, but only as long
            -- as the best item is scarce. Then this rule doesn't fire and
            -- every second best item copy is eventually equipped by someone.
            [(ItemId
iidEqp, ItemFullKit -> Int
forall a a b. (a, (a, b)) -> a
getK ItemFullKit
itemEqp, CStore
CEqp, CStore
CStash)]
          [(Int, (ItemId, ItemFullKit))]
_ -> case [(Int, (ItemId, ItemFullKit))] -> [(Int, (ItemId, ItemFullKit))]
forall a. [a] -> [a]
reverse [(Int, (ItemId, ItemFullKit))]
bestEqp of
            bestEqpR :: [(Int, (ItemId, ItemFullKit))]
bestEqpR@((Int
vEqp, (ItemId
iidEqp, ItemFullKit
itemEqp)) : [(Int, (ItemId, ItemFullKit))]
_)
              | Actor -> Int -> Bool
eqpOverfull Actor
body Int
1  -- 10 items in equipment
                Bool -> Bool -> Bool
&& ([(Int, (ItemId, ItemFullKit))]
bestStash [(Int, (ItemId, ItemFullKit))]
-> [(Int, (ItemId, ItemFullKit))] -> Bool
forall a b b. Ord a => [(a, b)] -> [(a, b)] -> Bool
`betterThanEqp` [(Int, (ItemId, ItemFullKit))]
bestEqpR
                    Bool -> Bool -> Bool
|| ItemFullKit -> Int
forall a a b. (a, (a, b)) -> a
getK ItemFullKit
itemEqp Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
1 Bool -> Bool -> Bool
&& Int
vEqp Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
20) ->
              -- To make place in eqp for an item better than any ours.
              -- Even a minor boost is removed only if stash has a better one.
              -- Also remove extra copies if the item weak, ih hopes
              -- of a prompt better pickup.
              [(ItemId
iidEqp, Int
1, CStore
CEqp, CStore
CStash)]
            [(Int, (ItemId, ItemFullKit))]
_ -> []
      getK :: (a, (a, b)) -> a
getK (a
_, (a
itemK, b
_)) = a
itemK
      worseThanEqp :: [(a, b)] -> [(a, b)] -> Bool
worseThanEqp ((a
vStash, b
_) : [(a, b)]
_) ((a
vEqp, b
_) : [(a, b)]
_) = a
vStash a -> a -> Bool
forall a. Ord a => a -> a -> Bool
< a
vEqp
      worseThanEqp [] [(a, b)]
_ = Bool
True
      worseThanEqp [(a, b)]
_ [] = String -> Bool
forall a. (?callStack::CallStack) => String -> a
error String
"unEquipItems: worseThanEqp: []"
      -- Not @>=@ or we could remove a useful item, without replacing it
      -- with a better or even equal one. We only remove it so if the item
      -- is weak and duplicated in equipment.
      betterThanEqp :: [(a, b)] -> [(a, b)] -> Bool
betterThanEqp ((a
vStash, b
_) : [(a, b)]
_) ((a
vEqp, b
_) : [(a, b)]
_) = a
vStash a -> a -> Bool
forall a. Ord a => a -> a -> Bool
> a
vEqp
      betterThanEqp [] [(a, b)]
_ = Bool
False
      betterThanEqp [(a, b)]
_ [] = String -> Bool
forall a. (?callStack::CallStack) => String -> a
error String
"unEquipItems: betterThanEqp: []"
      heavilyDistressed :: Bool
heavilyDistressed =  -- Actor hit by a projectile or similarly distressed.
        ResDelta -> Bool
deltasSerious (Actor -> ResDelta
bcalmDelta Actor
body)
      recentlyFled :: Bool
recentlyFled = Bool -> ((Point, Time) -> Bool) -> Maybe (Point, Time) -> Bool
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Bool
False (\(Point
_, Time
time) -> Time -> Time -> Bool
timeRecent5 Time
localTime Time
time)
                           (ActorId
aid ActorId -> EnumMap ActorId (Point, Time) -> Maybe (Point, Time)
forall k a. Enum k => k -> EnumMap k a -> Maybe a
`EM.lookup` EnumMap ActorId (Point, Time)
fleeD)
      uneasy :: Bool
uneasy = Bool
condAimEnemyOrRemembered
               Bool -> Bool -> Bool
|| Bool -> Bool
not Bool
calmE
               Bool -> Bool -> Bool
|| Bool
heavilyDistressed
               Bool -> Bool -> Bool
|| Bool
recentlyFled
      -- Here we don't need to filter out items that hinder (except in stash)
      -- because they are moved to stash and will be equipped by another actor
      -- at another time, where hindering will be completely different.
      -- If they hinder and we unequip them, all the better.
      -- We filter stash to consider only eligible items in @betterThanEqp@.
      filterNeeded :: (ItemId, ItemFullKit) -> Bool
filterNeeded (ItemId
_, (ItemFull
itemFull, ItemQuant
_)) =
        Bool -> Bool
not (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$ Bool -> Bool -> Skills -> ItemFull -> Bool
hinders Bool
condShineWouldBetray Bool
uneasy Skills
actorMaxSk ItemFull
itemFull
      bestTwo :: [([(Int, (ItemId, ItemFullKit))], [(Int, (ItemId, ItemFullKit))])]
bestTwo = DiscoveryBenefit
-> [(ItemId, ItemFullKit)]
-> [(ItemId, ItemFullKit)]
-> [([(Int, (ItemId, ItemFullKit))],
     [(Int, (ItemId, ItemFullKit))])]
bestByEqpSlot DiscoveryBenefit
discoBenefit
                              (((ItemId, ItemFullKit) -> Bool)
-> [(ItemId, ItemFullKit)] -> [(ItemId, ItemFullKit)]
forall a. (a -> Bool) -> [a] -> [a]
filter (ItemId, ItemFullKit) -> Bool
filterNeeded [(ItemId, ItemFullKit)]
stashAssocs)
                              [(ItemId, ItemFullKit)]
eqpAssocs
      bEqpStash :: [(ItemId, Int, CStore, CStore)]
bEqpStash = (([(Int, (ItemId, ItemFullKit))], [(Int, (ItemId, ItemFullKit))])
 -> [(ItemId, Int, CStore, CStore)])
-> [([(Int, (ItemId, ItemFullKit))],
     [(Int, (ItemId, ItemFullKit))])]
-> [(ItemId, Int, CStore, CStore)]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap ([(Int, (ItemId, ItemFullKit))], [(Int, (ItemId, ItemFullKit))])
-> [(ItemId, Int, CStore, CStore)]
improve [([(Int, (ItemId, ItemFullKit))], [(Int, (ItemId, ItemFullKit))])]
bestTwo
  Strategy RequestTimed -> m (Strategy RequestTimed)
forall (m :: * -> *) a. Monad m => a -> m a
return (Strategy RequestTimed -> m (Strategy RequestTimed))
-> Strategy RequestTimed -> m (Strategy RequestTimed)
forall a b. (a -> b) -> a -> b
$! if Bool -> Bool
not Bool
calmE Bool -> Bool -> Bool
|| [(ItemId, Int, CStore, CStore)] -> Bool
forall a. [a] -> Bool
null [(ItemId, Int, CStore, CStore)]
bEqpStash
            then Strategy RequestTimed
forall a. Strategy a
reject
            else Text -> RequestTimed -> Strategy RequestTimed
forall a. Text -> a -> Strategy a
returN Text
"unEquipItems" (RequestTimed -> Strategy RequestTimed)
-> RequestTimed -> Strategy RequestTimed
forall a b. (a -> b) -> a -> b
$ [(ItemId, Int, CStore, CStore)] -> RequestTimed
ReqMoveItems [(ItemId, Int, CStore, CStore)]
bEqpStash

groupByEqpSlot :: [(ItemId, ItemFullKit)]
               -> EM.EnumMap EqpSlot [(ItemId, ItemFullKit)]
groupByEqpSlot :: [(ItemId, ItemFullKit)] -> EnumMap EqpSlot [(ItemId, ItemFullKit)]
groupByEqpSlot [(ItemId, ItemFullKit)]
is =
  let f :: (a, (ItemFull, b)) -> Maybe (EqpSlot, [(a, (ItemFull, b))])
f (a
iid, (ItemFull, b)
itemFullKit) =
        let arItem :: AspectRecord
arItem = ItemFull -> AspectRecord
aspectRecordFull (ItemFull -> AspectRecord) -> ItemFull -> AspectRecord
forall a b. (a -> b) -> a -> b
$ (ItemFull, b) -> ItemFull
forall a b. (a, b) -> a
fst (ItemFull, b)
itemFullKit
        in case AspectRecord -> Maybe EqpSlot
IA.aEqpSlot AspectRecord
arItem of
          Maybe EqpSlot
Nothing -> Maybe (EqpSlot, [(a, (ItemFull, b))])
forall a. Maybe a
Nothing
          Just EqpSlot
es -> (EqpSlot, [(a, (ItemFull, b))])
-> Maybe (EqpSlot, [(a, (ItemFull, b))])
forall a. a -> Maybe a
Just (EqpSlot
es, [(a
iid, (ItemFull, b)
itemFullKit)])
      withES :: [(EqpSlot, [(ItemId, ItemFullKit)])]
withES = ((ItemId, ItemFullKit) -> Maybe (EqpSlot, [(ItemId, ItemFullKit)]))
-> [(ItemId, ItemFullKit)] -> [(EqpSlot, [(ItemId, ItemFullKit)])]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe (ItemId, ItemFullKit) -> Maybe (EqpSlot, [(ItemId, ItemFullKit)])
forall a b.
(a, (ItemFull, b)) -> Maybe (EqpSlot, [(a, (ItemFull, b))])
f [(ItemId, ItemFullKit)]
is
  in ([(ItemId, ItemFullKit)]
 -> [(ItemId, ItemFullKit)] -> [(ItemId, ItemFullKit)])
-> [(EqpSlot, [(ItemId, ItemFullKit)])]
-> EnumMap EqpSlot [(ItemId, ItemFullKit)]
forall k a. Enum k => (a -> a -> a) -> [(k, a)] -> EnumMap k a
EM.fromListWith [(ItemId, ItemFullKit)]
-> [(ItemId, ItemFullKit)] -> [(ItemId, ItemFullKit)]
forall a. [a] -> [a] -> [a]
(++) [(EqpSlot, [(ItemId, ItemFullKit)])]
withES

bestByEqpSlot :: DiscoveryBenefit
              -> [(ItemId, ItemFullKit)]
              -> [(ItemId, ItemFullKit)]
              -> [( [(Int, (ItemId, ItemFullKit))]
                  , [(Int, (ItemId, ItemFullKit))] )]
bestByEqpSlot :: DiscoveryBenefit
-> [(ItemId, ItemFullKit)]
-> [(ItemId, ItemFullKit)]
-> [([(Int, (ItemId, ItemFullKit))],
     [(Int, (ItemId, ItemFullKit))])]
bestByEqpSlot DiscoveryBenefit
discoBenefit [(ItemId, ItemFullKit)]
eqpAssocs [(ItemId, ItemFullKit)]
stashAssocs =
  let eqpMap :: EnumMap EqpSlot ([(ItemId, ItemFullKit)], [(ItemId, ItemFullKit)])
eqpMap = ([(ItemId, ItemFullKit)]
 -> ([(ItemId, ItemFullKit)], [(ItemId, ItemFullKit)]))
-> EnumMap EqpSlot [(ItemId, ItemFullKit)]
-> EnumMap
     EqpSlot ([(ItemId, ItemFullKit)], [(ItemId, ItemFullKit)])
forall a b k. (a -> b) -> EnumMap k a -> EnumMap k b
EM.map (\[(ItemId, ItemFullKit)]
g -> ([(ItemId, ItemFullKit)]
g, [])) (EnumMap EqpSlot [(ItemId, ItemFullKit)]
 -> EnumMap
      EqpSlot ([(ItemId, ItemFullKit)], [(ItemId, ItemFullKit)]))
-> EnumMap EqpSlot [(ItemId, ItemFullKit)]
-> EnumMap
     EqpSlot ([(ItemId, ItemFullKit)], [(ItemId, ItemFullKit)])
forall a b. (a -> b) -> a -> b
$ [(ItemId, ItemFullKit)] -> EnumMap EqpSlot [(ItemId, ItemFullKit)]
groupByEqpSlot [(ItemId, ItemFullKit)]
eqpAssocs
      stashMap :: EnumMap EqpSlot ([(ItemId, ItemFullKit)], [(ItemId, ItemFullKit)])
stashMap = ([(ItemId, ItemFullKit)]
 -> ([(ItemId, ItemFullKit)], [(ItemId, ItemFullKit)]))
-> EnumMap EqpSlot [(ItemId, ItemFullKit)]
-> EnumMap
     EqpSlot ([(ItemId, ItemFullKit)], [(ItemId, ItemFullKit)])
forall a b k. (a -> b) -> EnumMap k a -> EnumMap k b
EM.map (\[(ItemId, ItemFullKit)]
g -> ([], [(ItemId, ItemFullKit)]
g)) (EnumMap EqpSlot [(ItemId, ItemFullKit)]
 -> EnumMap
      EqpSlot ([(ItemId, ItemFullKit)], [(ItemId, ItemFullKit)]))
-> EnumMap EqpSlot [(ItemId, ItemFullKit)]
-> EnumMap
     EqpSlot ([(ItemId, ItemFullKit)], [(ItemId, ItemFullKit)])
forall a b. (a -> b) -> a -> b
$ [(ItemId, ItemFullKit)] -> EnumMap EqpSlot [(ItemId, ItemFullKit)]
groupByEqpSlot [(ItemId, ItemFullKit)]
stashAssocs
      appendTwo :: ([a], [a]) -> ([a], [a]) -> ([a], [a])
appendTwo ([a]
g1, [a]
g2) ([a]
h1, [a]
h2) = ([a]
g1 [a] -> [a] -> [a]
forall a. [a] -> [a] -> [a]
++ [a]
h1, [a]
g2 [a] -> [a] -> [a]
forall a. [a] -> [a] -> [a]
++ [a]
h2)
      eqpStashMap :: EnumMap EqpSlot ([(ItemId, ItemFullKit)], [(ItemId, ItemFullKit)])
eqpStashMap = (([(ItemId, ItemFullKit)], [(ItemId, ItemFullKit)])
 -> ([(ItemId, ItemFullKit)], [(ItemId, ItemFullKit)])
 -> ([(ItemId, ItemFullKit)], [(ItemId, ItemFullKit)]))
-> [EnumMap
      EqpSlot ([(ItemId, ItemFullKit)], [(ItemId, ItemFullKit)])]
-> EnumMap
     EqpSlot ([(ItemId, ItemFullKit)], [(ItemId, ItemFullKit)])
forall a k. (a -> a -> a) -> [EnumMap k a] -> EnumMap k a
EM.unionsWith ([(ItemId, ItemFullKit)], [(ItemId, ItemFullKit)])
-> ([(ItemId, ItemFullKit)], [(ItemId, ItemFullKit)])
-> ([(ItemId, ItemFullKit)], [(ItemId, ItemFullKit)])
forall a a. ([a], [a]) -> ([a], [a]) -> ([a], [a])
appendTwo [EnumMap EqpSlot ([(ItemId, ItemFullKit)], [(ItemId, ItemFullKit)])
eqpMap, EnumMap EqpSlot ([(ItemId, ItemFullKit)], [(ItemId, ItemFullKit)])
stashMap]
      bestSingle :: EqpSlot
-> [(ItemId, ItemFullKit)] -> [(Int, (ItemId, ItemFullKit))]
bestSingle = DiscoveryBenefit
-> EqpSlot
-> [(ItemId, ItemFullKit)]
-> [(Int, (ItemId, ItemFullKit))]
strongestSlot DiscoveryBenefit
discoBenefit
      bestTwo :: EqpSlot
-> ([(ItemId, ItemFullKit)], [(ItemId, ItemFullKit)])
-> ([(Int, (ItemId, ItemFullKit))], [(Int, (ItemId, ItemFullKit))])
bestTwo EqpSlot
eqpSlot ([(ItemId, ItemFullKit)]
g1, [(ItemId, ItemFullKit)]
g2) = (EqpSlot
-> [(ItemId, ItemFullKit)] -> [(Int, (ItemId, ItemFullKit))]
bestSingle EqpSlot
eqpSlot [(ItemId, ItemFullKit)]
g1, EqpSlot
-> [(ItemId, ItemFullKit)] -> [(Int, (ItemId, ItemFullKit))]
bestSingle EqpSlot
eqpSlot [(ItemId, ItemFullKit)]
g2)
  in EnumMap
  EqpSlot
  ([(Int, (ItemId, ItemFullKit))], [(Int, (ItemId, ItemFullKit))])
-> [([(Int, (ItemId, ItemFullKit))],
     [(Int, (ItemId, ItemFullKit))])]
forall k a. EnumMap k a -> [a]
EM.elems (EnumMap
   EqpSlot
   ([(Int, (ItemId, ItemFullKit))], [(Int, (ItemId, ItemFullKit))])
 -> [([(Int, (ItemId, ItemFullKit))],
      [(Int, (ItemId, ItemFullKit))])])
-> EnumMap
     EqpSlot
     ([(Int, (ItemId, ItemFullKit))], [(Int, (ItemId, ItemFullKit))])
-> [([(Int, (ItemId, ItemFullKit))],
     [(Int, (ItemId, ItemFullKit))])]
forall a b. (a -> b) -> a -> b
$ (EqpSlot
 -> ([(ItemId, ItemFullKit)], [(ItemId, ItemFullKit)])
 -> ([(Int, (ItemId, ItemFullKit))],
     [(Int, (ItemId, ItemFullKit))]))
-> EnumMap
     EqpSlot ([(ItemId, ItemFullKit)], [(ItemId, ItemFullKit)])
-> EnumMap
     EqpSlot
     ([(Int, (ItemId, ItemFullKit))], [(Int, (ItemId, ItemFullKit))])
forall k a b. Enum k => (k -> a -> b) -> EnumMap k a -> EnumMap k b
EM.mapWithKey EqpSlot
-> ([(ItemId, ItemFullKit)], [(ItemId, ItemFullKit)])
-> ([(Int, (ItemId, ItemFullKit))], [(Int, (ItemId, ItemFullKit))])
bestTwo EnumMap EqpSlot ([(ItemId, ItemFullKit)], [(ItemId, ItemFullKit)])
eqpStashMap

harmful :: DiscoveryBenefit -> ItemId -> Bool
harmful :: DiscoveryBenefit -> ItemId -> Bool
harmful DiscoveryBenefit
discoBenefit ItemId
iid =
  -- Items that are known, perhaps recently discovered, and it's now revealed
  -- they should not be kept in equipment, should be unequipped
  -- (either they are harmful or they waste eqp space).
  Bool -> Bool
not (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$ Benefit -> Bool
benInEqp (Benefit -> Bool) -> Benefit -> Bool
forall a b. (a -> b) -> a -> b
$ DiscoveryBenefit
discoBenefit DiscoveryBenefit -> ItemId -> Benefit
forall k a. Enum k => EnumMap k a -> k -> a
EM.! ItemId
iid

-- If enemy (or even a friend) blocks the way, sometimes melee him
-- even though normally you wouldn't.
-- This is also a trick to make a foe use up its non-durable weapons,
-- e.g., on cheap slow projectiles fired in its path.
meleeBlocker :: MonadClient m
             => Ability.Skills -> ActorId -> m (Strategy RequestTimed)
meleeBlocker :: Skills -> ActorId -> m (Strategy RequestTimed)
meleeBlocker Skills
actorSk ActorId
aid = do
  Actor
b <- (State -> Actor) -> m Actor
forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
getsState ((State -> Actor) -> m Actor) -> (State -> Actor) -> m Actor
forall a b. (a -> b) -> a -> b
$ ActorId -> State -> Actor
getActorBody ActorId
aid
  Skills
actorMaxSk <- (State -> Skills) -> m Skills
forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
getsState ((State -> Skills) -> m Skills) -> (State -> Skills) -> m Skills
forall a b. (a -> b) -> a -> b
$ ActorId -> State -> Skills
getActorMaxSkills ActorId
aid
  Faction
fact <- (State -> Faction) -> m Faction
forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
getsState ((State -> Faction) -> m Faction)
-> (State -> Faction) -> m Faction
forall a b. (a -> b) -> a -> b
$ (EnumMap FactionId Faction -> FactionId -> Faction
forall k a. Enum k => EnumMap k a -> k -> a
EM.! Actor -> FactionId
bfid Actor
b) (EnumMap FactionId Faction -> Faction)
-> (State -> EnumMap FactionId Faction) -> State -> Faction
forall b c a. (b -> c) -> (a -> b) -> a -> c
. State -> EnumMap FactionId Faction
sfactionD
  Maybe TgtAndPath
mtgtMPath <- (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
aid (EnumMap ActorId TgtAndPath -> Maybe TgtAndPath)
-> (StateClient -> EnumMap ActorId TgtAndPath)
-> StateClient
-> Maybe TgtAndPath
forall b c a. (b -> c) -> (a -> b) -> a -> c
. StateClient -> EnumMap ActorId TgtAndPath
stargetD
  case Maybe TgtAndPath
mtgtMPath of
    Just TgtAndPath{ tapTgt :: TgtAndPath -> Target
tapTgt=TEnemy{}
                   , tapPath :: TgtAndPath -> Maybe AndPath
tapPath=Just AndPath{pathList :: AndPath -> [Point]
pathList=Point
q : [Point]
_, Point
pathGoal :: Point
pathGoal :: AndPath -> Point
pathGoal} }
      | Point
q Point -> Point -> Bool
forall a. Eq a => a -> a -> Bool
== Point
pathGoal -> Strategy RequestTimed -> m (Strategy RequestTimed)
forall (m :: * -> *) a. Monad m => a -> m a
return Strategy RequestTimed
forall a. Strategy a
reject
        -- not a real blocker, but goal enemy, so defer deciding whether
        -- to melee him to the code that deals with goal enemies
    Just TgtAndPath{tapPath :: TgtAndPath -> Maybe AndPath
tapPath=Just AndPath{pathList :: AndPath -> [Point]
pathList=Point
q : [Point]
_, Point
pathGoal :: Point
pathGoal :: AndPath -> Point
pathGoal}} -> do
      -- We prefer the goal position, so that we can kill the foe and enter it,
      -- but we accept any @q@ as well.
      Level
lvl <- LevelId -> m Level
forall (m :: * -> *). MonadStateRead m => LevelId -> m Level
getLevel (Actor -> LevelId
blid Actor
b)
      let maim :: Maybe Point
maim | Point -> Point -> Bool
adjacent (Actor -> Point
bpos Actor
b) Point
pathGoal = Point -> Maybe Point
forall a. a -> Maybe a
Just Point
pathGoal
               | Point -> Point -> Bool
adjacent (Actor -> Point
bpos Actor
b) Point
q = Point -> Maybe Point
forall a. a -> Maybe a
Just Point
q
               | Bool
otherwise = Maybe Point
forall a. Maybe a
Nothing  -- MeleeDistant
          lBlocker :: [ActorId]
lBlocker = case Maybe Point
maim of
            Maybe Point
Nothing -> []
            Just Point
aim -> Point -> Level -> [ActorId]
posToAidsLvl Point
aim Level
lvl
      case [ActorId]
lBlocker of
        ActorId
aid2 : [ActorId]
_ -> do
          Actor
body2 <- (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
aid2
          Skills
actorMaxSk2 <- (State -> Skills) -> m Skills
forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
getsState ((State -> Skills) -> m Skills) -> (State -> Skills) -> m Skills
forall a b. (a -> b) -> a -> b
$ ActorId -> State -> Skills
getActorMaxSkills ActorId
aid2
          -- No problem if there are many projectiles at the spot. We just
          -- attack the first one.
          if | Actor -> Bool
bproj Actor
body2  -- displacing saves a move, so don't melee
               Bool -> Bool -> Bool
&& Skill -> Skills -> Int
getSk Skill
SkDisplace Skills
actorSk Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
0 ->
               Strategy RequestTimed -> m (Strategy RequestTimed)
forall (m :: * -> *) a. Monad m => a -> m a
return Strategy RequestTimed
forall a. Strategy a
reject
             | FactionId -> Faction -> FactionId -> Bool
isFoe (Actor -> FactionId
bfid Actor
b) Faction
fact (Actor -> FactionId
bfid Actor
body2)
                 -- at war with us, so hit, not displace
               Bool -> Bool -> Bool
|| FactionId -> Faction -> FactionId -> Bool
isFriend (Actor -> FactionId
bfid Actor
b) Faction
fact (Actor -> FactionId
bfid Actor
body2) -- don't start a war
                  Bool -> Bool -> Bool
&& Skill -> Skills -> Int
getSk Skill
SkDisplace Skills
actorSk Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
0
                       -- can't displace
                  Bool -> Bool -> Bool
&& Skill -> Skills -> Int
getSk Skill
SkMove Skills
actorSk Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
0  -- blocked move
                  Bool -> Bool -> Bool
&& Int64
3 Int64 -> Int64 -> Int64
forall a. Num a => a -> a -> a
* Actor -> Int64
bhp Actor
body2 Int64 -> Int64 -> Bool
forall a. Ord a => a -> a -> Bool
< Actor -> Int64
bhp Actor
b  -- only get rid of weak friends
                  Bool -> Bool -> Bool
&& Skills -> Speed
gearSpeed Skills
actorMaxSk2 Speed -> Speed -> Bool
forall a. Ord a => a -> a -> Bool
<= Skills -> Speed
gearSpeed Skills
actorMaxSk -> do
               [RequestTimed]
mel <- Maybe RequestTimed -> [RequestTimed]
forall a. Maybe a -> [a]
maybeToList (Maybe RequestTimed -> [RequestTimed])
-> m (Maybe RequestTimed) -> m [RequestTimed]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ActorId -> ActorId -> m (Maybe RequestTimed)
forall (m :: * -> *).
MonadClient m =>
ActorId -> ActorId -> m (Maybe RequestTimed)
pickWeaponClient ActorId
aid ActorId
aid2
               Strategy RequestTimed -> m (Strategy RequestTimed)
forall (m :: * -> *) a. Monad m => a -> m a
return (Strategy RequestTimed -> m (Strategy RequestTimed))
-> Strategy RequestTimed -> m (Strategy RequestTimed)
forall a b. (a -> b) -> a -> b
$! Frequency RequestTimed -> Strategy RequestTimed
forall a. Frequency a -> Strategy a
liftFrequency (Frequency RequestTimed -> Strategy RequestTimed)
-> Frequency RequestTimed -> Strategy RequestTimed
forall a b. (a -> b) -> a -> b
$ Text -> [RequestTimed] -> Frequency RequestTimed
forall a. Text -> [a] -> Frequency a
uniformFreq Text
"melee in the way" [RequestTimed]
mel
             | Bool
otherwise -> Strategy RequestTimed -> m (Strategy RequestTimed)
forall (m :: * -> *) a. Monad m => a -> m a
return Strategy RequestTimed
forall a. Strategy a
reject
        [] -> Strategy RequestTimed -> m (Strategy RequestTimed)
forall (m :: * -> *) a. Monad m => a -> m a
return Strategy RequestTimed
forall a. Strategy a
reject
    Maybe TgtAndPath
_ -> Strategy RequestTimed -> m (Strategy RequestTimed)
forall (m :: * -> *) a. Monad m => a -> m a
return Strategy RequestTimed
forall a. Strategy a
reject  -- probably no path to the enemy, if any

-- Everybody melees in a pinch, skills and weapons allowing,
-- even though some prefer ranged attacks. However only potentially harmful
-- enemies or those having loot or moving (can follow and spy) are meleed
-- (or those that are in the way, see elsewhere).
-- Projectiles are rather displaced or sidestepped, because it's cheaper
-- and also the projectile may be explosive and so harm anyway
-- and also if ignored it may hit enemies --- AI can't tell.
meleeAny :: MonadClient m => ActorId -> m (Strategy RequestTimed)
meleeAny :: ActorId -> m (Strategy RequestTimed)
meleeAny ActorId
aid = do
  Actor
b <- (State -> Actor) -> m Actor
forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
getsState ((State -> Actor) -> m Actor) -> (State -> Actor) -> m Actor
forall a b. (a -> b) -> a -> b
$ ActorId -> State -> Actor
getActorBody ActorId
aid
  Faction
fact <- (State -> Faction) -> m Faction
forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
getsState ((State -> Faction) -> m Faction)
-> (State -> Faction) -> m Faction
forall a b. (a -> b) -> a -> b
$ (EnumMap FactionId Faction -> FactionId -> Faction
forall k a. Enum k => EnumMap k a -> k -> a
EM.! Actor -> FactionId
bfid Actor
b) (EnumMap FactionId Faction -> Faction)
-> (State -> EnumMap FactionId Faction) -> State -> Faction
forall b c a. (b -> c) -> (a -> b) -> a -> c
. State -> EnumMap FactionId Faction
sfactionD
  [(ActorId, Actor)]
adjBigAssocs <- (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
$ Actor -> State -> [(ActorId, Actor)]
adjacentBigAssocs Actor
b
  ActorMaxSkills
actorMaxSkills <- (State -> ActorMaxSkills) -> m ActorMaxSkills
forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
getsState State -> ActorMaxSkills
sactorMaxSkills
  let foe :: Actor -> Bool
foe Actor
b2 = FactionId -> Faction -> FactionId -> Bool
isFoe (Actor -> FactionId
bfid Actor
b) Faction
fact (Actor -> FactionId
bfid Actor
b2)
      adjFoes :: [(ActorId, Actor)]
adjFoes = ((ActorId, Actor) -> Bool)
-> [(ActorId, Actor)] -> [(ActorId, Actor)]
forall a. (a -> Bool) -> [a] -> [a]
filter ((ActorId -> Actor -> Bool) -> (ActorId, Actor) -> Bool
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry ((ActorId -> Actor -> Bool) -> (ActorId, Actor) -> Bool)
-> (ActorId -> Actor -> Bool) -> (ActorId, Actor) -> Bool
forall a b. (a -> b) -> a -> b
$ ActorMaxSkills -> ActorId -> Actor -> Bool
actorWorthKilling ActorMaxSkills
actorMaxSkills)
                ([(ActorId, Actor)] -> [(ActorId, Actor)])
-> [(ActorId, Actor)] -> [(ActorId, Actor)]
forall a b. (a -> b) -> a -> b
$ ((ActorId, Actor) -> Bool)
-> [(ActorId, Actor)] -> [(ActorId, Actor)]
forall a. (a -> Bool) -> [a] -> [a]
filter (Actor -> Bool
foe (Actor -> Bool)
-> ((ActorId, Actor) -> Actor) -> (ActorId, Actor) -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ActorId, Actor) -> Actor
forall a b. (a, b) -> b
snd) [(ActorId, Actor)]
adjBigAssocs
  Maybe Target
btarget <- (StateClient -> Maybe Target) -> m (Maybe Target)
forall (m :: * -> *) a.
MonadClientRead m =>
(StateClient -> a) -> m a
getsClient ((StateClient -> Maybe Target) -> m (Maybe Target))
-> (StateClient -> Maybe Target) -> m (Maybe Target)
forall a b. (a -> b) -> a -> b
$ ActorId -> StateClient -> Maybe Target
getTarget ActorId
aid
  Maybe [(ActorId, Actor)]
mtargets <- case Maybe Target
btarget of
    Just (TEnemy ActorId
aid2) -> do
      Actor
b2 <- (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
aid2
      Maybe [(ActorId, Actor)] -> m (Maybe [(ActorId, Actor)])
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe [(ActorId, Actor)] -> m (Maybe [(ActorId, Actor)]))
-> Maybe [(ActorId, Actor)] -> m (Maybe [(ActorId, Actor)])
forall a b. (a -> b) -> a -> b
$! if Point -> Point -> Bool
adjacent (Actor -> Point
bpos Actor
b2) (Actor -> Point
bpos Actor
b)
                   Bool -> Bool -> Bool
&& ActorMaxSkills -> ActorId -> Actor -> Bool
actorWorthKilling ActorMaxSkills
actorMaxSkills ActorId
aid2 Actor
b2
                then [(ActorId, Actor)] -> Maybe [(ActorId, Actor)]
forall a. a -> Maybe a
Just [(ActorId
aid2, Actor
b2)]
                else Maybe [(ActorId, Actor)]
forall a. Maybe a
Nothing
    Maybe Target
_ -> Maybe [(ActorId, Actor)] -> m (Maybe [(ActorId, Actor)])
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe [(ActorId, Actor)]
forall a. Maybe a
Nothing
  let adjTargets :: [(ActorId, Actor)]
adjTargets = [(ActorId, Actor)]
-> Maybe [(ActorId, Actor)] -> [(ActorId, Actor)]
forall a. a -> Maybe a -> a
fromMaybe [(ActorId, Actor)]
adjFoes Maybe [(ActorId, Actor)]
mtargets
  [Maybe RequestTimed]
mels <- ((ActorId, Actor) -> m (Maybe RequestTimed))
-> [(ActorId, Actor)] -> m [Maybe RequestTimed]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (ActorId -> ActorId -> m (Maybe RequestTimed)
forall (m :: * -> *).
MonadClient m =>
ActorId -> ActorId -> m (Maybe RequestTimed)
pickWeaponClient ActorId
aid (ActorId -> m (Maybe RequestTimed))
-> ((ActorId, Actor) -> ActorId)
-> (ActorId, Actor)
-> m (Maybe RequestTimed)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ActorId, Actor) -> ActorId
forall a b. (a, b) -> a
fst) [(ActorId, Actor)]
adjTargets
  let freq :: Frequency RequestTimed
freq = Text -> [RequestTimed] -> Frequency RequestTimed
forall a. Text -> [a] -> Frequency a
uniformFreq Text
"melee adjacent" ([RequestTimed] -> Frequency RequestTimed)
-> [RequestTimed] -> Frequency RequestTimed
forall a b. (a -> b) -> a -> b
$ [Maybe RequestTimed] -> [RequestTimed]
forall a. [Maybe a] -> [a]
catMaybes [Maybe RequestTimed]
mels
  Strategy RequestTimed -> m (Strategy RequestTimed)
forall (m :: * -> *) a. Monad m => a -> m a
return (Strategy RequestTimed -> m (Strategy RequestTimed))
-> Strategy RequestTimed -> m (Strategy RequestTimed)
forall a b. (a -> b) -> a -> b
$! Frequency RequestTimed -> Strategy RequestTimed
forall a. Frequency a -> Strategy a
liftFrequency Frequency RequestTimed
freq

-- The level the actor is on is either explored or the actor already
-- has a weapon equipped, so no need to explore further, he tries to find
-- enemies on other levels, hence triggering terrain.
-- We don't verify any embedded item is targeted by the actor, but at least
-- the actor doesn't target a visible enemy at this point.
-- TODO: In @actionStrategy@ we require minimal @SkAlter@ even for the case
-- of triggerable tile underfoot. Let's say this quirk is a specialization
-- of AI actors, because there are usually many, so not all need to trigger.
trigger :: MonadClientRead m
        => ActorId -> FleeViaStairsOrEscape
        -> m (Strategy RequestTimed)
trigger :: ActorId -> FleeViaStairsOrEscape -> m (Strategy RequestTimed)
trigger ActorId
aid FleeViaStairsOrEscape
fleeVia = do
  Actor
b <- (State -> Actor) -> m Actor
forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
getsState ((State -> Actor) -> m Actor) -> (State -> Actor) -> m Actor
forall a b. (a -> b) -> a -> b
$ ActorId -> State -> Actor
getActorBody ActorId
aid
  Level
lvl <- LevelId -> m Level
forall (m :: * -> *). MonadStateRead m => LevelId -> m Level
getLevel (Actor -> LevelId
blid Actor
b)
  let f :: Point -> Maybe (Point, ItemBag)
f Point
pos = case Point -> EnumMap Point ItemBag -> Maybe ItemBag
forall k a. Enum k => k -> EnumMap k a -> Maybe a
EM.lookup Point
pos (EnumMap Point ItemBag -> Maybe ItemBag)
-> EnumMap Point ItemBag -> Maybe ItemBag
forall a b. (a -> b) -> a -> b
$ Level -> EnumMap Point ItemBag
lembed Level
lvl of
        Maybe ItemBag
Nothing -> Maybe (Point, ItemBag)
forall a. Maybe a
Nothing
        Just ItemBag
bag -> (Point, ItemBag) -> Maybe (Point, ItemBag)
forall a. a -> Maybe a
Just (Point
pos, ItemBag
bag)
      pbags :: [(Point, ItemBag)]
pbags = (Point -> Maybe (Point, ItemBag)) -> [Point] -> [(Point, ItemBag)]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe Point -> Maybe (Point, ItemBag)
f ([Point] -> [(Point, ItemBag)]) -> [Point] -> [(Point, ItemBag)]
forall a b. (a -> b) -> a -> b
$ Actor -> Point
bpos Actor
b Point -> [Point] -> [Point]
forall a. a -> [a] -> [a]
: Point -> [Point]
vicinityUnsafe (Actor -> Point
bpos Actor
b)
  [(Double, (Point, ItemBag))]
efeat <- FleeViaStairsOrEscape
-> ActorId -> [(Point, ItemBag)] -> m [(Double, (Point, ItemBag))]
forall (m :: * -> *).
MonadClientRead m =>
FleeViaStairsOrEscape
-> ActorId -> [(Point, ItemBag)] -> m [(Double, (Point, ItemBag))]
embedBenefit FleeViaStairsOrEscape
fleeVia ActorId
aid [(Point, ItemBag)]
pbags
  Strategy RequestTimed -> m (Strategy RequestTimed)
forall (m :: * -> *) a. Monad m => a -> m a
return (Strategy RequestTimed -> m (Strategy RequestTimed))
-> Strategy RequestTimed -> m (Strategy RequestTimed)
forall a b. (a -> b) -> a -> b
$! Frequency RequestTimed -> Strategy RequestTimed
forall a. Frequency a -> Strategy a
liftFrequency (Frequency RequestTimed -> Strategy RequestTimed)
-> Frequency RequestTimed -> Strategy RequestTimed
forall a b. (a -> b) -> a -> b
$ Text -> [(Int, RequestTimed)] -> Frequency RequestTimed
forall a. Text -> [(Int, a)] -> Frequency a
toFreq Text
"trigger"
    [ (Double -> Int
forall a b. (RealFrac a, Integral b) => a -> b
ceiling Double
benefit, Point -> RequestTimed
ReqAlter Point
pos)
    | (Double
benefit, (Point
pos, ItemBag
_)) <- [(Double, (Point, ItemBag))]
efeat
    , let underFeet :: Bool
underFeet = Point
pos Point -> Point -> Bool
forall a. Eq a => a -> a -> Bool
== Actor -> Point
bpos Actor
b
    , Bool
underFeet
      Bool -> Bool -> Bool
|| Bool -> Bool
not (Point -> Level -> Bool
occupiedBigLvl Point
pos Level
lvl)
         Bool -> Bool -> Bool
&& Bool -> Bool
not (Point -> Level -> Bool
occupiedProjLvl Point
pos Level
lvl) -- AlterBlockActor
         Bool -> Bool -> Bool
&& Point -> EnumMap Point ItemBag -> Bool
forall k a. Enum k => k -> EnumMap k a -> Bool
EM.notMember Point
pos (Level -> EnumMap Point ItemBag
lfloor Level
lvl) ]  -- AlterBlockItem

projectItem :: MonadClientRead m
            => Ability.Skills -> ActorId -> m (Strategy RequestTimed)
projectItem :: Skills -> ActorId -> m (Strategy RequestTimed)
projectItem Skills
actorSk ActorId
aid = do
  Maybe Target
btarget <- (StateClient -> Maybe Target) -> m (Maybe Target)
forall (m :: * -> *) a.
MonadClientRead m =>
(StateClient -> a) -> m a
getsClient ((StateClient -> Maybe Target) -> m (Maybe Target))
-> (StateClient -> Maybe Target) -> m (Maybe Target)
forall a b. (a -> b) -> a -> b
$ ActorId -> StateClient -> Maybe Target
getTarget ActorId
aid
  Actor
b <- (State -> Actor) -> m Actor
forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
getsState ((State -> Actor) -> m Actor) -> (State -> Actor) -> m Actor
forall a b. (a -> b) -> a -> b
$ ActorId -> State -> Actor
getActorBody ActorId
aid
  -- We query target, not path, because path is not needed for flinging.
  -- Even if unknown tiles exist between us and the target, we assume
  -- they are walkable and not just transparent and we happily try to shoot.
  Maybe Point
mfpos <- (State -> Maybe Point) -> m (Maybe Point)
forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
getsState ((State -> Maybe Point) -> m (Maybe Point))
-> (State -> Maybe Point) -> m (Maybe Point)
forall a b. (a -> b) -> a -> b
$ Maybe ActorId -> LevelId -> Maybe Target -> State -> Maybe Point
aidTgtToPos (ActorId -> Maybe ActorId
forall a. a -> Maybe a
Just ActorId
aid) (Actor -> LevelId
blid Actor
b) Maybe Target
btarget
  case (Maybe Target
btarget, Maybe Point
mfpos) of
    (Maybe Target
_, Just Point
fpos) | Point -> Point -> Bool
adjacent (Actor -> Point
bpos Actor
b) Point
fpos -> Strategy RequestTimed -> m (Strategy RequestTimed)
forall (m :: * -> *) a. Monad m => a -> m a
return Strategy RequestTimed
forall a. Strategy a
reject
    (Just (TEnemy ActorId
aidE), Just Point
fpos) -> do
      ActorMaxSkills
actorMaxSkills <- (State -> ActorMaxSkills) -> m ActorMaxSkills
forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
getsState State -> ActorMaxSkills
sactorMaxSkills
      Actor
body <- (State -> Actor) -> m Actor
forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
getsState ((State -> Actor) -> m Actor) -> (State -> Actor) -> m Actor
forall a b. (a -> b) -> a -> b
$ ActorId -> State -> Actor
getActorBody ActorId
aidE
      if ActorMaxSkills -> ActorId -> Actor -> Bool
actorWorthChasing ActorMaxSkills
actorMaxSkills ActorId
aidE Actor
body then do
        COps
cops <- (State -> COps) -> m COps
forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
getsState State -> COps
scops
        Level
lvl <- LevelId -> m Level
forall (m :: * -> *). MonadStateRead m => LevelId -> m Level
getLevel (Actor -> LevelId
blid Actor
b)
        Int
seps <- (StateClient -> Int) -> m Int
forall (m :: * -> *) a.
MonadClientRead m =>
(StateClient -> a) -> m a
getsClient StateClient -> Int
seps
        case Bool -> Actor -> Point -> Int -> COps -> Level -> Maybe Int
makeLine Bool
False Actor
b Point
fpos Int
seps COps
cops Level
lvl of
          Just Int
newEps -> do
            let skill :: Int
skill = Skill -> Skills -> Int
getSk Skill
SkProject Skills
actorSk
            -- ProjectAimOnself, ProjectBlockActor, ProjectBlockTerrain
            -- and no actors or obstacles along the path.
            [(Double, CStore, ItemId, ItemFull, ItemQuant)]
benList <- Int -> ActorId -> m [(Double, CStore, ItemId, ItemFull, ItemQuant)]
forall (m :: * -> *).
MonadClientRead m =>
Int -> ActorId -> m [(Double, CStore, ItemId, ItemFull, ItemQuant)]
condProjectListM Int
skill ActorId
aid
            Time
localTime <- (State -> Time) -> m Time
forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
getsState ((State -> Time) -> m Time) -> (State -> Time) -> m Time
forall a b. (a -> b) -> a -> b
$ LevelId -> State -> Time
getLocalTime (Actor -> LevelId
blid Actor
b)
            let fRanged :: (Double, CStore, ItemId, ItemFull, ItemQuant)
-> Maybe (Int, RequestTimed)
fRanged (Double
benR, CStore
cstore, ItemId
iid, ItemFull
itemFull, ItemQuant
kit) =
                  -- If the item is discharged, neither the kinetic hit nor
                  -- any effects activate, so no point projecting.
                  -- This changes in time, so recharging is not included
                  -- in @condProjectListM@, but checked here, just before fling.
                  let recharged :: Bool
recharged = Time -> ItemQuant -> Bool
hasCharge Time
localTime ItemQuant
kit
                      arItem :: AspectRecord
arItem = ItemFull -> AspectRecord
aspectRecordFull ItemFull
itemFull
                      trange :: Int
trange = AspectRecord -> ItemKind -> Int
IA.totalRange AspectRecord
arItem (ItemKind -> Int) -> ItemKind -> Int
forall a b. (a -> b) -> a -> b
$ ItemFull -> ItemKind
itemKind ItemFull
itemFull
                      bestRange :: Int
bestRange =
                        Point -> Point -> Int
chessDist (Actor -> Point
bpos Actor
b) Point
fpos Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
2  -- margin for fleeing
                      rangeMult :: Int
rangeMult =  -- penalize wasted or unsafely low range
                        Int
10 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int -> Int -> Int
forall a. Ord a => a -> a -> a
max Int
0 (Int
10 Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int -> Int
forall a. Num a => a -> a
abs (Int
trange Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
bestRange))
                  in if Int
trange Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Point -> Point -> Int
chessDist (Actor -> Point
bpos Actor
b) Point
fpos Bool -> Bool -> Bool
&& Bool
recharged
                     then (Int, RequestTimed) -> Maybe (Int, RequestTimed)
forall a. a -> Maybe a
Just ( - Double -> Int
forall a b. (RealFrac a, Integral b) => a -> b
ceiling (Double
benR Double -> Double -> Double
forall a. Num a => a -> a -> a
* Int -> Double
intToDouble Int
rangeMult Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ Double
10)
                               , Point -> Int -> ItemId -> CStore -> RequestTimed
ReqProject Point
fpos Int
newEps ItemId
iid CStore
cstore )
                     else Maybe (Int, RequestTimed)
forall a. Maybe a
Nothing
                benRanged :: [(Int, RequestTimed)]
benRanged = ((Double, CStore, ItemId, ItemFull, ItemQuant)
 -> Maybe (Int, RequestTimed))
-> [(Double, CStore, ItemId, ItemFull, ItemQuant)]
-> [(Int, RequestTimed)]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe (Double, CStore, ItemId, ItemFull, ItemQuant)
-> Maybe (Int, RequestTimed)
fRanged [(Double, CStore, ItemId, ItemFull, ItemQuant)]
benList
            Strategy RequestTimed -> m (Strategy RequestTimed)
forall (m :: * -> *) a. Monad m => a -> m a
return (Strategy RequestTimed -> m (Strategy RequestTimed))
-> Strategy RequestTimed -> m (Strategy RequestTimed)
forall a b. (a -> b) -> a -> b
$! Frequency RequestTimed -> Strategy RequestTimed
forall a. Frequency a -> Strategy a
liftFrequency (Frequency RequestTimed -> Strategy RequestTimed)
-> Frequency RequestTimed -> Strategy RequestTimed
forall a b. (a -> b) -> a -> b
$ Text -> [(Int, RequestTimed)] -> Frequency RequestTimed
forall a. Text -> [(Int, a)] -> Frequency a
toFreq Text
"projectItem" [(Int, RequestTimed)]
benRanged
          Maybe Int
_ -> Strategy RequestTimed -> m (Strategy RequestTimed)
forall (m :: * -> *) a. Monad m => a -> m a
return Strategy RequestTimed
forall a. Strategy a
reject
      else Strategy RequestTimed -> m (Strategy RequestTimed)
forall (m :: * -> *) a. Monad m => a -> m a
return Strategy RequestTimed
forall a. Strategy a
reject
    (Maybe Target, Maybe Point)
_ -> Strategy RequestTimed -> m (Strategy RequestTimed)
forall (m :: * -> *) a. Monad m => a -> m a
return Strategy RequestTimed
forall a. Strategy a
reject

data ApplyItemGroup = ApplyAll | ApplyFirstAid
  deriving ApplyItemGroup -> ApplyItemGroup -> Bool
(ApplyItemGroup -> ApplyItemGroup -> Bool)
-> (ApplyItemGroup -> ApplyItemGroup -> Bool) -> Eq ApplyItemGroup
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ApplyItemGroup -> ApplyItemGroup -> Bool
$c/= :: ApplyItemGroup -> ApplyItemGroup -> Bool
== :: ApplyItemGroup -> ApplyItemGroup -> Bool
$c== :: ApplyItemGroup -> ApplyItemGroup -> Bool
Eq

applyItem :: MonadClientRead m
          => Ability.Skills -> ActorId -> ApplyItemGroup
          -> m (Strategy RequestTimed)
applyItem :: Skills -> ActorId -> ApplyItemGroup -> m (Strategy RequestTimed)
applyItem Skills
actorSk ActorId
aid ApplyItemGroup
applyGroup = do
  COps{RuleContent
corule :: COps -> RuleContent
corule :: RuleContent
corule} <- (State -> COps) -> m COps
forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
getsState State -> COps
scops
  Actor
b <- (State -> Actor) -> m Actor
forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
getsState ((State -> Actor) -> m Actor) -> (State -> Actor) -> m Actor
forall a b. (a -> b) -> a -> b
$ ActorId -> State -> Actor
getActorBody ActorId
aid
  Faction
fact <- (State -> Faction) -> m Faction
forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
getsState ((State -> Faction) -> m Faction)
-> (State -> Faction) -> m Faction
forall a b. (a -> b) -> a -> b
$ (EnumMap FactionId Faction -> FactionId -> Faction
forall k a. Enum k => EnumMap k a -> k -> a
EM.! Actor -> FactionId
bfid Actor
b) (EnumMap FactionId Faction -> Faction)
-> (State -> EnumMap FactionId Faction) -> State -> Faction
forall b c a. (b -> c) -> (a -> b) -> a -> c
. State -> EnumMap FactionId Faction
sfactionD
  Bool
condShineWouldBetray <- ActorId -> m Bool
forall (m :: * -> *). MonadStateRead m => ActorId -> m Bool
condShineWouldBetrayM ActorId
aid
  Bool
condAimEnemyOrRemembered <- ActorId -> m Bool
forall (m :: * -> *). MonadClientRead m => ActorId -> m Bool
condAimEnemyOrRememberedM ActorId
aid
  Time
localTime <- (State -> Time) -> m Time
forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
getsState ((State -> Time) -> m Time) -> (State -> Time) -> m Time
forall a b. (a -> b) -> a -> b
$ LevelId -> State -> Time
getLocalTime (Actor -> LevelId
blid Actor
b)
  let calmE :: Bool
calmE = Actor -> Skills -> Bool
calmEnough Actor
b Skills
actorSk
      heavilyDistressed :: Bool
heavilyDistressed =  -- Actor hit by a projectile or similarly distressed.
        ResDelta -> Bool
deltasSerious (Actor -> ResDelta
bcalmDelta Actor
b)
      uneasy :: Bool
uneasy = Bool
condAimEnemyOrRemembered
               Bool -> Bool -> Bool
|| Bool -> Bool
not Bool
calmE
               Bool -> Bool -> Bool
|| Bool
heavilyDistressed
        -- don't take recent fleeing into account when item can be lost
      skill :: Int
skill = Skill -> Skills -> Int
getSk Skill
SkApply Skills
actorSk
      -- This detects if the value of keeping the item in eqp is in fact < 0.
      hind :: ItemFull -> Bool
hind = Bool -> Bool -> Skills -> ItemFull -> Bool
hinders Bool
condShineWouldBetray Bool
uneasy Skills
actorSk
      canEsc :: Bool
canEsc = FactionKind -> Bool
fcanEscape (Faction -> FactionKind
gkind Faction
fact)
      permittedActor :: Maybe CStore -> ItemFull -> ItemQuant -> Bool
permittedActor Maybe CStore
cstore ItemFull
itemFull ItemQuant
kit =
        Bool -> Either ReqFailure Bool -> Bool
forall b a. b -> Either a b -> b
fromRight Bool
False
        (Either ReqFailure Bool -> Bool) -> Either ReqFailure Bool -> Bool
forall a b. (a -> b) -> a -> b
$ RuleContent
-> Time
-> Int
-> Bool
-> Maybe CStore
-> ItemFull
-> ItemQuant
-> Either ReqFailure Bool
permittedApply RuleContent
corule Time
localTime Int
skill Bool
calmE Maybe CStore
cstore ItemFull
itemFull ItemQuant
kit
      disqualify :: Bool -> IK.Effect -> Bool
      -- These effects tweak items, which is only situationally beneficial
      -- and not really the best idea while in combat.
      disqualify :: Bool -> Effect -> Bool
disqualify Bool
_ Effect
IK.PolyItem = Bool
True
      disqualify Bool
_ Effect
IK.RerollItem = Bool
True
      disqualify Bool
_ Effect
IK.DupItem = Bool
True
      disqualify Bool
_ Effect
IK.Identify = Bool
True
      -- This is hard to use and would be wasted recharging stomach.
      disqualify Bool
_ IK.Recharge{} = Bool
True
      -- This is usually the main effect of item and it's useless without Calm.
      disqualify Bool
durable IK.Summon{} =
        Bool
durable Bool -> Bool -> Bool
&& (Actor -> Int64
bcalm Actor
b Int64 -> Int64 -> Bool
forall a. Ord a => a -> a -> Bool
< Int -> Int64
xM Int
30 Bool -> Bool -> Bool
|| Bool -> Bool
not Bool
calmE)
      disqualify Bool
durable (IK.AtMostOneOf [Effect]
l) = (Effect -> Bool) -> [Effect] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (Bool -> Effect -> Bool
disqualify Bool
durable) [Effect]
l
      disqualify Bool
durable (IK.OneOf [Effect]
l) = (Effect -> Bool) -> [Effect] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (Bool -> Effect -> Bool
disqualify Bool
durable) [Effect]
l
      disqualify Bool
durable (IK.OnUser Effect
eff) = Bool -> Effect -> Bool
disqualify Bool
durable Effect
eff
      disqualify Bool
durable (IK.AndEffect Effect
eff1 Effect
eff2) =
        Bool -> Effect -> Bool
disqualify Bool
durable Effect
eff1 Bool -> Bool -> Bool
|| Bool -> Effect -> Bool
disqualify Bool
durable Effect
eff2
      disqualify Bool
durable (IK.OrEffect Effect
eff1 Effect
eff2) =
        Bool -> Effect -> Bool
disqualify Bool
durable Effect
eff1 Bool -> Bool -> Bool
|| Bool -> Effect -> Bool
disqualify Bool
durable Effect
eff2
      disqualify Bool
durable (IK.SeqEffect [Effect]
effs) = (Effect -> Bool) -> [Effect] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (Bool -> Effect -> Bool
disqualify Bool
durable) [Effect]
effs
      disqualify Bool
durable (IK.When Condition
_ Effect
eff) = Bool -> Effect -> Bool
disqualify Bool
durable Effect
eff
      disqualify Bool
durable (IK.Unless Condition
_ Effect
eff) = Bool -> Effect -> Bool
disqualify Bool
durable Effect
eff
      disqualify Bool
durable (IK.IfThenElse Condition
_ Effect
eff1 Effect
eff2) =
        Bool -> Effect -> Bool
disqualify Bool
durable Effect
eff1 Bool -> Bool -> Bool
|| Bool -> Effect -> Bool
disqualify Bool
durable Effect
eff2
      disqualify Bool
_ Effect
_ = Bool
False
      q :: (Benefit, CStore, ItemId, ItemFull, ItemQuant) -> Bool
q (Benefit{Bool
benInEqp :: Bool
benInEqp :: Benefit -> Bool
benInEqp}, CStore
cstore, ItemId
_, itemFull :: ItemFull
itemFull@ItemFull{ItemKind
itemKind :: ItemKind
itemKind :: ItemFull -> ItemKind
itemKind}, ItemQuant
kit) =
        let arItem :: AspectRecord
arItem = ItemFull -> AspectRecord
aspectRecordFull ItemFull
itemFull
            durable :: Bool
durable = Flag -> AspectRecord -> Bool
IA.checkFlag Flag
Durable AspectRecord
arItem
        in (Bool -> Bool
not Bool
benInEqp  -- can't wear, so OK to break
            Bool -> Bool -> Bool
|| Bool
durable  -- can wear, but can't break, even better
            Bool -> Bool -> Bool
|| Bool -> Bool
not (Flag -> AspectRecord -> Bool
IA.checkFlag Flag
Ability.Meleeable AspectRecord
arItem)
                 -- anything else expendable
               Bool -> Bool -> Bool
&& ItemFull -> Bool
hind ItemFull
itemFull)  -- hinders now, so possibly often, so away!
           Bool -> Bool -> Bool
&& Maybe CStore -> ItemFull -> ItemQuant -> Bool
permittedActor (CStore -> Maybe CStore
forall a. a -> Maybe a
Just CStore
cstore) ItemFull
itemFull ItemQuant
kit
           Bool -> Bool -> Bool
&& Bool -> Bool
not ((Effect -> Bool) -> [Effect] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (Bool -> Effect -> Bool
disqualify Bool
durable) ([Effect] -> Bool) -> [Effect] -> Bool
forall a b. (a -> b) -> a -> b
$ ItemKind -> [Effect]
IK.ieffects ItemKind
itemKind)
           Bool -> Bool -> Bool
&& (Bool
canEsc Bool -> Bool -> Bool
|| Bool -> Bool
not (ItemKind -> Bool
IA.isHumanTrinket ItemKind
itemKind))
                -- A hack to prevent monsters from using up treasure
                -- meant for heroes.
      stores :: [CStore]
stores = [CStore
CStash, CStore
CGround, CStore
COrgan] [CStore] -> [CStore] -> [CStore]
forall a. [a] -> [a] -> [a]
++ [CStore
CEqp | Bool
calmE]
  DiscoveryBenefit
discoBenefit <- (StateClient -> DiscoveryBenefit) -> m DiscoveryBenefit
forall (m :: * -> *) a.
MonadClientRead m =>
(StateClient -> a) -> m a
getsClient StateClient -> DiscoveryBenefit
sdiscoBenefit
  [(Benefit, CStore, ItemId, ItemFull, ItemQuant)]
benList <- (State -> [(Benefit, CStore, ItemId, ItemFull, ItemQuant)])
-> m [(Benefit, CStore, ItemId, ItemFull, ItemQuant)]
forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
getsState ((State -> [(Benefit, CStore, ItemId, ItemFull, ItemQuant)])
 -> m [(Benefit, CStore, ItemId, ItemFull, ItemQuant)])
-> (State -> [(Benefit, CStore, ItemId, ItemFull, ItemQuant)])
-> m [(Benefit, CStore, ItemId, ItemFull, ItemQuant)]
forall a b. (a -> b) -> a -> b
$ DiscoveryBenefit
-> ActorId
-> [CStore]
-> State
-> [(Benefit, CStore, ItemId, ItemFull, ItemQuant)]
benAvailableItems DiscoveryBenefit
discoBenefit ActorId
aid [CStore]
stores
  ItemId -> ItemKind
getKind <- (State -> ItemId -> ItemKind) -> m (ItemId -> ItemKind)
forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
getsState ((State -> ItemId -> ItemKind) -> m (ItemId -> ItemKind))
-> (State -> ItemId -> ItemKind) -> m (ItemId -> ItemKind)
forall a b. (a -> b) -> a -> b
$ (ItemId -> State -> ItemKind) -> State -> ItemId -> ItemKind
forall a b c. (a -> b -> c) -> b -> a -> c
flip ItemId -> State -> ItemKind
getIidKind
  let ([GroupName ItemKind]
myBadGrps, [GroupName ItemKind]
myGoodGrps) = [Either (GroupName ItemKind) (GroupName ItemKind)]
-> ([GroupName ItemKind], [GroupName ItemKind])
forall a b. [Either a b] -> ([a], [b])
partitionEithers ([Either (GroupName ItemKind) (GroupName ItemKind)]
 -> ([GroupName ItemKind], [GroupName ItemKind]))
-> [Either (GroupName ItemKind) (GroupName ItemKind)]
-> ([GroupName ItemKind], [GroupName ItemKind])
forall a b. (a -> b) -> a -> b
$ (ItemId
 -> Maybe (Either (GroupName ItemKind) (GroupName ItemKind)))
-> [ItemId] -> [Either (GroupName ItemKind) (GroupName ItemKind)]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe (\ItemId
iid ->
        let itemKind :: ItemKind
itemKind = ItemId -> ItemKind
getKind ItemId
iid
        in if Bool -> (Int -> Bool) -> Maybe Int -> Bool
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Bool
False (Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
0) (Maybe Int -> Bool) -> Maybe Int -> Bool
forall a b. (a -> b) -> a -> b
$ GroupName ItemKind -> [(GroupName ItemKind, Int)] -> Maybe Int
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup GroupName ItemKind
IK.CONDITION ([(GroupName ItemKind, Int)] -> Maybe Int)
-> [(GroupName ItemKind, Int)] -> Maybe Int
forall a b. (a -> b) -> a -> b
$ ItemKind -> [(GroupName ItemKind, Int)]
IK.ifreq ItemKind
itemKind
           then Either (GroupName ItemKind) (GroupName ItemKind)
-> Maybe (Either (GroupName ItemKind) (GroupName ItemKind))
forall a. a -> Maybe a
Just (Either (GroupName ItemKind) (GroupName ItemKind)
 -> Maybe (Either (GroupName ItemKind) (GroupName ItemKind)))
-> Either (GroupName ItemKind) (GroupName ItemKind)
-> Maybe (Either (GroupName ItemKind) (GroupName ItemKind))
forall a b. (a -> b) -> a -> b
$ if Benefit -> Bool
benInEqp (DiscoveryBenefit
discoBenefit DiscoveryBenefit -> ItemId -> Benefit
forall k a. Enum k => EnumMap k a -> k -> a
EM.! ItemId
iid)
                       then GroupName ItemKind
-> Either (GroupName ItemKind) (GroupName ItemKind)
forall a b. b -> Either a b
Right (GroupName ItemKind
 -> Either (GroupName ItemKind) (GroupName ItemKind))
-> GroupName ItemKind
-> Either (GroupName ItemKind) (GroupName ItemKind)
forall a b. (a -> b) -> a -> b
$ Text -> GroupName ItemKind
forall c. Text -> GroupName c
DefsInternal.GroupName (Text -> GroupName ItemKind) -> Text -> GroupName ItemKind
forall a b. (a -> b) -> a -> b
$ ItemKind -> Text
IK.iname ItemKind
itemKind
                         -- conveniently, @iname@ matches @ifreq@
                       else GroupName ItemKind
-> Either (GroupName ItemKind) (GroupName ItemKind)
forall a b. a -> Either a b
Left (GroupName ItemKind
 -> Either (GroupName ItemKind) (GroupName ItemKind))
-> GroupName ItemKind
-> Either (GroupName ItemKind) (GroupName ItemKind)
forall a b. (a -> b) -> a -> b
$ Text -> GroupName ItemKind
forall c. Text -> GroupName c
DefsInternal.GroupName (Text -> GroupName ItemKind) -> Text -> GroupName ItemKind
forall a b. (a -> b) -> a -> b
$ ItemKind -> Text
IK.iname ItemKind
itemKind
           else Maybe (Either (GroupName ItemKind) (GroupName ItemKind))
forall a. Maybe a
Nothing) (ItemBag -> [ItemId]
forall k a. Enum k => EnumMap k a -> [k]
EM.keys (ItemBag -> [ItemId]) -> ItemBag -> [ItemId]
forall a b. (a -> b) -> a -> b
$ Actor -> ItemBag
borgan Actor
b)
      fTool :: (Benefit, CStore, ItemId, ItemFull, ItemQuant)
-> Maybe (Int, RequestTimed)
fTool benAv :: (Benefit, CStore, ItemId, ItemFull, ItemQuant)
benAv@( Benefit{Double
benApply :: Benefit -> Double
benApply :: Double
benApply}, CStore
cstore, ItemId
iid
                  , itemFull :: ItemFull
itemFull@ItemFull{ItemKind
itemKind :: ItemKind
itemKind :: ItemFull -> ItemKind
itemKind}, ItemQuant
_ ) =
        let dropsGrps :: [GroupName ItemKind]
dropsGrps = ItemKind -> [GroupName ItemKind]
IK.getDropOrgans ItemKind
itemKind  -- @Impress@ effect included
            dropsBadOrgans :: Bool
dropsBadOrgans =
              Bool -> Bool
not ([GroupName ItemKind] -> Bool
forall a. [a] -> Bool
null [GroupName ItemKind]
myBadGrps)
              Bool -> Bool -> Bool
&& (GroupName ItemKind
IK.CONDITION GroupName ItemKind -> [GroupName ItemKind] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [GroupName ItemKind]
dropsGrps
                  Bool -> Bool -> Bool
|| Bool -> Bool
not ([GroupName ItemKind] -> Bool
forall a. [a] -> Bool
null ([GroupName ItemKind]
dropsGrps [GroupName ItemKind]
-> [GroupName ItemKind] -> [GroupName ItemKind]
forall a. Eq a => [a] -> [a] -> [a]
`intersect` [GroupName ItemKind]
myBadGrps)))
            dropsImpressed :: Bool
dropsImpressed =
              GroupName ItemKind
IK.S_IMPRESSED GroupName ItemKind -> [GroupName ItemKind] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [GroupName ItemKind]
myBadGrps
              Bool -> Bool -> Bool
&& (GroupName ItemKind
IK.CONDITION GroupName ItemKind -> [GroupName ItemKind] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [GroupName ItemKind]
dropsGrps
                  Bool -> Bool -> Bool
|| GroupName ItemKind
IK.S_IMPRESSED GroupName ItemKind -> [GroupName ItemKind] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [GroupName ItemKind]
dropsGrps)
            dropsGoodOrgans :: Bool
dropsGoodOrgans =
              Bool -> Bool
not ([GroupName ItemKind] -> Bool
forall a. [a] -> Bool
null [GroupName ItemKind]
myGoodGrps)
              Bool -> Bool -> Bool
&& (GroupName ItemKind
IK.CONDITION GroupName ItemKind -> [GroupName ItemKind] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [GroupName ItemKind]
dropsGrps
                  Bool -> Bool -> Bool
|| Bool -> Bool
not ([GroupName ItemKind] -> Bool
forall a. [a] -> Bool
null ([GroupName ItemKind]
dropsGrps [GroupName ItemKind]
-> [GroupName ItemKind] -> [GroupName ItemKind]
forall a. Eq a => [a] -> [a] -> [a]
`intersect` [GroupName ItemKind]
myGoodGrps)))
            wastesDrop :: Bool
wastesDrop = Bool -> Bool
not Bool
dropsBadOrgans Bool -> Bool -> Bool
&& Bool -> Bool
not ([GroupName ItemKind] -> Bool
forall a. [a] -> Bool
null [GroupName ItemKind]
dropsGrps)
            -- Don't include @Ascend@ nor @Teleport@, because maybe no foe near.
            -- Don't include @AtMostOneOf@ nor @OneOf@ because
            -- other effects may kill you.
            getHP :: Effect -> Int
getHP (IK.RefillHP Int
p) = Int -> Int -> Int
forall a. Ord a => a -> a -> a
max Int
0 Int
p
            getHP (IK.OnUser Effect
eff) = Effect -> Int
getHP Effect
eff
            getHP (IK.AndEffect Effect
eff1 Effect
eff2) = Effect -> Int
getHP Effect
eff1 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Effect -> Int
getHP Effect
eff2
            getHP (IK.OrEffect Effect
eff1 Effect
_) = Effect -> Int
getHP Effect
eff1
            getHP (IK.SeqEffect [Effect]
effs) = [Int] -> Int
forall a. Num a => [a] -> a
sum ([Int] -> Int) -> [Int] -> Int
forall a b. (a -> b) -> a -> b
$ (Effect -> Int) -> [Effect] -> [Int]
forall a b. (a -> b) -> [a] -> [b]
map Effect -> Int
getHP [Effect]
effs
            getHP (IK.When Condition
_ Effect
eff) = Effect -> Int
getHP Effect
eff
            getHP (IK.Unless Condition
_ Effect
eff) = Effect -> Int
getHP Effect
eff
            getHP (IK.IfThenElse Condition
_ Effect
eff1 Effect
eff2) = Effect -> Int
getHP Effect
eff1 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Effect -> Int
getHP Effect
eff2
            getHP Effect
_ = Int
0
            healPower :: Int
healPower = [Int] -> Int
forall a. Num a => [a] -> a
sum ([Int] -> Int) -> [Int] -> Int
forall a b. (a -> b) -> a -> b
$ (Effect -> Int) -> [Effect] -> [Int]
forall a b. (a -> b) -> [a] -> [b]
map Effect -> Int
getHP ([Effect] -> [Int]) -> [Effect] -> [Int]
forall a b. (a -> b) -> a -> b
$ ItemKind -> [Effect]
IK.ieffects ItemKind
itemKind
            wastesHP :: Bool
wastesHP = Int -> Int64
xM Int
healPower
                       Int64 -> Int64 -> Bool
forall a. Ord a => a -> a -> Bool
> Int -> Int64
xM (Skill -> Skills -> Int
Ability.getSk Skill
Ability.SkMaxHP Skills
actorSk) Int64 -> Int64 -> Int64
forall a. Num a => a -> a -> a
- Actor -> Int64
bhp Actor
b
            durable :: Bool
durable = Flag -> AspectRecord -> Bool
IA.checkFlag Flag
Durable (AspectRecord -> Bool) -> AspectRecord -> Bool
forall a b. (a -> b) -> a -> b
$ ItemFull -> AspectRecord
aspectRecordFull ItemFull
itemFull
            situationalBenApply :: Double
situationalBenApply =
              if | Bool
dropsBadOrgans -> if Bool
dropsImpressed
                                     then Double
benApply Double -> Double -> Double
forall a. Num a => a -> a -> a
+ Double
1000  -- crucial
                                     else Double
benApply Double -> Double -> Double
forall a. Num a => a -> a -> a
+ Double
20
                 | Bool
wastesDrop Bool -> Bool -> Bool
|| Bool
wastesHP -> Double
benApply Double -> Double -> Double
forall a. Num a => a -> a -> a
- Double
10
                 | Bool
otherwise -> Double
benApply
            coeff :: CStore -> Int
coeff CStore
CGround = Int
2  -- pickup turn saved
            coeff CStore
COrgan = if Bool
durable then Int
1 else Int
1000
              -- if not durable, must hinder currently or be very potent
            coeff CStore
CEqp = if Bool
durable then Int
1 else Int
1000
            coeff CStore
CStash = Int
1
            benR :: Int
benR = Double -> Int
forall a b. (RealFrac a, Integral b) => a -> b
ceiling Double
situationalBenApply Int -> Int -> Int
forall a. Num a => a -> a -> a
* CStore -> Int
coeff CStore
cstore
            canApply :: Bool
canApply =
              Double
situationalBenApply Double -> Double -> Bool
forall a. Ord a => a -> a -> Bool
> Double
0
              Bool -> Bool -> Bool
&& (Bool
dropsImpressed Bool -> Bool -> Bool
|| Bool -> Bool
not Bool
wastesHP)
                -- waste healing only if it drops impressed;
                -- otherwise apply anything beneficial at will
              Bool -> Bool -> Bool
&& case ApplyItemGroup
applyGroup of
                ApplyItemGroup
ApplyFirstAid -> (Benefit, CStore, ItemId, ItemFull, ItemQuant) -> Bool
q (Benefit, CStore, ItemId, ItemFull, ItemQuant)
benAv Bool -> Bool -> Bool
&& (Int
healPower Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
0 Bool -> Bool -> Bool
|| Bool
dropsImpressed)
                  -- when low HP, Calm easy to deplete, so impressed crucial
                ApplyItemGroup
ApplyAll -> (Benefit, CStore, ItemId, ItemFull, ItemQuant) -> Bool
q (Benefit, CStore, ItemId, ItemFull, ItemQuant)
benAv Bool -> Bool -> Bool
&& Bool -> Bool
not Bool
dropsGoodOrgans
                  -- not an emergency, so don't sacrifice own good conditions
        in if Bool
canApply
           then (Int, RequestTimed) -> Maybe (Int, RequestTimed)
forall a. a -> Maybe a
Just (Int
benR, ItemId -> CStore -> RequestTimed
ReqApply ItemId
iid CStore
cstore)
           else Maybe (Int, RequestTimed)
forall a. Maybe a
Nothing
      benTool :: [(Int, RequestTimed)]
benTool = ((Benefit, CStore, ItemId, ItemFull, ItemQuant)
 -> Maybe (Int, RequestTimed))
-> [(Benefit, CStore, ItemId, ItemFull, ItemQuant)]
-> [(Int, RequestTimed)]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe (Benefit, CStore, ItemId, ItemFull, ItemQuant)
-> Maybe (Int, RequestTimed)
fTool [(Benefit, CStore, ItemId, ItemFull, ItemQuant)]
benList
  Strategy RequestTimed -> m (Strategy RequestTimed)
forall (m :: * -> *) a. Monad m => a -> m a
return (Strategy RequestTimed -> m (Strategy RequestTimed))
-> Strategy RequestTimed -> m (Strategy RequestTimed)
forall a b. (a -> b) -> a -> b
$! Frequency RequestTimed -> Strategy RequestTimed
forall a. Frequency a -> Strategy a
liftFrequency (Frequency RequestTimed -> Strategy RequestTimed)
-> Frequency RequestTimed -> Strategy RequestTimed
forall a b. (a -> b) -> a -> b
$ Text -> [(Int, RequestTimed)] -> Frequency RequestTimed
forall a. Text -> [(Int, a)] -> Frequency a
toFreq Text
"applyItem" [(Int, RequestTimed)]
benTool

-- If low on health or alone, flee in panic, close to the path to target
-- and as far from the attackers, as possible. Usually fleeing from
-- foes will lead towards friends, but we don't insist on that.
flee :: MonadClient m
     => Ability.Skills -> ActorId -> Bool -> [(Int, Point)]
     -> m (Strategy RequestTimed)
flee :: Skills
-> ActorId -> Bool -> [(Int, Point)] -> m (Strategy RequestTimed)
flee Skills
actorSk ActorId
aid Bool
avoidAmbient [(Int, Point)]
fleeL = do
  COps{TileSpeedup
coTileSpeedup :: TileSpeedup
coTileSpeedup :: COps -> TileSpeedup
coTileSpeedup} <- (State -> COps) -> m COps
forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
getsState State -> COps
scops
  Actor
b <- (State -> Actor) -> m Actor
forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
getsState ((State -> Actor) -> m Actor) -> (State -> Actor) -> m Actor
forall a b. (a -> b) -> a -> b
$ ActorId -> State -> Actor
getActorBody ActorId
aid
  Time
localTime <- (State -> Time) -> m Time
forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
getsState ((State -> Time) -> m Time) -> (State -> Time) -> m Time
forall a b. (a -> b) -> a -> b
$ LevelId -> State -> Time
getLocalTime (Actor -> LevelId
blid Actor
b)
  EnumMap ActorId (Point, Time)
fleeD <- (StateClient -> EnumMap ActorId (Point, Time))
-> m (EnumMap ActorId (Point, Time))
forall (m :: * -> *) a.
MonadClientRead m =>
(StateClient -> a) -> m a
getsClient StateClient -> EnumMap ActorId (Point, Time)
sfleeD
  let recentlyFled :: Bool
recentlyFled = Bool -> ((Point, Time) -> Bool) -> Maybe (Point, Time) -> Bool
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Bool
False (\(Point
_, Time
time) -> Time -> Time -> Bool
timeRecent5 Time
localTime Time
time)
                           (ActorId
aid ActorId -> EnumMap ActorId (Point, Time) -> Maybe (Point, Time)
forall k a. Enum k => k -> EnumMap k a -> Maybe a
`EM.lookup` EnumMap ActorId (Point, Time)
fleeD)
  -- Regardless if fleeing accomplished, mark the need, but don't forget
  -- the location of initial danger, in case enemies not seen any more,
  -- if not too old.
  Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless Bool
recentlyFled (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$
    (StateClient -> StateClient) -> m ()
forall (m :: * -> *).
MonadClient m =>
(StateClient -> StateClient) -> m ()
modifyClient ((StateClient -> StateClient) -> m ())
-> (StateClient -> StateClient) -> m ()
forall a b. (a -> b) -> a -> b
$ \StateClient
cli ->
      StateClient
cli {sfleeD :: EnumMap ActorId (Point, Time)
sfleeD = ActorId
-> (Point, Time)
-> EnumMap ActorId (Point, Time)
-> EnumMap ActorId (Point, Time)
forall k a. Enum k => k -> a -> EnumMap k a -> EnumMap k a
EM.insert ActorId
aid (Actor -> Point
bpos Actor
b, Time
localTime) (StateClient -> EnumMap ActorId (Point, Time)
sfleeD StateClient
cli)}
  Level
lvl <- LevelId -> m Level
forall (m :: * -> *). MonadStateRead m => LevelId -> m Level
getLevel (LevelId -> m Level) -> LevelId -> m Level
forall a b. (a -> b) -> a -> b
$ Actor -> LevelId
blid Actor
b
  let isAmbient :: Point -> Bool
isAmbient Point
pos = TileSpeedup -> ContentId TileKind -> Bool
Tile.isLit TileSpeedup
coTileSpeedup (Level
lvl Level -> Point -> ContentId TileKind
`at` Point
pos)
                      Bool -> Bool -> Bool
&& TileSpeedup -> ContentId TileKind -> Bool
Tile.isWalkable TileSpeedup
coTileSpeedup (Level
lvl Level -> Point -> ContentId TileKind
`at` Point
pos)
                        -- if solid, will be altered and perhaps darkened
      fleeAmbientAvoided :: [(Int, Point)]
fleeAmbientAvoided = ((Int, Point) -> Bool) -> [(Int, Point)] -> [(Int, Point)]
forall a. (a -> Bool) -> [a] -> [a]
filter (Bool -> Bool
not (Bool -> Bool) -> ((Int, Point) -> Bool) -> (Int, Point) -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Point -> Bool
isAmbient (Point -> Bool) -> ((Int, Point) -> Point) -> (Int, Point) -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Int, Point) -> Point
forall a b. (a, b) -> b
snd) [(Int, Point)]
fleeL
      fleeAmbient :: [(Int, Point)]
fleeAmbient = if Bool
avoidAmbient Bool -> Bool -> Bool
&& Bool -> Bool
not ([(Int, Point)] -> Bool
forall a. [a] -> Bool
null [(Int, Point)]
fleeAmbientAvoided)
                    then [(Int, Point)]
fleeAmbientAvoided
                    else [(Int, Point)]
fleeL
  let vVic :: [(Int, Vector)]
vVic = ((Int, Point) -> (Int, Vector))
-> [(Int, Point)] -> [(Int, Vector)]
forall a b. (a -> b) -> [a] -> [b]
map ((Point -> Vector) -> (Int, Point) -> (Int, Vector)
forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> a (d, b) (d, c)
second (Point -> Point -> Vector
`vectorToFrom` Actor -> Point
bpos Actor
b)) [(Int, Point)]
fleeAmbient
      str :: Strategy Vector
str = Frequency Vector -> Strategy Vector
forall a. Frequency a -> Strategy a
liftFrequency (Frequency Vector -> Strategy Vector)
-> Frequency Vector -> Strategy Vector
forall a b. (a -> b) -> a -> b
$ Text -> [(Int, Vector)] -> Frequency Vector
forall a. Text -> [(Int, a)] -> Frequency a
toFreq Text
"flee" [(Int, Vector)]
vVic
  (Vector -> m (Maybe RequestTimed))
-> Strategy Vector -> m (Strategy RequestTimed)
forall (m :: * -> *) a b.
Monad m =>
(a -> m (Maybe b)) -> Strategy a -> m (Strategy b)
mapStrategyM (Skills -> ActorId -> Vector -> m (Maybe RequestTimed)
forall (m :: * -> *).
MonadClientRead m =>
Skills -> ActorId -> Vector -> m (Maybe RequestTimed)
moveOrRunAid Skills
actorSk ActorId
aid) Strategy Vector
str

-- The result of all these conditions is that AI displaces rarely,
-- but it can't be helped as long as the enemy is smart enough to form fronts.
displaceFoe :: MonadClientRead m => ActorId -> m (Strategy RequestTimed)
displaceFoe :: ActorId -> m (Strategy RequestTimed)
displaceFoe ActorId
aid = do
  COps{TileSpeedup
coTileSpeedup :: TileSpeedup
coTileSpeedup :: COps -> TileSpeedup
coTileSpeedup} <- (State -> COps) -> m COps
forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
getsState State -> COps
scops
  Actor
b <- (State -> Actor) -> m Actor
forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
getsState ((State -> Actor) -> m Actor) -> (State -> Actor) -> m Actor
forall a b. (a -> b) -> a -> b
$ ActorId -> State -> Actor
getActorBody ActorId
aid
  Level
lvl <- LevelId -> m Level
forall (m :: * -> *). MonadStateRead m => LevelId -> m Level
getLevel (LevelId -> m Level) -> LevelId -> m Level
forall a b. (a -> b) -> a -> b
$ Actor -> LevelId
blid Actor
b
  Faction
fact <- (State -> Faction) -> m Faction
forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
getsState ((State -> Faction) -> m Faction)
-> (State -> Faction) -> m Faction
forall a b. (a -> b) -> a -> b
$ (EnumMap FactionId Faction -> FactionId -> Faction
forall k a. Enum k => EnumMap k a -> k -> a
EM.! Actor -> FactionId
bfid Actor
b) (EnumMap FactionId Faction -> Faction)
-> (State -> EnumMap FactionId Faction) -> State -> Faction
forall b c a. (b -> c) -> (a -> b) -> a -> c
. State -> EnumMap FactionId Faction
sfactionD
  [Actor]
friends <- (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]
friendRegularList (Actor -> FactionId
bfid Actor
b) (Actor -> LevelId
blid Actor
b)
  [(ActorId, Actor)]
adjBigAssocs <- (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
$ Actor -> State -> [(ActorId, Actor)]
adjacentBigAssocs Actor
b
  let foe :: (ActorId, Actor) -> Bool
foe (ActorId
_, Actor
b2) = FactionId -> Faction -> FactionId -> Bool
isFoe (Actor -> FactionId
bfid Actor
b) Faction
fact (Actor -> FactionId
bfid Actor
b2)
      adjFoes :: [(ActorId, Actor)]
adjFoes = ((ActorId, Actor) -> Bool)
-> [(ActorId, Actor)] -> [(ActorId, Actor)]
forall a. (a -> Bool) -> [a] -> [a]
filter (ActorId, Actor) -> Bool
foe [(ActorId, Actor)]
adjBigAssocs
      walkable :: Point -> Bool
walkable Point
p =  -- DisplaceAccess
        TileSpeedup -> ContentId TileKind -> Bool
Tile.isWalkable TileSpeedup
coTileSpeedup (Level
lvl Level -> Point -> ContentId TileKind
`at` Point
p)
      nFriends :: Actor -> Int
nFriends Actor
body = [Actor] -> Int
forall a. [a] -> Int
length ([Actor] -> Int) -> [Actor] -> Int
forall a b. (a -> b) -> a -> b
$ (Actor -> Bool) -> [Actor] -> [Actor]
forall a. (a -> Bool) -> [a] -> [a]
filter (Point -> Point -> Bool
adjacent (Actor -> Point
bpos Actor
body) (Point -> Bool) -> (Actor -> Point) -> Actor -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Actor -> Point
bpos) [Actor]
friends
      nFrNew :: Int
nFrNew = Actor -> Int
nFriends Actor
b Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1
      qualifyActor :: (ActorId, Actor) -> m (Maybe (Int, RequestTimed))
qualifyActor (ActorId
aid2, Actor
b2) = do
        case Point -> Level -> [ActorId]
posToAidsLvl (Actor -> Point
bpos Actor
b2) Level
lvl of
          [ActorId]
_ | Bool -> Bool
not (Point -> Bool
walkable (Actor -> Point
bpos Actor
b2))  -- DisplaceAccess
              Bool -> Bool -> Bool
|| Actor -> Maybe Point
boldpos Actor
b Maybe Point -> Maybe Point -> Bool
forall a. Eq a => a -> a -> Bool
== Point -> Maybe Point
forall a. a -> Maybe a
Just (Actor -> Point
bpos Actor
b2)
                 Bool -> Bool -> Bool
&& Actor -> Maybe Point
boldpos Actor
b2 Maybe Point -> Maybe Point -> Bool
forall a. Eq a => a -> a -> Bool
== Point -> Maybe Point
forall a. a -> Maybe a
Just (Actor -> Point
bpos Actor
b) ->  -- avoid short loops
              Maybe (Int, RequestTimed) -> m (Maybe (Int, RequestTimed))
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe (Int, RequestTimed)
forall a. Maybe a
Nothing
          [ActorId
_] -> do
            Skills
actorMaxSk <- (State -> Skills) -> m Skills
forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
getsState ((State -> Skills) -> m Skills) -> (State -> Skills) -> m Skills
forall a b. (a -> b) -> a -> b
$ ActorId -> State -> Skills
getActorMaxSkills ActorId
aid2
            Bool
dEnemy <- (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 -> ActorId -> Skills -> State -> Bool
dispEnemy ActorId
aid ActorId
aid2 Skills
actorMaxSk
              -- DisplaceDying, DisplaceBraced, DisplaceImmobile,
              -- DisplaceSupported
            let nFrOld :: Int
nFrOld = Actor -> Int
nFriends Actor
b2
            Maybe (Int, RequestTimed) -> m (Maybe (Int, RequestTimed))
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe (Int, RequestTimed) -> m (Maybe (Int, RequestTimed)))
-> Maybe (Int, RequestTimed) -> m (Maybe (Int, RequestTimed))
forall a b. (a -> b) -> a -> b
$! if Bool
dEnemy Bool -> Bool -> Bool
&& Int
nFrOld Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
nFrNew
                      then (Int, RequestTimed) -> Maybe (Int, RequestTimed)
forall a. a -> Maybe a
Just ( (Int
nFrNew Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
nFrOld) Int -> Int -> Int
forall a b. (Num a, Integral b) => a -> b -> a
^ (Int
2 :: Int)
                                , ActorId -> RequestTimed
ReqDisplace ActorId
aid2 )
                      else Maybe (Int, RequestTimed)
forall a. Maybe a
Nothing
          [ActorId]
_ -> Maybe (Int, RequestTimed) -> m (Maybe (Int, RequestTimed))
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe (Int, RequestTimed)
forall a. Maybe a
Nothing  -- DisplaceProjectiles
  [Maybe (Int, RequestTimed)]
foes <- ((ActorId, Actor) -> m (Maybe (Int, RequestTimed)))
-> [(ActorId, Actor)] -> m [Maybe (Int, RequestTimed)]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (ActorId, Actor) -> m (Maybe (Int, RequestTimed))
qualifyActor [(ActorId, Actor)]
adjFoes
  Strategy RequestTimed -> m (Strategy RequestTimed)
forall (m :: * -> *) a. Monad m => a -> m a
return (Strategy RequestTimed -> m (Strategy RequestTimed))
-> Strategy RequestTimed -> m (Strategy RequestTimed)
forall a b. (a -> b) -> a -> b
$! Frequency RequestTimed -> Strategy RequestTimed
forall a. Frequency a -> Strategy a
liftFrequency (Frequency RequestTimed -> Strategy RequestTimed)
-> Frequency RequestTimed -> Strategy RequestTimed
forall a b. (a -> b) -> a -> b
$ Text -> [(Int, RequestTimed)] -> Frequency RequestTimed
forall a. Text -> [(Int, a)] -> Frequency a
toFreq Text
"displaceFoe" ([(Int, RequestTimed)] -> Frequency RequestTimed)
-> [(Int, RequestTimed)] -> Frequency RequestTimed
forall a b. (a -> b) -> a -> b
$ [Maybe (Int, RequestTimed)] -> [(Int, RequestTimed)]
forall a. [Maybe a] -> [a]
catMaybes [Maybe (Int, RequestTimed)]
foes

displaceBlocker :: MonadClientRead m => ActorId -> Bool -> m (Strategy RequestTimed)
displaceBlocker :: ActorId -> Bool -> m (Strategy RequestTimed)
displaceBlocker ActorId
aid Bool
retry = do
  Actor
b <- (State -> Actor) -> m Actor
forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
getsState ((State -> Actor) -> m Actor) -> (State -> Actor) -> m Actor
forall a b. (a -> b) -> a -> b
$ ActorId -> State -> Actor
getActorBody ActorId
aid
  Maybe TgtAndPath
mtgtMPath <- (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
aid (EnumMap ActorId TgtAndPath -> Maybe TgtAndPath)
-> (StateClient -> EnumMap ActorId TgtAndPath)
-> StateClient
-> Maybe TgtAndPath
forall b c a. (b -> c) -> (a -> b) -> a -> c
. StateClient -> EnumMap ActorId TgtAndPath
stargetD
  case Maybe TgtAndPath
mtgtMPath of
    Just TgtAndPath{ tapTgt :: TgtAndPath -> Target
tapTgt=TEnemy{}
                   , tapPath :: TgtAndPath -> Maybe AndPath
tapPath=Just AndPath{pathList :: AndPath -> [Point]
pathList=Point
q : [Point]
_, Point
pathGoal :: Point
pathGoal :: AndPath -> Point
pathGoal} }
      | Point
q Point -> Point -> Bool
forall a. Eq a => a -> a -> Bool
== Point
pathGoal  -- not a real blocker but goal; only try to displace
                       -- if desperate (that is, already tried to melee it)
        Bool -> Bool -> Bool
&& Bool -> Bool
not Bool
retry ->
        Strategy RequestTimed -> m (Strategy RequestTimed)
forall (m :: * -> *) a. Monad m => a -> m a
return Strategy RequestTimed
forall a. Strategy a
reject
    Just TgtAndPath{tapPath :: TgtAndPath -> Maybe AndPath
tapPath=Just AndPath{pathList :: AndPath -> [Point]
pathList=Point
q : [Point]
_}}
      | Point -> Point -> Bool
adjacent (Actor -> Point
bpos Actor
b) Point
q ->  -- not veered off target too much
        ActorId -> Point -> Bool -> m (Strategy RequestTimed)
forall (m :: * -> *).
MonadClientRead m =>
ActorId -> Point -> Bool -> m (Strategy RequestTimed)
displaceTgt ActorId
aid Point
q Bool
retry
    Maybe TgtAndPath
_ -> Strategy RequestTimed -> m (Strategy RequestTimed)
forall (m :: * -> *) a. Monad m => a -> m a
return Strategy RequestTimed
forall a. Strategy a
reject  -- goal reached

displaceTgt :: MonadClientRead m
            => ActorId -> Point -> Bool -> m (Strategy RequestTimed)
displaceTgt :: ActorId -> Point -> Bool -> m (Strategy RequestTimed)
displaceTgt ActorId
source Point
tpos Bool
retry = do
  COps{TileSpeedup
coTileSpeedup :: TileSpeedup
coTileSpeedup :: COps -> TileSpeedup
coTileSpeedup} <- (State -> COps) -> m COps
forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
getsState State -> COps
scops
  Actor
b <- (State -> Actor) -> m Actor
forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
getsState ((State -> Actor) -> m Actor) -> (State -> Actor) -> m Actor
forall a b. (a -> b) -> a -> b
$ ActorId -> State -> Actor
getActorBody ActorId
source
  ActorMaxSkills
actorMaxSkills <- (State -> ActorMaxSkills) -> m ActorMaxSkills
forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
getsState State -> ActorMaxSkills
sactorMaxSkills
  let !_A :: ()
_A = Bool -> () -> ()
forall a. (?callStack::CallStack) => Bool -> a -> a
assert (Point -> Point -> Bool
adjacent (Actor -> Point
bpos Actor
b) Point
tpos) ()
  Level
lvl <- LevelId -> m Level
forall (m :: * -> *). MonadStateRead m => LevelId -> m Level
getLevel (LevelId -> m Level) -> LevelId -> m Level
forall a b. (a -> b) -> a -> b
$ Actor -> LevelId
blid Actor
b
  let walkable :: Point -> Bool
walkable Point
p =  -- DisplaceAccess
        TileSpeedup -> ContentId TileKind -> Bool
Tile.isWalkable TileSpeedup
coTileSpeedup (Level
lvl Level -> Point -> ContentId TileKind
`at` Point
p)
  case Point -> Level -> [ActorId]
posToAidsLvl Point
tpos Level
lvl of
    [ActorId]
_ | Bool -> Bool
not (Point -> Bool
walkable Point
tpos) -> Strategy RequestTimed -> m (Strategy RequestTimed)
forall (m :: * -> *) a. Monad m => a -> m a
return Strategy RequestTimed
forall a. Strategy a
reject  -- DisplaceAccess
    [ActorId
aid2] -> do
      Actor
b2 <- (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
aid2
      Maybe ActorId
mleader <- (StateClient -> Maybe ActorId) -> m (Maybe ActorId)
forall (m :: * -> *) a.
MonadClientRead m =>
(StateClient -> a) -> m a
getsClient StateClient -> Maybe ActorId
sleader
      if | Actor -> Watchfulness
bwatch Actor
b2 Watchfulness -> [Watchfulness] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Watchfulness
WSleep, Watchfulness
WWake] ->
             Strategy RequestTimed -> m (Strategy RequestTimed)
forall (m :: * -> *) a. Monad m => a -> m a
return (Strategy RequestTimed -> m (Strategy RequestTimed))
-> Strategy RequestTimed -> m (Strategy RequestTimed)
forall a b. (a -> b) -> a -> b
$! Text -> RequestTimed -> Strategy RequestTimed
forall a. Text -> a -> Strategy a
returN Text
"displace sleeping" (RequestTimed -> Strategy RequestTimed)
-> RequestTimed -> Strategy RequestTimed
forall a b. (a -> b) -> a -> b
$ ActorId -> RequestTimed
ReqDisplace ActorId
aid2
         | ActorId -> Maybe ActorId
forall a. a -> Maybe a
Just ActorId
aid2 Maybe ActorId -> Maybe ActorId -> Bool
forall a. Eq a => a -> a -> Bool
== Maybe ActorId
mleader -> Strategy RequestTimed -> m (Strategy RequestTimed)
forall (m :: * -> *) a. Monad m => a -> m a
return Strategy RequestTimed
forall a. Strategy a
reject
         | Actor -> Maybe Point
boldpos Actor
b Maybe Point -> Maybe Point -> Bool
forall a. Eq a => a -> a -> Bool
== Point -> Maybe Point
forall a. a -> Maybe a
Just Point
tpos
           Bool -> Bool -> Bool
&& Actor -> Maybe Point
boldpos Actor
b2 Maybe Point -> Maybe Point -> Bool
forall a. Eq a => a -> a -> Bool
== Point -> Maybe Point
forall a. a -> Maybe a
Just (Actor -> Point
bpos Actor
b) ->
             Strategy RequestTimed -> m (Strategy RequestTimed)
forall (m :: * -> *) a. Monad m => a -> m a
return Strategy RequestTimed
forall a. Strategy a
reject  -- avoid short loops
         | Bool
otherwise -> do
           Faction
tfact <- (State -> Faction) -> m Faction
forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
getsState ((State -> Faction) -> m Faction)
-> (State -> Faction) -> m Faction
forall a b. (a -> b) -> a -> b
$ (EnumMap FactionId Faction -> FactionId -> Faction
forall k a. Enum k => EnumMap k a -> k -> a
EM.! Actor -> FactionId
bfid Actor
b2) (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
           Maybe TgtAndPath
mtgtMPath <- (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
aid2 (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
enemyTgt <- ActorId -> m Bool
forall (m :: * -> *). MonadClientRead m => ActorId -> m Bool
condAimEnemyOrRememberedM ActorId
source
           Bool
enemyTgt2 <- ActorId -> m Bool
forall (m :: * -> *). MonadClientRead m => ActorId -> m Bool
condAimEnemyOrRememberedM ActorId
aid2
           case Maybe TgtAndPath
mtgtMPath of
             -- I can see targets of only own team, so no check of @bfid@.
             Just TgtAndPath{tapPath :: TgtAndPath -> Maybe AndPath
tapPath=Just AndPath{pathList :: AndPath -> [Point]
pathList=Point
q : [Point]
_}}
               | Point
q Point -> Point -> Bool
forall a. Eq a => a -> a -> Bool
== Actor -> Point
bpos Actor
b ->  -- teammate wants to swap
                 Strategy RequestTimed -> m (Strategy RequestTimed)
forall (m :: * -> *) a. Monad m => a -> m a
return (Strategy RequestTimed -> m (Strategy RequestTimed))
-> Strategy RequestTimed -> m (Strategy RequestTimed)
forall a b. (a -> b) -> a -> b
$! Text -> RequestTimed -> Strategy RequestTimed
forall a. Text -> a -> Strategy a
returN Text
"displace mutual" (RequestTimed -> Strategy RequestTimed)
-> RequestTimed -> Strategy RequestTimed
forall a b. (a -> b) -> a -> b
$ ActorId -> RequestTimed
ReqDisplace ActorId
aid2
             Just TgtAndPath
_ -> Strategy RequestTimed -> m (Strategy RequestTimed)
forall (m :: * -> *) a. Monad m => a -> m a
return (Strategy RequestTimed -> m (Strategy RequestTimed))
-> Strategy RequestTimed -> m (Strategy RequestTimed)
forall a b. (a -> b) -> a -> b
$!
               -- Teammate, possibly without path, for whatever reason.
               if Bool
retry  -- me desperate
                  Bool -> Bool -> Bool
|| (LevelId, Point) -> Maybe (LevelId, Point)
forall a. a -> Maybe a
Just (Actor -> LevelId
blid Actor
b2, Actor -> Point
bpos Actor
b2) Maybe (LevelId, Point) -> Maybe (LevelId, Point) -> Bool
forall a. Eq a => a -> a -> Bool
== Faction -> Maybe (LevelId, Point)
gstash Faction
tfact  -- guarding; lazy
                  Bool -> Bool -> Bool
|| Skill -> Skills -> Int
getSk Skill
SkDisplace (ActorMaxSkills
actorMaxSkills ActorMaxSkills -> ActorId -> Skills
forall k a. Enum k => EnumMap k a -> k -> a
EM.! ActorId
aid2) Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
0
                       -- can't displace back
                  Bool -> Bool -> Bool
|| Bool
enemyTgt Bool -> Bool -> Bool
&& Bool -> Bool
not Bool
enemyTgt2
                       -- he doesn't have Enemy target and I have, so push him
                       -- aside, because, for heroes, he will never be a leader,
                       -- so he can't step aside himself
               then Text -> RequestTimed -> Strategy RequestTimed
forall a. Text -> a -> Strategy a
returN Text
"displace teammate" (RequestTimed -> Strategy RequestTimed)
-> RequestTimed -> Strategy RequestTimed
forall a b. (a -> b) -> a -> b
$ ActorId -> RequestTimed
ReqDisplace ActorId
aid2
               else Strategy RequestTimed
forall a. Strategy a
reject
             Maybe TgtAndPath
_ -> do  -- an enemy or ally or disoriented teammate
               Skills
actorMaxSk <- (State -> Skills) -> m Skills
forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
getsState ((State -> Skills) -> m Skills) -> (State -> Skills) -> m Skills
forall a b. (a -> b) -> a -> b
$ ActorId -> State -> Skills
getActorMaxSkills ActorId
aid2
               Bool
dEnemy <- (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 -> ActorId -> Skills -> State -> Bool
dispEnemy ActorId
source ActorId
aid2 Skills
actorMaxSk
                 -- DisplaceDying, DisplaceBraced, DisplaceImmobile,
                 -- DisplaceSupported
               Strategy RequestTimed -> m (Strategy RequestTimed)
forall (m :: * -> *) a. Monad m => a -> m a
return (Strategy RequestTimed -> m (Strategy RequestTimed))
-> Strategy RequestTimed -> m (Strategy RequestTimed)
forall a b. (a -> b) -> a -> b
$!
                 if Actor -> FactionId
bfid Actor
b FactionId -> FactionId -> Bool
forall a. Eq a => a -> a -> Bool
== Actor -> FactionId
bfid Actor
b2  -- disoriented teammate; doesn't care
                    Bool -> Bool -> Bool
|| FactionId -> Faction -> FactionId -> Bool
isFoe (Actor -> FactionId
bfid Actor
b2) Faction
tfact (Actor -> FactionId
bfid Actor
b) Bool -> Bool -> Bool
&& Bool
dEnemy  -- foe
                    Bool -> Bool -> Bool
|| Bool
retry  -- ally, I need to be desperate, as above
                 then Text -> RequestTimed -> Strategy RequestTimed
forall a. Text -> a -> Strategy a
returN Text
"displace other" (RequestTimed -> Strategy RequestTimed)
-> RequestTimed -> Strategy RequestTimed
forall a b. (a -> b) -> a -> b
$ ActorId -> RequestTimed
ReqDisplace ActorId
aid2
                 else Strategy RequestTimed
forall a. Strategy a
reject
    [ActorId]
_ -> Strategy RequestTimed -> m (Strategy RequestTimed)
forall (m :: * -> *) a. Monad m => a -> m a
return Strategy RequestTimed
forall a. Strategy a
reject  -- DisplaceProjectiles and no blocker at all

chase :: MonadClientRead m
      => Ability.Skills -> ActorId -> Bool -> Bool -> m (Strategy RequestTimed)
chase :: Skills -> ActorId -> Bool -> Bool -> m (Strategy RequestTimed)
chase Skills
actorSk ActorId
aid Bool
avoidAmbient Bool
retry = do
  Actor
body <- (State -> Actor) -> m Actor
forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
getsState ((State -> Actor) -> m Actor) -> (State -> Actor) -> m Actor
forall a b. (a -> b) -> a -> b
$ ActorId -> State -> Actor
getActorBody ActorId
aid
  Faction
fact <- (State -> Faction) -> m Faction
forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
getsState ((State -> Faction) -> m Faction)
-> (State -> Faction) -> m Faction
forall a b. (a -> b) -> a -> b
$ (EnumMap FactionId Faction -> FactionId -> Faction
forall k a. Enum k => EnumMap k a -> k -> a
EM.! Actor -> FactionId
bfid Actor
body) (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
  Maybe TgtAndPath
mtgtMPath <- (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
aid (EnumMap ActorId TgtAndPath -> Maybe TgtAndPath)
-> (StateClient -> EnumMap ActorId TgtAndPath)
-> StateClient
-> Maybe TgtAndPath
forall b c a. (b -> c) -> (a -> b) -> a -> c
. StateClient -> EnumMap ActorId TgtAndPath
stargetD
  let -- With no leader, the goal is vague, so permit arbitrary detours.
      relaxed :: Bool
relaxed = Bool -> Bool
not (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$ FactionKind -> Bool
fhasPointman (Faction -> FactionKind
gkind Faction
fact)
      strAmbient :: Bool -> m (Strategy Vector)
strAmbient Bool
avoid = case Maybe TgtAndPath
mtgtMPath of
        Just TgtAndPath{tapPath :: TgtAndPath -> Maybe AndPath
tapPath=Just AndPath{pathList :: AndPath -> [Point]
pathList=Point
q : [Point]
_, Int
Point
pathLen :: AndPath -> Int
pathSource :: AndPath -> Point
pathLen :: Int
pathGoal :: Point
pathSource :: Point
pathGoal :: AndPath -> Point
..}} ->
          if Point
pathGoal Point -> Point -> Bool
forall a. Eq a => a -> a -> Bool
== Actor -> Point
bpos Actor
body
          then Strategy Vector -> m (Strategy Vector)
forall (m :: * -> *) a. Monad m => a -> m a
return Strategy Vector
forall a. Strategy a
reject  -- done; picking up items, etc.
          else Skills
-> ActorId -> Bool -> Point -> Point -> Bool -> m (Strategy Vector)
forall (m :: * -> *).
MonadClientRead m =>
Skills
-> ActorId -> Bool -> Point -> Point -> Bool -> m (Strategy Vector)
moveTowards Skills
actorSk ActorId
aid Bool
avoid Point
q Point
pathGoal (Bool
relaxed Bool -> Bool -> Bool
|| Bool
retry)
        Maybe TgtAndPath
_ -> Strategy Vector -> m (Strategy Vector)
forall (m :: * -> *) a. Monad m => a -> m a
return Strategy Vector
forall a. Strategy a
reject  -- goal reached or banned ambient lit tile
  Strategy Vector
strAvoided <- Bool -> m (Strategy Vector)
strAmbient Bool
avoidAmbient
  Strategy Vector
str <- if Bool
avoidAmbient Bool -> Bool -> Bool
&& Strategy Vector -> Bool
forall a. Strategy a -> Bool
nullStrategy Strategy Vector
strAvoided
         then Bool -> m (Strategy Vector)
strAmbient Bool
False
         else Strategy Vector -> m (Strategy Vector)
forall (m :: * -> *) a. Monad m => a -> m a
return Strategy Vector
strAvoided
  (Vector -> m (Maybe RequestTimed))
-> Strategy Vector -> m (Strategy RequestTimed)
forall (m :: * -> *) a b.
Monad m =>
(a -> m (Maybe b)) -> Strategy a -> m (Strategy b)
mapStrategyM (Skills -> ActorId -> Vector -> m (Maybe RequestTimed)
forall (m :: * -> *).
MonadClientRead m =>
Skills -> ActorId -> Vector -> m (Maybe RequestTimed)
moveOrRunAid Skills
actorSk ActorId
aid) Strategy Vector
str

moveTowards :: MonadClientRead m
            => Ability.Skills -> ActorId -> Bool -> Point -> Point -> Bool
            -> m (Strategy Vector)
moveTowards :: Skills
-> ActorId -> Bool -> Point -> Point -> Bool -> m (Strategy Vector)
moveTowards Skills
actorSk ActorId
aid Bool
avoidAmbient Point
target Point
goal Bool
relaxed = do
  COps{TileSpeedup
coTileSpeedup :: TileSpeedup
coTileSpeedup :: COps -> TileSpeedup
coTileSpeedup} <- (State -> COps) -> m COps
forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
getsState State -> COps
scops
  Actor
b <- (State -> Actor) -> m Actor
forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
getsState ((State -> Actor) -> m Actor) -> (State -> Actor) -> m Actor
forall a b. (a -> b) -> a -> b
$ ActorId -> State -> Actor
getActorBody ActorId
aid
  Level
lvl <- LevelId -> m Level
forall (m :: * -> *). MonadStateRead m => LevelId -> m Level
getLevel (LevelId -> m Level) -> LevelId -> m Level
forall a b. (a -> b) -> a -> b
$ Actor -> LevelId
blid Actor
b
  let source :: Point
source = Actor -> Point
bpos Actor
b
      alterSkill :: Int
alterSkill = Skill -> Skills -> Int
getSk Skill
SkAlter Skills
actorSk
      !_A :: ()
_A = Bool -> () -> ()
forall a. (?callStack::CallStack) => Bool -> a -> a
assert (Point -> Point -> Bool
adjacent Point
source Point
target
                    Bool -> (Point, Point, ActorId, Actor, Point) -> Bool
forall a. Show a => Bool -> a -> Bool
`blame` (Point
source, Point
target, ActorId
aid, Actor
b, Point
goal)) ()
  Faction
fact <- (State -> Faction) -> m Faction
forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
getsState ((State -> Faction) -> m Faction)
-> (State -> Faction) -> m Faction
forall a b. (a -> b) -> a -> b
$ (EnumMap FactionId Faction -> FactionId -> Faction
forall k a. Enum k => EnumMap k a -> k -> a
EM.! Actor -> FactionId
bfid Actor
b) (EnumMap FactionId Faction -> Faction)
-> (State -> EnumMap FactionId Faction) -> State -> Faction
forall b c a. (b -> c) -> (a -> b) -> a -> c
. State -> EnumMap FactionId Faction
sfactionD
  AlterLid
salter <- (StateClient -> AlterLid) -> m AlterLid
forall (m :: * -> *) a.
MonadClientRead m =>
(StateClient -> a) -> m a
getsClient StateClient -> AlterLid
salter
  Point -> Bool
noFriends <- (State -> Point -> Bool) -> m (Point -> Bool)
forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
getsState ((State -> Point -> Bool) -> m (Point -> Bool))
-> (State -> Point -> Bool) -> m (Point -> Bool)
forall a b. (a -> b) -> a -> b
$ \State
s Point
p ->
    ((ActorId, Actor) -> Bool) -> [(ActorId, Actor)] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all (FactionId -> Faction -> FactionId -> Bool
isFoe (Actor -> FactionId
bfid Actor
b) Faction
fact (FactionId -> Bool)
-> ((ActorId, Actor) -> FactionId) -> (ActorId, Actor) -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Actor -> FactionId
bfid (Actor -> FactionId)
-> ((ActorId, Actor) -> Actor) -> (ActorId, Actor) -> FactionId
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ActorId, Actor) -> Actor
forall a b. (a, b) -> b
snd)
        (Point -> LevelId -> State -> [(ActorId, Actor)]
posToAidAssocs Point
p (Actor -> LevelId
blid Actor
b) State
s)  -- don't kill own projectiles
  let lalter :: Array Word8
lalter = AlterLid
salter AlterLid -> LevelId -> Array Word8
forall k a. Enum k => EnumMap k a -> k -> a
EM.! Actor -> LevelId
blid Actor
b
      isAmbient :: Point -> Bool
isAmbient Point
pos = TileSpeedup -> ContentId TileKind -> Bool
Tile.isLit TileSpeedup
coTileSpeedup (Level
lvl Level -> Point -> ContentId TileKind
`at` Point
pos)
                      Bool -> Bool -> Bool
&& TileSpeedup -> ContentId TileKind -> Bool
Tile.isWalkable TileSpeedup
coTileSpeedup (Level
lvl Level -> Point -> ContentId TileKind
`at` Point
pos)
                        -- if solid, will be altered and perhaps darkened
      -- Only actors with SkAlter can search for hidden doors, etc.
      enterableHere :: Point -> Bool
enterableHere Point
p = Int
alterSkill Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Word8 -> Int
forall a. Enum a => a -> Int
fromEnum (Array Word8
lalter Array Word8 -> Point -> Word8
forall c. UnboxRepClass c => Array c -> Point -> c
PointArray.! Point
p)
      permittedHere :: Point -> Bool
permittedHere Point
p | Bool
avoidAmbient = Point -> Bool
enterableHere Point
p Bool -> Bool -> Bool
&& Bool -> Bool
not (Point -> Bool
isAmbient Point
p)
                      | Bool
otherwise = Point -> Bool
enterableHere Point
p
  -- If target is the final goal, is not occupied and is lit, permit
  -- movement into lit position, regardless.
  if Point -> Bool
noFriends Point
target Bool -> Bool -> Bool
&& (Point
target Point -> Point -> Bool
forall a. Eq a => a -> a -> Bool
== Point
goal Bool -> Bool -> Bool
&& Point -> Bool
enterableHere Point
target
                          Bool -> Bool -> Bool
|| Point -> Bool
permittedHere Point
target) then
    Strategy Vector -> m (Strategy Vector)
forall (m :: * -> *) a. Monad m => a -> m a
return (Strategy Vector -> m (Strategy Vector))
-> Strategy Vector -> m (Strategy Vector)
forall a b. (a -> b) -> a -> b
$! Text -> Vector -> Strategy Vector
forall a. Text -> a -> Strategy a
returN Text
"moveTowards target" (Vector -> Strategy Vector) -> Vector -> Strategy Vector
forall a b. (a -> b) -> a -> b
$ Point
target Point -> Point -> Vector
`vectorToFrom` Point
source
  else do
    -- This lets animals mill around, even when blocked,
    -- because they have nothing to lose (unless other animals melee).
    -- Blocked heroes instead don't become leaders and don't move
    -- until friends sidestep to let them reach their goal.
    let goesBack :: Point -> Bool
goesBack Point
p = Point -> Maybe Point
forall a. a -> Maybe a
Just Point
p Maybe Point -> Maybe Point -> Bool
forall a. Eq a => a -> a -> Bool
== Actor -> Maybe Point
boldpos Actor
b
        nonincreasing :: Point -> Bool
nonincreasing Point
p = Point -> Point -> Int
chessDist Point
source Point
goal Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Point -> Point -> Int
chessDist Point
p Point
goal
        isSensible :: Point -> Bool
isSensible | Bool
relaxed = \Point
p -> Point -> Bool
noFriends Point
p
                                     Bool -> Bool -> Bool
&& Point -> Bool
permittedHere Point
p
                   | Bool
otherwise = \Point
p -> Point -> Bool
nonincreasing Point
p
                                       Bool -> Bool -> Bool
&& Bool -> Bool
not (Point -> Bool
goesBack Point
p)
                                       Bool -> Bool -> Bool
&& Point -> Bool
noFriends Point
p
                                       Bool -> Bool -> Bool
&& Point -> Bool
permittedHere Point
p
        sensible :: [((Bool, Int), Vector)]
sensible = [ ((Point -> Bool
goesBack Point
p, Point -> Point -> Int
chessDist Point
p Point
goal), Vector
v)
                   | Vector
v <- [Vector]
moves
                   , let p :: Point
p = Point
source Point -> Vector -> Point
`shift` Vector
v
                   , Point -> Bool
isSensible Point
p ]
        -- @SortOn@ less efficient here, because function cheap.
        sorted :: [((Bool, Int), Vector)]
sorted = (((Bool, Int), Vector) -> ((Bool, Int), Vector) -> Ordering)
-> [((Bool, Int), Vector)] -> [((Bool, Int), Vector)]
forall a. (a -> a -> Ordering) -> [a] -> [a]
sortBy ((((Bool, Int), Vector) -> (Bool, Int))
-> ((Bool, Int), Vector) -> ((Bool, Int), Vector) -> Ordering
forall a b. Ord a => (b -> a) -> b -> b -> Ordering
comparing ((Bool, Int), Vector) -> (Bool, Int)
forall a b. (a, b) -> a
fst) [((Bool, Int), Vector)]
sensible
        groups :: [[Vector]]
groups = ([((Bool, Int), Vector)] -> [Vector])
-> [[((Bool, Int), Vector)]] -> [[Vector]]
forall a b. (a -> b) -> [a] -> [b]
map ((((Bool, Int), Vector) -> Vector)
-> [((Bool, Int), Vector)] -> [Vector]
forall a b. (a -> b) -> [a] -> [b]
map ((Bool, Int), Vector) -> Vector
forall a b. (a, b) -> b
snd) ([[((Bool, Int), Vector)]] -> [[Vector]])
-> [[((Bool, Int), Vector)]] -> [[Vector]]
forall a b. (a -> b) -> a -> b
$ (((Bool, Int), Vector) -> ((Bool, Int), Vector) -> Bool)
-> [((Bool, Int), Vector)] -> [[((Bool, Int), Vector)]]
forall a. (a -> a -> Bool) -> [a] -> [[a]]
groupBy ((Bool, Int) -> (Bool, Int) -> Bool
forall a. Eq a => a -> a -> Bool
(==) ((Bool, Int) -> (Bool, Int) -> Bool)
-> (((Bool, Int), Vector) -> (Bool, Int))
-> ((Bool, Int), Vector)
-> ((Bool, Int), Vector)
-> Bool
forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
`on` ((Bool, Int), Vector) -> (Bool, Int)
forall a b. (a, b) -> a
fst) [((Bool, Int), Vector)]
sorted
        freqs :: [Strategy Vector]
freqs = ([Vector] -> Strategy Vector) -> [[Vector]] -> [Strategy Vector]
forall a b. (a -> b) -> [a] -> [b]
map (Frequency Vector -> Strategy Vector
forall a. Frequency a -> Strategy a
liftFrequency (Frequency Vector -> Strategy Vector)
-> ([Vector] -> Frequency Vector) -> [Vector] -> Strategy Vector
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> [Vector] -> Frequency Vector
forall a. Text -> [a] -> Frequency a
uniformFreq Text
"moveTowards") [[Vector]]
groups
    Strategy Vector -> m (Strategy Vector)
forall (m :: * -> *) a. Monad m => a -> m a
return (Strategy Vector -> m (Strategy Vector))
-> Strategy Vector -> m (Strategy Vector)
forall a b. (a -> b) -> a -> b
$! (Strategy Vector -> Strategy Vector -> Strategy Vector)
-> Strategy Vector -> [Strategy Vector] -> Strategy Vector
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr Strategy Vector -> Strategy Vector -> Strategy Vector
forall a. Strategy a -> Strategy a -> Strategy a
(.|) Strategy Vector
forall a. Strategy a
reject [Strategy Vector]
freqs

-- Actor moves or searches or alters or attacks.
-- This function is very general, even though it's often used in contexts
-- when only one or two of the many cases can possibly occur.
moveOrRunAid :: MonadClientRead m
             => Ability.Skills -> ActorId -> Vector -> m (Maybe RequestTimed)
moveOrRunAid :: Skills -> ActorId -> Vector -> m (Maybe RequestTimed)
moveOrRunAid Skills
actorSk ActorId
source Vector
dir = do
  COps{TileSpeedup
coTileSpeedup :: TileSpeedup
coTileSpeedup :: COps -> TileSpeedup
coTileSpeedup} <- (State -> COps) -> m COps
forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
getsState State -> COps
scops
  Actor
sb <- (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
source
  let lid :: LevelId
lid = Actor -> LevelId
blid Actor
sb
  Level
lvl <- LevelId -> m Level
forall (m :: * -> *). MonadStateRead m => LevelId -> m Level
getLevel LevelId
lid
  let walkable :: Bool
walkable =  -- DisplaceAccess
        TileSpeedup -> ContentId TileKind -> Bool
Tile.isWalkable TileSpeedup
coTileSpeedup (Level
lvl Level -> Point -> ContentId TileKind
`at` Point
tpos)
      notLooping :: Actor -> Point -> Bool
notLooping Actor
body Point
p =  -- avoid displace loops
        Actor -> Maybe Point
boldpos Actor
body Maybe Point -> Maybe Point -> Bool
forall a. Eq a => a -> a -> Bool
/= Point -> Maybe Point
forall a. a -> Maybe a
Just Point
p Bool -> Bool -> Bool
|| Actor -> Bool
actorWaits Actor
body
      spos :: Point
spos = Actor -> Point
bpos Actor
sb           -- source position
      tpos :: Point
tpos = Point
spos Point -> Vector -> Point
`shift` Vector
dir  -- target position
      t :: ContentId TileKind
t = Level
lvl Level -> Point -> ContentId TileKind
`at` Point
tpos
  -- We start by checking actors at the target position,
  -- which gives a partial information (actors can be invisible),
  -- as opposed to accessibility (and items) which are always accurate
  -- (tiles can't be invisible).
  case Point -> Level -> [ActorId]
posToAidsLvl Point
tpos Level
lvl of
    [ActorId
target] | Bool
walkable
               Bool -> Bool -> Bool
&& Skill -> Skills -> Int
getSk Skill
SkDisplace Skills
actorSk Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
0
               Bool -> Bool -> Bool
&& Actor -> Point -> Bool
notLooping Actor
sb Point
tpos -> do
      -- @target@ can be a foe, as well as a friend.
      Actor
tb <- (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
target
      Faction
tfact <- (State -> Faction) -> m Faction
forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
getsState ((State -> Faction) -> m Faction)
-> (State -> Faction) -> m Faction
forall a b. (a -> b) -> a -> b
$ (EnumMap FactionId Faction -> FactionId -> Faction
forall k a. Enum k => EnumMap k a -> k -> a
EM.! Actor -> FactionId
bfid Actor
tb) (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
      Skills
actorMaxSk <- (State -> Skills) -> m Skills
forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
getsState ((State -> Skills) -> m Skills) -> (State -> Skills) -> m Skills
forall a b. (a -> b) -> a -> b
$ ActorId -> State -> Skills
getActorMaxSkills ActorId
target
      Bool
dEnemy <- (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 -> ActorId -> Skills -> State -> Bool
dispEnemy ActorId
source ActorId
target Skills
actorMaxSk
        -- DisplaceDying, DisplaceBraced, DisplaceImmobile, DisplaceSupported
      if FactionId -> Faction -> FactionId -> Bool
isFoe (Actor -> FactionId
bfid Actor
tb) Faction
tfact (Actor -> FactionId
bfid Actor
sb) Bool -> Bool -> Bool
&& Bool -> Bool
not Bool
dEnemy
      then Maybe RequestTimed -> m (Maybe RequestTimed)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe RequestTimed
forall a. Maybe a
Nothing
      else Maybe RequestTimed -> m (Maybe RequestTimed)
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe RequestTimed -> m (Maybe RequestTimed))
-> Maybe RequestTimed -> m (Maybe RequestTimed)
forall a b. (a -> b) -> a -> b
$ RequestTimed -> Maybe RequestTimed
forall a. a -> Maybe a
Just (RequestTimed -> Maybe RequestTimed)
-> RequestTimed -> Maybe RequestTimed
forall a b. (a -> b) -> a -> b
$ ActorId -> RequestTimed
ReqDisplace ActorId
target
    [] | Bool
walkable Bool -> Bool -> Bool
&& Skill -> Skills -> Int
getSk Skill
SkMove Skills
actorSk Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
0 ->
      -- Movement requires full access. The potential invisible actor is hit.
      Maybe RequestTimed -> m (Maybe RequestTimed)
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe RequestTimed -> m (Maybe RequestTimed))
-> Maybe RequestTimed -> m (Maybe RequestTimed)
forall a b. (a -> b) -> a -> b
$ RequestTimed -> Maybe RequestTimed
forall a. a -> Maybe a
Just (RequestTimed -> Maybe RequestTimed)
-> RequestTimed -> Maybe RequestTimed
forall a b. (a -> b) -> a -> b
$ Vector -> RequestTimed
ReqMove Vector
dir
    [] | Bool -> Bool
not Bool
walkable
         Bool -> Bool -> Bool
&& Skill -> Skills -> Int
getSk Skill
SkAlter Skills
actorSk
              Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= TileSpeedup -> ContentId TileKind -> Int
Tile.alterMinWalk TileSpeedup
coTileSpeedup ContentId TileKind
t  -- AlterUnwalked
         -- Only possible if items allowed inside unwalkable tiles:
         Bool -> Bool -> Bool
&& Point -> EnumMap Point ItemBag -> Bool
forall k a. Enum k => k -> EnumMap k a -> Bool
EM.notMember Point
tpos (Level -> EnumMap Point ItemBag
lfloor Level
lvl) ->  -- AlterBlockItem
      -- Not walkable, but alter skill suffices, so search or alter the tile.
      -- We assume that unalterable unwalkable tiles are protected by high
      -- skill req. We don't alter walkable tiles (e.g., to close doors).
      Maybe RequestTimed -> m (Maybe RequestTimed)
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe RequestTimed -> m (Maybe RequestTimed))
-> Maybe RequestTimed -> m (Maybe RequestTimed)
forall a b. (a -> b) -> a -> b
$ RequestTimed -> Maybe RequestTimed
forall a. a -> Maybe a
Just (RequestTimed -> Maybe RequestTimed)
-> RequestTimed -> Maybe RequestTimed
forall a b. (a -> b) -> a -> b
$ Point -> RequestTimed
ReqAlter Point
tpos
    [ActorId]
_ -> Maybe RequestTimed -> m (Maybe RequestTimed)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe RequestTimed
forall a. Maybe a
Nothing  -- can't displace, move nor alter