module Game.LambdaHack.Client.AI.ConditionM
( condAimEnemyPresentM
, condAimEnemyRememberedM
, condTgtNonmovingM
, condAnyFoeAdjM
, condAdjTriggerableM
, meleeThreatDistList
, condBlocksFriendsM
, condFloorWeaponM
, condNoEqpWeaponM
, condCanProjectM
, condProjectListM
, benAvailableItems
, hinders
, condDesirableFloorItemM
, benGroundItems
, desirableItem
, condSupport
, condSoloM
, condShineWouldBetrayM
, fleeList
) where
import Prelude ()
import Game.LambdaHack.Common.Prelude
import qualified Data.EnumMap.Strict as EM
import Data.Ord
import Game.LambdaHack.Client.Bfs
import Game.LambdaHack.Client.CommonM
import Game.LambdaHack.Client.MonadClient
import Game.LambdaHack.Client.State
import qualified Game.LambdaHack.Common.Ability as Ability
import Game.LambdaHack.Common.Actor
import Game.LambdaHack.Common.ActorState
import Game.LambdaHack.Common.Faction
import Game.LambdaHack.Common.Item
import qualified Game.LambdaHack.Common.ItemAspect as IA
import Game.LambdaHack.Common.Kind
import Game.LambdaHack.Common.Level
import Game.LambdaHack.Common.Misc
import Game.LambdaHack.Common.MonadStateRead
import Game.LambdaHack.Common.Point
import 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.Vector
import qualified Game.LambdaHack.Content.ItemKind as IK
import Game.LambdaHack.Content.ModeKind
condAimEnemyPresentM :: MonadClient m => ActorId -> m Bool
condAimEnemyPresentM aid = do
btarget <- getsClient $ getTarget aid
return $ case btarget of
Just (TEnemy _ permit) -> not permit
_ -> False
condAimEnemyRememberedM :: MonadClient m => ActorId -> m Bool
condAimEnemyRememberedM aid = do
b <- getsState $ getActorBody aid
btarget <- getsClient $ getTarget aid
return $ case btarget of
Just (TPoint (TEnemyPos _ permit) lid _) -> lid == blid b && not permit
_ -> False
condTgtNonmovingM :: MonadClient m => ActorId -> m Bool
condTgtNonmovingM aid = do
btarget <- getsClient $ getTarget aid
case btarget of
Just (TEnemy enemy _) -> do
actorMaxSk <- maxActorSkillsClient enemy
return $ EM.findWithDefault 0 Ability.AbMove actorMaxSk <= 0
_ -> return False
condAnyFoeAdjM :: MonadStateRead m => ActorId -> m Bool
condAnyFoeAdjM aid = getsState $ anyFoeAdj aid
condAdjTriggerableM :: MonadStateRead m => ActorId -> m Bool
condAdjTriggerableM aid = do
b <- getsState $ getActorBody aid
lvl <- getLevel $ blid b
let hasTriggerable p = p `EM.member` lembed lvl
return $ any hasTriggerable $ vicinityUnsafe $ bpos b
meleeThreatDistList :: ActorId -> State -> [(Int, (ActorId, Actor))]
meleeThreatDistList aid s =
let actorAspect = sactorAspect s
b = getActorBody aid s
allAtWar = foeRegularAssocs (bfid b) (blid b) s
strongActor (aid2, b2) =
let ar = actorAspect EM.! aid2
actorMaxSkE = IA.aSkills ar
nonmoving = EM.findWithDefault 0 Ability.AbMove actorMaxSkE <= 0
in not (hpTooLow b2 ar || nonmoving)
&& actorCanMelee actorAspect aid2 b2
allThreats = filter strongActor allAtWar
addDist (aid2, b2) = (chessDist (bpos b) (bpos b2), (aid2, b2))
in sortBy (comparing fst) $ map addDist allThreats
condBlocksFriendsM :: MonadClient m => ActorId -> m Bool
condBlocksFriendsM aid = do
b <- getsState $ getActorBody aid
targetD <- getsClient stargetD
let blocked aid2 = aid2 /= aid &&
case EM.lookup aid2 targetD of
Just TgtAndPath{tapPath=AndPath{pathList=q : _}} | q == bpos b -> True
_ -> False
any blocked <$> getsState (fidActorRegularIds (bfid b) (blid b))
condFloorWeaponM :: MonadStateRead m => ActorId -> m Bool
condFloorWeaponM aid =
any (IK.isMelee . itemKind . snd) <$> getsState (fullAssocs aid [CGround])
condNoEqpWeaponM :: MonadStateRead m => ActorId -> m Bool
condNoEqpWeaponM aid =
all (not . IK.isMelee . itemKind . snd) <$> getsState (fullAssocs aid [CEqp])
condCanProjectM :: MonadClient m => Int -> ActorId -> m Bool
{-# INLINE condCanProjectM #-}
condCanProjectM skill aid =
not . null <$> condProjectListM skill aid
condProjectListM :: MonadClient m
=> Int -> ActorId
-> m [(Benefit, CStore, ItemId, ItemFull, ItemQuant)]
{-# INLINE condProjectListM #-}
condProjectListM skill aid = do
condShineWouldBetray <- condShineWouldBetrayM aid
condAimEnemyPresent <- condAimEnemyPresentM aid
discoBenefit <- getsClient sdiscoBenefit
getsState $ projectList discoBenefit skill aid
condShineWouldBetray condAimEnemyPresent
projectList :: DiscoveryBenefit -> Int -> ActorId -> Bool -> Bool -> State
-> [(Benefit, CStore, ItemId, ItemFull, ItemQuant)]
projectList discoBenefit skill aid
condShineWouldBetray condAimEnemyPresent s =
let b = getActorBody aid s
ar = getActorAspect aid s
calmE = calmEnough b ar
condNotCalmEnough = not calmE
heavilyDistressed =
deltaSerious (bcalmDelta b)
hind = hinders condShineWouldBetray condAimEnemyPresent
heavilyDistressed condNotCalmEnough ar
q (Benefit{benInEqp, benFling}, _, _, itemFull, _) =
benFling < 0
&& (not benInEqp
|| not (IK.isMelee $ itemKind itemFull)
&& hind itemFull)
&& permittedProjectAI skill calmE itemFull
stores = [CEqp, CInv, CGround] ++ [CSha | calmE]
in filter q $ benAvailableItems discoBenefit aid stores s
benAvailableItems :: DiscoveryBenefit -> ActorId -> [CStore] -> State
-> [(Benefit, CStore, ItemId, ItemFull, ItemQuant)]
benAvailableItems discoBenefit aid cstores s =
let b = getActorBody aid s
ben cstore bag =
[ (discoBenefit EM.! iid, cstore, iid, itemToFull iid s, kit)
| (iid, kit) <- EM.assocs bag]
benCStore cs = ben cs $ getBodyStoreBag b cs s
in concatMap benCStore cstores
hinders :: Bool -> Bool -> Bool -> Bool -> IA.AspectRecord -> ItemFull
-> Bool
hinders condShineWouldBetray condAimEnemyPresent
heavilyDistressed condNotCalmEnough
ar itemFull =
let itemShine = 0 < IA.aShine (aspectRecordFull itemFull)
itemShineBad = condShineWouldBetray && itemShine
in
(condAimEnemyPresent || condNotCalmEnough || heavilyDistressed)
&& itemShineBad
|| gearSpeed ar > speedWalk
&& not (IK.isMelee $ itemKind itemFull)
&& 0 > IA.aHurtMelee (aspectRecordFull itemFull)
condDesirableFloorItemM :: MonadClient m => ActorId -> m Bool
condDesirableFloorItemM aid = not . null <$> benGroundItems aid
benGroundItems :: MonadClient m
=> ActorId
-> m [(Benefit, CStore, ItemId, ItemFull, ItemQuant)]
benGroundItems aid = do
b <- getsState $ getActorBody aid
fact <- getsState $ (EM.! bfid b) . sfactionD
discoBenefit <- getsClient sdiscoBenefit
let canEsc = fcanEscape (gplayer fact)
isDesirable (ben, _, _, ItemFull{itemKind}, _) =
desirableItem canEsc (benPickup ben) itemKind
filter isDesirable
<$> getsState (benAvailableItems discoBenefit aid [CGround])
desirableItem :: Bool -> Double -> IK.ItemKind -> Bool
desirableItem canEsc benPickup itemKind =
if canEsc
then benPickup > 0 || IK.Precious `elem` IK.ifeature itemKind
else
let preciousNotUseful = IK.isHumanTrinket itemKind
in benPickup > 0 && not preciousNotUseful
condSupport :: MonadClient m => Int -> ActorId -> m Bool
{-# INLINE condSupport #-}
condSupport param aid = do
btarget <- getsClient $ getTarget aid
condAimEnemyPresent <- condAimEnemyPresentM aid
condAimEnemyRemembered <- condAimEnemyRememberedM aid
getsState $ strongSupport param aid btarget
condAimEnemyPresent condAimEnemyRemembered
strongSupport :: Int -> ActorId -> Maybe Target -> Bool -> Bool -> State -> Bool
strongSupport param aid btarget condAimEnemyPresent condAimEnemyRemembered s =
let n = min 2 param - IA.aAggression ar
actorAspect = sactorAspect s
ar = actorAspect EM.! aid
b = getActorBody aid s
mtgtPos = case btarget of
Nothing -> Nothing
Just target -> aidTgtToPos aid (blid b) target s
approaching b2 = case mtgtPos of
Just tgtPos | condAimEnemyPresent || condAimEnemyRemembered ->
chessDist (bpos b2) tgtPos <= 1 + param
_ -> False
closeEnough b2 = let dist = chessDist (bpos b) (bpos b2)
in dist > 0 && (dist <= param || approaching b2)
closeAndStrong (aid2, b2) = closeEnough b2
&& actorCanMelee actorAspect aid2 b2
friends = friendRegularAssocs (bfid b) (blid b) s
closeAndStrongFriends = filter closeAndStrong friends
in not $ n > 0 && null (drop (n - 1) closeAndStrongFriends)
condSoloM :: MonadClient m => ActorId -> m Bool
condSoloM aid = do
b <- getsState $ getActorBody aid
let isSingleton [_] = True
isSingleton _ = False
isSingleton <$> getsState (friendRegularList (bfid b) (blid b))
condShineWouldBetrayM :: MonadStateRead m => ActorId -> m Bool
condShineWouldBetrayM aid = do
b <- getsState $ getActorBody aid
aInAmbient <- getsState $ actorInAmbient b
return $ not aInAmbient
fleeList :: MonadClient m => ActorId -> m ([(Int, Point)], [(Int, Point)])
fleeList aid = do
COps{coTileSpeedup} <- getsState scops
mtgtMPath <- getsClient $ EM.lookup aid . stargetD
let etgtPath = case mtgtMPath of
Just TgtAndPath{ tapPath=tapPath@AndPath{pathList}
, tapTgt } -> case tapTgt of
TEnemy{} -> Left tapPath
TPoint TEnemyPos{} _ _ -> Left tapPath
_ -> Right pathList
_ -> Right []
b <- getsState $ getActorBody aid
lvl@Level{lxsize, lysize} <- getLevel $ blid b
s <- getState
let posFoes = map bpos $ foeRegularList (bfid b) (blid b) s
myVic = vicinity lxsize lysize $ bpos b
dist p | null posFoes = 100
| otherwise = minimum $ map (chessDist p) posFoes
dVic = map (dist &&& id) myVic
accUnocc p = Tile.isWalkable coTileSpeedup (lvl `at` p)
&& null (posToAssocs p (blid b) s)
accVic = filter (accUnocc . snd) dVic
gtVic = filter ((> dist (bpos b)) . fst) accVic
eqVic = filter ((== dist (bpos b)) . fst) accVic
ltVic = filter ((< dist (bpos b)) . fst) accVic
rewardPath mult (d, p) = case etgtPath of
Right tgtPath | p `elem` tgtPath ->
(100 * mult * d, p)
Right tgtPath | any (adjacent p) tgtPath ->
(10 * mult * d, p)
Left AndPath{pathGoal} | bpos b /= pathGoal ->
let venemy = towards (bpos b) pathGoal
vflee = towards (bpos b) p
sq = euclidDistSqVector venemy vflee
skew = case compare sq 2 of
GT -> 100 * sq
EQ -> 10 * sq
LT -> sq
in (mult * skew * d, p)
_ -> (mult * d, p)
goodVic = map (rewardPath 10000) gtVic
++ map (rewardPath 100) eqVic
badVic = map (rewardPath 1) ltVic
return (goodVic, badVic)