-- | Semantics of abilities in terms of actions and the AI procedure -- for picking the best action for an actor. module Game.LambdaHack.Client.AI.ConditionM ( condAimEnemyPresentM , condAimEnemyRememberedM , condTgtNonmovingM , condAnyFoeAdjM , condAdjTriggerableM , condBlocksFriendsM , condFloorWeaponM , condNoEqpWeaponM , condCanProjectM , condProjectListM , condDesirableFloorItemM , condSupport , benAvailableItems , hinders , benGroundItems , desirableItem , meleeThreatDistList , 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.Kind as 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.Request 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 -- All conditions are (partially) lazy, because they are not always -- used in the strict monadic computations they are in. -- | Require that the target enemy is visible by the party. condAimEnemyPresentM :: MonadClient m => ActorId -> m Bool condAimEnemyPresentM aid = do btarget <- getsClient $ getTarget aid return $ case btarget of Just (TEnemy _ permit) -> not permit _ -> False -- | Require that the target enemy is remembered on the actor's level. 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 -- | Check if the target is nonmoving. 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 -- | Require that any non-dying foe is adjacent, except projectiles -- that (possibly) explode upon contact. condAnyFoeAdjM :: MonadStateRead m => ActorId -> m Bool condAnyFoeAdjM aid = getsState $ anyFoeAdj aid -- | Require the actor stands adjacent to a triggerable tile (e.g., stairs). 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 -- | 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 then when melee is started, it's usually too late -- to retreat. meleeThreatDistList :: MonadClient m => ActorId -> m [(Int, (ActorId, Actor))] meleeThreatDistList aid = do actorAspect <- getsClient sactorAspect b <- getsState $ getActorBody aid fact <- getsState $ (EM.! bfid b) . sfactionD allAtWar <- getsState $ actorRegularAssocs (isAtWar fact) (blid b) let strongActor (aid2, b2) = let ar = actorAspect EM.! aid2 actorMaxSkE = 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)) return $ sortBy (comparing fst) $ map addDist allThreats -- | Require the actor blocks the paths of any of his party members. condBlocksFriendsM :: MonadClient m => ActorId -> m Bool condBlocksFriendsM aid = do b <- getsState $ getActorBody aid ours <- getsState $ fidActorRegularIds (bfid b) (blid b) 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 return $ any blocked ours -- | Require the actor stands over a weapon that would be auto-equipped. condFloorWeaponM :: MonadClient m => ActorId -> m Bool condFloorWeaponM aid = do floorAssocs <- getsState $ getActorAssocs aid CGround let lootIsWeapon = any (isMelee . snd) floorAssocs return lootIsWeapon -- | Check whether the actor has no weapon in equipment. condNoEqpWeaponM :: MonadClient m => ActorId -> m Bool condNoEqpWeaponM aid = do eqpAssocs <- getsState $ getActorAssocs aid CEqp return $ all (not . isMelee . snd) eqpAssocs -- | Require that the actor can project any items. condCanProjectM :: MonadClient m => Int -> ActorId -> m Bool condCanProjectM skill aid = do -- Compared to conditions in @projectItem@, range and charge are ignored, -- because they may change by the time the position for the fling is reached. benList <- condProjectListM skill aid return $ not $ null benList condProjectListM :: MonadClient m => Int -> ActorId -> m [(Maybe Benefit, CStore, ItemId, ItemFull)] condProjectListM skill aid = do b <- getsState $ getActorBody aid condShineWouldBetray <- condShineWouldBetrayM aid condAimEnemyPresent <- condAimEnemyPresentM aid actorAspect <- getsClient sactorAspect let ar = fromMaybe (assert `failure` aid) (EM.lookup aid actorAspect) calmE = calmEnough b ar condNotCalmEnough = not calmE heavilyDistressed = -- Actor hit by a projectile or similarly distressed. deltaSerious (bcalmDelta b) -- This detects if the value of keeping the item in eqp is in fact < 0. hind = hinders condShineWouldBetray condAimEnemyPresent heavilyDistressed condNotCalmEnough b ar q (mben, _, _, itemFull) = let (bInEqp, bFling) = case mben of Just Benefit{benInEqp, benFling} -> (benInEqp, benFling) Nothing -> (goesIntoEqp $ itemBase itemFull, -10) in bFling < 0 && (not bInEqp -- can't wear, so OK to risk losing or breaking || not (isMelee $ itemBase itemFull) -- anything else expendable && hind itemFull) -- hinders now, so possibly often, so away! && permittedProjectAI skill calmE itemFull benList <- benAvailableItems aid $ [CEqp, CInv, CGround] ++ [CSha | calmE] return $ filter q benList -- | Produce the list of items with a given property available to the actor -- and the items' values. benAvailableItems :: MonadClient m => ActorId -> [CStore] -> m [(Maybe Benefit, CStore, ItemId, ItemFull)] benAvailableItems aid cstores = do itemToF <- itemToFullClient b <- getsState $ getActorBody aid discoBenefit <- getsClient sdiscoBenefit s <- getState let ben cstore bag = [ (mben, cstore, iid, itemFull) | (iid, kit) <- EM.assocs bag , let itemFull = itemToF iid kit mben = EM.lookup iid discoBenefit ] benCStore cs = ben cs $ getBodyStoreBag b cs s return $ concatMap benCStore cstores hinders :: Bool -> Bool -> Bool -> Bool -> Actor -> AspectRecord -> ItemFull -> Bool hinders condShineWouldBetray condAimEnemyPresent heavilyDistressed condNotCalmEnough -- guess that enemies have projectiles and used them now or recently body ar itemFull = let itemShine = 0 < aShine (aspectRecordFull itemFull) -- @condAnyFoeAdj@ is not checked, because it's transient and also item -- management is unlikely to happen during melee, anyway itemShineBad = condShineWouldBetray && itemShine in -- In the presence of enemies (seen, or unseen but distressing) -- actors want to hide in the dark. (condAimEnemyPresent || condNotCalmEnough || heavilyDistressed) && 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. || bspeed body ar > speedWalk && not (isMelee $ itemBase itemFull) -- in case it's the only weapon && 0 > aHurtMelee (aspectRecordFull itemFull) -- | Require that the actor stands over a desirable item. condDesirableFloorItemM :: MonadClient m => ActorId -> m Bool condDesirableFloorItemM aid = do benItemL <- benGroundItems aid return $ not $ null benItemL -- | Produce the list of items on the ground beneath the actor -- that are worth picking up. benGroundItems :: MonadClient m => ActorId -> m [(Maybe Benefit, CStore, ItemId, ItemFull)] benGroundItems aid = do b <- getsState $ getActorBody aid fact <- getsState $ (EM.! bfid b) . sfactionD let canEsc = fcanEscape (gplayer fact) isDesirable (mben, _, _, itemFull) = desirableItem canEsc (benPickup <$> mben) (itemBase itemFull) benList <- benAvailableItems aid [CGround] return $ filter isDesirable benList desirableItem :: Bool -> Maybe Int -> Item -> Bool desirableItem canEsc mpickupSum item = if canEsc then fromMaybe 10 mpickupSum > 0 || IK.Precious `elem` jfeature item else -- A hack to prevent monsters from picking up treasure meant for heroes. let preciousNotUseful = -- suspect and probably useless jewelry IK.Precious `elem` jfeature item -- risk from treasure hunters && IK.Equipable `notElem` jfeature item -- can't wear in fromMaybe 10 mpickupSum > 0 && not preciousNotUseful -- hack for elixir: even if @use@ positive condSupport :: MonadClient m => Int -> ActorId -> m Bool condSupport param aid = do actorAspect <- getsClient sactorAspect b <- getsState $ getActorBody aid btarget <- getsClient $ getTarget aid mtgtPos <- case btarget of Nothing -> return Nothing Just target -> aidTgtToPos aid (blid b) target condAimEnemyPresent <- condAimEnemyPresentM aid condAimEnemyRemembered <- condAimEnemyRememberedM aid fact <- getsState $ (EM.! bfid b) . sfactionD let friendlyFid fid = fid == bfid b || isAllied fact fid ar = actorAspect EM.! aid friends <- getsState $ actorRegularAssocs friendlyFid (blid b) let approaching = case mtgtPos of Just tgtPos | condAimEnemyPresent || condAimEnemyRemembered -> \b2 -> chessDist (bpos b2) tgtPos <= 1 + param _ -> const 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 closeAndStrongFriends = filter closeAndStrong friends -- The smaller area scanned for friends, the lower number required. suport = length closeAndStrongFriends >= param - aAggression ar || length friends <= 1 -- solo fighters aggresive return suport -- | Require that the actor stands in the dark and so would be betrayed -- by his own equipped light, condShineWouldBetrayM :: MonadClient m => ActorId -> m Bool condShineWouldBetrayM aid = do b <- getsState $ getActorBody 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 :: MonadClient m => ActorId -> m ([(Int, Point)], [(Int, Point)]) fleeList aid = do Kind.COps{coTileSpeedup} <- getsState 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 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 allFoes <- getsState $ warActorRegularList (bfid b) (blid b) lvl@Level{lxsize, lysize} <- getLevel $ blid b s <- getState let posFoes = map bpos allFoes myVic = vicinity lxsize lysize $ bpos b dist p | null posFoes = 100 | otherwise = minimum $ map (chessDist p) posFoes dVic = map (dist &&& id) myVic -- Flee, if possible. Direct access required; not enough time to open. -- Can't be occupied. 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 -- going towards enemy (but may escape adjacent foes) in (mult * skew * d, p) _ -> (mult * d, p) -- far from target path or even on target goal goodVic = map (rewardPath 10000) gtVic ++ map (rewardPath 100) eqVic badVic = map (rewardPath 1) ltVic return (goodVic, badVic)