-- | 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 qualified Game.LambdaHack.Content.ItemKind as IK
import           Game.LambdaHack.Content.ModeKind
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

-- | Pick the most desirable AI ation for the actor.
pickAction :: MonadClient m => ActorId -> Bool -> m RequestTimed
{-# INLINE pickAction #-}
pickAction :: ActorId -> Bool -> m RequestTimed
pickAction aid :: ActorId
aid retry :: 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` "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` "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)) ()
  -- Reset fleeing flag. May then be set in @flee@.
  Strategy RequestTimed
stratAction <- ActorId -> Bool -> m (Strategy RequestTimed)
forall (m :: * -> *).
MonadClient m =>
ActorId -> Bool -> m (Strategy RequestTimed)
actionStrategy 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` "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 :: forall m. MonadClient m
               => ActorId -> Bool -> m (Strategy RequestTimed)
{-# INLINE actionStrategy #-}
actionStrategy :: ActorId -> Bool -> m (Strategy RequestTimed)
actionStrategy aid :: ActorId
aid retry :: Bool
retry = do
  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
  Bool
condInMelee <- LevelId -> m Bool
forall (m :: * -> *). MonadClient m => LevelId -> m Bool
condInMeleeM (LevelId -> m Bool) -> LevelId -> m Bool
forall a b. (a -> b) -> a -> b
$ Actor -> LevelId
blid Actor
body
  Bool
condAimEnemyPresent <- ActorId -> m Bool
forall (m :: * -> *). MonadClient m => ActorId -> m Bool
condAimEnemyPresentM ActorId
aid
  Bool
condAimEnemyNoMelee <- ActorId -> m Bool
forall (m :: * -> *). MonadClient m => ActorId -> m Bool
condAimEnemyNoMeleeM ActorId
aid
  Bool
condAimEnemyRemembered <- ActorId -> m Bool
forall (m :: * -> *). MonadClient m => ActorId -> m Bool
condAimEnemyRememberedM ActorId
aid
  Bool
condAimNonEnemyPresent <- ActorId -> m Bool
forall (m :: * -> *). MonadClient m => ActorId -> m Bool
condAimNonEnemyPresentM ActorId
aid
  Bool
condAimCrucial <- ActorId -> m Bool
forall (m :: * -> *). MonadClient m => ActorId -> m Bool
condAimCrucialM ActorId
aid
  Bool
condAnyFoeAdj <- ActorId -> m Bool
forall (m :: * -> *). MonadStateRead m => ActorId -> m Bool
condAnyFoeAdjM ActorId
aid
  [(Int, (ActorId, Actor))]
threatDistL <- (State -> [(Int, (ActorId, Actor))]) -> m [(Int, (ActorId, Actor))]
forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
getsState ((State -> [(Int, (ActorId, Actor))])
 -> m [(Int, (ActorId, Actor))])
-> (State -> [(Int, (ActorId, Actor))])
-> m [(Int, (ActorId, Actor))]
forall a b. (a -> b) -> a -> b
$ ActorId -> State -> [(Int, (ActorId, Actor))]
meleeThreatDistList ActorId
aid
  (fleeL :: [(Int, Point)]
fleeL, badVic :: [(Int, Point)]
badVic) <- ActorId -> m ([(Int, Point)], [(Int, Point)])
forall (m :: * -> *).
MonadClient m =>
ActorId -> m ([(Int, Point)], [(Int, Point)])
fleeList ActorId
aid
  (StateClient -> StateClient) -> m ()
forall (m :: * -> *).
MonadClient m =>
(StateClient -> StateClient) -> m ()
modifyClient ((StateClient -> StateClient) -> m ())
-> (StateClient -> StateClient) -> m ()
forall a b. (a -> b) -> a -> b
$ \cli :: StateClient
cli -> StateClient
cli {sfleeD :: EnumMap ActorId Point
sfleeD = ActorId -> EnumMap ActorId Point -> EnumMap ActorId Point
forall k a. Enum k => k -> EnumMap k a -> EnumMap k a
EM.delete ActorId
aid (StateClient -> EnumMap ActorId Point
sfleeD StateClient
cli)}
  Bool
condSupport1 <- Int -> ActorId -> m Bool
forall (m :: * -> *). MonadClient m => Int -> ActorId -> m Bool
condSupport 1 ActorId
aid
  Bool
condSupport3 <- Int -> ActorId -> m Bool
forall (m :: * -> *). MonadClient m => Int -> ActorId -> m Bool
condSupport 3 ActorId
aid
  Bool
condSolo <- ActorId -> m Bool
forall (m :: * -> *). MonadClient m => ActorId -> m Bool
condSoloM ActorId
aid  -- solo fighters aggresive
  [Point]
canDeAmbientL <- (State -> [Point]) -> m [Point]
forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
getsState ((State -> [Point]) -> m [Point])
-> (State -> [Point]) -> m [Point]
forall a b. (a -> b) -> a -> b
$ Actor -> State -> [Point]
canDeAmbientList Actor
body
  Skills
actorSk <- ActorId -> m Skills
forall (m :: * -> *). MonadClientRead m => ActorId -> m Skills
currentSkillsClient ActorId
aid
  Bool
condCanProject <- Int -> ActorId -> m Bool
forall (m :: * -> *). MonadClient m => Int -> ActorId -> m Bool
condCanProjectM (Skill -> Skills -> Int
getSk Skill
SkProject Skills
actorSk) ActorId
aid
  Bool
condAdjTriggerable <- ActorId -> m Bool
forall (m :: * -> *). MonadClient m => ActorId -> m Bool
condAdjTriggerableM ActorId
aid
  Bool
condBlocksFriends <- ActorId -> m Bool
forall (m :: * -> *). MonadClient 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 :: * -> *). MonadClient m => ActorId -> m Bool
condDesirableFloorItemM ActorId
aid
  Bool
condTgtNonmovingEnemy <- ActorId -> m Bool
forall (m :: * -> *). MonadClient 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
  ActorMaxSkills
actorMaxSkills <- (State -> ActorMaxSkills) -> m ActorMaxSkills
forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
getsState State -> ActorMaxSkills
sactorMaxSkills
  [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
body) (Actor -> LevelId
blid Actor
body)
  let anyFriendOnLevelAwake :: Bool
anyFriendOnLevelAwake = (Actor -> Bool) -> [Actor] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (\b :: Actor
b ->
        Actor -> Watchfulness
bwatch Actor
b Watchfulness -> Watchfulness -> Bool
forall a. Eq a => a -> a -> Bool
/= Watchfulness
WSleep Bool -> Bool -> Bool
&& Actor -> Point
bpos Actor
b Point -> Point -> Bool
forall a. Eq a => a -> a -> Bool
/= Actor -> Point
bpos Actor
body) [Actor]
friends
      actorMaxSk :: Skills
actorMaxSk = ActorMaxSkills
actorMaxSkills ActorMaxSkills -> ActorId -> Skills
forall k a. Enum k => EnumMap k a -> k -> a
EM.! ActorId
aid
      prefersSleepWhenAwake :: Bool
prefersSleepWhenAwake = case Actor -> Watchfulness
bwatch Actor
body of
        WSleep -> Skill -> Skills -> Int
Ability.getSk Skill
Ability.SkMoveItem Skills
actorMaxSk Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= -10
        _ -> Skills -> Bool
prefersSleep Skills
actorMaxSk  -- nm @WWake@
      mayFallAsleep :: Bool
mayFallAsleep = Bool -> Bool
not Bool
condAimEnemyRemembered
                      Bool -> Bool -> Bool
&& Bool
mayContinueSleep
                      Bool -> Bool -> Bool
&& Skills -> Bool
canSleep Skills
actorSk
      mayContinueSleep :: Bool
mayContinueSleep = Bool -> Bool
not Bool
condAimEnemyPresent
                         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 n :: Int
n -> Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> 0
                _ -> 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 (Actor -> LevelId
blid Actor
body) 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)
      condNotCalmEnough :: Bool
condNotCalmEnough = Bool -> Bool
not (Actor -> Skills -> Bool
calmEnough Actor
body Skills
actorMaxSk)
      uneasy :: Bool
uneasy = Bool
heavilyDistressed Bool -> Bool -> Bool
|| Bool
condNotCalmEnough
      speed1_5 :: Speed
speed1_5 = Rational -> Speed -> Speed
speedScale (3Integer -> Integer -> Rational
forall a. Integral a => a -> a -> Ratio a
%2) (Skills -> Speed
gearSpeed Skills
actorMaxSk)
      -- 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)
      condThreat :: Int -> Bool
condThreat n :: Int
n = Bool -> Bool
not (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$ [(Int, (ActorId, Actor))] -> Bool
forall a. [a] -> Bool
null ([(Int, (ActorId, Actor))] -> Bool)
-> [(Int, (ActorId, Actor))] -> Bool
forall a b. (a -> b) -> a -> b
$ ((Int, (ActorId, Actor)) -> Bool)
-> [(Int, (ActorId, Actor))] -> [(Int, (ActorId, Actor))]
forall a. (a -> Bool) -> [a] -> [a]
takeWhile ((Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
n) (Int -> Bool)
-> ((Int, (ActorId, Actor)) -> Int)
-> (Int, (ActorId, Actor))
-> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Int, (ActorId, Actor)) -> Int
forall a b. (a, b) -> a
fst) [(Int, (ActorId, Actor))]
threatDistL
      threatAdj :: [(Int, (ActorId, Actor))]
threatAdj = ((Int, (ActorId, Actor)) -> Bool)
-> [(Int, (ActorId, Actor))] -> [(Int, (ActorId, Actor))]
forall a. (a -> Bool) -> [a] -> [a]
takeWhile ((Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== 1) (Int -> Bool)
-> ((Int, (ActorId, Actor)) -> Int)
-> (Int, (ActorId, Actor))
-> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Int, (ActorId, Actor)) -> Int
forall a b. (a, b) -> a
fst) [(Int, (ActorId, Actor))]
threatDistL
      condManyThreatAdj :: Bool
condManyThreatAdj = [(Int, (ActorId, Actor))] -> Int
forall a. [a] -> Int
length [(Int, (ActorId, Actor))]
threatAdj Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= 2
      condFastThreatAdj :: Bool
condFastThreatAdj =
        ((Int, (ActorId, Actor)) -> Bool)
-> [(Int, (ActorId, Actor))] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (\(_, (aid2 :: ActorId
aid2, _)) ->
              let 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
      actorShines :: Bool
actorShines = Skill -> Skills -> Int
Ability.getSk Skill
SkShine Skills
actorMaxSk Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> 0
      aCanDeLightL :: [Point]
aCanDeLightL | Bool
actorShines = []
                   | Bool
otherwise = [Point]
canDeAmbientL
      aCanDeLight :: Bool
aCanDeLight = Bool -> Bool
not (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$ [Point] -> Bool
forall a. [a] -> Bool
null [Point]
aCanDeLightL
      canFleeFromLight :: Bool
canFleeFromLight = Bool -> Bool
not (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$ [Point] -> Bool
forall a. [a] -> Bool
null ([Point] -> Bool) -> [Point] -> Bool
forall a b. (a -> b) -> a -> b
$ [Point]
aCanDeLightL [Point] -> [Point] -> [Point]
forall a. Eq a => [a] -> [a] -> [a]
`intersect` ((Int, Point) -> Point) -> [(Int, Point)] -> [Point]
forall a b. (a -> b) -> [a] -> [b]
map (Int, Point) -> Point
forall a b. (a, b) -> b
snd [(Int, Point)]
fleeL
      abInMaxSkill :: Skill -> Bool
abInMaxSkill sk :: Skill
sk = Skill -> Skills -> Int
getSk Skill
sk Skills
actorMaxSk Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> 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 scale :: Int
scale mstrat :: 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
== 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]
          , ActorId -> ApplyItemGroup -> m (Strategy RequestTimed)
forall (m :: * -> *).
MonadClient m =>
ActorId -> ApplyItemGroup -> m (Strategy RequestTimed)
applyItem ActorId
aid ApplyItemGroup
ApplyFirstAid
          , Bool -> Bool
not Bool
condAnyFoeAdj Bool -> Bool -> Bool
&& Bool
condHpTooLow)
        , ( [Skill
SkAlter]
          , ActorId -> FleeViaStairsOrEscape -> m (Strategy RequestTimed)
forall (m :: * -> *).
MonadClient 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
condAimEnemyPresent
            Bool -> Bool -> Bool
&& ((Bool
condNotCalmEnough Bool -> Bool -> Bool
|| Bool
condHpTooLow)  -- flee
                Bool -> Bool -> Bool
&& Bool
condMeleeBad Bool -> Bool -> Bool
&& Int -> Bool
condThreat 1
                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 :: * -> *).
MonadClient 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 :: * -> *).
MonadClient m =>
ActorId -> Bool -> m (Strategy RequestTimed)
pickup ActorId
aid Bool
True
          , Bool
condNoEqpWeapon  -- we assume organ weapons usually inferior
            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 :: * -> *).
MonadClient m =>
ActorId -> FleeViaStairsOrEscape -> m (Strategy RequestTimed)
trigger ActorId
aid FleeViaStairsOrEscape
ViaEscape
          , Bool
condAdjTriggerable Bool -> Bool -> Bool
&& Bool -> Bool
not Bool
condAimEnemyPresent
            Bool -> Bool -> Bool
&& Bool -> Bool
not Bool
condDesirableFloorItem )  -- collect the last loot
        , ( [Skill]
runSkills
          , ActorId -> [(Int, Point)] -> m (Strategy RequestTimed)
forall (m :: * -> *).
MonadClient m =>
ActorId -> [(Int, Point)] -> m (Strategy RequestTimed)
flee ActorId
aid [(Int, Point)]
fleeL
          , -- Flee either from melee, if our melee is bad and enemy close
            -- or from missiles, if hit and enemies are only far away,
            -- can fling at us and we can't well fling at them.
            Bool -> Bool
not Bool
condFastThreatAdj
            Bool -> Bool -> Bool
&& if | Int -> Bool
condThreat 1 ->
                    -- 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
condManyThreatAdj Bool -> Bool -> Bool
&& Bool -> Bool
not Bool
condSupport1 Bool -> Bool -> Bool
&& Bool -> Bool
not Bool
condSolo
                  | Bool -> Bool
not Bool
condInMelee
                    Bool -> Bool -> Bool
&& (Int -> Bool
condThreat 2 Bool -> Bool -> Bool
|| Int -> Bool
condThreat 5 Bool -> Bool -> Bool
&& Bool
canFleeFromLight) ->
                    -- Don't keep fleeing if just hit, because too close
                    -- to enemy to get out of his range, most likely,
                    -- and so melee him instead, unless can't melee at all.
                    Bool -> Bool
not Bool
condCanMelee
                    Bool -> Bool -> Bool
|| Bool -> Bool
not Bool
condSupport3 Bool -> Bool -> Bool
&& Bool -> Bool
not Bool
condSolo
                       Bool -> Bool -> Bool
&& Bool -> Bool
not Bool
heavilyDistressed
                  | Int -> Bool
condThreat 5
                    Bool -> Bool -> Bool
|| Bool -> Bool
not Bool
condInMelee Bool -> Bool -> Bool
&& Bool
condAimEnemyNoMelee Bool -> Bool -> Bool
&& Bool
condCanMelee ->
                    -- Too far to flee from melee, too close from ranged,
                    -- not in ambient, so no point fleeing into dark; advance.
                    -- Or the target enemy doesn't melee and melee enemies
                    -- far away, so chase him.
                    Bool
False
                  | Bool
otherwise ->
                    -- If I'm hit, they are still in range to fling at me,
                    -- even if I can't see them. And probably far away.
                    -- Too far to close in for melee; can't shoot; flee from
                    -- ranged attack and prepare ambush for later on.
                    Bool -> Bool
not Bool
condInMelee
                    Bool -> Bool -> Bool
&& Bool
heavilyDistressed
                    Bool -> Bool -> Bool
&& (Bool -> Bool
not Bool
condCanProject Bool -> Bool -> Bool
|| Bool
canFleeFromLight) )
        , ( [Skill
SkMelee]
          , ActorId -> m (Strategy RequestTimed)
forall (m :: * -> *).
MonadClient m =>
ActorId -> m (Strategy RequestTimed)
meleeBlocker ActorId
aid  -- only melee blocker
          , Bool
condAnyFoeAdj  -- if foes, don't displace, otherwise friends:
            Bool -> Bool -> Bool
|| Bool -> Bool
not (Skill -> Bool
abInMaxSkill Skill
SkDisplace)  -- displace friends, if possible
               Bool -> Bool -> Bool
&& Bool
condAimEnemyPresent )  -- excited
                    -- So 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 :: * -> *).
MonadClient 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
condAimEnemyPresent )
        , ( [Skill
SkDisplace]  -- prevents some looping movement
          , ActorId -> Bool -> m (Strategy RequestTimed)
forall (m :: * -> *).
MonadClient 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
          , ActorId -> [(Int, Point)] -> m (Strategy RequestTimed)
forall (m :: * -> *).
MonadClient m =>
ActorId -> [(Int, Point)] -> m (Strategy RequestTimed)
flee ActorId
aid [(Int, Point)]
panicFleeL  -- ultimate panic mode; open tiles, if needed
          , Bool
condAnyFoeAdj )
        ]
      -- 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.
      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 2 else 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 :: * -> *).
MonadClient 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 1
            (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 :: * -> *).
MonadClient 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 20 else 3)
              -- 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
$ ActorId -> m (Strategy RequestTimed)
forall (m :: * -> *).
MonadClient m =>
ActorId -> m (Strategy RequestTimed)
projectItem ActorId
aid  -- equivalent of @condCanProject@ called inside
          , Bool
condAimEnemyPresent Bool -> Bool -> Bool
&& Bool -> Bool
not Bool
condInMelee )
        , ( [Skill
SkApply]
          , Int -> m (Strategy RequestTimed) -> m (Frequency RequestTimed)
stratToFreq 1
            (m (Strategy RequestTimed) -> m (Frequency RequestTimed))
-> m (Strategy RequestTimed) -> m (Frequency RequestTimed)
forall a b. (a -> b) -> a -> b
$ ActorId -> ApplyItemGroup -> m (Strategy RequestTimed)
forall (m :: * -> *).
MonadClient m =>
ActorId -> ApplyItemGroup -> m (Strategy RequestTimed)
applyItem ActorId
aid ApplyItemGroup
ApplyAll  -- use any potion or scroll
          , Bool
condAimEnemyPresent Bool -> Bool -> Bool
|| Int -> Bool
condThreat 9 )  -- can affect enemies
        , ( [Skill]
runSkills
          , Int -> m (Strategy RequestTimed) -> m (Frequency RequestTimed)
stratToFreq (if | Bool
condInMelee ->
                              400  -- friends pummeled by target, go to help
                            | Bool -> Bool
not Bool
condAimEnemyPresent ->
                              2  -- if enemy only remembered investigate anyway
                            | Bool
otherwise ->
                              20)
            (m (Strategy RequestTimed) -> m (Frequency RequestTimed))
-> m (Strategy RequestTimed) -> m (Frequency RequestTimed)
forall a b. (a -> b) -> a -> b
$ ActorId -> Bool -> Bool -> m (Strategy RequestTimed)
forall (m :: * -> *).
MonadClient m =>
ActorId -> Bool -> Bool -> m (Strategy RequestTimed)
chase ActorId
aid (Bool -> Bool
not Bool
condInMelee
                         Bool -> Bool -> Bool
&& (Int -> Bool
condThreat 12 Bool -> Bool -> Bool
|| Bool
heavilyDistressed)
                         Bool -> Bool -> Bool
&& Bool
aCanDeLight) Bool
retry
          , Bool
condCanMelee
            Bool -> Bool -> Bool
&& (if Bool
condInMelee then Bool
condAimEnemyPresent
                else (Bool
condAimEnemyPresent
                      Bool -> Bool -> Bool
|| Bool
condAimEnemyRemembered
                      Bool -> Bool -> Bool
|| Bool
condAimNonEnemyPresent)
                     Bool -> Bool -> Bool
&& (Bool -> Bool
not (Int -> Bool
condThreat 2)
                         Bool -> Bool -> Bool
|| Bool
heavilyDistressed  -- if under fire, do something!
                         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 :: * -> *).
MonadClient 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 -> Bool
not Bool
dozes )
        , ( [Skill
SkMoveItem]
          , ActorId -> m (Strategy RequestTimed)
forall (m :: * -> *).
MonadClient 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 :: * -> *). MonadClient 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
          , ActorId -> Bool -> Bool -> m (Strategy RequestTimed)
forall (m :: * -> *).
MonadClient m =>
ActorId -> Bool -> Bool -> m (Strategy RequestTimed)
chase ActorId
aid (Bool -> Bool
not Bool
condInMelee
                       Bool -> Bool -> Bool
&& Bool
heavilyDistressed
                       Bool -> Bool -> Bool
&& Bool
aCanDeLight) Bool
retry
          , Bool -> Bool
not Bool
dozes
            Bool -> Bool -> Bool
&& if Bool
condInMelee
               then Bool
condCanMelee Bool -> Bool -> Bool
&& Bool
condAimEnemyPresent
               else Bool -> Bool
not (Int -> Bool
condThreat 2) Bool -> Bool -> Bool
|| Bool -> Bool
not Bool
condMeleeBad )
        ]
      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
              WSleep -> m (Strategy RequestTimed)
forall (m :: * -> *). MonadClient m => m (Strategy RequestTimed)
yellNow  -- we know actor doesn't want to sleep,
                                 -- so celebrate wake up with a bang
              _ -> m (Strategy RequestTimed)
forall (m :: * -> *). MonadClient m => m (Strategy RequestTimed)
waitBlockNow  -- block, etc.
          , Bool
True )
        , ( [Skill]
runSkills  -- if can't block, at least change something
          , ActorId -> Bool -> Bool -> m (Strategy RequestTimed)
forall (m :: * -> *).
MonadClient m =>
ActorId -> Bool -> Bool -> m (Strategy RequestTimed)
chase ActorId
aid (Bool -> Bool
not Bool
condInMelee
                       Bool -> Bool -> Bool
&& Bool
heavilyDistressed
                       Bool -> Bool -> Bool
&& Bool
aCanDeLight) Bool
True
          , Bool -> Bool
not Bool
condInMelee Bool -> Bool -> Bool
|| Bool
condCanMelee Bool -> Bool -> Bool
&& Bool
condAimEnemyPresent )
        , ( [Skill
SkDisplace]  -- if can't brace, at least change something
          , ActorId -> Bool -> m (Strategy RequestTimed)
forall (m :: * -> *).
MonadClient m =>
ActorId -> Bool -> m (Strategy RequestTimed)
displaceBlocker ActorId
aid Bool
True
          , Bool
True )
        , ( []
          , m (Strategy RequestTimed)
forall (m :: * -> *). MonadClient 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 abInSkill :: Skill -> Bool
abInSkill sk :: Skill
sk = Skill -> Skills -> Int
getSk Skill
sk Skills
actorSk Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> 0
      checkAction :: ([Skill], m a, Bool) -> Bool
      checkAction :: ([Skill], m a, Bool) -> Bool
checkAction (abts :: [Skill]
abts, _, cond :: 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 (Strategy RequestTimed), Bool)]
-> m (Strategy RequestTimed)
sumS abAction :: [([Skill], m (Strategy RequestTimed), Bool)]
abAction = do
        let as :: [([Skill], m (Strategy RequestTimed), Bool)]
as = (([Skill], m (Strategy RequestTimed), Bool) -> Bool)
-> [([Skill], m (Strategy RequestTimed), Bool)]
-> [([Skill], m (Strategy RequestTimed), Bool)]
forall a. (a -> Bool) -> [a] -> [a]
filter ([Skill], m (Strategy RequestTimed), Bool) -> Bool
forall a. ([Skill], m a, Bool) -> Bool
checkAction [([Skill], m (Strategy RequestTimed), Bool)]
abAction
        [Strategy RequestTimed]
strats <- (([Skill], m (Strategy RequestTimed), Bool)
 -> m (Strategy RequestTimed))
-> [([Skill], m (Strategy RequestTimed), Bool)]
-> m [Strategy RequestTimed]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (\(_, m :: m (Strategy RequestTimed)
m, _) -> m (Strategy RequestTimed)
m) [([Skill], m (Strategy RequestTimed), Bool)]
as
        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
$! [Strategy RequestTimed] -> Strategy RequestTimed
forall (t :: * -> *) (m :: * -> *) a.
(Foldable t, MonadPlus m) =>
t (m a) -> m a
msum [Strategy RequestTimed]
strats
      sumF :: [([Skill], m (Frequency RequestTimed), Bool)]
-> m (Frequency RequestTimed)
sumF abFreq :: [([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
        [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 (\(_, m :: m (Frequency RequestTimed)
m, _) -> 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 as :: [([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
  Strategy RequestTimed
sumPrefix <- [([Skill], m (Strategy RequestTimed), Bool)]
-> m (Strategy RequestTimed)
sumS [([Skill], m (Strategy RequestTimed), Bool)]
prefix
  Strategy RequestTimed
comDistant <- [([Skill], m (Frequency RequestTimed), Bool)]
-> m (Strategy RequestTimed)
combineWeighted [([Skill], m (Frequency RequestTimed), Bool)]
distant
  Strategy RequestTimed
sumSuffix <- [([Skill], m (Strategy RequestTimed), Bool)]
-> m (Strategy RequestTimed)
sumS [([Skill], m (Strategy RequestTimed), Bool)]
suffix
  Strategy RequestTimed
sumFallback <- [([Skill], m (Strategy RequestTimed), Bool)]
-> m (Strategy RequestTimed)
sumS [([Skill], m (Strategy RequestTimed), Bool)]
fallback
  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 -> 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 Text -> RequestTimed -> Strategy RequestTimed
forall a. Text -> a -> Strategy a
returN "sleep" RequestTimed
ReqWait
            else Strategy RequestTimed
sumPrefix Strategy RequestTimed
-> Strategy RequestTimed -> Strategy RequestTimed
forall a. Strategy a -> Strategy a -> Strategy a
.| Strategy RequestTimed
comDistant Strategy RequestTimed
-> Strategy RequestTimed -> Strategy RequestTimed
forall a. Strategy a -> Strategy a -> Strategy a
.| Strategy RequestTimed
sumSuffix Strategy RequestTimed
-> Strategy RequestTimed -> Strategy RequestTimed
forall a. Strategy a -> Strategy a -> Strategy a
.| Strategy RequestTimed
sumFallback

waitBlockNow :: MonadClient 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 "wait" RequestTimed
ReqWait

yellNow :: MonadClient 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 "yell" RequestTimed
ReqYell

pickup :: MonadClient m => ActorId -> Bool -> m (Strategy RequestTimed)
pickup :: ActorId -> Bool -> m (Strategy RequestTimed)
pickup aid :: ActorId
aid onlyWeapon :: Bool
onlyWeapon = do
  [(Benefit, CStore, ItemId, ItemFull, ItemQuant)]
benItemL <- ActorId -> m [(Benefit, CStore, ItemId, ItemFull, ItemQuant)]
forall (m :: * -> *).
MonadClient 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 (_, _, _, itemFull :: ItemFull
itemFull, _) =
        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 (oldN :: Int
oldN, l4 :: [(ItemId, Int, CStore, CStore)]
l4)
                 (Benefit{Bool
benInEqp :: Benefit -> Bool
benInEqp :: Bool
benInEqp}, _, iid :: ItemId
iid, itemFull :: ItemFull
itemFull, (itemK :: Int
itemK, _)) =
        let prep :: Int -> CStore -> (Int, [(ItemId, Int, CStore, CStore)])
prep newN :: Int
newN toCStore :: 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
            arItem :: AspectRecord
arItem = ItemFull -> AspectRecord
aspectRecordFull ItemFull
itemFull
        in if | Bool
calmE Bool -> Bool -> Bool
&& AspectRecord -> Bool
IA.goesIntoSha AspectRecord
arItem Bool -> Bool -> Bool
&& Bool -> Bool
not Bool
onlyWeapon ->
                Int -> CStore -> (Int, [(ItemId, Int, CStore, CStore)])
prep Int
oldN CStore
CSha
              | Bool
benInEqp Bool -> Bool -> Bool
&& Actor -> Int -> Bool
eqpOverfull Actor
b Int
n ->
                if Bool
onlyWeapon then (Int
oldN, [(ItemId, Int, CStore, CStore)]
l4)
                else Int -> CStore -> (Int, [(ItemId, Int, CStore, CStore)])
prep Int
oldN (if Bool
calmE then CStore
CSha else CStore
CInv)
              | Bool
benInEqp ->
                Int -> CStore -> (Int, [(ItemId, Int, CStore, CStore)])
prep Int
n CStore
CEqp
              | Bool -> Bool
not Bool
onlyWeapon ->
                Int -> CStore -> (Int, [(ItemId, Int, CStore, CStore)])
prep Int
oldN CStore
CInv
              | Bool
otherwise -> (Int
oldN, [(ItemId, Int, CStore, CStore)]
l4)
      (_, prepared :: [(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 (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 "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 @inEqp@ (which implies @goesIntoEqp@).
-- Such items are moved between any stores, as needed. In this case,
-- from inv or sha to eqp.
equipItems :: MonadClient m => ActorId -> m (Strategy RequestTimed)
equipItems :: ActorId -> m (Strategy RequestTimed)
equipItems aid :: 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)]
invAssocs <- (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
CInv]
  [(ItemId, ItemFullKit)]
shaAssocs <- (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
CSha]
  Bool
condShineWouldBetray <- ActorId -> m Bool
forall (m :: * -> *). MonadStateRead m => ActorId -> m Bool
condShineWouldBetrayM ActorId
aid
  Bool
condAimEnemyPresent <- ActorId -> m Bool
forall (m :: * -> *). MonadClient m => ActorId -> m Bool
condAimEnemyPresentM ActorId
aid
  DiscoveryBenefit
discoBenefit <- (StateClient -> DiscoveryBenefit) -> m DiscoveryBenefit
forall (m :: * -> *) a.
MonadClientRead m =>
(StateClient -> a) -> m a
getsClient StateClient -> DiscoveryBenefit
sdiscoBenefit
  let improve :: CStore
              -> (Int, [(ItemId, Int, CStore, CStore)])
              -> ( [(Int, (ItemId, ItemFullKit))]
                 , [(Int, (ItemId, ItemFullKit))] )
              -> (Int, [(ItemId, Int, CStore, CStore)])
      improve :: CStore
-> (Int, [(ItemId, Int, CStore, CStore)])
-> ([(Int, (ItemId, ItemFullKit))], [(Int, (ItemId, ItemFullKit))])
-> (Int, [(ItemId, Int, CStore, CStore)])
improve fromCStore :: CStore
fromCStore (oldN :: Int
oldN, l4 :: [(ItemId, Int, CStore, CStore)]
l4) (bestInv :: [(Int, (ItemId, ItemFullKit))]
bestInv, bestEqp :: [(Int, (ItemId, ItemFullKit))]
bestEqp) =
        let n :: Int
n = 1 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
oldN
        in case ([(Int, (ItemId, ItemFullKit))]
bestInv, [(Int, (ItemId, ItemFullKit))]
bestEqp) of
          ((_, (iidInv :: ItemId
iidInv, _)) : _, []) | Bool -> Bool
not (Actor -> Int -> Bool
eqpOverfull Actor
body Int
n) ->
            (Int
n, (ItemId
iidInv, 1, CStore
fromCStore, CStore
CEqp) (ItemId, Int, CStore, CStore)
-> [(ItemId, Int, CStore, CStore)]
-> [(ItemId, Int, CStore, CStore)]
forall a. a -> [a] -> [a]
: [(ItemId, Int, CStore, CStore)]
l4)
          ((vInv :: Int
vInv, (iidInv :: ItemId
iidInv, _)) : _, (vEqp :: Int
vEqp, _) : _)
            | Int
vInv Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
vEqp Bool -> Bool -> Bool
&& Bool -> Bool
not (Actor -> Int -> Bool
eqpOverfull Actor
body Int
n) ->
                (Int
n, (ItemId
iidInv, 1, CStore
fromCStore, 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
oldN, [(ItemId, Int, CStore, CStore)]
l4)
      heavilyDistressed :: Bool
heavilyDistressed =  -- Actor hit by a projectile or similarly distressed.
        ResDelta -> Bool
deltasSerious (Actor -> ResDelta
bcalmDelta Actor
body)
      -- 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 (_, (itemFull :: ItemFull
itemFull, _)) =
        Bool -> Bool
not (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$ Bool -> Bool -> Bool -> Bool -> Skills -> ItemFull -> Bool
hinders Bool
condShineWouldBetray Bool
condAimEnemyPresent
                      Bool
heavilyDistressed (Bool -> Bool
not Bool
calmE) Skills
actorMaxSk ItemFull
itemFull
      bestThree :: [([(Int, (ItemId, ItemFullKit))], [(Int, (ItemId, ItemFullKit))],
  [(Int, (ItemId, ItemFullKit))])]
bestThree = DiscoveryBenefit
-> [(ItemId, ItemFullKit)]
-> [(ItemId, ItemFullKit)]
-> [(ItemId, ItemFullKit)]
-> [([(Int, (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)]
eqpAssocs)
                                (((ItemId, ItemFullKit) -> Bool)
-> [(ItemId, ItemFullKit)] -> [(ItemId, ItemFullKit)]
forall a. (a -> Bool) -> [a] -> [a]
filter (ItemId, ItemFullKit) -> Bool
filterNeeded [(ItemId, ItemFullKit)]
invAssocs)
                                (((ItemId, ItemFullKit) -> Bool)
-> [(ItemId, ItemFullKit)] -> [(ItemId, ItemFullKit)]
forall a. (a -> Bool) -> [a] -> [a]
filter (ItemId, ItemFullKit) -> Bool
filterNeeded [(ItemId, ItemFullKit)]
shaAssocs)
      bEqpInv :: (Int, [(ItemId, Int, CStore, CStore)])
bEqpInv = ((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' (CStore
-> (Int, [(ItemId, Int, CStore, CStore)])
-> ([(Int, (ItemId, ItemFullKit))], [(Int, (ItemId, ItemFullKit))])
-> (Int, [(ItemId, Int, CStore, CStore)])
improve CStore
CInv) (0, [])
                ([([(Int, (ItemId, ItemFullKit))], [(Int, (ItemId, ItemFullKit))])]
 -> (Int, [(ItemId, Int, CStore, CStore)]))
-> [([(Int, (ItemId, ItemFullKit))],
     [(Int, (ItemId, ItemFullKit))])]
-> (Int, [(ItemId, Int, CStore, CStore)])
forall a b. (a -> b) -> a -> b
$ (([(Int, (ItemId, ItemFullKit))], [(Int, (ItemId, ItemFullKit))],
  [(Int, (ItemId, ItemFullKit))])
 -> ([(Int, (ItemId, ItemFullKit))],
     [(Int, (ItemId, ItemFullKit))]))
-> [([(Int, (ItemId, ItemFullKit))],
     [(Int, (ItemId, ItemFullKit))], [(Int, (ItemId, ItemFullKit))])]
-> [([(Int, (ItemId, ItemFullKit))],
     [(Int, (ItemId, ItemFullKit))])]
forall a b. (a -> b) -> [a] -> [b]
map (\(eqp :: [(Int, (ItemId, ItemFullKit))]
eqp, inv :: [(Int, (ItemId, ItemFullKit))]
inv, _) -> ([(Int, (ItemId, ItemFullKit))]
inv, [(Int, (ItemId, ItemFullKit))]
eqp)) [([(Int, (ItemId, ItemFullKit))], [(Int, (ItemId, ItemFullKit))],
  [(Int, (ItemId, ItemFullKit))])]
bestThree
      bEqpBoth :: (Int, [(ItemId, Int, CStore, CStore)])
bEqpBoth | Bool
calmE =
                   ((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' (CStore
-> (Int, [(ItemId, Int, CStore, CStore)])
-> ([(Int, (ItemId, ItemFullKit))], [(Int, (ItemId, ItemFullKit))])
-> (Int, [(ItemId, Int, CStore, CStore)])
improve CStore
CSha) (Int, [(ItemId, Int, CStore, CStore)])
bEqpInv
                   ([([(Int, (ItemId, ItemFullKit))], [(Int, (ItemId, ItemFullKit))])]
 -> (Int, [(ItemId, Int, CStore, CStore)]))
-> [([(Int, (ItemId, ItemFullKit))],
     [(Int, (ItemId, ItemFullKit))])]
-> (Int, [(ItemId, Int, CStore, CStore)])
forall a b. (a -> b) -> a -> b
$ (([(Int, (ItemId, ItemFullKit))], [(Int, (ItemId, ItemFullKit))],
  [(Int, (ItemId, ItemFullKit))])
 -> ([(Int, (ItemId, ItemFullKit))],
     [(Int, (ItemId, ItemFullKit))]))
-> [([(Int, (ItemId, ItemFullKit))],
     [(Int, (ItemId, ItemFullKit))], [(Int, (ItemId, ItemFullKit))])]
-> [([(Int, (ItemId, ItemFullKit))],
     [(Int, (ItemId, ItemFullKit))])]
forall a b. (a -> b) -> [a] -> [b]
map (\(eqp :: [(Int, (ItemId, ItemFullKit))]
eqp, _, sha :: [(Int, (ItemId, ItemFullKit))]
sha) -> ([(Int, (ItemId, ItemFullKit))]
sha, [(Int, (ItemId, ItemFullKit))]
eqp)) [([(Int, (ItemId, ItemFullKit))], [(Int, (ItemId, ItemFullKit))],
  [(Int, (ItemId, ItemFullKit))])]
bestThree
               | Bool
otherwise = (Int, [(ItemId, Int, CStore, CStore)])
bEqpInv
      (_, prepared :: [(ItemId, Int, CStore, CStore)]
prepared) = (Int, [(ItemId, Int, CStore, CStore)])
bEqpBoth
  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 "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 :: MonadClient m => ActorId -> m (Strategy RequestTimed)
yieldUnneeded :: ActorId -> m (Strategy RequestTimed)
yieldUnneeded aid :: 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
condAimEnemyPresent <- ActorId -> m Bool
forall (m :: * -> *). MonadClient m => ActorId -> m Bool
condAimEnemyPresentM ActorId
aid
  DiscoveryBenefit
discoBenefit <- (StateClient -> DiscoveryBenefit) -> m DiscoveryBenefit
forall (m :: * -> *) a.
MonadClientRead m =>
(StateClient -> a) -> m a
getsClient StateClient -> DiscoveryBenefit
sdiscoBenefit
  -- 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)
      csha :: CStore
csha = if Bool
calmE then CStore
CSha else CStore
CInv
      yieldSingleUnneeded :: (ItemId, ItemFullKit) -> [(ItemId, Int, CStore, CStore)]
yieldSingleUnneeded (iidEqp :: ItemId
iidEqp, (itemEqp :: ItemFull
itemEqp, (itemK :: Int
itemK, _))) =
        if | DiscoveryBenefit -> ItemId -> Bool
harmful DiscoveryBenefit
discoBenefit ItemId
iidEqp ->
             [(ItemId
iidEqp, Int
itemK, CStore
CEqp, CStore
CInv)]  -- harmful not shared
           | Bool -> Bool -> Bool -> Bool -> Skills -> ItemFull -> Bool
hinders Bool
condShineWouldBetray Bool
condAimEnemyPresent
                     Bool
heavilyDistressed (Bool -> Bool
not Bool
calmE) Skills
actorMaxSk ItemFull
itemEqp ->
             [(ItemId
iidEqp, Int
itemK, CStore
CEqp, CStore
csha)]
           | Bool
otherwise -> []
      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 [(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 "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 can be equipped, that is with a slot
-- and with @inEqp@ (which implies @goesIntoEqp@).
-- Such items are moved between any stores, as needed. In this case,
-- from inv or eqp to sha.
unEquipItems :: MonadClient m => ActorId -> m (Strategy RequestTimed)
unEquipItems :: ActorId -> m (Strategy RequestTimed)
unEquipItems aid :: 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)]
invAssocs <- (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
CInv]
  [(ItemId, ItemFullKit)]
shaAssocs <- (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
CSha]
  Bool
condShineWouldBetray <- ActorId -> m Bool
forall (m :: * -> *). MonadStateRead m => ActorId -> m Bool
condShineWouldBetrayM ActorId
aid
  Bool
condAimEnemyPresent <- ActorId -> m Bool
forall (m :: * -> *). MonadClient m => ActorId -> m Bool
condAimEnemyPresentM ActorId
aid
  DiscoveryBenefit
discoBenefit <- (StateClient -> DiscoveryBenefit) -> m DiscoveryBenefit
forall (m :: * -> *) a.
MonadClientRead m =>
(StateClient -> a) -> m a
getsClient StateClient -> DiscoveryBenefit
sdiscoBenefit
  let improve :: CStore -> ( [(Int, (ItemId, ItemFullKit))]
                           , [(Int, (ItemId, ItemFullKit))] )
              -> [(ItemId, Int, CStore, CStore)]
      improve :: CStore
-> ([(Int, (ItemId, ItemFullKit))], [(Int, (ItemId, ItemFullKit))])
-> [(ItemId, Int, CStore, CStore)]
improve fromCStore :: CStore
fromCStore (bestSha :: [(Int, (ItemId, ItemFullKit))]
bestSha, bestEOrI :: [(Int, (ItemId, ItemFullKit))]
bestEOrI) =
        case [(Int, (ItemId, ItemFullKit))]
bestEOrI of
          ((vEOrI :: Int
vEOrI, (iidEOrI :: ItemId
iidEOrI, bei :: ItemFullKit
bei)) : _) | ItemFullKit -> Int
forall a a b. (a, (a, b)) -> a
getK ItemFullKit
bei Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> 1
                                          Bool -> Bool -> Bool
&& Int -> [(Int, (ItemId, ItemFullKit))] -> Bool
forall a b. Ord a => a -> [(a, b)] -> Bool
betterThanSha Int
vEOrI [(Int, (ItemId, ItemFullKit))]
bestSha ->
            -- To share the best items with others, if they care.
            [(ItemId
iidEOrI, ItemFullKit -> Int
forall a a b. (a, (a, b)) -> a
getK ItemFullKit
bei Int -> Int -> Int
forall a. Num a => a -> a -> a
- 1, CStore
fromCStore, CStore
CSha)]
          (_ : (vEOrI :: Int
vEOrI, (iidEOrI :: ItemId
iidEOrI, bei :: ItemFullKit
bei)) : _) | Int -> [(Int, (ItemId, ItemFullKit))] -> Bool
forall a b. Ord a => a -> [(a, b)] -> Bool
betterThanSha Int
vEOrI [(Int, (ItemId, ItemFullKit))]
bestSha ->
            -- To share the second best items with others, if they care.
            [(ItemId
iidEOrI, ItemFullKit -> Int
forall a a b. (a, (a, b)) -> a
getK ItemFullKit
bei, CStore
fromCStore, CStore
CSha)]
          ((vEOrI :: Int
vEOrI, (_, _)) : _) | CStore
fromCStore CStore -> CStore -> Bool
forall a. Eq a => a -> a -> Bool
== CStore
CEqp
                                  Bool -> Bool -> Bool
&& Actor -> Int -> Bool
eqpOverfull Actor
body 1
                                  Bool -> Bool -> Bool
&& Int -> [(Int, (ItemId, ItemFullKit))] -> Bool
forall a b. Ord a => a -> [(a, b)] -> Bool
worseThanSha Int
vEOrI [(Int, (ItemId, ItemFullKit))]
bestSha ->
            -- To make place in eqp for an item better than any ours.
            -- Even a minor boost is removed only if sha has a better one.
            [((ItemId, ItemFullKit) -> ItemId
forall a b. (a, b) -> a
fst ((ItemId, ItemFullKit) -> ItemId)
-> (ItemId, ItemFullKit) -> ItemId
forall a b. (a -> b) -> a -> b
$ (Int, (ItemId, ItemFullKit)) -> (ItemId, ItemFullKit)
forall a b. (a, b) -> b
snd ((Int, (ItemId, ItemFullKit)) -> (ItemId, ItemFullKit))
-> (Int, (ItemId, ItemFullKit)) -> (ItemId, ItemFullKit)
forall a b. (a -> b) -> a -> b
$ [(Int, (ItemId, ItemFullKit))] -> (Int, (ItemId, ItemFullKit))
forall a. [a] -> a
last [(Int, (ItemId, ItemFullKit))]
bestEOrI, 1, CStore
fromCStore, CStore
CSha)]
          _ -> []
      getK :: (a, (a, b)) -> a
getK (_, (itemK :: a
itemK, _)) = a
itemK
      betterThanSha :: a -> [(a, b)] -> Bool
betterThanSha _ [] = Bool
True
      betterThanSha vEOrI :: a
vEOrI ((vSha :: a
vSha, _) : _) = a
vEOrI a -> a -> Bool
forall a. Ord a => a -> a -> Bool
> a
vSha
      worseThanSha :: a -> [(a, b)] -> Bool
worseThanSha _ [] = Bool
False
      worseThanSha vEOrI :: a
vEOrI ((vSha :: a
vSha, _) : _) = a
vEOrI a -> a -> Bool
forall a. Ord a => a -> a -> Bool
< a
vSha
      heavilyDistressed :: Bool
heavilyDistressed =  -- Actor hit by a projectile or similarly distressed.
        ResDelta -> Bool
deltasSerious (Actor -> ResDelta
bcalmDelta Actor
body)
      -- Here we don't need to filter out items that hinder (except in sha)
      -- because they are moved to sha 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 sha to consider only eligible items in @worseThanSha@.
      filterNeeded :: (ItemId, ItemFullKit) -> Bool
filterNeeded (_, (itemFull :: ItemFull
itemFull, _)) =
        Bool -> Bool
not (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$ Bool -> Bool -> Bool -> Bool -> Skills -> ItemFull -> Bool
hinders Bool
condShineWouldBetray Bool
condAimEnemyPresent
                      Bool
heavilyDistressed (Bool -> Bool
not Bool
calmE) Skills
actorMaxSk ItemFull
itemFull
      bestThree :: [([(Int, (ItemId, ItemFullKit))], [(Int, (ItemId, ItemFullKit))],
  [(Int, (ItemId, ItemFullKit))])]
bestThree = DiscoveryBenefit
-> [(ItemId, ItemFullKit)]
-> [(ItemId, ItemFullKit)]
-> [(ItemId, ItemFullKit)]
-> [([(Int, (ItemId, ItemFullKit))],
     [(Int, (ItemId, ItemFullKit))], [(Int, (ItemId, ItemFullKit))])]
bestByEqpSlot DiscoveryBenefit
discoBenefit [(ItemId, ItemFullKit)]
eqpAssocs [(ItemId, ItemFullKit)]
invAssocs
                                (((ItemId, ItemFullKit) -> Bool)
-> [(ItemId, ItemFullKit)] -> [(ItemId, ItemFullKit)]
forall a. (a -> Bool) -> [a] -> [a]
filter (ItemId, ItemFullKit) -> Bool
filterNeeded [(ItemId, ItemFullKit)]
shaAssocs)
      bInvSha :: [(ItemId, Int, CStore, CStore)]
bInvSha = (([(Int, (ItemId, ItemFullKit))], [(Int, (ItemId, ItemFullKit))],
  [(Int, (ItemId, ItemFullKit))])
 -> [(ItemId, Int, CStore, CStore)])
-> [([(Int, (ItemId, ItemFullKit))],
     [(Int, (ItemId, ItemFullKit))], [(Int, (ItemId, ItemFullKit))])]
-> [(ItemId, Int, CStore, CStore)]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap
                  (CStore
-> ([(Int, (ItemId, ItemFullKit))], [(Int, (ItemId, ItemFullKit))])
-> [(ItemId, Int, CStore, CStore)]
improve CStore
CInv (([(Int, (ItemId, ItemFullKit))], [(Int, (ItemId, ItemFullKit))])
 -> [(ItemId, Int, CStore, CStore)])
-> (([(Int, (ItemId, ItemFullKit))],
     [(Int, (ItemId, ItemFullKit))], [(Int, (ItemId, ItemFullKit))])
    -> ([(Int, (ItemId, ItemFullKit))],
        [(Int, (ItemId, ItemFullKit))]))
-> ([(Int, (ItemId, ItemFullKit))], [(Int, (ItemId, ItemFullKit))],
    [(Int, (ItemId, ItemFullKit))])
-> [(ItemId, Int, CStore, CStore)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (\(_, inv :: [(Int, (ItemId, ItemFullKit))]
inv, sha :: [(Int, (ItemId, ItemFullKit))]
sha) -> ([(Int, (ItemId, ItemFullKit))]
sha, [(Int, (ItemId, ItemFullKit))]
inv))) [([(Int, (ItemId, ItemFullKit))], [(Int, (ItemId, ItemFullKit))],
  [(Int, (ItemId, ItemFullKit))])]
bestThree
      bEqpSha :: [(ItemId, Int, CStore, CStore)]
bEqpSha = (([(Int, (ItemId, ItemFullKit))], [(Int, (ItemId, ItemFullKit))],
  [(Int, (ItemId, ItemFullKit))])
 -> [(ItemId, Int, CStore, CStore)])
-> [([(Int, (ItemId, ItemFullKit))],
     [(Int, (ItemId, ItemFullKit))], [(Int, (ItemId, ItemFullKit))])]
-> [(ItemId, Int, CStore, CStore)]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap
                  (CStore
-> ([(Int, (ItemId, ItemFullKit))], [(Int, (ItemId, ItemFullKit))])
-> [(ItemId, Int, CStore, CStore)]
improve CStore
CEqp (([(Int, (ItemId, ItemFullKit))], [(Int, (ItemId, ItemFullKit))])
 -> [(ItemId, Int, CStore, CStore)])
-> (([(Int, (ItemId, ItemFullKit))],
     [(Int, (ItemId, ItemFullKit))], [(Int, (ItemId, ItemFullKit))])
    -> ([(Int, (ItemId, ItemFullKit))],
        [(Int, (ItemId, ItemFullKit))]))
-> ([(Int, (ItemId, ItemFullKit))], [(Int, (ItemId, ItemFullKit))],
    [(Int, (ItemId, ItemFullKit))])
-> [(ItemId, Int, CStore, CStore)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (\(eqp :: [(Int, (ItemId, ItemFullKit))]
eqp, _, sha :: [(Int, (ItemId, ItemFullKit))]
sha) -> ([(Int, (ItemId, ItemFullKit))]
sha, [(Int, (ItemId, ItemFullKit))]
eqp))) [([(Int, (ItemId, ItemFullKit))], [(Int, (ItemId, ItemFullKit))],
  [(Int, (ItemId, ItemFullKit))])]
bestThree
      prepared :: [(ItemId, Int, CStore, CStore)]
prepared = if Bool
calmE then [(ItemId, Int, CStore, CStore)]
bInvSha [(ItemId, Int, CStore, CStore)]
-> [(ItemId, Int, CStore, CStore)]
-> [(ItemId, Int, CStore, CStore)]
forall a. [a] -> [a] -> [a]
++ [(ItemId, Int, CStore, CStore)]
bEqpSha else []
  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 "unEquipItems" (RequestTimed -> Strategy RequestTimed)
-> RequestTimed -> Strategy RequestTimed
forall a b. (a -> b) -> a -> b
$ [(ItemId, Int, CStore, CStore)] -> RequestTimed
ReqMoveItems [(ItemId, Int, CStore, CStore)]
prepared

groupByEqpSlot :: [(ItemId, ItemFullKit)]
               -> EM.EnumMap EqpSlot [(ItemId, ItemFullKit)]
groupByEqpSlot :: [(ItemId, ItemFullKit)] -> EnumMap EqpSlot [(ItemId, ItemFullKit)]
groupByEqpSlot is :: [(ItemId, ItemFullKit)]
is =
  let f :: (a, (ItemFull, b)) -> Maybe (EqpSlot, [(a, (ItemFull, b))])
f (iid :: a
iid, itemFullKit :: (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
          Nothing -> Maybe (EqpSlot, [(a, (ItemFull, b))])
forall a. Maybe a
Nothing
          Just es :: 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)]
              -> [(ItemId, ItemFullKit)]
              -> [( [(Int, (ItemId, ItemFullKit))]
                  , [(Int, (ItemId, ItemFullKit))]
                  , [(Int, (ItemId, ItemFullKit))] )]
bestByEqpSlot :: DiscoveryBenefit
-> [(ItemId, ItemFullKit)]
-> [(ItemId, ItemFullKit)]
-> [(ItemId, ItemFullKit)]
-> [([(Int, (ItemId, ItemFullKit))],
     [(Int, (ItemId, ItemFullKit))], [(Int, (ItemId, ItemFullKit))])]
bestByEqpSlot discoBenefit :: DiscoveryBenefit
discoBenefit eqpAssocs :: [(ItemId, ItemFullKit)]
eqpAssocs invAssocs :: [(ItemId, ItemFullKit)]
invAssocs shaAssocs :: [(ItemId, ItemFullKit)]
shaAssocs =
  let eqpMap :: EnumMap
  EqpSlot
  ([(ItemId, ItemFullKit)], [(ItemId, ItemFullKit)],
   [(ItemId, ItemFullKit)])
eqpMap = ([(ItemId, ItemFullKit)]
 -> ([(ItemId, ItemFullKit)], [(ItemId, ItemFullKit)],
     [(ItemId, ItemFullKit)]))
-> EnumMap EqpSlot [(ItemId, ItemFullKit)]
-> EnumMap
     EqpSlot
     ([(ItemId, ItemFullKit)], [(ItemId, ItemFullKit)],
      [(ItemId, ItemFullKit)])
forall a b k. (a -> b) -> EnumMap k a -> EnumMap k b
EM.map (\g :: [(ItemId, ItemFullKit)]
g -> ([(ItemId, ItemFullKit)]
g, [], [])) (EnumMap EqpSlot [(ItemId, ItemFullKit)]
 -> EnumMap
      EqpSlot
      ([(ItemId, ItemFullKit)], [(ItemId, ItemFullKit)],
       [(ItemId, ItemFullKit)]))
-> EnumMap EqpSlot [(ItemId, ItemFullKit)]
-> EnumMap
     EqpSlot
     ([(ItemId, ItemFullKit)], [(ItemId, ItemFullKit)],
      [(ItemId, ItemFullKit)])
forall a b. (a -> b) -> a -> b
$ [(ItemId, ItemFullKit)] -> EnumMap EqpSlot [(ItemId, ItemFullKit)]
groupByEqpSlot [(ItemId, ItemFullKit)]
eqpAssocs
      invMap :: EnumMap
  EqpSlot
  ([(ItemId, ItemFullKit)], [(ItemId, ItemFullKit)],
   [(ItemId, ItemFullKit)])
invMap = ([(ItemId, ItemFullKit)]
 -> ([(ItemId, ItemFullKit)], [(ItemId, ItemFullKit)],
     [(ItemId, ItemFullKit)]))
-> EnumMap EqpSlot [(ItemId, ItemFullKit)]
-> EnumMap
     EqpSlot
     ([(ItemId, ItemFullKit)], [(ItemId, ItemFullKit)],
      [(ItemId, ItemFullKit)])
forall a b k. (a -> b) -> EnumMap k a -> EnumMap k b
EM.map (\g :: [(ItemId, ItemFullKit)]
g -> ([], [(ItemId, ItemFullKit)]
g, [])) (EnumMap EqpSlot [(ItemId, ItemFullKit)]
 -> EnumMap
      EqpSlot
      ([(ItemId, ItemFullKit)], [(ItemId, ItemFullKit)],
       [(ItemId, ItemFullKit)]))
-> EnumMap EqpSlot [(ItemId, ItemFullKit)]
-> EnumMap
     EqpSlot
     ([(ItemId, ItemFullKit)], [(ItemId, ItemFullKit)],
      [(ItemId, ItemFullKit)])
forall a b. (a -> b) -> a -> b
$ [(ItemId, ItemFullKit)] -> EnumMap EqpSlot [(ItemId, ItemFullKit)]
groupByEqpSlot [(ItemId, ItemFullKit)]
invAssocs
      shaMap :: EnumMap
  EqpSlot
  ([(ItemId, ItemFullKit)], [(ItemId, ItemFullKit)],
   [(ItemId, ItemFullKit)])
shaMap = ([(ItemId, ItemFullKit)]
 -> ([(ItemId, ItemFullKit)], [(ItemId, ItemFullKit)],
     [(ItemId, ItemFullKit)]))
-> EnumMap EqpSlot [(ItemId, ItemFullKit)]
-> EnumMap
     EqpSlot
     ([(ItemId, ItemFullKit)], [(ItemId, ItemFullKit)],
      [(ItemId, ItemFullKit)])
forall a b k. (a -> b) -> EnumMap k a -> EnumMap k b
EM.map (\g :: [(ItemId, ItemFullKit)]
g -> ([], [], [(ItemId, ItemFullKit)]
g)) (EnumMap EqpSlot [(ItemId, ItemFullKit)]
 -> EnumMap
      EqpSlot
      ([(ItemId, ItemFullKit)], [(ItemId, ItemFullKit)],
       [(ItemId, ItemFullKit)]))
-> EnumMap EqpSlot [(ItemId, ItemFullKit)]
-> EnumMap
     EqpSlot
     ([(ItemId, ItemFullKit)], [(ItemId, ItemFullKit)],
      [(ItemId, ItemFullKit)])
forall a b. (a -> b) -> a -> b
$ [(ItemId, ItemFullKit)] -> EnumMap EqpSlot [(ItemId, ItemFullKit)]
groupByEqpSlot [(ItemId, ItemFullKit)]
shaAssocs
      appendThree :: ([a], [a], [a]) -> ([a], [a], [a]) -> ([a], [a], [a])
appendThree (g1 :: [a]
g1, g2 :: [a]
g2, g3 :: [a]
g3) (h1 :: [a]
h1, h2 :: [a]
h2, h3 :: [a]
h3) = ([a]
g1 [a] -> [a] -> [a]
forall a. [a] -> [a] -> [a]
++ [a]
h1, [a]
g2 [a] -> [a] -> [a]
forall a. [a] -> [a] -> [a]
++ [a]
h2, [a]
g3 [a] -> [a] -> [a]
forall a. [a] -> [a] -> [a]
++ [a]
h3)
      eqpInvShaMap :: EnumMap
  EqpSlot
  ([(ItemId, ItemFullKit)], [(ItemId, ItemFullKit)],
   [(ItemId, ItemFullKit)])
eqpInvShaMap = (([(ItemId, ItemFullKit)], [(ItemId, ItemFullKit)],
  [(ItemId, ItemFullKit)])
 -> ([(ItemId, ItemFullKit)], [(ItemId, ItemFullKit)],
     [(ItemId, ItemFullKit)])
 -> ([(ItemId, ItemFullKit)], [(ItemId, ItemFullKit)],
     [(ItemId, ItemFullKit)]))
-> [EnumMap
      EqpSlot
      ([(ItemId, ItemFullKit)], [(ItemId, ItemFullKit)],
       [(ItemId, ItemFullKit)])]
-> EnumMap
     EqpSlot
     ([(ItemId, ItemFullKit)], [(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)])
-> ([(ItemId, ItemFullKit)], [(ItemId, ItemFullKit)],
    [(ItemId, ItemFullKit)])
forall a a a. ([a], [a], [a]) -> ([a], [a], [a]) -> ([a], [a], [a])
appendThree [EnumMap
  EqpSlot
  ([(ItemId, ItemFullKit)], [(ItemId, ItemFullKit)],
   [(ItemId, ItemFullKit)])
eqpMap, EnumMap
  EqpSlot
  ([(ItemId, ItemFullKit)], [(ItemId, ItemFullKit)],
   [(ItemId, ItemFullKit)])
invMap, EnumMap
  EqpSlot
  ([(ItemId, ItemFullKit)], [(ItemId, ItemFullKit)],
   [(ItemId, ItemFullKit)])
shaMap]
      bestSingle :: EqpSlot
-> [(ItemId, ItemFullKit)] -> [(Int, (ItemId, ItemFullKit))]
bestSingle = DiscoveryBenefit
-> EqpSlot
-> [(ItemId, ItemFullKit)]
-> [(Int, (ItemId, ItemFullKit))]
strongestSlot DiscoveryBenefit
discoBenefit
      bestThree :: EqpSlot
-> ([(ItemId, ItemFullKit)], [(ItemId, ItemFullKit)],
    [(ItemId, ItemFullKit)])
-> ([(Int, (ItemId, ItemFullKit))], [(Int, (ItemId, ItemFullKit))],
    [(Int, (ItemId, ItemFullKit))])
bestThree eqpSlot :: EqpSlot
eqpSlot (g1 :: [(ItemId, ItemFullKit)]
g1, g2 :: [(ItemId, ItemFullKit)]
g2, g3 :: [(ItemId, ItemFullKit)]
g3) = (EqpSlot
-> [(ItemId, ItemFullKit)] -> [(Int, (ItemId, ItemFullKit))]
bestSingle EqpSlot
eqpSlot [(ItemId, ItemFullKit)]
g1,
                                        EqpSlot
-> [(ItemId, ItemFullKit)] -> [(Int, (ItemId, ItemFullKit))]
bestSingle EqpSlot
eqpSlot [(ItemId, ItemFullKit)]
g2,
                                        EqpSlot
-> [(ItemId, ItemFullKit)] -> [(Int, (ItemId, ItemFullKit))]
bestSingle EqpSlot
eqpSlot [(ItemId, ItemFullKit)]
g3)
  in EnumMap
  EqpSlot
  ([(Int, (ItemId, ItemFullKit))], [(Int, (ItemId, ItemFullKit))],
   [(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))],
      [(Int, (ItemId, ItemFullKit))], [(Int, (ItemId, ItemFullKit))])])
-> EnumMap
     EqpSlot
     ([(Int, (ItemId, ItemFullKit))], [(Int, (ItemId, ItemFullKit))],
      [(Int, (ItemId, ItemFullKit))])
-> [([(Int, (ItemId, ItemFullKit))],
     [(Int, (ItemId, ItemFullKit))], [(Int, (ItemId, ItemFullKit))])]
forall a b. (a -> b) -> a -> b
$ (EqpSlot
 -> ([(ItemId, ItemFullKit)], [(ItemId, ItemFullKit)],
     [(ItemId, ItemFullKit)])
 -> ([(Int, (ItemId, ItemFullKit))], [(Int, (ItemId, ItemFullKit))],
     [(Int, (ItemId, ItemFullKit))]))
-> EnumMap
     EqpSlot
     ([(ItemId, ItemFullKit)], [(ItemId, ItemFullKit)],
      [(ItemId, ItemFullKit)])
-> EnumMap
     EqpSlot
     ([(Int, (ItemId, ItemFullKit))], [(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)],
    [(ItemId, ItemFullKit)])
-> ([(Int, (ItemId, ItemFullKit))], [(Int, (ItemId, ItemFullKit))],
    [(Int, (ItemId, ItemFullKit))])
bestThree EnumMap
  EqpSlot
  ([(ItemId, ItemFullKit)], [(ItemId, ItemFullKit)],
   [(ItemId, ItemFullKit)])
eqpInvShaMap

harmful :: DiscoveryBenefit -> ItemId -> Bool
harmful :: DiscoveryBenefit -> ItemId -> Bool
harmful discoBenefit :: DiscoveryBenefit
discoBenefit iid :: 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

-- Everybody melees in a pinch, even though some prefer ranged attacks.
meleeBlocker :: MonadClient m => ActorId -> m (Strategy RequestTimed)
meleeBlocker :: ActorId -> m (Strategy RequestTimed)
meleeBlocker aid :: 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
  Skills
actorSk <- ActorId -> m Skills
forall (m :: * -> *). MonadClientRead m => ActorId -> m Skills
currentSkillsClient 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=q :: Point
q : _, Point
pathGoal :: AndPath -> Point
pathGoal :: 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
    Just TgtAndPath{tapPath :: TgtAndPath -> Maybe AndPath
tapPath=Just AndPath{pathList :: AndPath -> [Point]
pathList=q :: Point
q : _, 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
            Nothing -> []
            Just aim :: Point
aim -> Point -> Level -> [ActorId]
posToAidsLvl Point
aim Level
lvl
      case [ActorId]
lBlocker of
        aid2 :: ActorId
aid2 : _ -> 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
actorDying Actor
body2
               Bool -> Bool -> Bool
|| 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
> 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
<= 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
> 0  -- blocked move
                  Bool -> Bool -> Bool
&& 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 "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
    _ -> 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.
meleeAny :: MonadClient m => ActorId -> m (Strategy RequestTimed)
meleeAny :: ActorId -> m (Strategy RequestTimed)
meleeAny aid :: 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
  let foe :: (ActorId, Actor) -> Bool
foe (_, b2 :: Actor
b2) = FactionId -> Faction -> FactionId -> Bool
isFoe (Actor -> FactionId
bfid Actor
b) Faction
fact (Actor -> FactionId
bfid Actor
b2) Bool -> Bool -> Bool
&& Actor -> Int64
bhp Actor
b2 Int64 -> Int64 -> Bool
forall a. Ord a => a -> a -> Bool
> 0
      adjFoes :: [ActorId]
adjFoes = ((ActorId, Actor) -> ActorId) -> [(ActorId, Actor)] -> [ActorId]
forall a b. (a -> b) -> [a] -> [b]
map (ActorId, Actor) -> ActorId
forall a b. (a, b) -> a
fst ([(ActorId, Actor)] -> [ActorId])
-> [(ActorId, Actor)] -> [ActorId]
forall a b. (a -> b) -> a -> b
$ ((ActorId, Actor) -> Bool)
-> [(ActorId, Actor)] -> [(ActorId, Actor)]
forall a. (a -> Bool) -> [a] -> [a]
filter (ActorId, Actor) -> Bool
foe [(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]
mtargets <- case Maybe Target
btarget of
    Just (TEnemy aid2 :: 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] -> m (Maybe [ActorId])
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe [ActorId] -> m (Maybe [ActorId]))
-> Maybe [ActorId] -> m (Maybe [ActorId])
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
&& (ActorId, Actor) -> Bool
foe (ActorId
aid2, Actor
b2)
                then [ActorId] -> Maybe [ActorId]
forall a. a -> Maybe a
Just [ActorId
aid2]
                else Maybe [ActorId]
forall a. Maybe a
Nothing
    _ -> Maybe [ActorId] -> m (Maybe [ActorId])
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe [ActorId]
forall a. Maybe a
Nothing
  let adjTargets :: [ActorId]
adjTargets = [ActorId] -> Maybe [ActorId] -> [ActorId]
forall a. a -> Maybe a -> a
fromMaybe [ActorId]
adjFoes Maybe [ActorId]
mtargets
  [Maybe RequestTimed]
mels <- (ActorId -> m (Maybe RequestTimed))
-> [ActorId] -> 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]
adjTargets
  let freq :: Frequency RequestTimed
freq = Text -> [RequestTimed] -> Frequency RequestTimed
forall a. Text -> [a] -> Frequency a
uniformFreq "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.
-- 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. A quirk; a specialization of AI actors.
trigger :: MonadClient m
        => ActorId -> FleeViaStairsOrEscape
        -> m (Strategy RequestTimed)
trigger :: ActorId -> FleeViaStairsOrEscape -> m (Strategy RequestTimed)
trigger aid :: ActorId
aid fleeVia :: 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 pos :: 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
        Nothing -> Maybe (Point, ItemBag)
forall a. Maybe a
Nothing
        Just bag :: 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 "trigger"
    [ (Double -> Int
forall a b. (RealFrac a, Integral b) => a -> b
ceiling Double
benefit, Point -> RequestTimed
ReqAlter Point
pos)
    | (benefit :: Double
benefit, (pos :: Point
pos, _)) <- [(Double, (Point, ItemBag))]
efeat ]

projectItem :: MonadClient m => ActorId -> m (Strategy RequestTimed)
projectItem :: ActorId -> m (Strategy RequestTimed)
projectItem aid :: 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
  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
$ ActorId -> LevelId -> Maybe Target -> State -> Maybe Point
aidTgtToPos ActorId
aid (Actor -> LevelId
blid Actor
b) Maybe Target
btarget
  Int
seps <- (StateClient -> Int) -> m Int
forall (m :: * -> *) a.
MonadClientRead m =>
(StateClient -> a) -> m a
getsClient StateClient -> Int
seps
  case (Maybe Target
btarget, Maybe Point
mfpos) of
    (_, Just fpos :: 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{}, Just fpos :: Point
fpos) -> do
      Maybe Int
mnewEps <- Bool -> Actor -> Point -> Int -> m (Maybe Int)
forall (m :: * -> *).
MonadStateRead m =>
Bool -> Actor -> Point -> Int -> m (Maybe Int)
makeLine Bool
False Actor
b Point
fpos Int
seps
      case Maybe Int
mnewEps of
        Just newEps :: Int
newEps -> do
          Skills
actorSk <- ActorId -> m Skills
forall (m :: * -> *). MonadClientRead m => ActorId -> m Skills
currentSkillsClient ActorId
aid
          let skill :: Int
skill = Skill -> Skills -> Int
getSk Skill
SkProject Skills
actorSk
          -- ProjectAimOnself, ProjectBlockActor, ProjectBlockTerrain
          -- and no actors or obstacles along the path.
          [(Benefit, CStore, ItemId, ItemFull, ItemQuant)]
benList <- Int
-> ActorId -> m [(Benefit, CStore, ItemId, ItemFull, ItemQuant)]
forall (m :: * -> *).
MonadClient m =>
Int
-> ActorId -> m [(Benefit, 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 coeff :: CStore -> Double
coeff CGround = 2  -- pickup turn saved
              coeff COrgan = String -> Double
forall a. (?callStack::CallStack) => String -> a
error (String -> Double) -> String -> Double
forall a b. (a -> b) -> a -> b
$ "" String
-> [(Benefit, CStore, ItemId, ItemFull, ItemQuant)] -> String
forall v. Show v => String -> v -> String
`showFailure` [(Benefit, CStore, ItemId, ItemFull, ItemQuant)]
benList
              coeff CEqp = 1000  -- must hinder currently (or be very potent);
                                 -- note: not larger, to avoid Int32 overflow
              coeff CInv = 1
              coeff CSha = 1
              fRanged :: (Benefit, CStore, ItemId, ItemFull, ItemQuant)
-> Maybe (Int, RequestTimed)
fRanged (Benefit{Double
benFling :: Benefit -> Double
benFling :: Double
benFling}, cstore :: CStore
cstore, iid :: ItemId
iid, itemFull :: ItemFull
itemFull, kit :: 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 -> ItemFull -> ItemQuant -> Bool
hasCharge Time
localTime ItemFull
itemFull 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
+ 2  -- margin for fleeing
                    rangeMult :: Int
rangeMult =  -- penalize wasted or unsafely low range
                      10 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int -> Int -> Int
forall a. Ord a => a -> a -> a
max 0 (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))
                    benR :: Double
benR = CStore -> Double
coeff CStore
cstore Double -> Double -> Double
forall a. Num a => a -> a -> a
* Double
benFling
                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
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
rangeMult Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ 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 = ((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)
fRanged [(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 "projectItem" [(Int, RequestTimed)]
benRanged
        _ -> 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

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 :: MonadClient m
          => ActorId -> ApplyItemGroup -> m (Strategy RequestTimed)
applyItem :: ActorId -> ApplyItemGroup -> m (Strategy RequestTimed)
applyItem aid :: ActorId
aid applyGroup :: ApplyItemGroup
applyGroup = do
  Skills
actorSk <- ActorId -> m Skills
forall (m :: * -> *). MonadClientRead m => ActorId -> m Skills
currentSkillsClient 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
  Bool
condShineWouldBetray <- ActorId -> m Bool
forall (m :: * -> *). MonadStateRead m => ActorId -> m Bool
condShineWouldBetrayM ActorId
aid
  Bool
condAimEnemyPresent <- ActorId -> m Bool
forall (m :: * -> *). MonadClient m => ActorId -> m Bool
condAimEnemyPresentM 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)
  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
      condNotCalmEnough :: Bool
condNotCalmEnough = Bool -> Bool
not Bool
calmE
      heavilyDistressed :: Bool
heavilyDistressed =  -- Actor hit by a projectile or similarly distressed.
        ResDelta -> Bool
deltasSerious (Actor -> ResDelta
bcalmDelta Actor
b)
      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 -> Bool -> Bool -> Skills -> ItemFull -> Bool
hinders Bool
condShineWouldBetray Bool
condAimEnemyPresent
                     Bool
heavilyDistressed Bool
condNotCalmEnough Skills
actorMaxSk
      permittedActor :: ItemFull -> ItemQuant -> Bool
permittedActor itemFull :: ItemFull
itemFull kit :: ItemQuant
kit =
        (ReqFailure -> Bool)
-> (Bool -> Bool) -> Either ReqFailure Bool -> Bool
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (Bool -> ReqFailure -> Bool
forall a b. a -> b -> a
const Bool
False) Bool -> Bool
forall a. a -> a
id
        (Either ReqFailure Bool -> Bool) -> Either ReqFailure Bool -> Bool
forall a b. (a -> b) -> a -> b
$ Time
-> Int -> Bool -> ItemFull -> ItemQuant -> Either ReqFailure Bool
permittedApply Time
localTime Int
skill Bool
calmE 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 _ IK.PolyItem = Bool
True
      disqualify _ IK.RerollItem = Bool
True
      disqualify _ IK.DupItem = Bool
True
      disqualify _ IK.Identify = Bool
True
      -- This is usually the main effect of item and it's useless without Calm.
      disqualify durable :: 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 30 Bool -> Bool -> Bool
|| Bool
condNotCalmEnough)
      disqualify durable :: Bool
durable (IK.OneOf l :: [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 durable :: Bool
durable (IK.Composite l :: [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
False
      q :: (Benefit, CStore, ItemId, ItemFull, ItemQuant) -> Bool
q (Benefit{Bool
benInEqp :: Bool
benInEqp :: Benefit -> Bool
benInEqp}, _, _, itemFull :: ItemFull
itemFull@ItemFull{ItemKind
itemKind :: ItemKind
itemKind :: ItemFull -> ItemKind
itemKind}, kit :: 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
&& ItemFull -> ItemQuant -> Bool
permittedActor 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 -> Bool
not (ItemKind -> Bool
IA.isHumanTrinket ItemKind
itemKind)  -- hack for elixir of youth
      -- Organs are not taken into account, because usually they are either
      -- melee items, so harmful, or periodic, so charging between activations.
      -- The case of a weak weapon curing poison is too rare to incur overhead.
      stores :: [CStore]
stores = [CStore
CEqp, CStore
CInv, CStore
CGround] [CStore] -> [CStore] -> [CStore]
forall a. [a] -> [a] -> [a]
++ [CStore
CSha | 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 (myBadGrps :: [GroupName ItemKind]
myBadGrps, myGoodGrps :: [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 (\iid :: ItemId
iid ->
        let itemKind :: ItemKind
itemKind = ItemId -> ItemKind
getKind ItemId
iid
        in if Maybe Int -> Bool
forall a. Maybe a -> Bool
isJust (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 "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. 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 a. Text -> GroupName a
toGroupName (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. 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 a. Text -> GroupName a
toGroupName (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)
      coeff :: CStore -> Int
coeff CGround = 2  -- pickup turn saved
      coeff COrgan = String -> Int
forall a. (?callStack::CallStack) => String -> a
error (String -> Int) -> String -> Int
forall a b. (a -> b) -> a -> b
$ "" String
-> [(Benefit, CStore, ItemId, ItemFull, ItemQuant)] -> String
forall v. Show v => String -> v -> String
`showFailure` [(Benefit, CStore, ItemId, ItemFull, ItemQuant)]
benList
      coeff CEqp = 1
      coeff CInv = 1
      coeff CSha = 1
      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
cstore, iid :: ItemId
iid
                  , itemFull :: ItemFull
itemFull@ItemFull{ItemKind
itemKind :: ItemKind
itemKind :: ItemFull -> ItemKind
itemKind}, _ ) =
        let -- Don't include @Ascend@ nor @Teleport@, because maybe no foe near.
            -- Don't include @OneOf@ because other effects may kill you.
            getHP :: Effect -> Bool
getHP (IK.RefillHP p :: Int
p) | Int
p Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> 0 = Bool
True
            getHP (IK.Composite l :: [Effect]
l) = (Effect -> Bool) -> [Effect] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any Effect -> Bool
getHP [Effect]
l
            getHP _ = Bool
False
            heals :: Bool
heals = (Effect -> Bool) -> [Effect] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any Effect -> Bool
getHP ([Effect] -> Bool) -> [Effect] -> Bool
forall a b. (a -> b) -> a -> b
$ ItemKind -> [Effect]
IK.ieffects ItemKind
itemKind
            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
&& ("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 =
              "impressed" GroupName ItemKind -> [GroupName ItemKind] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [GroupName ItemKind]
myBadGrps
              Bool -> Bool -> Bool
&& ("condition" GroupName ItemKind -> [GroupName ItemKind] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [GroupName ItemKind]
dropsGrps
                  Bool -> Bool -> Bool
|| "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
&& ("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)
            wastesHP :: Bool
wastesHP = Actor -> Skills -> Bool
hpEnough Actor
b Skills
actorMaxSk Bool -> Bool -> Bool
&& Bool
heals
            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
+ 1000  -- crucial
                                     else Double
benApply Double -> Double -> Double
forall a. Num a => a -> a -> a
+ 20
                 | Bool
wastesDrop Bool -> Bool -> Bool
|| Bool
wastesHP -> Double
benApply Double -> Double -> Double
forall a. Num a => a -> a -> a
- 10
                 | Bool
otherwise -> Double
benApply
            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
* if CStore
cstore CStore -> CStore -> Bool
forall a. Eq a => a -> a -> Bool
== CStore
CEqp Bool -> Bool -> Bool
&& Bool -> Bool
not Bool
durable
                     then 1000  -- must hinder currently (or be very potent)
                     else CStore -> Int
coeff CStore
cstore
            canApply :: Bool
canApply = Double
situationalBenApply Double -> Double -> Bool
forall a. Ord a => a -> a -> Bool
> 0 Bool -> Bool -> Bool
&& case ApplyItemGroup
applyGroup of
              ApplyFirstAid -> (Benefit, CStore, ItemId, ItemFull, ItemQuant) -> Bool
q (Benefit, CStore, ItemId, ItemFull, ItemQuant)
benAv Bool -> Bool -> Bool
&& (Bool
heals Bool -> Bool -> Bool
|| Bool
dropsImpressed)
                -- when low HP, Calm easy to deplete, so impressed crucial
              ApplyAll -> (Benefit, CStore, ItemId, ItemFull, ItemQuant) -> Bool
q (Benefit, CStore, ItemId, ItemFull, ItemQuant)
benAv
                          Bool -> Bool -> Bool
&& Bool -> Bool
not Bool
dropsGoodOrgans
                          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
        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 "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
     => ActorId -> [(Int, Point)] -> m (Strategy RequestTimed)
flee :: ActorId -> [(Int, Point)] -> m (Strategy RequestTimed)
flee aid :: ActorId
aid fleeL :: [(Int, Point)]
fleeL = 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
  -- Regardless if fleeing accomplished, mark the need.
  (StateClient -> StateClient) -> m ()
forall (m :: * -> *).
MonadClient m =>
(StateClient -> StateClient) -> m ()
modifyClient ((StateClient -> StateClient) -> m ())
-> (StateClient -> StateClient) -> m ()
forall a b. (a -> b) -> a -> b
$ \cli :: StateClient
cli -> StateClient
cli {sfleeD :: EnumMap ActorId Point
sfleeD = ActorId -> Point -> EnumMap ActorId Point -> EnumMap ActorId Point
forall k a. Enum k => k -> a -> EnumMap k a -> EnumMap k a
EM.insert ActorId
aid (Actor -> Point
bpos Actor
b) (StateClient -> EnumMap ActorId Point
sfleeD StateClient
cli)}
  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)]
fleeL
      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 "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 (ActorId -> Vector -> m (Maybe RequestTimed)
forall (m :: * -> *).
MonadClient m =>
ActorId -> Vector -> m (Maybe RequestTimed)
moveOrRunAid 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 :: MonadClient m => ActorId -> m (Strategy RequestTimed)
displaceFoe :: ActorId -> m (Strategy RequestTimed)
displaceFoe aid :: ActorId
aid = 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
  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 (_, b2 :: 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 p :: Point
p =  -- DisplaceAccess
        TileSpeedup -> ContentId TileKind -> Bool
Tile.isWalkable TileSpeedup
coTileSpeedup (Level
lvl Level -> Point -> ContentId TileKind
`at` Point
p)
      notLooping :: Actor -> Point -> Bool
notLooping body :: Actor
body p :: 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
      nFriends :: Actor -> Int
nFriends body :: 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
+ 1
      qualifyActor :: (ActorId, Actor) -> m (Maybe (Int, RequestTimed))
qualifyActor (aid2 :: ActorId
aid2, body2 :: Actor
body2) = do
        let tpos :: Point
tpos = Actor -> Point
bpos Actor
body2
        case Point -> Level -> [ActorId]
posToAidsLvl Point
tpos Level
lvl of
          [_] -> 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
body2
            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 Point -> Bool
walkable (Actor -> Point
bpos Actor
body2)  -- DisplaceAccess
                         Bool -> Bool -> Bool
&& Bool
dEnemy Bool -> Bool -> Bool
&& Int
nFrOld Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
nFrNew
                         Bool -> Bool -> Bool
&& Actor -> Point -> Bool
notLooping Actor
b (Actor -> Point
bpos Actor
body2)
                      then (Int, RequestTimed) -> Maybe (Int, RequestTimed)
forall a. a -> Maybe a
Just (Int
nFrOld Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
nFrOld, ActorId -> RequestTimed
ReqDisplace ActorId
aid2)
                      else Maybe (Int, RequestTimed)
forall a. Maybe a
Nothing
          _ -> 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 "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 :: MonadClient m => ActorId -> Bool -> m (Strategy RequestTimed)
displaceBlocker :: ActorId -> Bool -> m (Strategy RequestTimed)
displaceBlocker aid :: ActorId
aid retry :: 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
  ActorMaxSkills
actorMaxSkills <- (State -> ActorMaxSkills) -> m ActorMaxSkills
forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
getsState State -> ActorMaxSkills
sactorMaxSkills
  let condCanMelee :: Bool
condCanMelee = ActorMaxSkills -> ActorId -> Actor -> Bool
actorCanMelee ActorMaxSkills
actorMaxSkills ActorId
aid Actor
b
  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=q :: Point
q : _, 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 displace if can't
                       -- melee (e.g., followed leader) and desperate
        Bool -> Bool -> Bool
&& Bool -> Bool
not (Bool
retry Bool -> Bool -> Bool
&& Bool
condCanMelee) ->
        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=q :: Point
q : _}}
      | 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 :: * -> *).
MonadClient m =>
ActorId -> Point -> Bool -> m (Strategy RequestTimed)
displaceTgt ActorId
aid Point
q Bool
retry
    _ -> Strategy RequestTimed -> m (Strategy RequestTimed)
forall (m :: * -> *) a. Monad m => a -> m a
return Strategy RequestTimed
forall a. Strategy a
reject  -- goal reached

displaceTgt :: MonadClient m
            => ActorId -> Point -> Bool -> m (Strategy RequestTimed)
displaceTgt :: ActorId -> Point -> Bool -> m (Strategy RequestTimed)
displaceTgt source :: ActorId
source tpos :: Point
tpos retry :: 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
  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 p :: Point
p =  -- DisplaceAccess
        TileSpeedup -> ContentId TileKind -> Bool
Tile.isWalkable TileSpeedup
coTileSpeedup (Level
lvl Level -> Point -> ContentId TileKind
`at` Point
p)
      notLooping :: Actor -> Point -> Bool
notLooping body :: Actor
body p :: 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
  if Point -> Bool
walkable Point
tpos Bool -> Bool -> Bool
&& Actor -> Point -> Bool
notLooping Actor
b Point
tpos then do
    Maybe ActorId
mleader <- (StateClient -> Maybe ActorId) -> m (Maybe ActorId)
forall (m :: * -> *) a.
MonadClientRead m =>
(StateClient -> a) -> m a
getsClient StateClient -> Maybe ActorId
sleader
    case Point -> Level -> [ActorId]
posToAidsLvl Point
tpos Level
lvl of
      [] -> Strategy RequestTimed -> m (Strategy RequestTimed)
forall (m :: * -> *) a. Monad m => a -> m a
return Strategy RequestTimed
forall a. Strategy a
reject
      [aid2 :: 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 -> 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 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 :: * -> *). MonadClient m => ActorId -> m Bool
condAimEnemyPresentM ActorId
source
        Bool
enemyPos <- ActorId -> m Bool
forall (m :: * -> *). MonadClient m => ActorId -> m Bool
condAimEnemyRememberedM ActorId
source
        Bool
enemyTgt2 <- ActorId -> m Bool
forall (m :: * -> *). MonadClient m => ActorId -> m Bool
condAimEnemyPresentM ActorId
aid2
        Bool
enemyPos2 <- ActorId -> m Bool
forall (m :: * -> *). MonadClient m => ActorId -> m Bool
condAimEnemyRememberedM ActorId
aid2
        case Maybe TgtAndPath
mtgtMPath of
          Just TgtAndPath{tapPath :: TgtAndPath -> Maybe AndPath
tapPath=Just AndPath{pathList :: AndPath -> [Point]
pathList=q :: Point
q : _}}
            | Point
q Point -> Point -> Bool
forall a. Eq a => a -> a -> Bool
== Actor -> Point
bpos Actor
b  -- friend wants to swap
              Bool -> Bool -> Bool
|| Actor -> Watchfulness
bwatch Actor
b2 Watchfulness -> [Watchfulness] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Watchfulness
WSleep, Watchfulness
WWake]  -- friend sleeps, not cares
              Bool -> Bool -> Bool
|| Bool
retry  -- desperate
                 Bool -> Bool -> Bool
&& Bool -> Bool
not (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  -- and no displace loop
                         Bool -> Bool -> Bool
&& Bool -> Bool
not (Actor -> Bool
actorWaits Actor
b))
              Bool -> Bool -> Bool
|| (Bool
enemyTgt Bool -> Bool -> Bool
|| Bool
enemyPos) Bool -> Bool -> Bool
&& Bool -> Bool
not (Bool
enemyTgt2 Bool -> Bool -> Bool
|| Bool
enemyPos2) ->
                 -- 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
              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 "displace friend" (RequestTimed -> Strategy RequestTimed)
-> RequestTimed -> Strategy RequestTimed
forall a b. (a -> b) -> a -> b
$ ActorId -> RequestTimed
ReqDisplace ActorId
aid2
          Just _ | Actor -> Watchfulness
bwatch Actor
b2 Watchfulness -> [Watchfulness] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`notElem` [Watchfulness
WSleep, Watchfulness
WWake] -> Strategy RequestTimed -> m (Strategy RequestTimed)
forall (m :: * -> *) a. Monad m => a -> m a
return Strategy RequestTimed
forall a. Strategy a
reject
          _ -> do  -- an enemy or ally or dozing or disoriented friend --- swap
            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
            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
            if Bool -> Bool
not (FactionId -> Faction -> FactionId -> Bool
isFoe (Actor -> FactionId
bfid Actor
b2) Faction
tfact (Actor -> FactionId
bfid Actor
b)) Bool -> Bool -> Bool
|| Bool
dEnemy 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 "displace other" (RequestTimed -> Strategy RequestTimed)
-> RequestTimed -> Strategy RequestTimed
forall a b. (a -> b) -> a -> b
$ ActorId -> RequestTimed
ReqDisplace ActorId
aid2
            else 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  -- DisplaceProjectiles or trying to displace leader
  else Strategy RequestTimed -> m (Strategy RequestTimed)
forall (m :: * -> *) a. Monad m => a -> m a
return Strategy RequestTimed
forall a. Strategy a
reject

chase :: MonadClient m => ActorId -> Bool -> Bool -> m (Strategy RequestTimed)
chase :: ActorId -> Bool -> Bool -> m (Strategy RequestTimed)
chase aid :: ActorId
aid avoidAmbient :: Bool
avoidAmbient retry :: 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
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
  Level
lvl <- LevelId -> m Level
forall (m :: * -> *). MonadStateRead m => LevelId -> m Level
getLevel (LevelId -> m Level) -> LevelId -> m Level
forall a b. (a -> b) -> a -> b
$ Actor -> LevelId
blid Actor
body
  let isAmbient :: Point -> Bool
isAmbient pos :: 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
  Strategy Vector
str <- case Maybe TgtAndPath
mtgtMPath of
    Just TgtAndPath{tapPath :: TgtAndPath -> Maybe AndPath
tapPath=Just AndPath{pathList :: AndPath -> [Point]
pathList=q :: Point
q : _, ..}}
      | Point
pathGoal Point -> Point -> Bool
forall a. Eq a => a -> a -> Bool
== Actor -> Point
bpos Actor
body -> 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.
      | Bool -> Bool
not (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$ Bool
avoidAmbient Bool -> Bool -> Bool
&& Point -> Bool
isAmbient Point
q ->
      -- With no leader, the goal is vague, so permit arbitrary detours.
      ActorId -> Point -> Point -> Bool -> m (Strategy Vector)
forall (m :: * -> *).
MonadClient m =>
ActorId -> Point -> Point -> Bool -> m (Strategy Vector)
moveTowards ActorId
aid Point
q Point
pathGoal (Player -> LeaderMode
fleaderMode (Faction -> Player
gplayer Faction
fact) LeaderMode -> LeaderMode -> Bool
forall a. Eq a => a -> a -> Bool
== LeaderMode
LeaderNull
                                  Bool -> Bool -> Bool
|| Bool
retry)
    _ -> 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
  if Bool
avoidAmbient Bool -> Bool -> Bool
&& Strategy Vector -> Bool
forall a. Strategy a -> Bool
nullStrategy Strategy Vector
str
  then ActorId -> Bool -> Bool -> m (Strategy RequestTimed)
forall (m :: * -> *).
MonadClient m =>
ActorId -> Bool -> Bool -> m (Strategy RequestTimed)
chase ActorId
aid Bool
False Bool
retry
  else (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 (ActorId -> Vector -> m (Maybe RequestTimed)
forall (m :: * -> *).
MonadClient m =>
ActorId -> Vector -> m (Maybe RequestTimed)
moveOrRunAid ActorId
aid) Strategy Vector
str

moveTowards :: MonadClient m
            => ActorId -> Point -> Point -> Bool -> m (Strategy Vector)
moveTowards :: ActorId -> Point -> Point -> Bool -> m (Strategy Vector)
moveTowards aid :: ActorId
aid target :: Point
target goal :: Point
goal relaxed :: Bool
relaxed = 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
actorSk <- ActorId -> m Skills
forall (m :: * -> *). MonadClientRead m => ActorId -> m Skills
currentSkillsClient ActorId
aid
  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
$ \s :: State
s p :: 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
      -- Only actors with SkAlter can search for hidden doors, etc.
      enterableHere :: Point -> Bool
enterableHere p :: 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)
  if Point -> Bool
noFriends Point
target Bool -> Bool -> Bool
&& Point -> Bool
enterableHere 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 "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 p :: 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 p :: 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 = \p :: Point
p -> Point -> Bool
noFriends Point
p
                                     Bool -> Bool -> Bool
&& Point -> Bool
enterableHere Point
p
                   | Bool
otherwise = \p :: 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
enterableHere 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 ]
        sorted :: [((Bool, Int), Vector)]
sorted = (((Bool, Int), Vector) -> (Bool, Int))
-> [((Bool, Int), Vector)] -> [((Bool, Int), Vector)]
forall b a. Ord b => (a -> b) -> [a] -> [a]
sortOn ((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 "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 :: MonadClient m => ActorId -> Vector -> m (Maybe RequestTimed)
moveOrRunAid :: ActorId -> Vector -> m (Maybe RequestTimed)
moveOrRunAid source :: ActorId
source dir :: 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
  Skills
actorSk <- ActorId -> m Skills
forall (m :: * -> *). MonadClientRead m => ActorId -> m Skills
currentSkillsClient 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 body :: Actor
body p :: 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
    [target :: 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
> 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
> 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., 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
    _ -> 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