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

import Prelude ()

import Game.LambdaHack.Core.Prelude

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

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

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

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

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

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

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

pickup :: MonadClientRead m => ActorId -> Bool -> m (Strategy RequestTimed)
pickup :: forall (m :: * -> *).
MonadClientRead m =>
ActorId -> Bool -> m (Strategy RequestTimed)
pickup ActorId
aid Bool
onlyWeapon = do
  benItemL <- ActorId -> m [(Benefit, CStore, ItemId, ItemFull, ItemQuant)]
forall (m :: * -> *).
MonadClientRead m =>
ActorId -> m [(Benefit, CStore, ItemId, ItemFull, ItemQuant)]
benGroundItems ActorId
aid
  b <- getsState $ getActorBody 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)
  actorMaxSk <- getsState $ getActorMaxSkills aid
  let calmE = Actor -> Skills -> Bool
calmEnough Actor
b Skills
actorMaxSk
      isWeapon (a
_, b
_, c
_, ItemFull
itemFull, e
_) =
        Flag -> AspectRecord -> Bool
IA.checkFlag Flag
Ability.Meleeable (AspectRecord -> Bool) -> AspectRecord -> Bool
forall a b. (a -> b) -> a -> b
$ ItemFull -> AspectRecord
aspectRecordFull ItemFull
itemFull
      filterWeapon | 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
oldN, [(ItemId, Int, CStore, CStore)]
l4)
                 (Benefit{Bool
benInEqp :: Bool
benInEqp :: Benefit -> Bool
benInEqp}, CStore
_, ItemId
iid, ItemFull
_, (Int
itemK, ItemTimers
_)) =
        let prep :: Int -> CStore -> (Int, [(ItemId, Int, CStore, CStore)])
prep Int
newN CStore
toCStore = (Int
newN, (ItemId
iid, Int
itemK, CStore
CGround, CStore
toCStore) (ItemId, Int, CStore, CStore)
-> [(ItemId, Int, CStore, CStore)]
-> [(ItemId, Int, CStore, CStore)]
forall a. a -> [a] -> [a]
: [(ItemId, Int, CStore, CStore)]
l4)
            n :: Int
n = Int
oldN Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
itemK
        in if | Bool
benInEqp Bool -> Bool -> Bool
&& Bool
calmE Bool -> Bool -> Bool
&& Bool -> Bool
not (Actor -> Int -> Bool
eqpOverfull Actor
b Int
n) -> Int -> CStore -> (Int, [(ItemId, Int, CStore, CStore)])
prep Int
n CStore
CEqp
              | Bool
onlyWeapon -> (Int
oldN, [(ItemId, Int, CStore, CStore)]
l4)
              | Bool
otherwise -> Int -> CStore -> (Int, [(ItemId, Int, CStore, CStore)])
prep Int
n CStore
CStash
      (_, prepared) = foldl' prepareOne (0, []) $ filterWeapon benItemL
  return $! if null prepared then reject
            else returN "pickup" $ ReqMoveItems prepared

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

moveTowards :: MonadClientRead m
            => Ability.Skills -> ActorId -> Bool -> Point -> Point -> Bool
            -> m (Strategy Vector)
moveTowards :: forall (m :: * -> *).
MonadClientRead m =>
Skills
-> ActorId -> Bool -> Point -> Point -> Bool -> m (Strategy Vector)
moveTowards Skills
actorSk ActorId
aid Bool
avoidAmbient Point
target Point
goal Bool
relaxed = do
  COps{coTileSpeedup} <- (State -> COps) -> m COps
forall a. (State -> a) -> m a
forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
getsState State -> COps
scops
  b <- getsState $ getActorBody aid
  lvl <- getLevel $ blid b
  let source = Actor -> Point
bpos Actor
b
      alterSkill = Skill -> Skills -> Int
getSk Skill
SkAlter Skills
actorSk
      !_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 v. Show v => Bool -> v -> Bool
`blame` (Point
source, Point
target, ActorId
aid, Actor
b, Point
goal)) ()
  fact <- getsState $ (EM.! bfid b) . sfactionD
  salter <- getsClient salter
  noFriends <- getsState $ \State
s Point
p ->
    ((ActorId, Actor) -> Bool) -> [(ActorId, Actor)] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all (FactionId -> Faction -> FactionId -> Bool
isFoe (Actor -> FactionId
bfid Actor
b) Faction
fact (FactionId -> Bool)
-> ((ActorId, Actor) -> FactionId) -> (ActorId, Actor) -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Actor -> FactionId
bfid (Actor -> FactionId)
-> ((ActorId, Actor) -> Actor) -> (ActorId, Actor) -> FactionId
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ActorId, Actor) -> Actor
forall a b. (a, b) -> b
snd)
        (Point -> LevelId -> State -> [(ActorId, Actor)]
posToAidAssocs Point
p (Actor -> LevelId
blid Actor
b) State
s)  -- don't kill own projectiles
  let lalter = AlterLid
salter AlterLid -> LevelId -> Array Word8
forall k a. Enum k => EnumMap k a -> k -> a
EM.! Actor -> LevelId
blid Actor
b
      isAmbient Point
pos = TileSpeedup -> ContentId TileKind -> Bool
Tile.isLit TileSpeedup
coTileSpeedup (Level
lvl Level -> Point -> ContentId TileKind
`at` Point
pos)
                      Bool -> Bool -> Bool
&& TileSpeedup -> ContentId TileKind -> Bool
Tile.isWalkable TileSpeedup
coTileSpeedup (Level
lvl Level -> Point -> ContentId TileKind
`at` Point
pos)
                        -- if solid, will be altered and perhaps darkened
      -- Only actors with SkAlter can search for hidden doors, etc.
      enterableHere Point
p = Int
alterSkill Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Word8 -> Int
forall a. Enum a => a -> Int
fromEnum (Array Word8
lalter Array Word8 -> Point -> Word8
forall c. UnboxRepClass c => Array c -> Point -> c
PointArray.! Point
p)
      permittedHere Point
p | Bool
avoidAmbient = Point -> Bool
enterableHere Point
p Bool -> Bool -> Bool
&& Bool -> Bool
not (Point -> Bool
isAmbient Point
p)
                      | Bool
otherwise = Point -> Bool
enterableHere Point
p
  -- If target is the final goal, is not occupied and is lit, permit
  -- movement into lit position, regardless.
  if noFriends target && (target == goal && enterableHere target
                          || permittedHere target) then
    return $! returN "moveTowards target" $ target `vectorToFrom` 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
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
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 | Bool
relaxed = \Point
p -> Point -> Bool
noFriends Point
p
                                     Bool -> Bool -> Bool
&& Point -> Bool
permittedHere Point
p
                   | Bool
otherwise = \Point
p -> Point -> Bool
nonincreasing Point
p
                                       Bool -> Bool -> Bool
&& Bool -> Bool
not (Point -> Bool
goesBack Point
p)
                                       Bool -> Bool -> Bool
&& Point -> Bool
noFriends Point
p
                                       Bool -> Bool -> Bool
&& Point -> Bool
permittedHere Point
p
        sensible = [ ((Point -> Bool
goesBack Point
p, Point -> Point -> Int
chessDist Point
p Point
goal), Vector
v)
                   | Vector
v <- [Vector]
moves
                   , let p :: Point
p = Point
source Point -> Vector -> Point
`shift` Vector
v
                   , Point -> Bool
isSensible Point
p ]
        -- @SortOn@ less efficient here, because function cheap.
        sorted = (((Bool, Int), Vector) -> ((Bool, Int), Vector) -> Ordering)
-> [((Bool, Int), Vector)] -> [((Bool, Int), Vector)]
forall a. (a -> a -> Ordering) -> [a] -> [a]
sortBy ((((Bool, Int), Vector) -> (Bool, Int))
-> ((Bool, Int), Vector) -> ((Bool, Int), Vector) -> Ordering
forall a b. Ord a => (b -> a) -> b -> b -> Ordering
comparing ((Bool, Int), Vector) -> (Bool, Int)
forall a b. (a, b) -> a
fst) [((Bool, Int), Vector)]
sensible
        groups = ([((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 = ([Vector] -> Strategy Vector) -> [[Vector]] -> [Strategy Vector]
forall a b. (a -> b) -> [a] -> [b]
map (Frequency Vector -> Strategy Vector
forall a. Frequency a -> Strategy a
liftFrequency (Frequency Vector -> Strategy Vector)
-> ([Vector] -> Frequency Vector) -> [Vector] -> Strategy Vector
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> [Vector] -> Frequency Vector
forall a. Text -> [a] -> Frequency a
uniformFreq Text
"moveTowards") [[Vector]]
groups
    return $! foldr (.|) reject freqs

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