module Game.LambdaHack.Client.AI.ConditionM
( condAimEnemyPresentM
, condAimEnemyRememberedM
, condAimNonEnemyPresentM
, condAimEnemyNoMeleeM
, condInMeleeM
, condAimCrucialM
, condTgtNonmovingEnemyM
, condAnyFoeAdjM
, condAdjTriggerableM
, meleeThreatDistList
, condBlocksFriendsM
, condFloorWeaponM
, condNoEqpWeaponM
, condCanProjectM
, condProjectListM
, benAvailableItems
, hinders
, condDesirableFloorItemM
, benGroundItems
, desirableItem
, condSupport
, condSoloM
, condShineWouldBetrayM
, fleeList
) where
import Prelude ()
import Game.LambdaHack.Core.Prelude
import qualified Data.EnumMap.Strict as EM
import Data.Ord
import Game.LambdaHack.Client.Bfs
import Game.LambdaHack.Client.CommonM
import Game.LambdaHack.Client.MonadClient
import Game.LambdaHack.Client.State
import Game.LambdaHack.Common.Actor
import Game.LambdaHack.Common.ActorState
import Game.LambdaHack.Common.Faction
import Game.LambdaHack.Common.Item
import qualified Game.LambdaHack.Common.ItemAspect as IA
import Game.LambdaHack.Common.Kind
import Game.LambdaHack.Common.Level
import Game.LambdaHack.Common.MonadStateRead
import Game.LambdaHack.Common.ReqFailure
import Game.LambdaHack.Common.State
import qualified Game.LambdaHack.Common.Tile as Tile
import Game.LambdaHack.Common.Time
import Game.LambdaHack.Common.Types
import Game.LambdaHack.Common.Vector
import qualified Game.LambdaHack.Content.ItemKind as IK
import Game.LambdaHack.Content.ModeKind
import Game.LambdaHack.Content.RuleKind
import qualified Game.LambdaHack.Core.Dice as Dice
import Game.LambdaHack.Common.Point
import qualified Game.LambdaHack.Definition.Ability as Ability
import Game.LambdaHack.Definition.Defs
condAimEnemyPresentM :: MonadClient m => ActorId -> m Bool
condAimEnemyPresentM aid = do
btarget <- getsClient $ getTarget aid
return $ case btarget of
Just (TEnemy _) -> True
_ -> 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 _) lid _) -> lid == blid b
_ -> False
condAimNonEnemyPresentM :: MonadClient m => ActorId -> m Bool
condAimNonEnemyPresentM aid = do
btarget <- getsClient $ getTarget aid
return $ case btarget of
Just (TNonEnemy _) -> True
_ -> False
condAimEnemyNoMeleeM :: MonadClient m => ActorId -> m Bool
condAimEnemyNoMeleeM aid = do
btarget <- getsClient $ getTarget aid
case btarget of
Just (TEnemy aid2) -> do
b2 <- getsState $ getActorBody aid2
actorMaxSkills <- getsState sactorMaxSkills
return $ actorCanMelee actorMaxSkills aid2 b2
_ -> return False
condInMeleeM :: MonadClient m => LevelId -> m Bool
condInMeleeM lid = do
condInMelee <- getsClient scondInMelee
case EM.lookup lid condInMelee of
Just inM -> return inM
Nothing -> do
side <- getsClient sside
inM <- getsState $ inMelee side lid
modifyClient $ \cli ->
cli {scondInMelee = EM.insert lid inM condInMelee}
return inM
condAimCrucialM :: MonadClient m => ActorId -> m Bool
condAimCrucialM aid = do
b <- getsState $ getActorBody aid
mtgtMPath <- getsClient $ EM.lookup aid . stargetD
return $ case mtgtMPath of
Just TgtAndPath{tapTgt=TEnemy _} -> True
Just TgtAndPath{tapTgt=TPoint tgoal lid _, tapPath=Just AndPath{pathLen}} ->
lid == blid b
&& (pathLen < 10
|| tgoal `notElem` [TUnknown, TKnown])
Just TgtAndPath{tapTgt=TVector{}, tapPath=Just AndPath{pathLen}} ->
pathLen < 7
_ -> False
condTgtNonmovingEnemyM :: MonadClient m => ActorId -> m Bool
condTgtNonmovingEnemyM aid = do
btarget <- getsClient $ getTarget aid
case btarget of
Just (TEnemy enemy) -> do
actorMaxSk <- getsState $ getActorMaxSkills enemy
return $ Ability.getSk Ability.SkMove actorMaxSk <= 0
_ -> return False
condAnyFoeAdjM :: MonadStateRead m => ActorId -> m Bool
condAnyFoeAdjM aid = getsState $ anyFoeAdj aid
condAdjTriggerableM :: MonadClient m => ActorId -> m Bool
condAdjTriggerableM aid = do
COps{coTileSpeedup} <- getsState scops
b <- getsState $ getActorBody aid
lvl <- getLevel $ blid b
actorSk <- currentSkillsClient aid
let alterSkill = Ability.getSk Ability.SkAlter actorSk
alterMinSkill p = Tile.alterMinSkill coTileSpeedup $ lvl `at` p
underFeet p = p == bpos b
hasTriggerable p = (underFeet p
|| alterSkill >= fromEnum (alterMinSkill p))
&& p `EM.member` lembed lvl
return $ any hasTriggerable $ bpos b : vicinityUnsafe (bpos b)
meleeThreatDistList :: ActorId -> State -> [(Int, (ActorId, Actor))]
meleeThreatDistList aid s =
let actorMaxSkills = sactorMaxSkills s
b = getActorBody aid s
allAtWar = foeRegularAssocs (bfid b) (blid b) s
strongActor (aid2, b2) =
let actorMaxSk = actorMaxSkills EM.! aid2
nonmoving = Ability.getSk Ability.SkMove actorMaxSk <= 0
in not (hpTooLow b2 actorMaxSk || nonmoving)
&& actorCanMelee actorMaxSkills 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=Just 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 (IA.checkFlag Ability.Meleeable . aspectRecordFull . snd) <$>
getsState (fullAssocs aid [CGround])
condNoEqpWeaponM :: MonadStateRead m => ActorId -> m Bool
condNoEqpWeaponM aid =
all (not . IA.checkFlag Ability.Meleeable . aspectRecordFull . snd) <$>
getsState (fullAssocs aid [CEqp])
condCanProjectM :: MonadClient m => Int -> ActorId -> m Bool
condCanProjectM skill aid =
if skill < 1 then return False else
not . null <$> condProjectListM skill aid
condProjectListM :: MonadClient m
=> Int -> ActorId
-> m [(Benefit, CStore, ItemId, ItemFull, ItemQuant)]
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
actorMaxSk = getActorMaxSkills aid s
calmE = calmEnough b actorMaxSk
condNotCalmEnough = not calmE
heavilyDistressed =
deltasSerious (bcalmDelta b)
hind = hinders condShineWouldBetray condAimEnemyPresent
heavilyDistressed condNotCalmEnough actorMaxSk
q (Benefit{benInEqp, benFling}, _, _, itemFull, _) =
let arItem = aspectRecordFull itemFull
in benFling < 0
&& (not benInEqp
|| not (IA.checkFlag Ability.Meleeable arItem)
&& 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 -> Ability.Skills -> ItemFull
-> Bool
hinders condShineWouldBetray condAimEnemyPresent
heavilyDistressed condNotCalmEnough
actorMaxSk itemFull =
let arItem = aspectRecordFull itemFull
itemShine = 0 < IA.getSkill Ability.SkShine arItem
itemShineBad = condShineWouldBetray && itemShine
in
(condAimEnemyPresent || condNotCalmEnough || heavilyDistressed)
&& itemShineBad
|| gearSpeed actorMaxSk > speedWalk
&& not (IA.checkFlag Ability.Meleeable arItem)
&& 0 > IA.getSkill Ability.SkHurtMelee arItem
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
cops <- getsState scops
b <- getsState $ getActorBody aid
fact <- getsState $ (EM.! bfid b) . sfactionD
discoBenefit <- getsClient sdiscoBenefit
let canEsc = fcanEscape (gplayer fact)
isDesirable (ben, _, _, itemFull, _) =
desirableItem cops canEsc (benPickup ben)
(aspectRecordFull itemFull) (itemKind itemFull)
99
filter isDesirable
<$> getsState (benAvailableItems discoBenefit aid [CGround])
desirableItem :: COps -> Bool -> Double -> IA.AspectRecord -> IK.ItemKind -> Int
-> Bool
desirableItem COps{corule=RuleContent{rsymbolProjectile}}
canEsc benPickup arItem itemKind k =
let loneProjectile = IK.isymbol itemKind == rsymbolProjectile
&& k == 1
&& Dice.infDice (IK.icount itemKind) > 1
useful = if canEsc
then benPickup > 0
|| IA.checkFlag Ability.Precious arItem
else
let preciousNotUseful = IA.isHumanTrinket itemKind
in benPickup > 0 && not preciousNotUseful
in useful && not loneProjectile
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 actorMaxSkills = sactorMaxSkills s
actorMaxSk = actorMaxSkills EM.! aid
n = min 2 param - Ability.getSk Ability.SkAggression actorMaxSk
b = getActorBody aid s
mtgtPos = aidTgtToPos aid (blid b) btarget 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 actorMaxSkills aid2 b2
friends = friendRegularAssocs (bfid b) (blid b) s
closeAndStrongFriends = filter closeAndStrong friends
in n <= 0 || not (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=Just AndPath{pathList, pathGoal}
, tapTgt } -> case tapTgt of
TEnemy{} -> Left pathGoal
TPoint TEnemyPos{} _ _ -> Left pathGoal
_ -> Right pathList
_ -> Right []
fleeD <- getsClient sfleeD
let eOldFleeOrTgt = case EM.lookup aid fleeD of
Nothing -> etgtPath
Just p -> Left p
b <- getsState $ getActorBody aid
lvl <- getLevel $ blid b
posFoes <- getsState $ map bpos . foeRegularList (bfid b) (blid b)
let myVic = vicinityUnsafe $ bpos b
dist p | null posFoes = 100
| otherwise = minimum $ map (chessDist p) posFoes
dVic = map (dist &&& id) myVic
accWalkUnocc p = Tile.isWalkable coTileSpeedup (lvl `at` p)
&& not (occupiedBigLvl p lvl)
&& not (occupiedProjLvl p lvl)
accWalkVic = filter (accWalkUnocc . snd) dVic
gtVic = filter ((> dist (bpos b)) . fst) accWalkVic
eqVicRaw = filter ((== dist (bpos b)) . fst) accWalkVic
(eqVicOld, eqVic) = partition ((== boldpos b) . Just . snd) eqVicRaw
accNonWalkUnocc p = not (Tile.isWalkable coTileSpeedup (lvl `at` p))
&& Tile.isEasyOpen coTileSpeedup (lvl `at` p)
&& not (occupiedBigLvl p lvl)
&& not (occupiedProjLvl p lvl)
accNonWalkVic = filter (accNonWalkUnocc . snd) dVic
gtEqNonVic = filter ((>= dist (bpos b)) . fst) accNonWalkVic
ltAllVic = filter ((< dist (bpos b)) . fst) dVic
rewardPath mult (d, p) = case eOldFleeOrTgt of
Right tgtPathList | p `elem` tgtPathList ->
(100 * mult * d, p)
Right tgtPathList | any (adjacent p) tgtPathList ->
(10 * mult * d, p)
Left 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) $ gtEqNonVic ++ eqVicOld ++ ltAllVic
return (goodVic, badVic)