-- | Semantics of abilities in terms of actions and the AI procedure -- for picking the best action for an actor. module Game.LambdaHack.Client.AI.ConditionClient ( condTgtEnemyPresentM , condTgtEnemyRememberedM , condTgtEnemyAdjFriendM , condTgtNonmovingM , condAnyFoeAdjM , condHpTooLowM , condOnTriggerableM , condBlocksFriendsM , condFloorWeaponM , condNoEqpWeaponM , condEnoughGearM , condCanProjectM , condNotCalmEnoughM , condDesirableFloorItemM , condMeleeBadM , condLightBetraysM , benAvailableItems , hinders , benGroundItems , desirableItem , threatDistList , fleeList ) where import Control.Applicative import Control.Arrow ((&&&)) import Control.Exception.Assert.Sugar import Control.Monad import qualified Data.EnumMap.Strict as EM import Data.List import Data.Maybe import Data.Ord import Game.LambdaHack.Client.AI.Preferences import Game.LambdaHack.Client.CommonClient 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 Game.LambdaHack.Common.ItemStrongest 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 -- | Require that the target enemy is visible by the party. condTgtEnemyPresentM :: MonadClient m => ActorId -> m Bool condTgtEnemyPresentM 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. condTgtEnemyRememberedM :: MonadClient m => ActorId -> m Bool condTgtEnemyRememberedM aid = do b <- getsState $ getActorBody aid btarget <- getsClient $ getTarget aid return $! case btarget of Just (TEnemyPos _ lid _ permit) | lid == blid b -> not permit _ -> False -- | Require that the target enemy is adjacent to at least one friend. condTgtEnemyAdjFriendM :: MonadClient m => ActorId -> m Bool condTgtEnemyAdjFriendM aid = do btarget <- getsClient $ getTarget aid case btarget of Just (TEnemy enemy _) -> do be <- getsState $ getActorBody enemy b <- getsState $ getActorBody aid fact <- getsState $ (EM.! bfid b) . sfactionD let friendlyFid fid = fid == bfid b || isAllied fact fid friends <- getsState $ actorRegularList friendlyFid (blid b) return $ any (adjacent (bpos be) . bpos) friends -- keep it lazy _ -> return 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 activeItems <- activeItemsClient enemy let actorMaxSkE = sumSkills activeItems return $! EM.findWithDefault 0 Ability.AbMove actorMaxSkE <= 0 _ -> return False -- | Require that any non-dying foe is adjacent. condAnyFoeAdjM :: MonadStateRead m => ActorId -> m Bool condAnyFoeAdjM aid = do b <- getsState $ getActorBody aid fact <- getsState $ (EM.! bfid b) . sfactionD allFoes <- getsState $ actorRegularList (isAtWar fact) (blid b) return $ any (adjacent (bpos b) . bpos) allFoes -- keep it lazy -- | Require the actor's HP is low enough. condHpTooLowM :: MonadClient m => ActorId -> m Bool condHpTooLowM aid = do b <- getsState $ getActorBody aid activeItems <- activeItemsClient aid return $! hpTooLow b activeItems -- | Require the actor stands over a triggerable tile. condOnTriggerableM :: MonadStateRead m => ActorId -> m Bool condOnTriggerableM aid = do Kind.COps{cotile} <- getsState scops b <- getsState $ getActorBody aid lvl <- getLevel $ blid b let t = lvl `at` bpos b return $! not $ null $ Tile.causeEffects cotile t -- | Produce the chess-distance-sorted list of non-low-HP foes on the level. -- We don't consider path-distance, because we are interested in how soon -- the foe can hit us, which can diverge greately from path distance -- for short distances. threatDistList :: MonadClient m => ActorId -> m [(Int, (ActorId, Actor))] threatDistList aid = do b <- getsState $ getActorBody aid fact <- getsState $ (EM.! bfid b) . sfactionD allAtWar <- getsState $ actorRegularAssocs (isAtWar fact) (blid b) let strongActor (aid2, b2) = do activeItems <- activeItemsClient aid2 let actorMaxSkE = sumSkills activeItems nonmoving = EM.findWithDefault 0 Ability.AbMove actorMaxSkE <= 0 return $! not $ (hpTooLow b2 activeItems || nonmoving) allThreats <- filterM strongActor allAtWar let 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 $ actorRegularAssocs (== bfid b) (blid b) targetD <- getsClient stargetD let blocked (aid2, _) = aid2 /= aid && case EM.lookup aid2 targetD of Just (_, Just (_ : q : _, _)) | q == bpos b -> True _ -> False return $ any blocked ours -- keep it lazy -- | Require the actor stands over a weapon that would be auto-equipped. condFloorWeaponM :: MonadClient m => ActorId -> m Bool condFloorWeaponM aid = do floorAssocs <- fullAssocsClient aid [CGround] let lootIsWeapon = any (isMeleeEqp . snd) floorAssocs return lootIsWeapon -- keep it lazy -- | Check whether the actor has no weapon in equipment. condNoEqpWeaponM :: MonadClient m => ActorId -> m Bool condNoEqpWeaponM aid = do allAssocs <- fullAssocsClient aid [CEqp] return $ all (not . isMelee . snd) allAssocs -- keep it lazy -- | Check whether the actor has enough gear to go look for enemies. condEnoughGearM :: MonadClient m => ActorId -> m Bool condEnoughGearM aid = do eqpAssocs <- fullAssocsClient aid [CEqp] invAssocs <- fullAssocsClient aid [CInv] return $ any (isMelee . snd) eqpAssocs || length (eqpAssocs ++ invAssocs) >= 5 -- keep it lazy -- | Require that the actor can project any items. condCanProjectM :: MonadClient m => Bool -> ActorId -> m Bool condCanProjectM maxSkills aid = do actorSk <- if maxSkills then do activeItems <- activeItemsClient aid return $! sumSkills activeItems else actorSkillsClient aid let skill = EM.findWithDefault 0 Ability.AbProject actorSk q _ itemFull b activeItems = either (const False) id $ permittedProject " " False skill itemFull b activeItems benList <- benAvailableItems aid q [CEqp, CInv, CGround] let missiles = filter (maybe True ((< 0) . snd) . fst . fst) benList return $ not (null missiles) -- keep it lazy -- | Produce the list of items with a given property available to the actor -- and the items' values. benAvailableItems :: MonadClient m => ActorId -> (Maybe Int -> ItemFull -> Actor -> [ItemFull] -> Bool) -> [CStore] -> m [( (Maybe (Int, Int), (Int, CStore)) , (ItemId, ItemFull) )] benAvailableItems aid permitted cstores = do cops <- getsState scops itemToF <- itemToFullClient b <- getsState $ getActorBody aid activeItems <- activeItemsClient aid fact <- getsState $ (EM.! bfid b) . sfactionD condAnyFoeAdj <- condAnyFoeAdjM aid condLightBetrays <- condLightBetraysM aid condTgtEnemyPresent <- condTgtEnemyPresentM aid condNotCalmEnough <- condNotCalmEnoughM aid let ben cstore bag = [ ((benefit, (k, cstore)), (iid, itemFull)) | (iid, kit@(k, _)) <- EM.assocs bag , let itemFull = itemToF iid kit benefit = totalUsefulness cops b activeItems fact itemFull hind = hinders condAnyFoeAdj condLightBetrays condTgtEnemyPresent condNotCalmEnough b activeItems itemFull , permitted (fst <$> benefit) itemFull b activeItems && (cstore /= CEqp || hind) ] benCStore cs = do bag <- getsState $ getActorBag aid cs return $! ben cs bag perBag <- mapM benCStore cstores return $ concat perBag -- keep it lazy -- TODO: also take into account dynamic lights *not* wielded by the actor hinders :: Bool -> Bool -> Bool -> Bool -> Actor -> [ItemFull] -> ItemFull -> Bool hinders condAnyFoeAdj condLightBetrays condTgtEnemyPresent condNotCalmEnough -- perhaps enemies don't have projectiles body activeItems itemFull = let itemLit = isJust $ strengthFromEqpSlot IK.EqpSlotAddLight itemFull in -- Fast actors want to hide in darkness to ambush opponents and want -- to hit hard for the short span they get to survive melee. bspeed body activeItems > speedNormal && (condNotCalmEnough && itemLit || 0 > fromMaybe 0 (strengthFromEqpSlot IK.EqpSlotAddHurtMelee itemFull) || 0 > fromMaybe 0 (strengthFromEqpSlot IK.EqpSlotAddHurtRanged itemFull)) -- In the presence of enemies (seen, or unseen but distressing) -- actors want to hide in the dark. || let heavilyDistressed = -- actor hit by a proj or similarly distressed deltaSerious (bcalmDelta body) in condNotCalmEnough && (heavilyDistressed || condTgtEnemyPresent) && condLightBetrays && not condAnyFoeAdj && itemLit -- TODO: -- teach AI to turn shields OFF (or stash) when ganging up on an enemy -- (friends close, only one enemy close) -- and turning on afterwards (AI plays for time, especially spawners -- so shields are preferable by default; -- also, turning on when no friends and enemies close is too late, -- AI should flee or fire at such times, not muck around with eqp) -- | Require the actor is not calm enough. condNotCalmEnoughM :: MonadClient m => ActorId -> m Bool condNotCalmEnoughM aid = do b <- getsState $ getActorBody aid activeItems <- activeItemsClient aid return $! not (calmEnough b activeItems) -- | 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 -- keep it lazy -- | Produce the list of items on the ground beneath the actor -- that are worth picking up. benGroundItems :: MonadClient m => ActorId -> m [( (Maybe (Int, Int) , (Int, CStore)), (ItemId, ItemFull) )] benGroundItems aid = do b <- getsState $ getActorBody aid canEscape <- factionCanEscape (bfid b) benAvailableItems aid (\use itemFull _ _ -> desirableItem canEscape use itemFull) [CGround] desirableItem :: Bool -> Maybe Int -> ItemFull -> Bool desirableItem canEsc use itemFull = let item = itemBase itemFull freq = case itemDisco itemFull of Nothing -> [] Just ItemDisco{itemKind} -> IK.ifreq itemKind in if canEsc then use /= Just 0 || IK.Precious `elem` jfeature item else -- A hack to prevent monsters from picking up unidentified treasure. let preciousWithoutSlot = IK.Precious `elem` jfeature item -- risk from treasure hunters && isNothing (strengthEqpSlot item) -- unlikely to be useful in use /= Just 0 && not (isNothing use -- needs resources to id && preciousWithoutSlot) -- TODO: terrible hack for the identified healing gems and normal -- gems identified with a scroll && maybe True (<= 0) (lookup "gem" freq) -- | Require the actor is in a bad position to melee or can't melee at all. condMeleeBadM :: MonadClient m => ActorId -> m Bool condMeleeBadM aid = do b <- getsState $ getActorBody aid btarget <- getsClient $ getTarget aid mtgtPos <- aidTgtToPos aid (blid b) btarget condTgtEnemyPresent <- condTgtEnemyPresentM aid condTgtEnemyRemembered <- condTgtEnemyRememberedM aid fact <- getsState $ (EM.! bfid b) . sfactionD activeItems <- activeItemsClient aid let condNoUsableWeapon = all (not . isMelee) activeItems friendlyFid fid = fid == bfid b || isAllied fact fid friends <- getsState $ actorRegularAssocs friendlyFid (blid b) friendlyFacts <- getsState $ map snd . filter (friendlyFid . fst) . EM.assocs . sfactionD Level{lactorFreq} <- getLevel $ blid b let freqNames = map fst lactorFreq factNames = map (fgroup . gplayer) friendlyFacts spawnerOnLvl = any (`elem` freqNames) factNames closeEnough b2 = let dist = chessDist (bpos b) (bpos b2) in dist > 0 && (dist <= 2 || approaching b2) -- 3 is the condThreatAtHand distance that AI keeps when alone. approaching = case mtgtPos of Just tgtPos | condTgtEnemyPresent || condTgtEnemyRemembered -> \b1 -> chessDist (bpos b1) tgtPos <= 3 _ -> const False closeFriends = filter (closeEnough . snd) friends strongActor (aid2, b2) = do activeItems2 <- activeItemsClient aid2 let condUsableWeapon2 = any isMelee activeItems2 actorMaxSk2 = sumSkills activeItems2 canMelee2 = EM.findWithDefault 0 Ability.AbMelee actorMaxSk2 > 0 hpGood = not $ hpTooLow b2 activeItems2 return $! hpGood && condUsableWeapon2 && canMelee2 strongCloseFriends <- filterM strongActor closeFriends let noFriendlyHelp = length closeFriends < 3 && null strongCloseFriends && (length friends > 1 -- solo fighters aggresive || spawnerOnLvl) && not (hpHuge b) -- uniques, etc., aggresive let actorMaxSk = sumSkills activeItems return $ condNoUsableWeapon || EM.findWithDefault 0 Ability.AbMelee actorMaxSk <= 0 || noFriendlyHelp -- still not getting friends' help -- no $!; keep it lazy -- | Require that the actor stands in the dark, but is betrayed -- by his own equipped light, condLightBetraysM :: MonadClient m => ActorId -> m Bool condLightBetraysM aid = do b <- getsState $ getActorBody aid eqpItems <- map snd <$> fullAssocsClient aid [CEqp] let actorEqpShines = sumSlotNoFilter IK.EqpSlotAddLight eqpItems > 0 aInAmbient <- getsState $ actorInAmbient b return $! not aInAmbient -- tile is dark, so actor could hide && actorEqpShines -- but actor betrayed by his equipped light -- | Produce a list of acceptable adjacent points to flee to. fleeList :: MonadClient m => ActorId -> m ([(Int, Point)], [(Int, Point)]) fleeList aid = do cops <- getsState scops mtgtMPath <- getsClient $ EM.lookup aid . stargetD let tgtPath = case mtgtMPath of -- prefer fleeing along the path to target Just (TEnemy{}, _) -> [] -- don't flee towards an enemy Just (TEnemyPos{}, _) -> [] Just (_, Just (_ : path, _)) -> path _ -> [] b <- getsState $ getActorBody aid fact <- getsState $ \s -> sfactionD s EM.! bfid b allFoes <- getsState $ actorRegularList (isAtWar fact) (blid b) lvl@Level{lxsize, lysize} <- getLevel $ blid b let posFoes = map bpos allFoes accessibleHere = accessible cops lvl $ bpos b myVic = vicinity lxsize lysize $ bpos b dist p | null posFoes = assert `failure` b | otherwise = minimum $ map (chessDist p) posFoes dVic = map (dist &&& id) myVic -- Flee, if possible. Access required. accVic = filter (accessibleHere . 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) | p `elem` tgtPath = (100 * mult * d, p) | any (\q -> chessDist p q == 1) tgtPath = (10 * mult * d, p) | otherwise = (mult * d, p) goodVic = map (rewardPath 10000) gtVic ++ map (rewardPath 100) eqVic badVic = map (rewardPath 1) ltVic return (goodVic, badVic) -- keep it lazy