-- | 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 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 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 :: MonadClient m => ActorId -> m Bool
condAimEnemyTargetedM :: ActorId -> m Bool
condAimEnemyTargetedM 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 a target enemy or enemy stash is visible by the party.
condAimEnemyOrStashM :: MonadClient m => ActorId -> m Bool
condAimEnemyOrStashM :: ActorId -> m Bool
condAimEnemyOrStashM 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
    Just (TPoint (TStash _) _ _) -> Bool
True  -- speedup from: lid == blid b
    _ -> Bool
False

-- | Require that a target enemy is remembered on the actor's level.
condAimEnemyOrRememberedM :: MonadClient m => ActorId -> m Bool
condAimEnemyOrRememberedM :: ActorId -> m Bool
condAimEnemyOrRememberedM 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 (TEnemy _) -> Bool
True
    Just (TPoint (TEnemyPos _) lid :: LevelId
lid _) -> LevelId
lid LevelId -> LevelId -> Bool
forall a. Eq a => a -> a -> Bool
== Actor -> LevelId
blid Actor
b
    Just (TPoint (TStash _) lid :: LevelId
lid _) -> LevelId
lid LevelId -> LevelId -> Bool
forall a. Eq a => a -> a -> Bool
== Actor -> LevelId
blid Actor
b
    _ -> Bool
False

-- | Require that a 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 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  -- 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
    _ -> 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 the actor stands on or adjacent to a triggerable tile
-- (e.g., stairs).
condAdjTriggerableM :: MonadClient m => Ability.Skills -> ActorId -> m Bool
condAdjTriggerableM :: Skills -> ActorId -> m Bool
condAdjTriggerableM actorSk :: Skills
actorSk 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
  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, Actor)] -> ActorId -> State
                    -> [(Int, (ActorId, Actor))]
meleeThreatDistList :: [(ActorId, Actor)] -> ActorId -> State -> [(Int, (ActorId, Actor))]
meleeThreatDistList foeAssocs :: [(ActorId, Actor)]
foeAssocs 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

      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
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 (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,
-- if only it was a desirable item (checked elsewhere).
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 = do
  FactionId
side <- (StateClient -> FactionId) -> m FactionId
forall (m :: * -> *) a.
MonadClientRead m =>
(StateClient -> a) -> m a
getsClient StateClient -> FactionId
sside
  Challenge
curChal <- (StateClient -> Challenge) -> m Challenge
forall (m :: * -> *) a.
MonadClientRead m =>
(StateClient -> a) -> m a
getsClient ((StateClient -> Challenge) -> m Challenge)
-> (StateClient -> Challenge) -> m Challenge
forall a b. (a -> b) -> a -> b
$ StateClient -> Challenge
scurChal
  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.! FactionId
side) (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
  if Int
skill Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< 1
     Bool -> Bool -> Bool
|| Challenge -> Bool
ckeeper Challenge
curChal Bool -> Bool -> Bool
&& Player -> Bool
fhasUI (Faction -> Player
gplayer Faction
fact)
  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)
-> ([(Double, CStore, ItemId, ItemFull, ItemQuant)] -> Bool)
-> [(Double, CStore, ItemId, ItemFull, ItemQuant)]
-> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [(Double, CStore, ItemId, ItemFull, ItemQuant)] -> Bool
forall a. [a] -> Bool
null ([(Double, CStore, ItemId, ItemFull, ItemQuant)] -> Bool)
-> m [(Double, CStore, ItemId, ItemFull, ItemQuant)] -> m Bool
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Int -> ActorId -> m [(Double, CStore, ItemId, ItemFull, ItemQuant)]
forall (m :: * -> *).
MonadClient m =>
Int -> ActorId -> m [(Double, CStore, ItemId, ItemFull, ItemQuant)]
condProjectListM Int
skill ActorId
aid

condProjectListM :: MonadClient m
                 => Int -> ActorId
                 -> m [(Double, CStore, ItemId, ItemFull, ItemQuant)]
condProjectListM :: Int -> ActorId -> m [(Double, 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
condAimEnemyOrRemembered <- ActorId -> m Bool
forall (m :: * -> *). MonadClient m => ActorId -> m Bool
condAimEnemyOrRememberedM ActorId
aid
  DiscoveryBenefit
discoBenefit <- (StateClient -> DiscoveryBenefit) -> m DiscoveryBenefit
forall (m :: * -> *) a.
MonadClientRead m =>
(StateClient -> a) -> m a
getsClient StateClient -> DiscoveryBenefit
sdiscoBenefit
  (State -> [(Double, CStore, ItemId, ItemFull, ItemQuant)])
-> m [(Double, CStore, ItemId, ItemFull, ItemQuant)]
forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
getsState ((State -> [(Double, CStore, ItemId, ItemFull, ItemQuant)])
 -> m [(Double, CStore, ItemId, ItemFull, ItemQuant)])
-> (State -> [(Double, CStore, ItemId, ItemFull, ItemQuant)])
-> m [(Double, CStore, ItemId, ItemFull, ItemQuant)]
forall a b. (a -> b) -> a -> b
$ DiscoveryBenefit
-> Int
-> ActorId
-> Bool
-> Bool
-> State
-> [(Double, CStore, ItemId, ItemFull, ItemQuant)]
projectList DiscoveryBenefit
discoBenefit Int
skill ActorId
aid
                          Bool
condShineWouldBetray Bool
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 discoBenefit :: DiscoveryBenefit
discoBenefit skill :: Int
skill aid :: ActorId
aid
            condShineWouldBetray :: Bool
condShineWouldBetray condAimEnemyOrRemembered :: Bool
condAimEnemyOrRemembered 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
      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 CGround = 2  -- pickup turn saved
      coeff COrgan = [Char] -> Double
forall a. HasCallStack => [Char] -> a
error ([Char] -> Double) -> [Char] -> Double
forall a b. (a -> b) -> a -> b
$ "" [Char]
-> [(Benefit, CStore, ItemId, ItemFull, ItemQuant)] -> [Char]
forall v. Show v => [Char] -> v -> [Char]
`showFailure` [(Benefit, CStore, ItemId, ItemFull, ItemQuant)]
benList
      coeff CEqp = 1000  -- must hinder currently (or be very potent);
                         -- note: not larger, to avoid Int32 overflow
      coeff CStash = 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 :: Benefit -> Bool
benInEqp :: Bool
benInEqp, Double
benFling :: Benefit -> Double
benFling :: Double
benFling}, cstore :: CStore
cstore, iid :: ItemId
iid, itemFull :: ItemFull
itemFull, kit :: 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
< -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 discoBenefit :: DiscoveryBenefit
discoBenefit aid :: ActorId
aid cstores :: [CStore]
cstores s :: 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 _ 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 bag :: ItemBag
bag cstore :: 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)
        | (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 = 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 condShineWouldBetray :: Bool
condShineWouldBetray uneasy :: Bool
uneasy 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, 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
&& 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, because 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 => [(ActorId, Actor)] -> Int -> ActorId -> m Bool
{-# INLINE condSupport #-}
condSupport :: [(ActorId, Actor)] -> Int -> ActorId -> m Bool
condSupport friendAssocs :: [(ActorId, Actor)]
friendAssocs param :: Int
param aid :: ActorId
aid = do
  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
  (State -> Bool) -> m Bool
forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
getsState ((State -> Bool) -> m Bool) -> (State -> Bool) -> m Bool
forall a b. (a -> b) -> a -> b
$ [(ActorId, Actor)]
-> Int -> ActorId -> Maybe TgtAndPath -> State -> Bool
strongSupport [(ActorId, Actor)]
friendAssocs Int
param ActorId
aid Maybe TgtAndPath
mtgtMPath

strongSupport :: [(ActorId, Actor)]
              -> Int -> ActorId -> Maybe TgtAndPath -> State
              -> Bool
strongSupport :: [(ActorId, Actor)]
-> Int -> ActorId -> Maybe TgtAndPath -> State -> Bool
strongSupport friendAssocs :: [(ActorId, Actor)]
friendAssocs param :: Int
param aid :: ActorId
aid mtgtMPath :: Maybe TgtAndPath
mtgtMPath 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
      approaching :: Actor -> Bool
approaching b2 :: Actor
b2 = case Maybe TgtAndPath
mtgtMPath of
        Just TgtAndPath{tapTgt :: TgtAndPath -> Target
tapTgt=TEnemy{},tapPath :: TgtAndPath -> Maybe AndPath
tapPath=Just AndPath{Point
pathGoal :: AndPath -> Point
pathGoal :: Point
pathGoal}} ->
            Point -> Point -> Int
chessDist (Actor -> Point
bpos Actor
b2) Point
pathGoal Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= 1 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
param  -- will soon melee anyway
        _ -> 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 -> Int -> Int
forall a. Ord a => a -> a -> a
max 2 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
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
<= 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

-- 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 :: MonadClient m => [(ActorId, Actor)] -> ActorId -> m Bool
condAloneM :: [(ActorId, Actor)] -> ActorId -> m Bool
condAloneM friendAssocs :: [(ActorId, Actor)]
friendAssocs 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 (LevelId, Point)
mstash <- (State -> Maybe (LevelId, Point)) -> m (Maybe (LevelId, Point))
forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
getsState ((State -> Maybe (LevelId, Point)) -> m (Maybe (LevelId, Point)))
-> (State -> Maybe (LevelId, Point)) -> m (Maybe (LevelId, Point))
forall a b. (a -> b) -> a -> b
$ \s :: 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 :: Bool
onStashLevel = case Maybe (LevelId, Point)
mstash of
        Nothing -> Bool
False
        Just (lid :: LevelId
lid, _) -> LevelId
lid LevelId -> LevelId -> Bool
forall a. Eq a => a -> a -> Bool
== Actor -> LevelId
blid 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
$! [(ActorId, Actor)] -> Int
forall a. [a] -> Int
length [(ActorId, Actor)]
friendAssocs Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= if Bool
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 :: 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, Actor)] -> ActorId -> m ([(Int, Point)], [(Int, Point)])
fleeList :: [(ActorId, Actor)] -> ActorId -> m ([(Int, Point)], [(Int, Point)])
fleeList foeAssocs :: [(ActorId, Actor)]
foeAssocs 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 :: Point
pathGoal :: AndPath -> 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
            -- this is too weak, because only one is recorded and sometimes
            -- many are needed to decide to flee next turn as well
          _ -> [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 []
  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
  Time
localTime <- (State -> Time) -> m Time
forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
getsState ((State -> Time) -> m Time) -> (State -> Time) -> m Time
forall a b. (a -> b) -> a -> b
$ LevelId -> State -> Time
getLocalTime (Actor -> LevelId
blid Actor
b)
  EnumMap ActorId (Point, Time)
fleeD <- (StateClient -> EnumMap ActorId (Point, Time))
-> m (EnumMap ActorId (Point, Time))
forall (m :: * -> *) a.
MonadClientRead m =>
(StateClient -> a) -> m a
getsClient StateClient -> EnumMap ActorId (Point, Time)
sfleeD
  -- But if fled recently, prefer even more fleeing further this turn.
  let eOldFleeOrTgt :: Either Point [Point]
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 (fleeStart :: Point
fleeStart, time :: Time
time) | Time -> Time -> Bool
timeRecent5 Time
localTime Time
time -> Point -> Either Point [Point]
forall a b. a -> Either a b
Left Point
fleeStart
        _ -> Either Point [Point]
etgtPath
      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 | [(ActorId, Actor)] -> Bool
forall a. [a] -> Bool
null [(ActorId, Actor)]
foeAssocs = 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
$ ((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 :: [(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)