-- | Assorted conditions used later on in AI logic.
module Game.LambdaHack.Client.AI.ConditionM
  ( condAimEnemyTargetedM
  , condAimEnemyOrStashM
  , condAimEnemyOrRememberedM
  , condAimNonEnemyPresentM
  , condAimCrucialM
  , condTgtNonmovingEnemyM
  , condAdjTriggerableM
  , meleeThreatDistList
  , condBlocksFriendsM
  , condFloorWeaponM
  , condNoEqpWeaponM
  , condCanProjectM
  , condProjectListM
  , benAvailableItems
  , hinders
  , condDesirableFloorItemM
  , benGroundItems
  , desirableItem
  , condSupport
  , condAloneM
  , condShineWouldBetrayM
  , fleeList
  ) where

import Prelude ()

import Game.LambdaHack.Core.Prelude

import qualified Data.EnumMap.Strict as EM

import           Game.LambdaHack.Client.Bfs
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.Point
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 qualified Game.LambdaHack.Content.RuleKind as RK
import qualified Game.LambdaHack.Core.Dice as Dice
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 a target enemy is visible by the party.
condAimEnemyTargetedM :: MonadClientRead m => ActorId -> m Bool
condAimEnemyTargetedM :: forall (m :: * -> *). MonadClientRead m => ActorId -> m Bool
condAimEnemyTargetedM 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
  return $ case btarget of
    Just (TEnemy ActorId
_) -> Bool
True
    Maybe Target
_ -> Bool
False

-- | Require that a target enemy or enemy stash is visible by the party.
condAimEnemyOrStashM :: MonadClientRead m => ActorId -> m Bool
condAimEnemyOrStashM :: forall (m :: * -> *). MonadClientRead m => ActorId -> m Bool
condAimEnemyOrStashM 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
  return $ case btarget of
    Just (TEnemy ActorId
_) -> Bool
True
    Just (TPoint (TStash FactionId
_) LevelId
_ Point
_) -> Bool
True  -- speedup from: lid == blid b
    Maybe Target
_ -> Bool
False

-- | Require that a target enemy is remembered on the actor's level.
condAimEnemyOrRememberedM :: MonadClientRead m => ActorId -> m Bool
condAimEnemyOrRememberedM :: forall (m :: * -> *). MonadClientRead m => ActorId -> m Bool
condAimEnemyOrRememberedM 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
  btarget <- getsClient $ getTarget aid
  return $ case btarget of
    Just (TEnemy ActorId
_) -> Bool
True
    Just (TPoint (TEnemyPos ActorId
_) LevelId
lid Point
_) -> LevelId
lid LevelId -> LevelId -> Bool
forall a. Eq a => a -> a -> Bool
== Actor -> LevelId
blid Actor
b
    Just (TPoint (TStash FactionId
_) LevelId
lid Point
_) -> LevelId
lid LevelId -> LevelId -> Bool
forall a. Eq a => a -> a -> Bool
== Actor -> LevelId
blid Actor
b
    Maybe Target
_ -> Bool
False

-- | Require that a target non-enemy is visible by the party.
condAimNonEnemyPresentM :: MonadClientRead m => ActorId -> m Bool
condAimNonEnemyPresentM :: forall (m :: * -> *). MonadClientRead m => ActorId -> m Bool
condAimNonEnemyPresentM 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
  return $ case btarget of
    Just (TNonEnemy ActorId
_) -> Bool
True
    Maybe Target
_ -> Bool
False

-- | 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 :: MonadClientRead m => ActorId -> m Bool
condAimCrucialM :: forall (m :: * -> *). MonadClientRead m => ActorId -> m Bool
condAimCrucialM 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
  mtgtMPath <- getsClient $ EM.lookup aid . stargetD
  return $ case mtgtMPath of
    Just TgtAndPath{tapTgt :: TgtAndPath -> Target
tapTgt=TEnemy ActorId
_} -> Bool
True
    Just TgtAndPath{tapTgt :: TgtAndPath -> Target
tapTgt=TPoint TGoal
tgoal LevelId
lid Point
_, tapPath :: TgtAndPath -> Maybe AndPath
tapPath=Just AndPath{Int
pathLen :: Int
pathLen :: AndPath -> 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
< Int
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 :: AndPath -> Int
pathLen :: Int
pathLen}} ->
      Int
pathLen Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
7  -- can't say if the target important, but the constants
                   -- from @take6@ and @traSlack7@ ensure target is
                   -- already approached or close to level edge
                   -- or not a random @traSlack7@ wandering
    Maybe TgtAndPath
_ -> Bool
False  -- includes the case of target with no path

-- | Check if the target is a nonmoving enemy.
condTgtNonmovingEnemyM :: MonadClientRead m => ActorId -> m Bool
condTgtNonmovingEnemyM :: forall (m :: * -> *). MonadClientRead m => ActorId -> m Bool
condTgtNonmovingEnemyM 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
  case btarget of
    Just (TEnemy ActorId
enemy) -> 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
enemy
      return $ Ability.getSk Ability.SkMove actorMaxSk <= 0
    Maybe Target
_ -> Bool -> m Bool
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
False

-- | Require the actor stands on or adjacent to a triggerable tile
-- (e.g., stairs).
condAdjTriggerableM :: MonadStateRead m => Ability.Skills -> ActorId -> m Bool
condAdjTriggerableM :: forall (m :: * -> *).
MonadStateRead m =>
Skills -> ActorId -> m Bool
condAdjTriggerableM Skills
actorSk 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
  let alterSkill = Skill -> Skills -> Int
Ability.getSk Skill
Ability.SkAlter Skills
actorSk
      alterMinSkill 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
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
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
  return $ any hasTriggerable $ bpos b : vicinityUnsafe (bpos 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, Actor)] -> ActorId -> State
                    -> [(Int, (ActorId, Actor))]
meleeThreatDistList :: [(ActorId, Actor)] -> ActorId -> State -> [(Int, (ActorId, Actor))]
meleeThreatDistList [(ActorId, Actor)]
foeAssocs ActorId
aid State
s =
  let actorMaxSkills :: ActorMaxSkills
actorMaxSkills = State -> ActorMaxSkills
sactorMaxSkills State
s
      b :: Actor
b = ActorId -> State -> Actor
getActorBody ActorId
aid State
s

      strongActor :: (ActorId, Actor) -> Bool
strongActor (ActorId
aid2, 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
<= Int
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
actorCanMeleeToHarm 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)]
foeAssocs
      addDist :: (ActorId, Actor) -> (Int, (ActorId, Actor))
addDist (ActorId
aid2, 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 :: MonadClientRead m => ActorId -> m Bool
condBlocksFriendsM :: forall (m :: * -> *). MonadClientRead m => ActorId -> m Bool
condBlocksFriendsM 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
  targetD <- getsClient stargetD
  let blocked 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=Point
q : [Point]
_}} | Point
q Point -> Point -> Bool
forall a. Eq a => a -> a -> Bool
== Actor -> Point
bpos Actor
b ->
            Bool
True
          Maybe TgtAndPath
_ -> Bool
False
  any blocked <$> getsState (fidActorRegularIds (bfid b) (blid b))

-- | Require the actor stands over a weapon that would be auto-equipped,
-- if only it was a desirable item (checked elsewhere).
condFloorWeaponM :: MonadStateRead m => ActorId -> m Bool
condFloorWeaponM :: forall (m :: * -> *). MonadStateRead m => ActorId -> m Bool
condFloorWeaponM 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 a. (State -> a) -> m a
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 :: forall (m :: * -> *). MonadStateRead m => ActorId -> m Bool
condNoEqpWeaponM ActorId
aid =
  Bool -> Bool
not (Bool -> Bool)
-> ([(ItemId, ItemFull)] -> Bool) -> [(ItemId, ItemFull)] -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((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 a. (State -> a) -> m a
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 :: MonadClientRead m => Int -> ActorId -> m Bool
condCanProjectM :: forall (m :: * -> *). MonadClientRead m => Int -> ActorId -> m Bool
condCanProjectM Int
skill ActorId
aid = 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
  curChal <- getsClient scurChal
  fact <- getsState $ (EM.! side) . sfactionD
  if skill < 1
     || ckeeper curChal && fhasUI (gkind fact)
  then return 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.
    not . null <$> condProjectListM skill aid

condProjectListM :: MonadClientRead m
                 => Int -> ActorId
                 -> m [(Double, CStore, ItemId, ItemFull, ItemQuant)]
condProjectListM :: forall (m :: * -> *).
MonadClientRead m =>
Int -> ActorId -> m [(Double, CStore, ItemId, ItemFull, ItemQuant)]
condProjectListM Int
skill ActorId
aid = do
  condShineWouldBetray <- ActorId -> m Bool
forall (m :: * -> *). MonadStateRead m => ActorId -> m Bool
condShineWouldBetrayM ActorId
aid
  condAimEnemyOrRemembered <- condAimEnemyOrRememberedM aid
  discoBenefit <- getsClient sdiscoBenefit
  getsState $ projectList discoBenefit skill aid
                          condShineWouldBetray condAimEnemyOrRemembered

projectList :: DiscoveryBenefit -> Int -> ActorId -> Bool -> Bool -> State
            -> [(Double, CStore, ItemId, ItemFull, ItemQuant)]
projectList :: DiscoveryBenefit
-> Int
-> ActorId
-> Bool
-> Bool
-> State
-> [(Double, CStore, ItemId, ItemFull, ItemQuant)]
projectList DiscoveryBenefit
discoBenefit Int
skill ActorId
aid
            Bool
condShineWouldBetray Bool
condAimEnemyOrRemembered 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
      heavilyDistressed :: Bool
heavilyDistressed =  -- Actor hit by a projectile or similarly distressed.
        ResDelta -> Bool
deltasSerious (Actor -> ResDelta
bcalmDelta Actor
b)
      uneasy :: Bool
uneasy = Bool
condAimEnemyOrRemembered
               Bool -> Bool -> Bool
|| Bool -> Bool
not Bool
calmE
               Bool -> Bool -> Bool
|| Bool
heavilyDistressed
        -- don't take recent fleeing into account when item can be lost
      coeff :: CStore -> Double
coeff CStore
CGround = Double
2  -- pickup turn saved
      coeff CStore
COrgan = [Char] -> Double
forall a. HasCallStack => [Char] -> a
error ([Char] -> Double) -> [Char] -> Double
forall a b. (a -> b) -> a -> b
$ [Char]
"" [Char]
-> [(Benefit, CStore, ItemId, ItemFull, ItemQuant)] -> [Char]
forall v. Show v => [Char] -> v -> [Char]
`showFailure` [(Benefit, CStore, ItemId, ItemFull, ItemQuant)]
benList
      coeff CStore
CEqp = Double
1000  -- must hinder currently (or be very potent);
                         -- note: not larger, to avoid Int32 overflow
      coeff CStore
CStash = Double
1
      -- This detects if the value of keeping the item in eqp is in fact < 0.
      hind :: ItemFull -> Bool
hind = Bool -> Bool -> Skills -> ItemFull -> Bool
hinders Bool
condShineWouldBetray Bool
uneasy Skills
actorMaxSk
      goodMissile :: (Benefit, CStore, ItemId, ItemFull, ItemQuant)
-> Maybe (Double, CStore, ItemId, ItemFull, ItemQuant)
goodMissile (Benefit{Bool
benInEqp :: Bool
benInEqp :: Benefit -> Bool
benInEqp, Double
benFling :: Double
benFling :: Benefit -> Double
benFling}, CStore
cstore, ItemId
iid, ItemFull
itemFull, ItemQuant
kit) =
        let arItem :: AspectRecord
arItem = ItemFull -> AspectRecord
aspectRecordFull ItemFull
itemFull
            benR :: Double
benR = CStore -> Double
coeff CStore
cstore Double -> Double -> Double
forall a. Num a => a -> a -> a
* Double
benFling
        in if Double
benR Double -> Double -> Bool
forall a. Ord a => a -> a -> Bool
< -Double
1  -- ignore very weak projectiles
              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
              Bool -> Bool -> Bool
&& Int -> Bool -> ItemFull -> Bool
permittedProjectAI Int
skill Bool
calmE ItemFull
itemFull
           then (Double, CStore, ItemId, ItemFull, ItemQuant)
-> Maybe (Double, CStore, ItemId, ItemFull, ItemQuant)
forall a. a -> Maybe a
Just (Double
benR, CStore
cstore, ItemId
iid, ItemFull
itemFull, ItemQuant
kit)
           else Maybe (Double, CStore, ItemId, ItemFull, ItemQuant)
forall a. Maybe a
Nothing
      stores :: [CStore]
stores = [CStore
CStash, CStore
CGround] [CStore] -> [CStore] -> [CStore]
forall a. [a] -> [a] -> [a]
++ [CStore
CEqp | Bool
calmE]
      benList :: [(Benefit, CStore, ItemId, ItemFull, ItemQuant)]
benList = DiscoveryBenefit
-> ActorId
-> [CStore]
-> State
-> [(Benefit, CStore, ItemId, ItemFull, ItemQuant)]
benAvailableItems DiscoveryBenefit
discoBenefit ActorId
aid [CStore]
stores State
s
  in ((Benefit, CStore, ItemId, ItemFull, ItemQuant)
 -> Maybe (Double, CStore, ItemId, ItemFull, ItemQuant))
-> [(Benefit, CStore, ItemId, ItemFull, ItemQuant)]
-> [(Double, CStore, ItemId, ItemFull, ItemQuant)]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe (Benefit, CStore, ItemId, ItemFull, ItemQuant)
-> Maybe (Double, CStore, ItemId, ItemFull, ItemQuant)
goodMissile [(Benefit, CStore, ItemId, ItemFull, ItemQuant)]
benList

-- | 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 DiscoveryBenefit
discoBenefit ActorId
aid [CStore]
cstores State
s =
  let b :: Actor
b = ActorId -> State -> Actor
getActorBody ActorId
aid State
s
      mstash :: Maybe (LevelId, Point)
mstash = Faction -> Maybe (LevelId, Point)
gstash (Faction -> Maybe (LevelId, Point))
-> Faction -> Maybe (LevelId, Point)
forall a b. (a -> b) -> a -> b
$ State -> EnumMap FactionId Faction
sfactionD State
s EnumMap FactionId Faction -> FactionId -> Faction
forall k a. Enum k => EnumMap k a -> k -> a
EM.! Actor -> FactionId
bfid Actor
b
      ben :: ItemBag
-> CStore -> [(Benefit, CStore, ItemId, ItemFull, ItemQuant)]
ben ItemBag
_ CStore
CGround | Maybe (LevelId, Point)
mstash Maybe (LevelId, Point) -> Maybe (LevelId, Point) -> Bool
forall a. Eq a => a -> a -> Bool
== (LevelId, Point) -> Maybe (LevelId, Point)
forall a. a -> Maybe a
Just (Actor -> LevelId
blid Actor
b, Actor -> Point
bpos Actor
b) = []
      ben ItemBag
bag CStore
cstore =
        [ (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)
        | (ItemId
iid, 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 CStore
cs = ItemBag
-> CStore -> [(Benefit, CStore, ItemId, ItemFull, ItemQuant)]
ben (Actor -> CStore -> State -> ItemBag
getBodyStoreBag Actor
b CStore
cs State
s) CStore
cs
  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 -> Ability.Skills -> ItemFull -> Bool
hinders :: Bool -> Bool -> Skills -> ItemFull -> Bool
hinders Bool
condShineWouldBetray Bool
uneasy Skills
actorMaxSk ItemFull
itemFull =
  let arItem :: AspectRecord
arItem = ItemFull -> AspectRecord
aspectRecordFull ItemFull
itemFull
      itemShine :: Bool
itemShine = Int
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, remembered or unseen but distressing)
     -- actors want to hide in the dark.
     Bool
uneasy 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
&& Int
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 :: MonadClientRead m => ActorId -> m Bool
condDesirableFloorItemM :: forall (m :: * -> *). MonadClientRead m => ActorId -> m Bool
condDesirableFloorItemM 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 :: * -> *).
MonadClientRead 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 :: MonadClientRead m
               => ActorId
               -> m [(Benefit, CStore, ItemId, ItemFull, ItemQuant)]
benGroundItems :: forall (m :: * -> *).
MonadClientRead m =>
ActorId -> m [(Benefit, CStore, ItemId, ItemFull, ItemQuant)]
benGroundItems ActorId
aid = do
  cops <- (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
  discoBenefit <- getsClient sdiscoBenefit
  let canEsc = FactionKind -> Bool
fcanEscape (Faction -> FactionKind
gkind Faction
fact)
      isDesirable (Benefit
ben, CStore
_, ItemId
_, ItemFull
itemFull, ItemQuant
_) =
        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)
                      Int
99  -- fake, because no time is wasted walking to item
  filter isDesirable
    <$> getsState (benAvailableItems discoBenefit aid [CGround])

desirableItem :: COps -> Bool -> Double -> IA.AspectRecord -> IK.ItemKind -> Int
              -> Bool
desirableItem :: COps -> Bool -> Double -> AspectRecord -> ItemKind -> Int -> Bool
desirableItem COps{RuleContent
corule :: RuleContent
corule :: COps -> RuleContent
corule}
              Bool
canEsc Double
benPickup AspectRecord
arItem ItemKind
itemKind Int
k =
  let loneProjectile :: Bool
loneProjectile =
        ItemKind -> Char
IK.isymbol ItemKind
itemKind Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== ItemSymbolsUsedInEngine -> Char
IK.rsymbolProjectile (RuleContent -> ItemSymbolsUsedInEngine
RK.ritemSymbols RuleContent
corule)
        Bool -> Bool -> Bool
&& Int
k Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
1
        Bool -> Bool -> Bool
&& Dice -> Int
Dice.infDice (ItemKind -> Dice
IK.icount ItemKind
itemKind) Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
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
> Double
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
> Double
0 Bool -> Bool -> Bool
&& Bool -> Bool
not Bool
preciousNotUseful
  in Bool
useful Bool -> Bool -> Bool
&& Bool -> Bool
not Bool
loneProjectile

condSupport :: MonadClientRead m
            => [(ActorId, Actor)] -> Int -> ActorId -> m Bool
{-# INLINE condSupport #-}
condSupport :: forall (m :: * -> *).
MonadClientRead m =>
[(ActorId, Actor)] -> Int -> ActorId -> m Bool
condSupport [(ActorId, Actor)]
friendAssocs Int
param ActorId
aid = do
  mtgtMPath <- (StateClient -> Maybe TgtAndPath) -> m (Maybe TgtAndPath)
forall a. (StateClient -> a) -> m a
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
  getsState $ strongSupport friendAssocs param aid mtgtMPath

strongSupport :: [(ActorId, Actor)]
              -> Int -> ActorId -> Maybe TgtAndPath -> State
              -> Bool
strongSupport :: [(ActorId, Actor)]
-> Int -> ActorId -> Maybe TgtAndPath -> State -> Bool
strongSupport [(ActorId, Actor)]
friendAssocs Int
param ActorId
aid Maybe TgtAndPath
mtgtMPath 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 Int
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
      approaching :: Actor -> Bool
approaching Actor
b2 = case Maybe TgtAndPath
mtgtMPath of
        Just TgtAndPath{tapTgt :: TgtAndPath -> Target
tapTgt=TEnemy{},tapPath :: TgtAndPath -> Maybe AndPath
tapPath=Just AndPath{Point
pathGoal :: Point
pathGoal :: AndPath -> Point
pathGoal}} ->
            Point -> Point -> Int
chessDist (Actor -> Point
bpos Actor
b2) Point
pathGoal Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
1 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
param  -- will soon melee anyway
        Maybe TgtAndPath
_ -> Bool
False
      closeEnough :: Actor -> Bool
closeEnough 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
> Int
0 Bool -> Bool -> Bool
&& (Int
dist Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int -> Int -> Int
forall a. Ord a => a -> a -> a
max Int
2 Int
param Bool -> Bool -> Bool
|| Actor -> Bool
approaching Actor
b2)
      closeAndStrong :: (ActorId, Actor) -> Bool
closeAndStrong (ActorId
aid2, Actor
b2) = Actor -> Bool
closeEnough Actor
b2
                                  Bool -> Bool -> Bool
&& ActorMaxSkills -> ActorId -> Actor -> Bool
actorCanMeleeToHarm ActorMaxSkills
actorMaxSkills ActorId
aid2 Actor
b2
      closeAndStrongFriends :: [(ActorId, Actor)]
closeAndStrongFriends = ((ActorId, Actor) -> Bool)
-> [(ActorId, Actor)] -> [(ActorId, Actor)]
forall a. (a -> Bool) -> [a] -> [a]
filter (ActorId, Actor) -> Bool
closeAndStrong [(ActorId, Actor)]
friendAssocs
  in Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
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
- Int
1) [(ActorId, Actor)]
closeAndStrongFriends))
       -- optimized: length closeAndStrongFriends >= n

-- The numbers reflect fleeing AI conditions for non-aggresive actors
-- so that actors don't wait for support that is not possible due to not
-- enough friends on the level, even counting sleeping ones.
condAloneM :: MonadStateRead m => [(ActorId, Actor)] -> ActorId -> m Bool
condAloneM :: forall (m :: * -> *).
MonadStateRead m =>
[(ActorId, Actor)] -> ActorId -> m Bool
condAloneM [(ActorId, Actor)]
friendAssocs 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
  mstash <- getsState $ \State
s -> Faction -> Maybe (LevelId, Point)
gstash (Faction -> Maybe (LevelId, Point))
-> Faction -> Maybe (LevelId, Point)
forall a b. (a -> b) -> a -> b
$ State -> EnumMap FactionId Faction
sfactionD State
s EnumMap FactionId Faction -> FactionId -> Faction
forall k a. Enum k => EnumMap k a -> k -> a
EM.! Actor -> FactionId
bfid Actor
b
  let onStashLevel = case Maybe (LevelId, Point)
mstash of
        Maybe (LevelId, Point)
Nothing -> Bool
False
        Just (LevelId
lid, Point
_) -> LevelId
lid LevelId -> LevelId -> Bool
forall a. Eq a => a -> a -> Bool
== Actor -> LevelId
blid Actor
b
  return $! length friendAssocs <= if onStashLevel then 3 else 2

-- | 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 :: forall (m :: * -> *). MonadStateRead m => ActorId -> m Bool
condShineWouldBetrayM 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
  aInAmbient <- getsState $ actorInAmbient b
  return $ not aInAmbient  -- tile is dark, so actor could hide

-- | Produce a list of acceptable adjacent points to flee to.
fleeList :: MonadClientRead m
         => [(ActorId, Actor)] -> ActorId -> m ([(Int, Point)], [(Int, Point)])
fleeList :: forall (m :: * -> *).
MonadClientRead m =>
[(ActorId, Actor)] -> ActorId -> m ([(Int, Point)], [(Int, Point)])
fleeList [(ActorId, Actor)]
foeAssocs 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
  mtgtMPath <- getsClient $ EM.lookup aid . stargetD
  -- Prefer fleeing along the path to target, unless the target is a foe,
  -- in which case flee in the opposite direction.
  let etgtPath = case Maybe TgtAndPath
mtgtMPath of
        Just TgtAndPath{ tapPath :: TgtAndPath -> Maybe AndPath
tapPath=Just AndPath{[Point]
pathList :: AndPath -> [Point]
pathList :: [Point]
pathList, Point
pathGoal :: AndPath -> Point
pathGoal :: Point
pathGoal}
                       , Target
tapTgt :: TgtAndPath -> Target
tapTgt :: Target
tapTgt } -> case Target
tapTgt of
          TEnemy{} -> Point -> Either Point [Point]
forall a b. a -> Either a b
Left Point
pathGoal
          TPoint TEnemyPos{} LevelId
_ Point
_ -> Point -> Either Point [Point]
forall a b. a -> Either a b
Left Point
pathGoal
            -- this is too weak, because only one is recorded and sometimes
            -- many are needed to decide to flee next turn as well
          Target
_ -> [Point] -> Either Point [Point]
forall a b. b -> Either a b
Right [Point]
pathList
        Maybe TgtAndPath
_ -> [Point] -> Either Point [Point]
forall a b. b -> Either a b
Right []
  b <- getsState $ getActorBody aid
  lvl <- getLevel $ blid b
  localTime <- getsState $ getLocalTime (blid b)
  fleeD <- getsClient sfleeD
  -- But if fled recently, prefer even more fleeing further this turn.
  let eOldFleeOrTgt = case ActorId -> EnumMap ActorId (Point, Time) -> Maybe (Point, Time)
forall k a. Enum k => k -> EnumMap k a -> Maybe a
EM.lookup ActorId
aid EnumMap ActorId (Point, Time)
fleeD of
        Just (Point
fleeStart, Time
time) | Time -> Time -> Bool
timeRecent5 Time
localTime Time
time -> Point -> Either Point [Point]
forall a b. a -> Either a b
Left Point
fleeStart
        Maybe (Point, Time)
_ -> Either Point [Point]
etgtPath
      myVic = Point -> [Point]
vicinityUnsafe (Point -> [Point]) -> Point -> [Point]
forall a b. (a -> b) -> a -> b
$ Actor -> Point
bpos Actor
b
      dist Point
p | [(ActorId, Actor)] -> Bool
forall a. [a] -> Bool
null [(ActorId, Actor)]
foeAssocs = Int
100
             | Bool
otherwise = [Int] -> Int
forall a. Ord a => [a] -> a
forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
minimum ([Int] -> Int) -> [Int] -> Int
forall a b. (a -> b) -> a -> b
$ ((ActorId, Actor) -> Int) -> [(ActorId, Actor)] -> [Int]
forall a b. (a -> b) -> [a] -> [b]
map (Point -> Point -> Int
chessDist Point
p (Point -> Int)
-> ((ActorId, Actor) -> Point) -> (ActorId, Actor) -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Actor -> Point
bpos (Actor -> Point)
-> ((ActorId, Actor) -> Actor) -> (ActorId, Actor) -> Point
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ActorId, Actor) -> Actor
forall a b. (a, b) -> b
snd) [(ActorId, Actor)]
foeAssocs
      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 b c c'. (b -> c) -> (b -> c') -> b -> (c, c')
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
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) -> 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) -> 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) -> 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, eqVic) = partition ((== boldpos b) . Just . snd) eqVicRaw
      accNonWalkUnocc 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) -> 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) -> 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) -> 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
mult (Int
d, Point
p) = case Either Point [Point]
eOldFleeOrTgt of
        Right [Point]
tgtPathList | Point
p Point -> [Point] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Point]
tgtPathList ->
          (Int
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 [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 ->
          (Int
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 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 Int
2 of
                Ordering
GT -> Int
100 Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
sq
                Ordering
EQ -> Int
10 Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
sq
                Ordering
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)
        Either Point [Point]
_ -> (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) -> (Int, Point)) -> [(Int, Point)] -> [(Int, Point)]
forall a b. (a -> b) -> [a] -> [b]
map (Int -> (Int, Point) -> (Int, Point)
rewardPath Int
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 Int
100) [(Int, Point)]
eqVic
      badVic = ((Int, Point) -> (Int, Point)) -> [(Int, Point)] -> [(Int, Point)]
forall a b. (a -> b) -> [a] -> [b]
map (Int -> (Int, Point) -> (Int, Point)
rewardPath Int
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
  return (goodVic, badVic)