-- | Assorted conditions used later on in AI logic.
module Game.LambdaHack.Client.AI.ConditionM
  ( condAimEnemyPresentM
  , condAimEnemyRememberedM
  , condAimNonEnemyPresentM
  , condAimEnemyNoMeleeM
  , condInMeleeM
  , condAimCrucialM
  , condTgtNonmovingEnemyM
  , condAnyFoeAdjM
  , condAdjTriggerableM
  , meleeThreatDistList
  , condBlocksFriendsM
  , condFloorWeaponM
  , condNoEqpWeaponM
  , condCanProjectM
  , condProjectListM
  , benAvailableItems
  , hinders
  , condDesirableFloorItemM
  , benGroundItems
  , desirableItem
  , condSupport
  , condSoloM
  , condShineWouldBetrayM
  , fleeList
  ) where

import Prelude ()

import Game.LambdaHack.Core.Prelude

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

import           Game.LambdaHack.Client.Bfs
import           Game.LambdaHack.Client.CommonM
import           Game.LambdaHack.Client.MonadClient
import           Game.LambdaHack.Client.State
import           Game.LambdaHack.Common.Actor
import           Game.LambdaHack.Common.ActorState
import           Game.LambdaHack.Common.Faction
import           Game.LambdaHack.Common.Item
import qualified Game.LambdaHack.Common.ItemAspect as IA
import           Game.LambdaHack.Common.Kind
import           Game.LambdaHack.Common.Level
import           Game.LambdaHack.Common.MonadStateRead
import           Game.LambdaHack.Common.ReqFailure
import           Game.LambdaHack.Common.State
import qualified Game.LambdaHack.Common.Tile as Tile
import           Game.LambdaHack.Common.Time
import           Game.LambdaHack.Common.Types
import           Game.LambdaHack.Common.Vector
import qualified Game.LambdaHack.Content.ItemKind as IK
import           Game.LambdaHack.Content.ModeKind
import           Game.LambdaHack.Content.RuleKind
import qualified Game.LambdaHack.Core.Dice as Dice
import           Game.LambdaHack.Common.Point
import qualified Game.LambdaHack.Definition.Ability as Ability
import           Game.LambdaHack.Definition.Defs

-- All conditions are (partially) lazy, because they are not always
-- used in the strict monadic computations they are in.

-- | Require that the target enemy is visible by the party.
condAimEnemyPresentM :: MonadClient m => ActorId -> m Bool
condAimEnemyPresentM :: ActorId -> m Bool
condAimEnemyPresentM aid :: ActorId
aid = do
  Maybe Target
btarget <- (StateClient -> Maybe Target) -> m (Maybe Target)
forall (m :: * -> *) a.
MonadClientRead m =>
(StateClient -> a) -> m a
getsClient ((StateClient -> Maybe Target) -> m (Maybe Target))
-> (StateClient -> Maybe Target) -> m (Maybe Target)
forall a b. (a -> b) -> a -> b
$ ActorId -> StateClient -> Maybe Target
getTarget ActorId
aid
  Bool -> m Bool
forall (m :: * -> *) a. Monad m => a -> m a
return (Bool -> m Bool) -> Bool -> m Bool
forall a b. (a -> b) -> a -> b
$ case Maybe Target
btarget of
    Just (TEnemy _) -> Bool
True
    _ -> Bool
False

-- | Require that the target enemy is remembered on the actor's level.
condAimEnemyRememberedM :: MonadClient m => ActorId -> m Bool
condAimEnemyRememberedM :: ActorId -> m Bool
condAimEnemyRememberedM aid :: ActorId
aid = do
  Actor
b <- (State -> Actor) -> m Actor
forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
getsState ((State -> Actor) -> m Actor) -> (State -> Actor) -> m Actor
forall a b. (a -> b) -> a -> b
$ ActorId -> State -> Actor
getActorBody ActorId
aid
  Maybe Target
btarget <- (StateClient -> Maybe Target) -> m (Maybe Target)
forall (m :: * -> *) a.
MonadClientRead m =>
(StateClient -> a) -> m a
getsClient ((StateClient -> Maybe Target) -> m (Maybe Target))
-> (StateClient -> Maybe Target) -> m (Maybe Target)
forall a b. (a -> b) -> a -> b
$ ActorId -> StateClient -> Maybe Target
getTarget ActorId
aid
  Bool -> m Bool
forall (m :: * -> *) a. Monad m => a -> m a
return (Bool -> m Bool) -> Bool -> m Bool
forall a b. (a -> b) -> a -> b
$ case Maybe Target
btarget of
    Just (TPoint (TEnemyPos _) lid :: LevelId
lid _) -> LevelId
lid LevelId -> LevelId -> Bool
forall a. Eq a => a -> a -> Bool
== Actor -> LevelId
blid Actor
b
    _ -> Bool
False

-- | Require that the target non-enemy is visible by the party.
condAimNonEnemyPresentM :: MonadClient m => ActorId -> m Bool
condAimNonEnemyPresentM :: ActorId -> m Bool
condAimNonEnemyPresentM aid :: ActorId
aid = do
  Maybe Target
btarget <- (StateClient -> Maybe Target) -> m (Maybe Target)
forall (m :: * -> *) a.
MonadClientRead m =>
(StateClient -> a) -> m a
getsClient ((StateClient -> Maybe Target) -> m (Maybe Target))
-> (StateClient -> Maybe Target) -> m (Maybe Target)
forall a b. (a -> b) -> a -> b
$ ActorId -> StateClient -> Maybe Target
getTarget ActorId
aid
  Bool -> m Bool
forall (m :: * -> *) a. Monad m => a -> m a
return (Bool -> m Bool) -> Bool -> m Bool
forall a b. (a -> b) -> a -> b
$ case Maybe Target
btarget of
    Just (TNonEnemy _) -> Bool
True
    _ -> Bool
False

-- | Require that the target enemy is visible by the party and doesn't melee.
condAimEnemyNoMeleeM :: MonadClient m => ActorId -> m Bool
condAimEnemyNoMeleeM :: ActorId -> m Bool
condAimEnemyNoMeleeM aid :: ActorId
aid = do
  Maybe Target
btarget <- (StateClient -> Maybe Target) -> m (Maybe Target)
forall (m :: * -> *) a.
MonadClientRead m =>
(StateClient -> a) -> m a
getsClient ((StateClient -> Maybe Target) -> m (Maybe Target))
-> (StateClient -> Maybe Target) -> m (Maybe Target)
forall a b. (a -> b) -> a -> b
$ ActorId -> StateClient -> Maybe Target
getTarget ActorId
aid
  case Maybe Target
btarget of
    Just (TEnemy aid2 :: ActorId
aid2) -> do
      Actor
b2 <- (State -> Actor) -> m Actor
forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
getsState ((State -> Actor) -> m Actor) -> (State -> Actor) -> m Actor
forall a b. (a -> b) -> a -> b
$ ActorId -> State -> Actor
getActorBody ActorId
aid2
      ActorMaxSkills
actorMaxSkills <- (State -> ActorMaxSkills) -> m ActorMaxSkills
forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
getsState State -> ActorMaxSkills
sactorMaxSkills
      Bool -> m Bool
forall (m :: * -> *) a. Monad m => a -> m a
return (Bool -> m Bool) -> Bool -> m Bool
forall a b. (a -> b) -> a -> b
$ ActorMaxSkills -> ActorId -> Actor -> Bool
actorCanMelee ActorMaxSkills
actorMaxSkills ActorId
aid2 Actor
b2
    _ -> Bool -> m Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
False

condInMeleeM :: MonadClient m => LevelId -> m Bool
condInMeleeM :: LevelId -> m Bool
condInMeleeM lid :: LevelId
lid = do
  EnumMap LevelId Bool
condInMelee <- (StateClient -> EnumMap LevelId Bool) -> m (EnumMap LevelId Bool)
forall (m :: * -> *) a.
MonadClientRead m =>
(StateClient -> a) -> m a
getsClient StateClient -> EnumMap LevelId Bool
scondInMelee
  case LevelId -> EnumMap LevelId Bool -> Maybe Bool
forall k a. Enum k => k -> EnumMap k a -> Maybe a
EM.lookup LevelId
lid EnumMap LevelId Bool
condInMelee of
    Just inM :: Bool
inM -> Bool -> m Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
inM
    Nothing -> do
      FactionId
side <- (StateClient -> FactionId) -> m FactionId
forall (m :: * -> *) a.
MonadClientRead m =>
(StateClient -> a) -> m a
getsClient StateClient -> FactionId
sside
      Bool
inM <- (State -> Bool) -> m Bool
forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
getsState ((State -> Bool) -> m Bool) -> (State -> Bool) -> m Bool
forall a b. (a -> b) -> a -> b
$ FactionId -> LevelId -> State -> Bool
inMelee FactionId
side LevelId
lid
      (StateClient -> StateClient) -> m ()
forall (m :: * -> *).
MonadClient m =>
(StateClient -> StateClient) -> m ()
modifyClient ((StateClient -> StateClient) -> m ())
-> (StateClient -> StateClient) -> m ()
forall a b. (a -> b) -> a -> b
$ \cli :: StateClient
cli ->
        StateClient
cli {scondInMelee :: EnumMap LevelId Bool
scondInMelee = LevelId -> Bool -> EnumMap LevelId Bool -> EnumMap LevelId Bool
forall k a. Enum k => k -> a -> EnumMap k a -> EnumMap k a
EM.insert LevelId
lid Bool
inM EnumMap LevelId Bool
condInMelee}
      Bool -> m Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
inM

-- | Require that the target is crucial to success, e.g., an item,
-- or that it's not too far away and so the changes to get it are high.
condAimCrucialM :: MonadClient m => ActorId -> m Bool
condAimCrucialM :: ActorId -> m Bool
condAimCrucialM aid :: ActorId
aid = do
  Actor
b <- (State -> Actor) -> m Actor
forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
getsState ((State -> Actor) -> m Actor) -> (State -> Actor) -> m Actor
forall a b. (a -> b) -> a -> b
$ ActorId -> State -> Actor
getActorBody ActorId
aid
  Maybe TgtAndPath
mtgtMPath <- (StateClient -> Maybe TgtAndPath) -> m (Maybe TgtAndPath)
forall (m :: * -> *) a.
MonadClientRead m =>
(StateClient -> a) -> m a
getsClient ((StateClient -> Maybe TgtAndPath) -> m (Maybe TgtAndPath))
-> (StateClient -> Maybe TgtAndPath) -> m (Maybe TgtAndPath)
forall a b. (a -> b) -> a -> b
$ ActorId -> EnumMap ActorId TgtAndPath -> Maybe TgtAndPath
forall k a. Enum k => k -> EnumMap k a -> Maybe a
EM.lookup ActorId
aid (EnumMap ActorId TgtAndPath -> Maybe TgtAndPath)
-> (StateClient -> EnumMap ActorId TgtAndPath)
-> StateClient
-> Maybe TgtAndPath
forall b c a. (b -> c) -> (a -> b) -> a -> c
. StateClient -> EnumMap ActorId TgtAndPath
stargetD
  Bool -> m Bool
forall (m :: * -> *) a. Monad m => a -> m a
return (Bool -> m Bool) -> Bool -> m Bool
forall a b. (a -> b) -> a -> b
$ case Maybe TgtAndPath
mtgtMPath of
    Just TgtAndPath{tapTgt :: TgtAndPath -> Target
tapTgt=TEnemy _} -> Bool
True
    Just TgtAndPath{tapTgt :: TgtAndPath -> Target
tapTgt=TPoint tgoal :: TGoal
tgoal lid :: LevelId
lid _, tapPath :: TgtAndPath -> Maybe AndPath
tapPath=Just AndPath{Int
pathLen :: AndPath -> Int
pathLen :: Int
pathLen}} ->
      LevelId
lid LevelId -> LevelId -> Bool
forall a. Eq a => a -> a -> Bool
== Actor -> LevelId
blid Actor
b
      Bool -> Bool -> Bool
&& (Int
pathLen Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< 10  -- close enough to get there first
          Bool -> Bool -> Bool
|| TGoal
tgoal TGoal -> [TGoal] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`notElem` [TGoal
TUnknown, TGoal
TKnown])
    Just TgtAndPath{tapTgt :: TgtAndPath -> Target
tapTgt=TVector{}, tapPath :: TgtAndPath -> Maybe AndPath
tapPath=Just AndPath{Int
pathLen :: Int
pathLen :: AndPath -> Int
pathLen}} ->
      Int
pathLen Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< 7  -- the constant in @vToTgt@, where only
                   -- non-crucial targets are produced; this will also
                   -- prevent animals from sleep close to cave edges
    _ -> Bool
False  -- includes the case of target with no path

-- | Check if the target is a nonmoving enemy.
condTgtNonmovingEnemyM :: MonadClient m => ActorId -> m Bool
condTgtNonmovingEnemyM :: ActorId -> m Bool
condTgtNonmovingEnemyM aid :: ActorId
aid = do
  Maybe Target
btarget <- (StateClient -> Maybe Target) -> m (Maybe Target)
forall (m :: * -> *) a.
MonadClientRead m =>
(StateClient -> a) -> m a
getsClient ((StateClient -> Maybe Target) -> m (Maybe Target))
-> (StateClient -> Maybe Target) -> m (Maybe Target)
forall a b. (a -> b) -> a -> b
$ ActorId -> StateClient -> Maybe Target
getTarget ActorId
aid
  case Maybe Target
btarget of
    Just (TEnemy enemy :: ActorId
enemy) -> do
      Skills
actorMaxSk <- (State -> Skills) -> m Skills
forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
getsState ((State -> Skills) -> m Skills) -> (State -> Skills) -> m Skills
forall a b. (a -> b) -> a -> b
$ ActorId -> State -> Skills
getActorMaxSkills ActorId
enemy
      Bool -> m Bool
forall (m :: * -> *) a. Monad m => a -> m a
return (Bool -> m Bool) -> Bool -> m Bool
forall a b. (a -> b) -> a -> b
$ Skill -> Skills -> Int
Ability.getSk Skill
Ability.SkMove Skills
actorMaxSk Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= 0
    _ -> Bool -> m Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
False

-- | Require that any non-dying foe is adjacent, except projectiles
-- that (possibly) explode upon contact.
condAnyFoeAdjM :: MonadStateRead m => ActorId -> m Bool
condAnyFoeAdjM :: ActorId -> m Bool
condAnyFoeAdjM aid :: ActorId
aid = (State -> Bool) -> m Bool
forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
getsState ((State -> Bool) -> m Bool) -> (State -> Bool) -> m Bool
forall a b. (a -> b) -> a -> b
$ ActorId -> State -> Bool
anyFoeAdj ActorId
aid

-- | Require the actor stands on or adjacent to a triggerable tile
-- (e.g., stairs).
condAdjTriggerableM :: MonadClient m => ActorId -> m Bool
condAdjTriggerableM :: ActorId -> m Bool
condAdjTriggerableM aid :: ActorId
aid = do
  COps{TileSpeedup
coTileSpeedup :: COps -> TileSpeedup
coTileSpeedup :: TileSpeedup
coTileSpeedup} <- (State -> COps) -> m COps
forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
getsState State -> COps
scops
  Actor
b <- (State -> Actor) -> m Actor
forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
getsState ((State -> Actor) -> m Actor) -> (State -> Actor) -> m Actor
forall a b. (a -> b) -> a -> b
$ ActorId -> State -> Actor
getActorBody ActorId
aid
  Level
lvl <- LevelId -> m Level
forall (m :: * -> *). MonadStateRead m => LevelId -> m Level
getLevel (LevelId -> m Level) -> LevelId -> m Level
forall a b. (a -> b) -> a -> b
$ Actor -> LevelId
blid Actor
b
  Skills
actorSk <- ActorId -> m Skills
forall (m :: * -> *). MonadClientRead m => ActorId -> m Skills
currentSkillsClient ActorId
aid
  let alterSkill :: Int
alterSkill = Skill -> Skills -> Int
Ability.getSk Skill
Ability.SkAlter Skills
actorSk
      alterMinSkill :: Point -> Int
alterMinSkill p :: Point
p = TileSpeedup -> ContentId TileKind -> Int
Tile.alterMinSkill TileSpeedup
coTileSpeedup (ContentId TileKind -> Int) -> ContentId TileKind -> Int
forall a b. (a -> b) -> a -> b
$ Level
lvl Level -> Point -> ContentId TileKind
`at` Point
p
      underFeet :: Point -> Bool
underFeet p :: Point
p = Point
p Point -> Point -> Bool
forall a. Eq a => a -> a -> Bool
== Actor -> Point
bpos Actor
b  -- if enter and alter, be more permissive
      -- Before items are applied (which AI attempts even if apply
      -- skills too low), tile must be alerable, hence both checks.
      hasTriggerable :: Point -> Bool
hasTriggerable p :: Point
p = (Point -> Bool
underFeet Point
p
                          Bool -> Bool -> Bool
|| Int
alterSkill Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int -> Int
forall a. Enum a => a -> Int
fromEnum (Point -> Int
alterMinSkill Point
p))
                         Bool -> Bool -> Bool
&& Point
p Point -> EnumMap Point ItemBag -> Bool
forall k a. Enum k => k -> EnumMap k a -> Bool
`EM.member` Level -> EnumMap Point ItemBag
lembed Level
lvl
  Bool -> m Bool
forall (m :: * -> *) a. Monad m => a -> m a
return (Bool -> m Bool) -> Bool -> m Bool
forall a b. (a -> b) -> a -> b
$ (Point -> Bool) -> [Point] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any Point -> Bool
hasTriggerable ([Point] -> Bool) -> [Point] -> Bool
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)

-- | Produce the chess-distance-sorted list of non-low-HP,
-- melee-cabable foes on the level. We don't consider path-distance,
-- because we are interested in how soon the foe can close in to hit us,
-- which can diverge greately from path distance for short distances,
-- e.g., when terrain gets revealed. We don't consider non-moving actors,
-- because they can't chase us and also because they can't be aggresive
-- so to resolve the stalemate, the opposing AI has to be aggresive
-- by ignoring them and closing in to melee distance.
meleeThreatDistList :: ActorId -> State -> [(Int, (ActorId, Actor))]
meleeThreatDistList :: ActorId -> State -> [(Int, (ActorId, Actor))]
meleeThreatDistList aid :: ActorId
aid s :: State
s =
  let actorMaxSkills :: ActorMaxSkills
actorMaxSkills = State -> ActorMaxSkills
sactorMaxSkills State
s
      b :: Actor
b = ActorId -> State -> Actor
getActorBody ActorId
aid State
s
      allAtWar :: [(ActorId, Actor)]
allAtWar = FactionId -> LevelId -> State -> [(ActorId, Actor)]
foeRegularAssocs (Actor -> FactionId
bfid Actor
b) (Actor -> LevelId
blid Actor
b) State
s
      strongActor :: (ActorId, Actor) -> Bool
strongActor (aid2 :: ActorId
aid2, b2 :: Actor
b2) =
        let actorMaxSk :: Skills
actorMaxSk = ActorMaxSkills
actorMaxSkills ActorMaxSkills -> ActorId -> Skills
forall k a. Enum k => EnumMap k a -> k -> a
EM.! ActorId
aid2
            nonmoving :: Bool
nonmoving = Skill -> Skills -> Int
Ability.getSk Skill
Ability.SkMove Skills
actorMaxSk Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= 0
        in Bool -> Bool
not (Actor -> Skills -> Bool
hpTooLow Actor
b2 Skills
actorMaxSk Bool -> Bool -> Bool
|| Bool
nonmoving)
           Bool -> Bool -> Bool
&& ActorMaxSkills -> ActorId -> Actor -> Bool
actorCanMelee ActorMaxSkills
actorMaxSkills ActorId
aid2 Actor
b2
      allThreats :: [(ActorId, Actor)]
allThreats = ((ActorId, Actor) -> Bool)
-> [(ActorId, Actor)] -> [(ActorId, Actor)]
forall a. (a -> Bool) -> [a] -> [a]
filter (ActorId, Actor) -> Bool
strongActor [(ActorId, Actor)]
allAtWar
      addDist :: (ActorId, Actor) -> (Int, (ActorId, Actor))
addDist (aid2 :: ActorId
aid2, b2 :: Actor
b2) = (Point -> Point -> Int
chessDist (Actor -> Point
bpos Actor
b) (Actor -> Point
bpos Actor
b2), (ActorId
aid2, Actor
b2))
  in ((Int, (ActorId, Actor)) -> (Int, (ActorId, Actor)) -> Ordering)
-> [(Int, (ActorId, Actor))] -> [(Int, (ActorId, Actor))]
forall a. (a -> a -> Ordering) -> [a] -> [a]
sortBy (((Int, (ActorId, Actor)) -> Int)
-> (Int, (ActorId, Actor)) -> (Int, (ActorId, Actor)) -> Ordering
forall a b. Ord a => (b -> a) -> b -> b -> Ordering
comparing (Int, (ActorId, Actor)) -> Int
forall a b. (a, b) -> a
fst) ([(Int, (ActorId, Actor))] -> [(Int, (ActorId, Actor))])
-> [(Int, (ActorId, Actor))] -> [(Int, (ActorId, Actor))]
forall a b. (a -> b) -> a -> b
$ ((ActorId, Actor) -> (Int, (ActorId, Actor)))
-> [(ActorId, Actor)] -> [(Int, (ActorId, Actor))]
forall a b. (a -> b) -> [a] -> [b]
map (ActorId, Actor) -> (Int, (ActorId, Actor))
addDist [(ActorId, Actor)]
allThreats

-- | Require the actor blocks the paths of any of his party members.
condBlocksFriendsM :: MonadClient m => ActorId -> m Bool
condBlocksFriendsM :: ActorId -> m Bool
condBlocksFriendsM aid :: ActorId
aid = do
  Actor
b <- (State -> Actor) -> m Actor
forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
getsState ((State -> Actor) -> m Actor) -> (State -> Actor) -> m Actor
forall a b. (a -> b) -> a -> b
$ ActorId -> State -> Actor
getActorBody ActorId
aid
  EnumMap ActorId TgtAndPath
targetD <- (StateClient -> EnumMap ActorId TgtAndPath)
-> m (EnumMap ActorId TgtAndPath)
forall (m :: * -> *) a.
MonadClientRead m =>
(StateClient -> a) -> m a
getsClient StateClient -> EnumMap ActorId TgtAndPath
stargetD
  let blocked :: ActorId -> Bool
blocked aid2 :: ActorId
aid2 = ActorId
aid2 ActorId -> ActorId -> Bool
forall a. Eq a => a -> a -> Bool
/= ActorId
aid Bool -> Bool -> Bool
&&
        case ActorId -> EnumMap ActorId TgtAndPath -> Maybe TgtAndPath
forall k a. Enum k => k -> EnumMap k a -> Maybe a
EM.lookup ActorId
aid2 EnumMap ActorId TgtAndPath
targetD of
          Just TgtAndPath{tapPath :: TgtAndPath -> Maybe AndPath
tapPath=Just AndPath{pathList :: AndPath -> [Point]
pathList=q :: Point
q : _}} | Point
q Point -> Point -> Bool
forall a. Eq a => a -> a -> Bool
== Actor -> Point
bpos Actor
b ->
            Bool
True
          _ -> Bool
False
  (ActorId -> Bool) -> [ActorId] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any ActorId -> Bool
blocked ([ActorId] -> Bool) -> m [ActorId] -> m Bool
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (State -> [ActorId]) -> m [ActorId]
forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
getsState (FactionId -> LevelId -> State -> [ActorId]
fidActorRegularIds (Actor -> FactionId
bfid Actor
b) (Actor -> LevelId
blid Actor
b))

-- | Require the actor stands over a weapon that would be auto-equipped.
condFloorWeaponM :: MonadStateRead m => ActorId -> m Bool
condFloorWeaponM :: ActorId -> m Bool
condFloorWeaponM aid :: ActorId
aid =
  ((ItemId, ItemFull) -> Bool) -> [(ItemId, ItemFull)] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (Flag -> AspectRecord -> Bool
IA.checkFlag Flag
Ability.Meleeable (AspectRecord -> Bool)
-> ((ItemId, ItemFull) -> AspectRecord)
-> (ItemId, ItemFull)
-> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ItemFull -> AspectRecord
aspectRecordFull (ItemFull -> AspectRecord)
-> ((ItemId, ItemFull) -> ItemFull)
-> (ItemId, ItemFull)
-> AspectRecord
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ItemId, ItemFull) -> ItemFull
forall a b. (a, b) -> b
snd) ([(ItemId, ItemFull)] -> Bool) -> m [(ItemId, ItemFull)] -> m Bool
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
    (State -> [(ItemId, ItemFull)]) -> m [(ItemId, ItemFull)]
forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
getsState (ActorId -> [CStore] -> State -> [(ItemId, ItemFull)]
fullAssocs ActorId
aid [CStore
CGround])

-- | Check whether the actor has no weapon in equipment.
condNoEqpWeaponM :: MonadStateRead m => ActorId -> m Bool
condNoEqpWeaponM :: ActorId -> m Bool
condNoEqpWeaponM aid :: ActorId
aid =
  ((ItemId, ItemFull) -> Bool) -> [(ItemId, ItemFull)] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all (Bool -> Bool
not (Bool -> Bool)
-> ((ItemId, ItemFull) -> Bool) -> (ItemId, ItemFull) -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Flag -> AspectRecord -> Bool
IA.checkFlag Flag
Ability.Meleeable (AspectRecord -> Bool)
-> ((ItemId, ItemFull) -> AspectRecord)
-> (ItemId, ItemFull)
-> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ItemFull -> AspectRecord
aspectRecordFull (ItemFull -> AspectRecord)
-> ((ItemId, ItemFull) -> ItemFull)
-> (ItemId, ItemFull)
-> AspectRecord
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ItemId, ItemFull) -> ItemFull
forall a b. (a, b) -> b
snd) ([(ItemId, ItemFull)] -> Bool) -> m [(ItemId, ItemFull)] -> m Bool
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
    (State -> [(ItemId, ItemFull)]) -> m [(ItemId, ItemFull)]
forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
getsState (ActorId -> [CStore] -> State -> [(ItemId, ItemFull)]
fullAssocs ActorId
aid [CStore
CEqp])

-- | Require that the actor can project any items.
condCanProjectM :: MonadClient m => Int -> ActorId -> m Bool
condCanProjectM :: Int -> ActorId -> m Bool
condCanProjectM skill :: Int
skill aid :: ActorId
aid =
  if Int
skill Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< 1 then Bool -> m Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
False else  -- shortcut
    -- Compared to conditions in @projectItem@, range and charge are ignored,
    -- because they may change by the time the position for the fling
    -- is reached.
    Bool -> Bool
not (Bool -> Bool)
-> ([(Benefit, CStore, ItemId, ItemFull, ItemQuant)] -> Bool)
-> [(Benefit, CStore, ItemId, ItemFull, ItemQuant)]
-> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [(Benefit, CStore, ItemId, ItemFull, ItemQuant)] -> Bool
forall a. [a] -> Bool
null ([(Benefit, CStore, ItemId, ItemFull, ItemQuant)] -> Bool)
-> m [(Benefit, CStore, ItemId, ItemFull, ItemQuant)] -> m Bool
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Int
-> ActorId -> m [(Benefit, CStore, ItemId, ItemFull, ItemQuant)]
forall (m :: * -> *).
MonadClient m =>
Int
-> ActorId -> m [(Benefit, CStore, ItemId, ItemFull, ItemQuant)]
condProjectListM Int
skill ActorId
aid

condProjectListM :: MonadClient m
                 => Int -> ActorId
                 -> m [(Benefit, CStore, ItemId, ItemFull, ItemQuant)]
condProjectListM :: Int
-> ActorId -> m [(Benefit, CStore, ItemId, ItemFull, ItemQuant)]
condProjectListM skill :: Int
skill aid :: ActorId
aid = do
  Bool
condShineWouldBetray <- ActorId -> m Bool
forall (m :: * -> *). MonadStateRead m => ActorId -> m Bool
condShineWouldBetrayM ActorId
aid
  Bool
condAimEnemyPresent <- ActorId -> m Bool
forall (m :: * -> *). MonadClient m => ActorId -> m Bool
condAimEnemyPresentM ActorId
aid
  DiscoveryBenefit
discoBenefit <- (StateClient -> DiscoveryBenefit) -> m DiscoveryBenefit
forall (m :: * -> *) a.
MonadClientRead m =>
(StateClient -> a) -> m a
getsClient StateClient -> DiscoveryBenefit
sdiscoBenefit
  (State -> [(Benefit, CStore, ItemId, ItemFull, ItemQuant)])
-> m [(Benefit, CStore, ItemId, ItemFull, ItemQuant)]
forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
getsState ((State -> [(Benefit, CStore, ItemId, ItemFull, ItemQuant)])
 -> m [(Benefit, CStore, ItemId, ItemFull, ItemQuant)])
-> (State -> [(Benefit, CStore, ItemId, ItemFull, ItemQuant)])
-> m [(Benefit, CStore, ItemId, ItemFull, ItemQuant)]
forall a b. (a -> b) -> a -> b
$ DiscoveryBenefit
-> Int
-> ActorId
-> Bool
-> Bool
-> State
-> [(Benefit, CStore, ItemId, ItemFull, ItemQuant)]
projectList DiscoveryBenefit
discoBenefit Int
skill ActorId
aid
                          Bool
condShineWouldBetray Bool
condAimEnemyPresent

projectList :: DiscoveryBenefit -> Int -> ActorId -> Bool -> Bool -> State
            -> [(Benefit, CStore, ItemId, ItemFull, ItemQuant)]
projectList :: DiscoveryBenefit
-> Int
-> ActorId
-> Bool
-> Bool
-> State
-> [(Benefit, CStore, ItemId, ItemFull, ItemQuant)]
projectList discoBenefit :: DiscoveryBenefit
discoBenefit skill :: Int
skill aid :: ActorId
aid
            condShineWouldBetray :: Bool
condShineWouldBetray condAimEnemyPresent :: Bool
condAimEnemyPresent s :: State
s =
  let b :: Actor
b = ActorId -> State -> Actor
getActorBody ActorId
aid State
s
      actorMaxSk :: Skills
actorMaxSk = ActorId -> State -> Skills
getActorMaxSkills ActorId
aid State
s
      calmE :: Bool
calmE = Actor -> Skills -> Bool
calmEnough Actor
b Skills
actorMaxSk
      condNotCalmEnough :: Bool
condNotCalmEnough = Bool -> Bool
not Bool
calmE
      heavilyDistressed :: Bool
heavilyDistressed =  -- Actor hit by a projectile or similarly distressed.
        ResDelta -> Bool
deltasSerious (Actor -> ResDelta
bcalmDelta Actor
b)
      -- This detects if the value of keeping the item in eqp is in fact < 0.
      hind :: ItemFull -> Bool
hind = Bool -> Bool -> Bool -> Bool -> Skills -> ItemFull -> Bool
hinders Bool
condShineWouldBetray Bool
condAimEnemyPresent
                     Bool
heavilyDistressed Bool
condNotCalmEnough Skills
actorMaxSk
      q :: (Benefit, CStore, ItemId, ItemFull, ItemQuant) -> Bool
q (Benefit{Bool
benInEqp :: Benefit -> Bool
benInEqp :: Bool
benInEqp, Double
benFling :: Benefit -> Double
benFling :: Double
benFling}, _, _, itemFull :: ItemFull
itemFull, _) =
        let arItem :: AspectRecord
arItem = ItemFull -> AspectRecord
aspectRecordFull ItemFull
itemFull
        in Double
benFling Double -> Double -> Bool
forall a. Ord a => a -> a -> Bool
< 0
           Bool -> Bool -> Bool
&& (Bool -> Bool
not Bool
benInEqp  -- can't wear, so OK to risk losing or breaking
               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
&& Int -> Bool -> ItemFull -> Bool
permittedProjectAI Int
skill Bool
calmE ItemFull
itemFull
      stores :: [CStore]
stores = [CStore
CEqp, CStore
CInv, CStore
CGround] [CStore] -> [CStore] -> [CStore]
forall a. [a] -> [a] -> [a]
++ [CStore
CSha | Bool
calmE]
  in ((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
q ([(Benefit, CStore, ItemId, ItemFull, ItemQuant)]
 -> [(Benefit, CStore, ItemId, ItemFull, ItemQuant)])
-> [(Benefit, CStore, ItemId, ItemFull, ItemQuant)]
-> [(Benefit, CStore, ItemId, ItemFull, ItemQuant)]
forall a b. (a -> b) -> a -> b
$ DiscoveryBenefit
-> ActorId
-> [CStore]
-> State
-> [(Benefit, CStore, ItemId, ItemFull, ItemQuant)]
benAvailableItems DiscoveryBenefit
discoBenefit ActorId
aid [CStore]
stores State
s

-- | Produce the list of items from the given stores available to the actor
-- and the items' values.
benAvailableItems :: DiscoveryBenefit -> ActorId -> [CStore] -> State
                  -> [(Benefit, CStore, ItemId, ItemFull, ItemQuant)]
benAvailableItems :: DiscoveryBenefit
-> ActorId
-> [CStore]
-> State
-> [(Benefit, CStore, ItemId, ItemFull, ItemQuant)]
benAvailableItems discoBenefit :: DiscoveryBenefit
discoBenefit aid :: ActorId
aid cstores :: [CStore]
cstores s :: State
s =
  let b :: Actor
b = ActorId -> State -> Actor
getActorBody ActorId
aid State
s
      ben :: CStore
-> ItemBag -> [(Benefit, CStore, ItemId, ItemFull, ItemQuant)]
ben cstore :: CStore
cstore bag :: ItemBag
bag =
        [ (DiscoveryBenefit
discoBenefit DiscoveryBenefit -> ItemId -> Benefit
forall k a. Enum k => EnumMap k a -> k -> a
EM.! ItemId
iid, CStore
cstore, ItemId
iid, ItemId -> State -> ItemFull
itemToFull ItemId
iid State
s, ItemQuant
kit)
        | (iid :: ItemId
iid, kit :: ItemQuant
kit) <- ItemBag -> [(ItemId, ItemQuant)]
forall k a. Enum k => EnumMap k a -> [(k, a)]
EM.assocs ItemBag
bag]
      benCStore :: CStore -> [(Benefit, CStore, ItemId, ItemFull, ItemQuant)]
benCStore cs :: CStore
cs = CStore
-> ItemBag -> [(Benefit, CStore, ItemId, ItemFull, ItemQuant)]
ben CStore
cs (ItemBag -> [(Benefit, CStore, ItemId, ItemFull, ItemQuant)])
-> ItemBag -> [(Benefit, CStore, ItemId, ItemFull, ItemQuant)]
forall a b. (a -> b) -> a -> b
$ Actor -> CStore -> State -> ItemBag
getBodyStoreBag Actor
b CStore
cs State
s
  in (CStore -> [(Benefit, CStore, ItemId, ItemFull, ItemQuant)])
-> [CStore] -> [(Benefit, CStore, ItemId, ItemFull, ItemQuant)]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap CStore -> [(Benefit, CStore, ItemId, ItemFull, ItemQuant)]
benCStore [CStore]
cstores

hinders :: Bool -> Bool -> Bool -> Bool -> Ability.Skills -> ItemFull
        -> Bool
hinders :: Bool -> Bool -> Bool -> Bool -> Skills -> ItemFull -> Bool
hinders condShineWouldBetray :: Bool
condShineWouldBetray condAimEnemyPresent :: Bool
condAimEnemyPresent
        heavilyDistressed :: Bool
heavilyDistressed condNotCalmEnough :: Bool
condNotCalmEnough
          -- guess that enemies have projectiles and used them now or recently
        actorMaxSk :: Skills
actorMaxSk itemFull :: ItemFull
itemFull =
  let arItem :: AspectRecord
arItem = ItemFull -> AspectRecord
aspectRecordFull ItemFull
itemFull
      itemShine :: Bool
itemShine = 0 Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Skill -> AspectRecord -> Int
IA.getSkill Skill
Ability.SkShine AspectRecord
arItem
      -- @condAnyFoeAdj@ is not checked, because it's transient and also item
      -- management is unlikely to happen during melee, anyway
      itemShineBad :: Bool
itemShineBad = Bool
condShineWouldBetray Bool -> Bool -> Bool
&& Bool
itemShine
  in -- In the presence of enemies (seen, or unseen but distressing)
     -- actors want to hide in the dark.
     (Bool
condAimEnemyPresent Bool -> Bool -> Bool
|| Bool
condNotCalmEnough Bool -> Bool -> Bool
|| Bool
heavilyDistressed)
     Bool -> Bool -> Bool
&& Bool
itemShineBad  -- even if it's a weapon, take it off
     -- Fast actors want to hit hard, because they hit much more often
     -- than receive hits.
     Bool -> Bool -> Bool
|| Skills -> Speed
gearSpeed Skills
actorMaxSk Speed -> Speed -> Bool
forall a. Ord a => a -> a -> Bool
> Speed
speedWalk
        Bool -> Bool -> Bool
&& Bool -> Bool
not (Flag -> AspectRecord -> Bool
IA.checkFlag Flag
Ability.Meleeable AspectRecord
arItem)
             -- in case it's the only weapon
        Bool -> Bool -> Bool
&& 0 Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Skill -> AspectRecord -> Int
IA.getSkill Skill
Ability.SkHurtMelee AspectRecord
arItem

-- | Require that the actor stands over a desirable item.
condDesirableFloorItemM :: MonadClient m => ActorId -> m Bool
condDesirableFloorItemM :: ActorId -> m Bool
condDesirableFloorItemM aid :: ActorId
aid = Bool -> Bool
not (Bool -> Bool)
-> ([(Benefit, CStore, ItemId, ItemFull, ItemQuant)] -> Bool)
-> [(Benefit, CStore, ItemId, ItemFull, ItemQuant)]
-> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [(Benefit, CStore, ItemId, ItemFull, ItemQuant)] -> Bool
forall a. [a] -> Bool
null ([(Benefit, CStore, ItemId, ItemFull, ItemQuant)] -> Bool)
-> m [(Benefit, CStore, ItemId, ItemFull, ItemQuant)] -> m Bool
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ActorId -> m [(Benefit, CStore, ItemId, ItemFull, ItemQuant)]
forall (m :: * -> *).
MonadClient m =>
ActorId -> m [(Benefit, CStore, ItemId, ItemFull, ItemQuant)]
benGroundItems ActorId
aid

-- | Produce the list of items on the ground beneath the actor
-- that are worth picking up.
benGroundItems :: MonadClient m
               => ActorId
               -> m [(Benefit, CStore, ItemId, ItemFull, ItemQuant)]
benGroundItems :: ActorId -> m [(Benefit, CStore, ItemId, ItemFull, ItemQuant)]
benGroundItems aid :: ActorId
aid = do
  COps
cops <- (State -> COps) -> m COps
forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
getsState State -> COps
scops
  Actor
b <- (State -> Actor) -> m Actor
forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
getsState ((State -> Actor) -> m Actor) -> (State -> Actor) -> m Actor
forall a b. (a -> b) -> a -> b
$ ActorId -> State -> Actor
getActorBody ActorId
aid
  Faction
fact <- (State -> Faction) -> m Faction
forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
getsState ((State -> Faction) -> m Faction)
-> (State -> Faction) -> m Faction
forall a b. (a -> b) -> a -> b
$ (EnumMap FactionId Faction -> FactionId -> Faction
forall k a. Enum k => EnumMap k a -> k -> a
EM.! Actor -> FactionId
bfid Actor
b) (EnumMap FactionId Faction -> Faction)
-> (State -> EnumMap FactionId Faction) -> State -> Faction
forall b c a. (b -> c) -> (a -> b) -> a -> c
. State -> EnumMap FactionId Faction
sfactionD
  DiscoveryBenefit
discoBenefit <- (StateClient -> DiscoveryBenefit) -> m DiscoveryBenefit
forall (m :: * -> *) a.
MonadClientRead m =>
(StateClient -> a) -> m a
getsClient StateClient -> DiscoveryBenefit
sdiscoBenefit
  let canEsc :: Bool
canEsc = Player -> Bool
fcanEscape (Faction -> Player
gplayer Faction
fact)
      isDesirable :: (Benefit, CStore, ItemId, ItemFull, ItemQuant) -> Bool
isDesirable (ben :: Benefit
ben, _, _, itemFull :: ItemFull
itemFull, _) =
        COps -> Bool -> Double -> AspectRecord -> ItemKind -> Int -> Bool
desirableItem COps
cops Bool
canEsc (Benefit -> Double
benPickup Benefit
ben)
                      (ItemFull -> AspectRecord
aspectRecordFull ItemFull
itemFull) (ItemFull -> ItemKind
itemKind ItemFull
itemFull)
                      99  -- fake, becuase no time is wasted walking to item
  ((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
isDesirable
    ([(Benefit, CStore, ItemId, ItemFull, ItemQuant)]
 -> [(Benefit, CStore, ItemId, ItemFull, ItemQuant)])
-> m [(Benefit, CStore, ItemId, ItemFull, ItemQuant)]
-> m [(Benefit, CStore, ItemId, ItemFull, ItemQuant)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (State -> [(Benefit, CStore, ItemId, ItemFull, ItemQuant)])
-> m [(Benefit, CStore, ItemId, ItemFull, ItemQuant)]
forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
getsState (DiscoveryBenefit
-> ActorId
-> [CStore]
-> State
-> [(Benefit, CStore, ItemId, ItemFull, ItemQuant)]
benAvailableItems DiscoveryBenefit
discoBenefit ActorId
aid [CStore
CGround])

desirableItem :: COps -> Bool -> Double -> IA.AspectRecord -> IK.ItemKind -> Int
              -> Bool
desirableItem :: COps -> Bool -> Double -> AspectRecord -> ItemKind -> Int -> Bool
desirableItem COps{corule :: COps -> RuleContent
corule=RuleContent{Char
rsymbolProjectile :: RuleContent -> Char
rsymbolProjectile :: Char
rsymbolProjectile}}
              canEsc :: Bool
canEsc benPickup :: Double
benPickup arItem :: AspectRecord
arItem itemKind :: ItemKind
itemKind k :: Int
k =
  let loneProjectile :: Bool
loneProjectile = ItemKind -> Char
IK.isymbol ItemKind
itemKind Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
rsymbolProjectile
                       Bool -> Bool -> Bool
&& Int
k Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== 1
                       Bool -> Bool -> Bool
&& Dice -> Int
Dice.infDice (ItemKind -> Dice
IK.icount ItemKind
itemKind) Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> 1
                            -- never generated as lone; usually means weak
      useful :: Bool
useful = if Bool
canEsc
               then Double
benPickup Double -> Double -> Bool
forall a. Ord a => a -> a -> Bool
> 0
                    Bool -> Bool -> Bool
|| Flag -> AspectRecord -> Bool
IA.checkFlag Flag
Ability.Precious AspectRecord
arItem
               else -- A hack to prevent monsters from picking up
                    -- treasure meant for heroes.
                 let preciousNotUseful :: Bool
preciousNotUseful = ItemKind -> Bool
IA.isHumanTrinket ItemKind
itemKind
                 in Double
benPickup Double -> Double -> Bool
forall a. Ord a => a -> a -> Bool
> 0 Bool -> Bool -> Bool
&& Bool -> Bool
not Bool
preciousNotUseful
  in Bool
useful Bool -> Bool -> Bool
&& Bool -> Bool
not Bool
loneProjectile

condSupport :: MonadClient m => Int -> ActorId -> m Bool
{-# INLINE condSupport #-}
condSupport :: Int -> ActorId -> m Bool
condSupport param :: Int
param aid :: ActorId
aid = do
  Maybe Target
btarget <- (StateClient -> Maybe Target) -> m (Maybe Target)
forall (m :: * -> *) a.
MonadClientRead m =>
(StateClient -> a) -> m a
getsClient ((StateClient -> Maybe Target) -> m (Maybe Target))
-> (StateClient -> Maybe Target) -> m (Maybe Target)
forall a b. (a -> b) -> a -> b
$ ActorId -> StateClient -> Maybe Target
getTarget ActorId
aid
  Bool
condAimEnemyPresent <- ActorId -> m Bool
forall (m :: * -> *). MonadClient m => ActorId -> m Bool
condAimEnemyPresentM ActorId
aid
  Bool
condAimEnemyRemembered <- ActorId -> m Bool
forall (m :: * -> *). MonadClient m => ActorId -> m Bool
condAimEnemyRememberedM ActorId
aid
  (State -> Bool) -> m Bool
forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
getsState ((State -> Bool) -> m Bool) -> (State -> Bool) -> m Bool
forall a b. (a -> b) -> a -> b
$ Int -> ActorId -> Maybe Target -> Bool -> Bool -> State -> Bool
strongSupport Int
param ActorId
aid Maybe Target
btarget
                            Bool
condAimEnemyPresent Bool
condAimEnemyRemembered

strongSupport :: Int -> ActorId -> Maybe Target -> Bool -> Bool -> State -> Bool
strongSupport :: Int -> ActorId -> Maybe Target -> Bool -> Bool -> State -> Bool
strongSupport param :: Int
param aid :: ActorId
aid btarget :: Maybe Target
btarget condAimEnemyPresent :: Bool
condAimEnemyPresent condAimEnemyRemembered :: Bool
condAimEnemyRemembered s :: State
s =
  -- The smaller the area scanned for friends, the lower number required.
  let actorMaxSkills :: ActorMaxSkills
actorMaxSkills = State -> ActorMaxSkills
sactorMaxSkills State
s
      actorMaxSk :: Skills
actorMaxSk = ActorMaxSkills
actorMaxSkills ActorMaxSkills -> ActorId -> Skills
forall k a. Enum k => EnumMap k a -> k -> a
EM.! ActorId
aid
      n :: Int
n = Int -> Int -> Int
forall a. Ord a => a -> a -> a
min 2 Int
param Int -> Int -> Int
forall a. Num a => a -> a -> a
- Skill -> Skills -> Int
Ability.getSk Skill
Ability.SkAggression Skills
actorMaxSk
      b :: Actor
b = ActorId -> State -> Actor
getActorBody ActorId
aid State
s
      mtgtPos :: Maybe Point
mtgtPos = ActorId -> LevelId -> Maybe Target -> State -> Maybe Point
aidTgtToPos ActorId
aid (Actor -> LevelId
blid Actor
b) Maybe Target
btarget State
s
      approaching :: Actor -> Bool
approaching b2 :: Actor
b2 = case Maybe Point
mtgtPos of
        Just tgtPos :: Point
tgtPos | Bool
condAimEnemyPresent Bool -> Bool -> Bool
|| Bool
condAimEnemyRemembered ->
          Point -> Point -> Int
chessDist (Actor -> Point
bpos Actor
b2) Point
tgtPos Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= 1 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
param
        _ -> Bool
False
      closeEnough :: Actor -> Bool
closeEnough b2 :: Actor
b2 = let dist :: Int
dist = Point -> Point -> Int
chessDist (Actor -> Point
bpos Actor
b) (Actor -> Point
bpos Actor
b2)
                       in Int
dist Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> 0 Bool -> Bool -> Bool
&& (Int
dist Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
param Bool -> Bool -> Bool
|| Actor -> Bool
approaching Actor
b2)
      closeAndStrong :: (ActorId, Actor) -> Bool
closeAndStrong (aid2 :: ActorId
aid2, b2 :: Actor
b2) = Actor -> Bool
closeEnough Actor
b2
                                  Bool -> Bool -> Bool
&& ActorMaxSkills -> ActorId -> Actor -> Bool
actorCanMelee ActorMaxSkills
actorMaxSkills ActorId
aid2 Actor
b2
      friends :: [(ActorId, Actor)]
friends = FactionId -> LevelId -> State -> [(ActorId, Actor)]
friendRegularAssocs (Actor -> FactionId
bfid Actor
b) (Actor -> LevelId
blid Actor
b) State
s
      closeAndStrongFriends :: [(ActorId, Actor)]
closeAndStrongFriends = ((ActorId, Actor) -> Bool)
-> [(ActorId, Actor)] -> [(ActorId, Actor)]
forall a. (a -> Bool) -> [a] -> [a]
filter (ActorId, Actor) -> Bool
closeAndStrong [(ActorId, Actor)]
friends
  in Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= 0 Bool -> Bool -> Bool
|| Bool -> Bool
not ([(ActorId, Actor)] -> Bool
forall a. [a] -> Bool
null (Int -> [(ActorId, Actor)] -> [(ActorId, Actor)]
forall a. Int -> [a] -> [a]
drop (Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
- 1) [(ActorId, Actor)]
closeAndStrongFriends))
       -- optimized: length closeAndStrongFriends >= n

condSoloM :: MonadClient m => ActorId -> m Bool
condSoloM :: ActorId -> m Bool
condSoloM aid :: ActorId
aid = do
  Actor
b <- (State -> Actor) -> m Actor
forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
getsState ((State -> Actor) -> m Actor) -> (State -> Actor) -> m Actor
forall a b. (a -> b) -> a -> b
$ ActorId -> State -> Actor
getActorBody ActorId
aid
  let isSingleton :: [a] -> Bool
isSingleton [_] = Bool
True
      isSingleton _ = Bool
False
  [Actor] -> Bool
forall a. [a] -> Bool
isSingleton ([Actor] -> Bool) -> m [Actor] -> m Bool
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (State -> [Actor]) -> m [Actor]
forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
getsState (FactionId -> LevelId -> State -> [Actor]
friendRegularList (Actor -> FactionId
bfid Actor
b) (Actor -> LevelId
blid Actor
b))

-- | Require that the actor stands in the dark and so would be betrayed
-- by his own equipped light,
condShineWouldBetrayM :: MonadStateRead m => ActorId -> m Bool
condShineWouldBetrayM :: ActorId -> m Bool
condShineWouldBetrayM aid :: ActorId
aid = do
  Actor
b <- (State -> Actor) -> m Actor
forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
getsState ((State -> Actor) -> m Actor) -> (State -> Actor) -> m Actor
forall a b. (a -> b) -> a -> b
$ ActorId -> State -> Actor
getActorBody ActorId
aid
  Bool
aInAmbient <- (State -> Bool) -> m Bool
forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
getsState ((State -> Bool) -> m Bool) -> (State -> Bool) -> m Bool
forall a b. (a -> b) -> a -> b
$ Actor -> State -> Bool
actorInAmbient Actor
b
  Bool -> m Bool
forall (m :: * -> *) a. Monad m => a -> m a
return (Bool -> m Bool) -> Bool -> m Bool
forall a b. (a -> b) -> a -> b
$ Bool -> Bool
not Bool
aInAmbient  -- tile is dark, so actor could hide

-- | Produce a list of acceptable adjacent points to flee to.
fleeList :: MonadClient m => ActorId -> m ([(Int, Point)], [(Int, Point)])
fleeList :: ActorId -> m ([(Int, Point)], [(Int, Point)])
fleeList aid :: ActorId
aid = do
  COps{TileSpeedup
coTileSpeedup :: TileSpeedup
coTileSpeedup :: COps -> TileSpeedup
coTileSpeedup} <- (State -> COps) -> m COps
forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
getsState State -> COps
scops
  Maybe TgtAndPath
mtgtMPath <- (StateClient -> Maybe TgtAndPath) -> m (Maybe TgtAndPath)
forall (m :: * -> *) a.
MonadClientRead m =>
(StateClient -> a) -> m a
getsClient ((StateClient -> Maybe TgtAndPath) -> m (Maybe TgtAndPath))
-> (StateClient -> Maybe TgtAndPath) -> m (Maybe TgtAndPath)
forall a b. (a -> b) -> a -> b
$ ActorId -> EnumMap ActorId TgtAndPath -> Maybe TgtAndPath
forall k a. Enum k => k -> EnumMap k a -> Maybe a
EM.lookup ActorId
aid (EnumMap ActorId TgtAndPath -> Maybe TgtAndPath)
-> (StateClient -> EnumMap ActorId TgtAndPath)
-> StateClient
-> Maybe TgtAndPath
forall b c a. (b -> c) -> (a -> b) -> a -> c
. StateClient -> EnumMap ActorId TgtAndPath
stargetD
  -- Prefer fleeing along the path to target, unless the target is a foe,
  -- in which case flee in the opposite direction.
  let etgtPath :: Either Point [Point]
etgtPath = case Maybe TgtAndPath
mtgtMPath of
        Just TgtAndPath{ tapPath :: TgtAndPath -> Maybe AndPath
tapPath=Just AndPath{[Point]
pathList :: [Point]
pathList :: AndPath -> [Point]
pathList, Point
pathGoal :: AndPath -> Point
pathGoal :: Point
pathGoal}
                       , Target
tapTgt :: Target
tapTgt :: TgtAndPath -> Target
tapTgt } -> case Target
tapTgt of
          TEnemy{} -> Point -> Either Point [Point]
forall a b. a -> Either a b
Left Point
pathGoal
          TPoint TEnemyPos{} _ _ -> Point -> Either Point [Point]
forall a b. a -> Either a b
Left Point
pathGoal
          _ -> [Point] -> Either Point [Point]
forall a b. b -> Either a b
Right [Point]
pathList
        _ -> [Point] -> Either Point [Point]
forall a b. b -> Either a b
Right []
  EnumMap ActorId Point
fleeD <- (StateClient -> EnumMap ActorId Point) -> m (EnumMap ActorId Point)
forall (m :: * -> *) a.
MonadClientRead m =>
(StateClient -> a) -> m a
getsClient StateClient -> EnumMap ActorId Point
sfleeD
  -- But if fled previous turn, prefer even more fleeing further this turn.
  let eOldFleeOrTgt :: Either Point [Point]
eOldFleeOrTgt = case ActorId -> EnumMap ActorId Point -> Maybe Point
forall k a. Enum k => k -> EnumMap k a -> Maybe a
EM.lookup ActorId
aid EnumMap ActorId Point
fleeD of
        Nothing -> Either Point [Point]
etgtPath
        Just p :: Point
p -> Point -> Either Point [Point]
forall a b. a -> Either a b
Left Point
p
  Actor
b <- (State -> Actor) -> m Actor
forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
getsState ((State -> Actor) -> m Actor) -> (State -> Actor) -> m Actor
forall a b. (a -> b) -> a -> b
$ ActorId -> State -> Actor
getActorBody ActorId
aid
  Level
lvl <- LevelId -> m Level
forall (m :: * -> *). MonadStateRead m => LevelId -> m Level
getLevel (LevelId -> m Level) -> LevelId -> m Level
forall a b. (a -> b) -> a -> b
$ Actor -> LevelId
blid Actor
b
  [Point]
posFoes <- (State -> [Point]) -> m [Point]
forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
getsState ((State -> [Point]) -> m [Point])
-> (State -> [Point]) -> m [Point]
forall a b. (a -> b) -> a -> b
$ (Actor -> Point) -> [Actor] -> [Point]
forall a b. (a -> b) -> [a] -> [b]
map Actor -> Point
bpos ([Actor] -> [Point]) -> (State -> [Actor]) -> State -> [Point]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FactionId -> LevelId -> State -> [Actor]
foeRegularList (Actor -> FactionId
bfid Actor
b) (Actor -> LevelId
blid Actor
b)
  let myVic :: [Point]
myVic = Point -> [Point]
vicinityUnsafe (Point -> [Point]) -> Point -> [Point]
forall a b. (a -> b) -> a -> b
$ Actor -> Point
bpos Actor
b
      dist :: Point -> Int
dist p :: Point
p | [Point] -> Bool
forall a. [a] -> Bool
null [Point]
posFoes = 100
             | Bool
otherwise = [Int] -> Int
forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
minimum ([Int] -> Int) -> [Int] -> Int
forall a b. (a -> b) -> a -> b
$ (Point -> Int) -> [Point] -> [Int]
forall a b. (a -> b) -> [a] -> [b]
map (Point -> Point -> Int
chessDist Point
p) [Point]
posFoes
      dVic :: [(Int, Point)]
dVic = (Point -> (Int, Point)) -> [Point] -> [(Int, Point)]
forall a b. (a -> b) -> [a] -> [b]
map (Point -> Int
dist (Point -> Int) -> (Point -> Point) -> Point -> (Int, Point)
forall (a :: * -> * -> *) b c c'.
Arrow a =>
a b c -> a b c' -> a b (c, c')
&&& Point -> Point
forall a. a -> a
id) [Point]
myVic
      -- Flee, if possible. Direct access required; not enough time to open.
      -- Can't be occupied.
      accWalkUnocc :: Point -> Bool
accWalkUnocc p :: Point
p = TileSpeedup -> ContentId TileKind -> Bool
Tile.isWalkable TileSpeedup
coTileSpeedup (Level
lvl Level -> Point -> ContentId TileKind
`at` Point
p)
                       Bool -> Bool -> Bool
&& Bool -> Bool
not (Point -> Level -> Bool
occupiedBigLvl Point
p Level
lvl)
                       Bool -> Bool -> Bool
&& Bool -> Bool
not (Point -> Level -> Bool
occupiedProjLvl Point
p Level
lvl)
      accWalkVic :: [(Int, Point)]
accWalkVic = ((Int, Point) -> Bool) -> [(Int, Point)] -> [(Int, Point)]
forall a. (a -> Bool) -> [a] -> [a]
filter (Point -> Bool
accWalkUnocc (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)]
dVic
      gtVic :: [(Int, Point)]
gtVic = ((Int, Point) -> Bool) -> [(Int, Point)] -> [(Int, Point)]
forall a. (a -> Bool) -> [a] -> [a]
filter ((Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Point -> Int
dist (Actor -> Point
bpos Actor
b)) (Int -> Bool) -> ((Int, Point) -> Int) -> (Int, Point) -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Int, Point) -> Int
forall a b. (a, b) -> a
fst) [(Int, Point)]
accWalkVic
      eqVicRaw :: [(Int, Point)]
eqVicRaw = ((Int, Point) -> Bool) -> [(Int, Point)] -> [(Int, Point)]
forall a. (a -> Bool) -> [a] -> [a]
filter ((Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Point -> Int
dist (Actor -> Point
bpos Actor
b)) (Int -> Bool) -> ((Int, Point) -> Int) -> (Int, Point) -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Int, Point) -> Int
forall a b. (a, b) -> a
fst) [(Int, Point)]
accWalkVic
      (eqVicOld :: [(Int, Point)]
eqVicOld, eqVic :: [(Int, Point)]
eqVic) = ((Int, Point) -> Bool)
-> [(Int, Point)] -> ([(Int, Point)], [(Int, Point)])
forall a. (a -> Bool) -> [a] -> ([a], [a])
partition ((Maybe Point -> Maybe Point -> Bool
forall a. Eq a => a -> a -> Bool
== Actor -> Maybe Point
boldpos Actor
b) (Maybe Point -> Bool)
-> ((Int, Point) -> Maybe Point) -> (Int, Point) -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Point -> Maybe Point
forall a. a -> Maybe a
Just (Point -> Maybe Point)
-> ((Int, Point) -> Point) -> (Int, Point) -> Maybe Point
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Int, Point) -> Point
forall a b. (a, b) -> b
snd) [(Int, Point)]
eqVicRaw
      accNonWalkUnocc :: Point -> Bool
accNonWalkUnocc p :: Point
p = Bool -> Bool
not (TileSpeedup -> ContentId TileKind -> Bool
Tile.isWalkable TileSpeedup
coTileSpeedup (Level
lvl Level -> Point -> ContentId TileKind
`at` Point
p))
                          Bool -> Bool -> Bool
&& TileSpeedup -> ContentId TileKind -> Bool
Tile.isEasyOpen TileSpeedup
coTileSpeedup (Level
lvl Level -> Point -> ContentId TileKind
`at` Point
p)
                          Bool -> Bool -> Bool
&& Bool -> Bool
not (Point -> Level -> Bool
occupiedBigLvl Point
p Level
lvl)
                          Bool -> Bool -> Bool
&& Bool -> Bool
not (Point -> Level -> Bool
occupiedProjLvl Point
p Level
lvl)
      accNonWalkVic :: [(Int, Point)]
accNonWalkVic = ((Int, Point) -> Bool) -> [(Int, Point)] -> [(Int, Point)]
forall a. (a -> Bool) -> [a] -> [a]
filter (Point -> Bool
accNonWalkUnocc (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)]
dVic
      gtEqNonVic :: [(Int, Point)]
gtEqNonVic = ((Int, Point) -> Bool) -> [(Int, Point)] -> [(Int, Point)]
forall a. (a -> Bool) -> [a] -> [a]
filter ((Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Point -> Int
dist (Actor -> Point
bpos Actor
b)) (Int -> Bool) -> ((Int, Point) -> Int) -> (Int, Point) -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Int, Point) -> Int
forall a b. (a, b) -> a
fst) [(Int, Point)]
accNonWalkVic
      ltAllVic :: [(Int, Point)]
ltAllVic = ((Int, Point) -> Bool) -> [(Int, Point)] -> [(Int, Point)]
forall a. (a -> Bool) -> [a] -> [a]
filter ((Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Point -> Int
dist (Actor -> Point
bpos Actor
b)) (Int -> Bool) -> ((Int, Point) -> Int) -> (Int, Point) -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Int, Point) -> Int
forall a b. (a, b) -> a
fst) [(Int, Point)]
dVic
      rewardPath :: Int -> (Int, Point) -> (Int, Point)
rewardPath mult :: Int
mult (d :: Int
d, p :: Point
p) = case Either Point [Point]
eOldFleeOrTgt of
        Right tgtPathList :: [Point]
tgtPathList | Point
p Point -> [Point] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Point]
tgtPathList ->
          (100 Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
mult Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
d, Point
p)
        Right tgtPathList :: [Point]
tgtPathList | (Point -> Bool) -> [Point] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (Point -> Point -> Bool
adjacent Point
p) [Point]
tgtPathList ->
          (10 Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
mult Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
d, Point
p)
        Left pathGoal :: Point
pathGoal | Actor -> Point
bpos Actor
b Point -> Point -> Bool
forall a. Eq a => a -> a -> Bool
/= Point
pathGoal ->
          let venemy :: Vector
venemy = Point -> Point -> Vector
towards (Actor -> Point
bpos Actor
b) Point
pathGoal
              vflee :: Vector
vflee = Point -> Point -> Vector
towards (Actor -> Point
bpos Actor
b) Point
p
              sq :: Int
sq = Vector -> Vector -> Int
euclidDistSqVector Vector
venemy Vector
vflee
              skew :: Int
skew = case Int -> Int -> Ordering
forall a. Ord a => a -> a -> Ordering
compare Int
sq 2 of
                GT -> 100 Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
sq
                EQ -> 10 Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
sq
                LT -> Int
sq  -- going towards enemy (but may escape adjacent foes)
          in (Int
mult Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
skew Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
d, Point
p)
        _ -> (Int
mult Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
d, Point
p)  -- far from target path or even on target goal
      goodVic :: [(Int, Point)]
goodVic = ((Int, Point) -> (Int, Point)) -> [(Int, Point)] -> [(Int, Point)]
forall a b. (a -> b) -> [a] -> [b]
map (Int -> (Int, Point) -> (Int, Point)
rewardPath 10000) [(Int, Point)]
gtVic
                [(Int, Point)] -> [(Int, Point)] -> [(Int, Point)]
forall a. [a] -> [a] -> [a]
++ ((Int, Point) -> (Int, Point)) -> [(Int, Point)] -> [(Int, Point)]
forall a b. (a -> b) -> [a] -> [b]
map (Int -> (Int, Point) -> (Int, Point)
rewardPath 100) [(Int, Point)]
eqVic
      badVic :: [(Int, Point)]
badVic = ((Int, Point) -> (Int, Point)) -> [(Int, Point)] -> [(Int, Point)]
forall a b. (a -> b) -> [a] -> [b]
map (Int -> (Int, Point) -> (Int, Point)
rewardPath 1) ([(Int, Point)] -> [(Int, Point)])
-> [(Int, Point)] -> [(Int, Point)]
forall a b. (a -> b) -> a -> b
$ [(Int, Point)]
gtEqNonVic [(Int, Point)] -> [(Int, Point)] -> [(Int, Point)]
forall a. [a] -> [a] -> [a]
++ [(Int, Point)]
eqVicOld [(Int, Point)] -> [(Int, Point)] -> [(Int, Point)]
forall a. [a] -> [a] -> [a]
++ [(Int, Point)]
ltAllVic
  ([(Int, Point)], [(Int, Point)])
-> m ([(Int, Point)], [(Int, Point)])
forall (m :: * -> *) a. Monad m => a -> m a
return ([(Int, Point)]
goodVic, [(Int, Point)]
badVic)