{-# LANGUAGE DataKinds #-} -- | Semantics of abilities in terms of actions and the AI procedure -- for picking the best action for an actor. module Game.LambdaHack.Client.AI.HandleAbilityClient ( actionStrategy ) where import Control.Applicative import Control.Arrow (second) import Control.Exception.Assert.Sugar import Control.Monad import qualified Data.EnumMap.Strict as EM import qualified Data.EnumSet as ES import Data.Function import Data.List import qualified Data.Map.Strict as M import Data.Maybe import Data.Ord import Data.Ratio import Data.Text (Text) import Game.LambdaHack.Client.AI.ConditionClient import Game.LambdaHack.Client.AI.Preferences import Game.LambdaHack.Client.AI.Strategy import Game.LambdaHack.Client.BfsClient import Game.LambdaHack.Client.CommonClient import Game.LambdaHack.Client.MonadClient import Game.LambdaHack.Client.State import Game.LambdaHack.Common.Ability import Game.LambdaHack.Common.Actor import Game.LambdaHack.Common.ActorState import qualified Game.LambdaHack.Common.Effect as Effect import Game.LambdaHack.Common.Faction import qualified Game.LambdaHack.Common.Feature as F import Game.LambdaHack.Common.Frequency 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.Perception 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 Game.LambdaHack.Content.ModeKind import Game.LambdaHack.Content.RuleKind import Game.LambdaHack.Content.TileKind as TileKind type ToAny a = Strategy (RequestTimed a) -> Strategy RequestAnyAbility toAny :: ToAny a toAny strat = RequestAnyAbility <$> strat -- | AI strategy based on actor's sight, smell, etc. -- Never empty. actionStrategy :: forall m. MonadClient m => ActorId -> m (Strategy RequestAnyAbility) actionStrategy aid = do Kind.COps{corule} <- getsState scops let stdRuleset = Kind.stdRuleset corule nearby = rnearby stdRuleset body <- getsState $ getActorBody aid activeItems <- activeItemsClient aid fact <- getsState $ (EM.! bfid body) . sfactionD condTgtEnemyPresent <- condTgtEnemyPresentM aid condTgtEnemyRemembered <- condTgtEnemyRememberedM aid condAnyFoeAdj <- condAnyFoeAdjM aid threatDistL <- threatDistList aid condHpTooLow <- condHpTooLowM aid condOnTriggerable <- condOnTriggerableM aid condBlocksFriends <- condBlocksFriendsM aid condNoEqpWeapon <- condNoEqpWeaponM aid condNoUsableWeapon <- null <$> pickWeaponClient aid aid condFloorWeapon <- condFloorWeaponM aid condCanProject <- condCanProjectM aid condNotCalmEnough <- condNotCalmEnoughM aid condDesirableFloorItem <- condDesirableFloorItemM aid condMeleeBad <- condMeleeBadM aid fleeL <- fleeList False aid panicFleeL <- fleeList True aid let condThreatAdj = not $ null $ takeWhile ((== 1) . fst) threatDistL condThreatAtHand = not $ null $ takeWhile ((<= 2) . fst) threatDistL condThreatNearby = not $ null $ takeWhile ((<= nearby) . fst) threatDistL speed1_5 = speedScale (3%2) (bspeed body activeItems) condFastThreatAdj = any (\(_, (_, b)) -> bspeed b activeItems > speed1_5) $ takeWhile ((== 1) . fst) threatDistL condCanFlee = not (null fleeL || condFastThreatAdj) mleader <- getsClient _sleader actorSk <- actorSkillsClient aid mleader let stratToFreq :: MonadStateRead m => Int -> m (Strategy RequestAnyAbility) -> m (Frequency RequestAnyAbility) stratToFreq scale mstrat = do st <- mstrat return $! scaleFreq scale $ bestVariant st -- TODO: flatten instead? prefix, suffix :: [([Ability], m (Strategy RequestAnyAbility), Bool)] prefix = [ ( [AbApply], (toAny :: ToAny AbApply) <$> applyItem aid ApplyFirstAid , condHpTooLow && not condAnyFoeAdj && not condOnTriggerable ) -- don't block stairs, perhaps ascend , ( [AbTrigger], (toAny :: ToAny AbTrigger) <$> trigger aid True -- flee via stairs, even if to wrong level -- may return via different stairs , condOnTriggerable && ((condNotCalmEnough || condHpTooLow) && condThreatNearby && not condTgtEnemyPresent || condMeleeBad && condThreatAdj) ) , ( [AbMove] , flee aid fleeL , condMeleeBad && condThreatAdj && condCanFlee ) , ( [AbDisplace] , displaceFoe aid -- only swap with an enemy to expose him , condBlocksFriends && condAnyFoeAdj && not condOnTriggerable && not condDesirableFloorItem ) , ( [AbMoveItem], (toAny :: ToAny AbMoveItem) <$> pickup aid True , condNoEqpWeapon && condFloorWeapon && not condHpTooLow ) , ( [AbMelee], (toAny :: ToAny AbMelee) <$> meleeBlocker aid -- only melee target or blocker , condAnyFoeAdj || EM.findWithDefault 0 AbDisplace actorSk <= 0 -- melee friends, not displace && fleaderMode (gplayer fact) == LeaderNull -- not restrained && (condTgtEnemyPresent || condTgtEnemyRemembered) ) -- excited , ( [AbTrigger], (toAny :: ToAny AbTrigger) <$> trigger aid False , condOnTriggerable && not condDesirableFloorItem ) , ( [AbDisplace] -- prevents some looping movement , displaceBlocker aid -- fires up only when path blocked , not condDesirableFloorItem ) , ( [AbMoveItem], (toAny :: ToAny AbMoveItem) <$> equipItems aid -- doesn't take long, very useful if safe -- only if calm enough, so high priority , not condAnyFoeAdj && not condDesirableFloorItem ) ] distant :: [([Ability], m (Frequency RequestAnyAbility), Bool)] distant = [ ( [AbProject] -- for high-value target, shoot even in melee , stratToFreq 2 $ (toAny :: ToAny AbProject) <$> ranged aid , condTgtEnemyPresent && condCanProject && not condOnTriggerable ) , ( [AbApply] , stratToFreq 2 $ (toAny :: ToAny AbApply) <$> applyItem aid ApplyAll -- use any option or scroll , (condTgtEnemyPresent || condThreatNearby) -- can affect enemies && not condOnTriggerable ) , ( [AbMove] , stratToFreq (if not condTgtEnemyPresent || condMeleeBad then 1 else 100) $ chase aid True , (condTgtEnemyPresent || condTgtEnemyRemembered) && not condDesirableFloorItem && not condNoUsableWeapon ) ] suffix = [ ( [AbMoveItem], (toAny :: ToAny AbMoveItem) <$> pickup aid False , True ) -- unconditionally, e.g., to give to other party members , ( [AbMove] , flee aid fleeL , condMeleeBad && (condNotCalmEnough && condThreatNearby || condThreatAtHand) && condCanFlee ) , ( [AbMelee], (toAny :: ToAny AbMelee) <$> meleeAny aid -- avoid getting damaged for naught , condAnyFoeAdj ) , ( [AbMoveItem], (toAny :: ToAny AbMoveItem) <$> unEquipItems aid -- late, because better to throw than unequip , True ) , ( [AbMove] -- TODO: forget old target (e.g., tile), to start shooting, -- unless can't shoot, etc. , flee aid panicFleeL -- panic mode; chasing would be pointless , condMeleeBad && condThreatNearby && (condNotCalmEnough || condThreatAtHand || condNoUsableWeapon) ) , ( [AbMove] , chase aid False , True ) , ( [AbWait], (toAny :: ToAny AbWait) <$> waitBlockNow -- Wait until friends sidestep; ensures strategy is never empty. -- TODO: try to switch leader away before that (we already -- switch him afterwards) , True ) ] -- TODO: don't msum not to evaluate until needed abInSkill ab = EM.findWithDefault 0 ab actorSk > 0 checkAction :: ([Ability], m a, Bool) -> Bool checkAction (abts, _, cond) = cond && all abInSkill abts sumS abAction = do let as = filter checkAction abAction strats <- sequence $ map (\(_, m, _) -> m) as return $! msum strats sumF abFreq = do let as = filter checkAction abFreq strats <- sequence $ map (\(_, m, _) -> m) as return $! msum strats combineDistant as = fmap liftFrequency $ sumF as sumPrefix <- sumS prefix comDistant <- combineDistant distant sumSuffix <- sumS suffix return $! sumPrefix .| comDistant .| sumSuffix -- | A strategy to always just wait. waitBlockNow :: MonadClient m => m (Strategy (RequestTimed AbWait)) waitBlockNow = return $! returN "wait" ReqWait pickup :: MonadClient m => ActorId -> Bool -> m (Strategy (RequestTimed AbMoveItem)) pickup aid onlyWeapon = do benItemL <- benGroundItems aid let isWeapon (_, (_, itemFull)) = maybe False ((== Effect.EqpSlotWeapon) . fst) $ strengthEqpSlot $ itemBase itemFull filterWeapon | onlyWeapon = filter isWeapon | otherwise = id cmp ((Nothing, _), _) = 5 -- experimenting is fun cmp ((Just (n, _), _), _) = abs n -- Pick up the best desirable item, if any. case reverse $ sortBy (comparing cmp) $ filterWeapon benItemL of ((_, (k, _)), (iid, itemFull)) : _ -> do updateItemSlot (Just aid) iid b <- getsState $ getActorBody aid -- TODO: instead of pickup to eqp and then move to inv, pickup to inv let toCStore = if goesIntoInv (itemBase itemFull) || eqpOverfull b k then CInv else CEqp return $! returN "pickup" $ ReqMoveItem iid k CGround toCStore [] -> return reject equipItems :: MonadClient m => ActorId -> m (Strategy (RequestTimed AbMoveItem)) equipItems aid = do cops@Kind.COps{corule} <- getsState scops let RuleKind{rsharedStash} = Kind.stdRuleset corule body <- getsState $ getActorBody aid activeItems <- activeItemsClient aid fact <- getsState $ (EM.! bfid body) . sfactionD eqpAssocs <- fullAssocsClient aid [CEqp] invAssocs <- fullAssocsClient aid [CInv] shaAssocs <- fullAssocsClient aid [CSha] condLightBetrays <- condLightBetraysM aid let improve :: CStore -> ([(Int, (ItemId, ItemFull))], [(Int, (ItemId, ItemFull))]) -> Strategy (RequestTimed AbMoveItem) improve fromCStore (bestInv, bestEqp) = case (bestInv, bestEqp) of ((_, (iidInv, _)) : _, []) | not (eqpOverfull body 1) -> returN "wield any" $ ReqMoveItem iidInv 1 fromCStore CEqp ((vInv, (iidInv, _)) : _, (vEqp, _) : _) | not (eqpOverfull body 1) && vInv > vEqp -> returN "wield better" $ ReqMoveItem iidInv 1 fromCStore CEqp _ -> reject -- We filter out unneeded items. In particular, we ignore them in eqp -- when comparing to items we may want to equip. Anyway, the unneeded -- items should be removed in yieldUnneeded earlier or soon after. filterNeeded (_, itemFull) = not $ unneeded cops condLightBetrays body activeItems fact itemFull bestThree = bestByEqpSlot (filter filterNeeded invAssocs) (filter filterNeeded eqpAssocs) (filter filterNeeded shaAssocs) bEqpInv = msum $ map (improve CInv) $ map (\(_, (eqp, inv, _)) -> (inv, eqp)) bestThree if nullStrategy bEqpInv then if rsharedStash && calmEnough body activeItems then return $! msum $ map (improve CSha) $ map (\(_, (eqp, _, sha)) -> (sha, eqp)) bestThree else return reject else return bEqpInv unEquipItems :: MonadClient m => ActorId -> m (Strategy (RequestTimed AbMoveItem)) unEquipItems aid = do cops@Kind.COps{corule} <- getsState scops let RuleKind{rsharedStash} = Kind.stdRuleset corule body <- getsState $ getActorBody aid activeItems <- activeItemsClient aid fact <- getsState $ (EM.! bfid body) . sfactionD eqpAssocs <- fullAssocsClient aid [CEqp] invAssocs <- fullAssocsClient aid [CInv] shaAssocs <- fullAssocsClient aid [CSha] condLightBetrays <- condLightBetraysM aid let yieldSingleUnneeded (iidEqp, itemEqp) = let csha = if rsharedStash && calmEnough body activeItems then CSha else CInv in if harmful cops body activeItems fact itemEqp then Just $ ReqMoveItem iidEqp (itemK itemEqp) CEqp CInv -- throw else if hinders condLightBetrays body activeItems itemEqp then Just $ ReqMoveItem iidEqp (itemK itemEqp) CEqp csha -- share else Nothing yieldUnneeded = mapMaybe yieldSingleUnneeded eqpAssocs improve :: CStore -> ( Effect.EqpSlot , ( [(Int, (ItemId, ItemFull))] , [(Int, (ItemId, ItemFull))] ) ) -> Strategy (RequestTimed AbMoveItem) improve fromCStore (slot, (bestInv, bestEqp)) = case (bestInv, bestEqp) of _ | slot == Effect.EqpSlotPeriodic && fromCStore == CEqp && not (eqpOverfull body 0) -> -- Don't get rid of periodic items from eqp unless eqp full. reject (_, (vEqp, (iidEqp, _)) : _) | getK bestEqp > 1 && betterThanInv vEqp bestInv -> -- To share the best items with others, if they care. returN "yield rest" $ ReqMoveItem iidEqp (getK bestEqp - 1) fromCStore CSha (_, _ : (vEqp, (iidEqp, _)) : _) | betterThanInv vEqp bestInv -> -- To share the second best items with others, if they care. returN "yield worse" $ ReqMoveItem iidEqp (getK bestEqp) fromCStore CSha _ -> reject getK [] = 0 getK ((_, (_, itemFull)) : _) = itemK itemFull betterThanInv _ [] = True betterThanInv vEqp ((vInv, _) : _) = vEqp > vInv bestThree = bestByEqpSlot invAssocs eqpAssocs shaAssocs case yieldUnneeded of [] -> if rsharedStash && calmEnough body activeItems then do let bInvSha = msum $ map (improve CInv) $ map (\((slot, _), (_, inv, sha)) -> (slot, (sha, inv))) bestThree if nullStrategy bInvSha then return $! msum $ map (improve CEqp) $ map (\((slot, _), (eqp, _, sha)) -> (slot, (sha, eqp))) bestThree else return $! bInvSha else return reject _ -> -- Here AI hides from the human player the Ring of Speed And Bleeding, -- which is a bit harsh, but fair. However any subsequent such -- rings will not be picked up at all, so the human player -- doesn't lose much fun. Additionally, if AI learns alchemy later on, -- they can repair the ring, wield it, drop at death and it's -- in play again. return $! liftFrequency $ uniformFreq "yield unneeded" yieldUnneeded groupByEqpSlot :: [(ItemId, ItemFull)] -> M.Map (Effect.EqpSlot, Text) [(ItemId, ItemFull)] groupByEqpSlot is = let f (iid, itemFull) = case strengthEqpSlot $ itemBase itemFull of Nothing -> Nothing Just es -> Just (es, [(iid, itemFull)]) withES = mapMaybe f is in M.fromListWith (++) withES bestByEqpSlot :: [(ItemId, ItemFull)] -> [(ItemId, ItemFull)] -> [(ItemId, ItemFull)] -> [((Effect.EqpSlot, Text) , ( [(Int, (ItemId, ItemFull))] , [(Int, (ItemId, ItemFull))] , [(Int, (ItemId, ItemFull))] ) )] bestByEqpSlot invAssocs eqpAssocs shaAssocs = let eqpMap = M.map (\g -> (g, [], [])) $ groupByEqpSlot eqpAssocs invMap = M.map (\g -> ([], g, [])) $ groupByEqpSlot invAssocs shaMap = M.map (\g -> ([], [], g)) $ groupByEqpSlot shaAssocs appendThree (g1, g2, g3) (h1, h2, h3) = (g1 ++ h1, g2 ++ h2, g3 ++ h3) invEqpShaMap = M.unionsWith appendThree [invMap, eqpMap, shaMap] bestSingle eqpSlot g = strongestSlot eqpSlot g bestThree (eqpSlot, _) (g1, g2, g3) = (bestSingle eqpSlot g1, bestSingle eqpSlot g2, bestSingle eqpSlot g3) in M.assocs $ M.mapWithKey bestThree invEqpShaMap hinders :: Bool -> Actor -> [ItemFull] -> ItemFull -> Bool hinders condLightBetrays body activeItems itemFull = -- 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 && (isJust (strengthFromEqpSlot Effect.EqpSlotAddLight itemFull) || 0 > fromMaybe 0 (strengthFromEqpSlot Effect.EqpSlotAddHurtMelee itemFull) || 0 > fromMaybe 0 (strengthFromEqpSlot Effect.EqpSlotAddHurtRanged itemFull))) -- Distressed actors want to hide in the dark. || (let heavilyDistressed = -- actor hit by a proj or similarly distressed deltaSerious (bcalmDelta body) in condLightBetrays && heavilyDistressed && isJust (strengthFromEqpSlot Effect.EqpSlotAddLight itemFull)) -- 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) harmful :: Kind.COps -> Actor -> [ItemFull] -> Faction -> ItemFull -> Bool harmful cops body activeItems fact itemFull = -- items that are known and their effects are not stricly beneficial -- should not be equipped (either they are harmful or they waste eqp space). maybe False (\(u, _) -> u <= 0) (totalUsefulness cops body activeItems fact itemFull) && (maybe True ((/= Effect.EqpSlotWeapon) . fst) $ strengthEqpSlot $ itemBase itemFull) unneeded :: Kind.COps -> Bool -> Actor -> [ItemFull] -> Faction -> ItemFull -> Bool unneeded cops condLightBetrays body activeItems fact itemFull = harmful cops body activeItems fact itemFull || hinders condLightBetrays body activeItems itemFull -- Everybody melees in a pinch, even though some prefer ranged attacks. meleeBlocker :: MonadClient m => ActorId -> m (Strategy (RequestTimed AbMelee)) meleeBlocker aid = do b <- getsState $ getActorBody aid fact <- getsState $ (EM.! bfid b) . sfactionD mleader <- getsClient _sleader actorSk <- actorSkillsClient aid mleader mtgtMPath <- getsClient $ EM.lookup aid . stargetD case mtgtMPath of Just (_, Just (_ : q : _, (goal, _))) -> do -- We prefer the goal (e.g., when no accessible, but adjacent), -- but accept @q@ even if it's only a blocking enemy position. let maim = if adjacent (bpos b) goal then Just goal else if adjacent (bpos b) q then Just q else Nothing -- MeleeDistant mBlocker <- case maim of Nothing -> return Nothing Just aim -> getsState $ posToActor aim (blid b) case mBlocker of Just ((aid2, _), _) -> do -- No problem if there are many projectiles at the spot. We just -- attack the first one. body2 <- getsState $ getActorBody aid2 if not (actorDying body2) -- already dying && (not (bproj body2) -- displacing saves a move && isAtWar fact (bfid body2) -- they at war with us || EM.findWithDefault 0 AbDisplace actorSk <= 0 -- not disp. && fleaderMode (gplayer fact) == LeaderNull -- no restrain && EM.findWithDefault 0 AbMove actorSk > 0 -- blocked move && bhp body2 < bhp b) -- respect power then do mel <- pickWeaponClient aid aid2 return $! liftFrequency $ uniformFreq "melee in the way" mel else return reject Nothing -> return reject _ -> return reject -- probably no path to the enemy, if any -- Everybody melees in a pinch, skills and weapons allowing, -- even though some prefer ranged attacks. meleeAny :: MonadClient m => ActorId -> m (Strategy (RequestTimed AbMelee)) meleeAny aid = do b <- getsState $ getActorBody aid fact <- getsState $ (EM.! bfid b) . sfactionD allFoes <- getsState $ actorRegularAssocs (isAtWar fact) (blid b) let adjFoes = filter (adjacent (bpos b) . bpos . snd) allFoes mels <- mapM (pickWeaponClient aid . fst) adjFoes -- TODO: prioritize somehow let freq = uniformFreq "melee adjacent" $ concat mels return $! liftFrequency freq -- Fast monsters don't pay enough attention to features. trigger :: MonadClient m => ActorId -> Bool -> m (Strategy (RequestTimed AbTrigger)) trigger aid fleeViaStairs = do cops@Kind.COps{cotile=Kind.Ops{okind}} <- getsState scops dungeon <- getsState sdungeon explored <- getsClient sexplored b <- getsState $ getActorBody aid activeItems <- activeItemsClient aid fact <- getsState $ (EM.! bfid b) . sfactionD lvl <- getLevel $ blid b unexploredD <- unexploredDepth s <- getState per <- getPerFid $ blid b let canSee = ES.member (bpos b) (totalVisible per) unexploredCurrent = ES.notMember (blid b) explored allExplored = ES.size explored == EM.size dungeon t = lvl `at` bpos b feats = TileKind.tfeature $ okind t ben feat = case feat of F.Cause (Effect.Ascend k) -> -- change levels sensibly, in teams let aimless = ftactic (gplayer fact) `elem` [TRoam, TPatrol] expBenefit = if aimless then 100 -- faction is not exploring, so switch at will else if unexploredCurrent then 0 -- don't leave the level until explored else if unexploredD (signum k) (blid b) then 1000 else if unexploredD (- signum k) (blid b) then 0 -- wait for stairs in the opposite direciton else if lescape lvl then 0 -- all explored, stay on the escape level else 2 -- no escape anywhere, switch levels occasionally (lid2, pos2) = whereTo (blid b) (bpos b) k dungeon actorsThere = posToActors pos2 lid2 s in if boldpos b == bpos b -- probably used stairs last turn && boldlid b == lid2 -- in the opposite direction then 0 -- avoid trivial loops (pushing, being pushed, etc.) else let leaderless = fleaderMode (gplayer fact) == LeaderNull eben = case actorsThere of [] | canSee -> expBenefit _ | leaderless -> 0 -- leaderless clog stairs easily _ -> min 1 expBenefit -- risk pushing in if fleeViaStairs then 1000 * eben + 1 -- strongly prefer correct direction else eben F.Cause ef@Effect.Escape{} -> do -- flee via this way, too -- Only some factions try to escape but they first explore all -- for high score. if not (fcanEscape $ gplayer fact) || not allExplored then 0 else effectToBenefit cops b activeItems fact ef F.Cause ef | not fleeViaStairs -> effectToBenefit cops b activeItems fact ef _ -> 0 benFeat = zip (map ben feats) feats return $! liftFrequency $ toFreq "trigger" $ [ (benefit, ReqTrigger (Just feat)) | (benefit, feat) <- benFeat , benefit > 0 ] ranged :: MonadClient m => ActorId -> m (Strategy (RequestTimed AbProject)) ranged aid = do btarget <- getsClient $ getTarget aid b@Actor{bpos, blid} <- getsState $ getActorBody aid mfpos <- aidTgtToPos aid blid btarget seps <- getsClient seps case (btarget, mfpos) of (Just TEnemy{}, Just fpos) -> do actorBlind <- radiusBlind <$> sumOrganEqpClient Effect.EqpSlotAddSight aid mnewEps <- makeLine b fpos seps case mnewEps of Just newEps | not actorBlind -> do -- ProjectBlind -- ProjectAimOnself, ProjectBlockActor, ProjectBlockTerrain -- and no actors or obstracles along the path. benList <- benAvailableItems aid permittedRanged [CEqp, CInv, CGround] let coeff CGround = 2 coeff COrgan = 3 -- can't give to others coeff CEqp = 1 coeff CInv = 1 coeff CSha = undefined -- banned fRanged ((mben, (_, cstore)), (iid, ItemFull{itemBase})) = let trange = totalRange itemBase bestRange = chessDist bpos fpos + 2 -- margin for fleeing rangeMult = -- penalize wasted or unsafely low range 10 + max 0 (10 - abs (trange - bestRange)) durableBonus = if Effect.Durable `elem` jfeature itemBase then 2 -- we or foes keep it after the throw else 1 benR = durableBonus * coeff cstore * case mben of Nothing -> -20 -- experimenting is fun Just (_, (_, ben)) -> ben in if benR < 0 && trange >= chessDist bpos fpos then Just ( -benR * rangeMult `div` 10 , ReqProject fpos newEps iid cstore ) else Nothing benRanged = mapMaybe fRanged benList return $! liftFrequency $ toFreq "ranged" benRanged _ -> return reject _ -> return reject data ApplyItemGroup = ApplyAll | ApplyFirstAid deriving Eq applyItem :: MonadClient m => ActorId -> ApplyItemGroup -> m (Strategy (RequestTimed AbApply)) applyItem aid applyGroup = do actorBlind <- radiusBlind <$> sumOrganEqpClient Effect.EqpSlotAddSight aid let permitted itemFull@ItemFull{itemBase=item} _ = not (unknownPrecious itemFull) && if jsymbol item == '?' && actorBlind then False else Effect.Applicable `elem` jfeature item benList <- benAvailableItems aid permitted [CEqp, CInv, CGround] let itemLegal itemFull = case applyGroup of ApplyFirstAid -> let getP (Effect.RefillHP p) _ | p > 0 = True getP _ acc = acc in case itemDisco itemFull of Just ItemDisco{itemAE=Just ItemAspectEffect{jeffects}} -> foldr getP False jeffects _ -> False ApplyAll -> True coeff CGround = 2 coeff COrgan = 3 -- can't give to others coeff CEqp = 1 coeff CInv = 1 coeff CSha = undefined -- banned fTool ((mben, (_, cstore)), (iid, itemFull)) = let durableBonus = if Effect.Durable `elem` jfeature (itemBase itemFull) then 5 -- we keep it after use else 1 benR = durableBonus * coeff cstore * case mben of Nothing -> 0 -- experimenting is fun, but it's better to risk -- foes' skin than ours -- TODO: when {activated} -- is implemented, enable this for items too heavy, -- etc. for throwing Just (_, (_, ben)) -> ben in if itemLegal itemFull then if benR > 0 then Just (benR, ReqApply iid cstore) else Nothing else Nothing benTool = mapMaybe fTool benList return $! liftFrequency $ toFreq "applyItem" benTool -- If low on health or alone, flee in panic, close to the path to target -- and as far from the attackers, as possible. Usually fleeing from -- foes will lead towards friends, but we don't insist on that. -- We use chess distances, not pathfinding, because melee can happen -- at path distance 2. flee :: MonadClient m => ActorId -> [(Int, Point)] -> m (Strategy RequestAnyAbility) flee aid fleeL = do b <- getsState $ getActorBody aid let vVic = map (second (`vectorToFrom` bpos b)) fleeL str = liftFrequency $ toFreq "flee" vVic mapStrategyM (moveOrRunAid True aid) str displaceFoe :: MonadClient m => ActorId -> m (Strategy RequestAnyAbility) displaceFoe aid = do cops <- getsState scops b <- getsState $ getActorBody aid lvl <- getLevel $ blid b fact <- getsState $ (EM.! bfid b) . sfactionD mleader <- getsClient _sleader let friendlyFid fid = fid == bfid b || isAllied fact fid friends <- getsState $ actorRegularList friendlyFid (blid b) allFoes <- getsState $ actorRegularAssocs (isAtWar fact) (blid b) let accessibleHere = accessible cops lvl $ bpos b -- DisplaceAccess displaceable body = -- DisplaceAccess, DisplaceDying, DisplaceSupported accessibleHere (bpos body) && adjacent (bpos body) (bpos b) nFriends body = length $ filter (adjacent (bpos body) . bpos) friends nFrHere = nFriends b + 1 qualifyActor (aid2, body2) = do activeItems <- activeItemsClient aid2 dEnemy <- getsState $ dispEnemy aid mleader aid2 activeItems let nFr = nFriends body2 return $! if displaceable body2 && dEnemy && nFr < nFrHere then Just (nFr * nFr, bpos body2 `vectorToFrom` bpos b) else Nothing vFoes <- mapM qualifyActor allFoes let str = liftFrequency $ toFreq "displaceFoe" $ catMaybes vFoes mapStrategyM (moveOrRunAid True aid) str displaceBlocker :: MonadClient m => ActorId -> m (Strategy RequestAnyAbility) displaceBlocker aid = do mtgtMPath <- getsClient $ EM.lookup aid . stargetD str <- case mtgtMPath of Just (_, Just (p : q : _, _)) -> displaceTowards aid p q _ -> return reject -- goal reached mapStrategyM (moveOrRunAid True aid) str -- TODO: perhaps modify target when actually moving, not when -- producing the strategy, even if it's a unique choice in this case. displaceTowards :: MonadClient m => ActorId -> Point -> Point -> m (Strategy Vector) displaceTowards aid source target = do cops <- getsState scops b <- getsState $ getActorBody aid assert (source == bpos b && adjacent source target) skip lvl <- getLevel $ blid b if boldpos b /= target -- avoid trivial loops && accessible cops lvl source target then do -- DisplaceAccess mleader <- getsClient _sleader mBlocker <- getsState $ posToActors target (blid b) case mBlocker of [] -> return reject [((aid2, b2), _)] | Just aid2 /= mleader -> do mtgtMPath <- getsClient $ EM.lookup aid2 . stargetD case mtgtMPath of Just (tgt, Just (p : q : rest, (goal, len))) | q == source && p == target -> do let newTgt = Just (tgt, Just (q : rest, (goal, len - 1))) modifyClient $ \cli -> cli {stargetD = EM.alter (const $ newTgt) aid (stargetD cli)} return $! returN "displace friend" $ target `vectorToFrom` source Just _ -> return reject Nothing -> do tfact <- getsState $ (EM.! bfid b2) . sfactionD activeItems <- activeItemsClient aid2 dEnemy <- getsState $ dispEnemy aid mleader aid2 activeItems if not (isAtWar tfact (bfid b)) || dEnemy then return $! returN "displace other" $ target `vectorToFrom` source else return reject -- DisplaceDying, DisplaceSupported _ -> return reject -- DisplaceProjectiles or trying to displace leader else return reject chase :: MonadClient m => ActorId -> Bool -> m (Strategy RequestAnyAbility) chase aid doDisplace = do body <- getsState $ getActorBody aid fact <- getsState $ (EM.! bfid body) . sfactionD mtgtMPath <- getsClient $ EM.lookup aid . stargetD str <- case mtgtMPath of Just (_, Just (p : q : _, (goal, _))) -> -- With no leader, the goal is vague, so permit arbitrary detours. moveTowards aid p q goal (fleaderMode (gplayer fact) == LeaderNull) _ -> return reject -- goal reached -- If @doDisplace@: don't pick fights, assuming the target is more important. -- We'd normally melee the target earlier on via @AbMelee@, but for -- actors that don't have this ability (and so melee only when forced to), -- this is meaningul. mapStrategyM (moveOrRunAid doDisplace aid) str moveTowards :: MonadClient m => ActorId -> Point -> Point -> Point -> Bool -> m (Strategy Vector) moveTowards aid source target goal relaxed = do cops@Kind.COps{cotile} <- getsState scops b <- getsState $ getActorBody aid assert (source == bpos b && adjacent source target) skip lvl <- getLevel $ blid b fact <- getsState $ (EM.! bfid b) . sfactionD friends <- getsState $ actorList (not . isAtWar fact) $ blid b let noFriends = unoccupied friends accessibleHere = accessible cops lvl source bumpableHere p = let t = lvl `at` p in Tile.isOpenable cotile t || Tile.isSuspect cotile t || Tile.isChangeable cotile t enterableHere p = accessibleHere p || bumpableHere p if noFriends target && enterableHere target then return $! returN "moveTowards adjacent" $ target `vectorToFrom` source else do let goesBack v = v == boldpos b `vectorToFrom` source nonincreasing p = chessDist source goal >= chessDist p goal isSensible p = (relaxed || nonincreasing p) && noFriends p && enterableHere p sensible = [ ((goesBack v, chessDist p goal), v) | v <- moves, let p = source `shift` v, isSensible p ] sorted = sortBy (comparing fst) sensible groups = map (map snd) $ groupBy ((==) `on` fst) sorted freqs = map (liftFrequency . uniformFreq "moveTowards") groups return $! foldr (.|) reject freqs -- | Actor moves or searches or alters or attacks. Displaces if @run@. -- This function is very general, even though it's often used in contexts -- when only one or two of the many cases can possibly occur. moveOrRunAid :: MonadClient m => Bool -> ActorId -> Vector -> m (Maybe RequestAnyAbility) moveOrRunAid run source dir = do cops@Kind.COps{cotile} <- getsState scops sb <- getsState $ getActorBody source let lid = blid sb lvl <- getLevel lid let spos = bpos sb -- source position tpos = spos `shift` dir -- target position t = lvl `at` tpos mleader <- getsClient _sleader -- We start by checking actors at the the target position, -- which gives a partial information (actors can be invisible), -- as opposed to accessibility (and items) which are always accurate -- (tiles can't be invisible). tgts <- getsState $ posToActors tpos lid case tgts of [((target, b2), _)] | run -> do -- @target@ can be a foe, as well as a friend. tfact <- getsState $ (EM.! bfid b2) . sfactionD activeItems <- activeItemsClient target dEnemy <- getsState $ dispEnemy source mleader target activeItems if boldpos sb /= tpos -- avoid trivial Displace loops && accessible cops lvl spos tpos -- DisplaceAccess && (not (isAtWar tfact (bfid sb)) || dEnemy) -- DisplaceDying, DisplaceSupported then return $! Just $ RequestAnyAbility $ ReqDisplace target else do wps <- pickWeaponClient source target case wps of [] -> return Nothing wp : _ -> return $! Just $ RequestAnyAbility wp ((target, _), _) : _ -> do -- can be a foe, as well as friend (e.g., proj.) -- No problem if there are many projectiles at the spot. We just -- attack the first one. -- Attacking does not require full access, adjacency is enough. wps <- pickWeaponClient source target case wps of [] -> return Nothing wp : _ -> return $! Just $ RequestAnyAbility wp [] -> do -- move or search or alter if accessible cops lvl spos tpos then -- Movement requires full access. return $! Just $ RequestAnyAbility $ ReqMove dir -- The potential invisible actor is hit. else if not $ EM.null $ lvl `atI` tpos then -- This is, e.g., inaccessible open door with an item in it. assert `failure` "AI causes AlterBlockItem" `twith` (run, source, dir) else if not (Tile.isWalkable cotile t) -- not implied && (Tile.isSuspect cotile t || Tile.isOpenable cotile t || Tile.isClosable cotile t || Tile.isChangeable cotile t) then -- No access, so search and/or alter the tile. return $! Just $ RequestAnyAbility $ ReqAlter tpos Nothing else -- Boring tile, no point bumping into it, do WaitSer if really idle. assert `failure` "AI causes MoveNothing or AlterNothing" `twith` (run, source, dir)