-- | Let AI pick the best target for an actor. module Game.LambdaHack.Client.AI.PickTargetClient ( targetStrategy, createPath ) where import Control.Applicative import Control.Exception.Assert.Sugar import qualified Data.EnumMap.Strict as EM import qualified Data.EnumSet as ES import Data.Maybe import Game.LambdaHack.Client.AI.ConditionClient import Game.LambdaHack.Client.AI.Preferences import Game.LambdaHack.Client.AI.Strategy import Game.LambdaHack.Client.Bfs 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 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.Random 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 import Game.LambdaHack.Content.RuleKind -- | AI proposes possible targets for the actor. Never empty. targetStrategy :: forall m. MonadClient m => ActorId -> ActorId -> m (Strategy (Target, Maybe PathEtc)) targetStrategy oldLeader aid = do cops@Kind.COps{corule, cotile=cotile@Kind.Ops{ouniqGroup}} <- getsState scops let stdRuleset = Kind.stdRuleset corule nearby = rnearby stdRuleset itemToF <- itemToFullClient modifyClient $ \cli -> cli { sbfsD = EM.delete aid (sbfsD cli) , seps = seps cli + 773 } -- randomize paths b <- getsState $ getActorBody aid activeItems <- activeItemsClient aid lvl@Level{lxsize, lysize} <- getLevel $ blid b let stepAccesible mtgt@(Just (_, (p : q : _ : _, _))) = -- goal not adjacent if accessible cops lvl p q then mtgt else Nothing stepAccesible mtgt = mtgt -- goal can be inaccessible, e.g., suspect mtgtMPath <- getsClient $ EM.lookup aid . stargetD oldTgtUpdatedPath <- case mtgtMPath of Just (tgt, Nothing) -> -- This case is especially for TEnemyPos that would be lost otherwise. -- This is also triggered by @UpdLeadFaction@. The recreated path can be -- different than on the other client (AI or UI), but we don't care -- as long as the target stays the same at least for a moment. createPath aid tgt Just (tgt, Just path) -> do mvalidPos <- aidTgtToPos aid (blid b) (Just tgt) if isNothing mvalidPos then return Nothing -- wrong level else return $! case path of (p : q : rest, (goal, len)) -> stepAccesible $ if bpos b == p then Just (tgt, path) -- no move last turn else if bpos b == q then Just (tgt, (q : rest, (goal, len - 1))) -- step along path else Nothing -- veered off the path ([p], (goal, _)) -> do assert (p == goal `blame` (aid, b, mtgtMPath)) skip if bpos b == p then Just (tgt, path) -- goal reached; stay there picking up items else Nothing -- somebody pushed us off the goal; let's target again ([], _) -> assert `failure` (aid, b, mtgtMPath) Nothing -> return Nothing -- no target assigned yet assert (not $ bproj b) skip -- would work, but is probably a bug fact <- getsState $ (EM.! bfid b) . sfactionD allFoes <- getsState $ actorRegularAssocs (isAtWar fact) (blid b) dungeon <- getsState sdungeon itemD <- getsState sitemD -- We assume the actor eventually becomes a leader (or has the same -- set of abilities as the leader, anyway) and set his target accordingly. actorSk <- maxActorSkillsClient aid condCanProject <- condCanProjectM aid condMeleeBad <- condMeleeBadM aid condHpTooLow <- condHpTooLowM aid let friendlyFid fid = fid == bfid b || isAllied fact fid friends <- getsState $ actorRegularList friendlyFid (blid b) -- TODO: refine all this when some actors specialize in ranged attacks -- (then we have to target, but keep the distance, we can do similarly for -- wounded or alone actors, perhaps only until they are shot first time, -- and only if they can shoot at the moment) canEscape <- factionCanEscape (bfid b) explored <- getsClient sexplored smellRadius <- sumOrganEqpClient IK.EqpSlotAddSmell aid let canSmell = smellRadius > 0 meleeNearby | canEscape = nearby `div` 2 -- not aggresive | otherwise = nearby rangedNearby = 2 * meleeNearby targetableMelee body = chessDist (bpos body) (bpos b) < meleeNearby && not condMeleeBad targetableRangedOrSpecial body = chessDist (bpos body) (bpos b) < rangedNearby && (condCanProject || hpTooLow body activeItems -- easy prey || any (adjacent (bpos body) . bpos) friends) -- attacks friends! targetableEnemy body = targetableMelee body || targetableRangedOrSpecial body nearbyFoes = filter (targetableEnemy . snd) allFoes unknownId = ouniqGroup "unknown space" itemUsefulness iid k = fst <$> totalUsefulness cops b activeItems fact (itemToF iid k) -- TODO: factor out from here and benGroundItems desirableItem iid item k | canEscape = itemUsefulness iid k /= Just 0 || IK.Precious `elem` jfeature item | otherwise = let use = itemUsefulness iid k -- A hack to prevent monsters from picking up treasure. preciousWithoutSlot item2 = IK.Precious `elem` jfeature item2 -- risk from treasure hunters && isNothing (strengthEqpSlot item2) -- unlikely to be useful in use /= Just 0 && not (isNothing use -- needs resources to id && preciousWithoutSlot item) desirableBag bag = any (\(iid, k) -> desirableItem iid (itemD EM.! iid) k) $ EM.assocs bag desirable (_, (_, Nothing)) = True desirable (_, (_, Just bag)) = desirableBag bag -- TODO: make more common when weak ranged foes preferred, etc. focused = bspeed b activeItems < speedNormal || condHpTooLow setPath :: Target -> m (Strategy (Target, Maybe PathEtc)) setPath tgt = do mpath <- createPath aid tgt return $! returN "pickNewTarget" $ maybe (tgt, Nothing) (\(t, p) -> (t, Just p)) mpath pickNewTarget :: m (Strategy (Target, Maybe PathEtc)) pickNewTarget = do -- TODO: for foes, items, etc. consider a few nearby, not just one cfoes <- closestFoes nearbyFoes aid case cfoes of (_, (aid2, _)) : _ -> setPath $ TEnemy aid2 False [] -> do -- Tracking enemies is more important than exploring, -- and smelling actors are usually blind, so bad at exploring. -- TODO: prefer closer items to older smells smpos <- if canSmell then closestSmell aid else return [] case smpos of [] -> do citems <- if EM.findWithDefault 0 AbMoveItem actorSk > 0 then closestItems aid else return [] case filter desirable citems of [] | ftactic (gplayer fact) == TRoam -> do mtgtPrev <- getsClient $ getTarget aid let vOld = bpos b `vectorToFrom` boldpos b v = case (mtgtPrev, isUnit vOld) of (Just (TVector tgtPrev), True) -> if euclidDistSqVector tgtPrev vOld <= 2 then tgtPrev else vOld (Just (TVector tgtPrev), False) -> tgtPrev (_, True) -> vOld (_, False) -> Vector 1 1 -- south-east -- Items and smells considered every 5 moves. -- Thanks to sentinels, @path@ is never null. path = trajectoryToPathBounded lxsize lysize (bpos b) (replicate 5 v) return $! returN "tgt with no playerLeader" ( TVector v , Just (bpos b : path, (last path, length path)) ) [] -> do let lidExplored = ES.member (blid b) explored upos <- if lidExplored then return Nothing else closestUnknown aid case upos of Nothing -> do csuspect <- if lidExplored then return [] else closestSuspect aid case csuspect of [] -> do ctriggers <- if EM.findWithDefault 0 AbTrigger actorSk > 0 then closestTriggers Nothing False aid else return [] case ctriggers of [] -> do -- All stones turned, time to win or die. afoes <- closestFoes allFoes aid case afoes of (_, (aid2, _)) : _ -> setPath $ TEnemy aid2 False [] -> do getDistant <- rndToAction $ oneOf $ [fmap (: []) . furthestKnown] ++ [ closestTriggers Nothing True | EM.size dungeon > 1 ] kpos <- getDistant aid case kpos of [] -> return reject p : _ -> setPath $ TPoint (blid b) p p : _ -> setPath $ TPoint (blid b) p p : _ -> setPath $ TPoint (blid b) p Just p -> setPath $ TPoint (blid b) p (_, (p, _)) : _ -> setPath $ TPoint (blid b) p (_, (p, _)) : _ -> setPath $ TPoint (blid b) p tellOthersNothingHere pos = do let f (tgt, _) = case tgt of TEnemyPos _ lid p _ -> p /= pos || lid /= blid b _ -> True modifyClient $ \cli -> cli {stargetD = EM.filter f (stargetD cli)} pickNewTarget updateTgt :: Target -> PathEtc -> m (Strategy (Target, Maybe PathEtc)) updateTgt oldTgt updatedPath@(_, (_, len)) = case oldTgt of TEnemy a permit -> do body <- getsState $ getActorBody a if not focused -- prefers closer foes && a `notElem` map fst nearbyFoes -- old one not close enough || blid body /= blid b -- wrong level || actorDying body -- foe already dying || permit -- never follow a friend more than 1 step then pickNewTarget else if bpos body == fst (snd updatedPath) then return $! returN "TEnemy" (oldTgt, Just updatedPath) -- The enemy didn't move since the target acquired. -- If any walls were added that make the enemy -- unreachable, AI learns that the hard way, -- as soon as it bumps into them. else do let p = bpos body (bfs, mpath) <- getCacheBfsAndPath aid p case mpath of Nothing -> pickNewTarget -- enemy became unreachable Just path -> return $! returN "TEnemy" (oldTgt, Just ( bpos b : path , (p, fromMaybe (assert `failure` mpath) $ accessBfs bfs p) )) TEnemyPos _ lid p permit -> -- Chase last position even if foe hides or dies, -- to find his companions, loot, etc. if lid /= blid b -- wrong level || chessDist (bpos b) p >= nearby -- too far and not visible || permit -- never follow a friend more than 1 step then pickNewTarget else if p == bpos b then tellOthersNothingHere p else return $! returN "TEnemyPos" (oldTgt, Just updatedPath) _ | not $ null nearbyFoes -> pickNewTarget -- prefer close foes to anything TPoint lid pos -> do let allExplored = ES.size explored == EM.size dungeon bag <- getsState $ getCBag $ CFloor lid pos if lid /= blid b -- wrong level -- Below we check the target could not be picked again in -- pickNewTarget, and only in this case it is invalidated. -- This ensures targets are eventually reached (unless a foe -- shows up) and not changed all the time mid-route -- to equally interesting, but perhaps a bit closer targets, -- most probably already targeted by other actors. || (EM.findWithDefault 0 AbMoveItem actorSk <= 0 -- closestItems || not (desirableBag bag)) && (not canSmell -- closestSmell || pos == bpos b -- in case server resends deleted smell || let sml = EM.findWithDefault timeZero pos (lsmell lvl) in sml <= ltime lvl) && let t = lvl `at` pos in if ES.notMember lid explored then t /= unknownId -- closestUnknown && not (Tile.isSuspect cotile t) -- closestSuspect else -- closestTriggers -- Try to kill that very last enemy for his loot before -- leaving the level or dungeon. not (null allFoes) || -- If all explored, escape/block escapes. (not (Tile.isEscape cotile t) || not allExplored) -- The next case is stairs in closestTriggers. -- We don't determine if the stairs are interesting -- (this changes with time), but allow the actor -- to reach them and then retarget, unless he can't -- trigger them in the first place. && (EM.findWithDefault 0 AbTrigger actorSk <= 0 || pos == bpos b || not (Tile.isStair cotile t)) -- The remaining case is furthestKnown. This is -- always an unimportant target, so we forget it -- if the actor is stuck (waits, though could move; -- or has zeroed individual moving skill, -- but then should change targets often anyway). && let isStuck = waitedLastTurn b && canMoveFact fact (oldLeader == aid) in pos == bpos b || isStuck || not allExplored then pickNewTarget else return $! returN "TPoint" (oldTgt, Just updatedPath) TVector{} | len > 1 -> return $! returN "TVector" (oldTgt, Just updatedPath) TVector{} -> pickNewTarget case oldTgtUpdatedPath of Just (oldTgt, updatedPath) -> updateTgt oldTgt updatedPath Nothing -> pickNewTarget createPath :: MonadClient m => ActorId -> Target -> m (Maybe (Target, PathEtc)) createPath aid tgt = do b <- getsState $ getActorBody aid mpos <- aidTgtToPos aid (blid b) (Just tgt) case mpos of Nothing -> return Nothing Just p -> do (bfs, mpath) <- getCacheBfsAndPath aid p return $! case mpath of Nothing -> Nothing Just path -> Just (tgt, ( bpos b : path , (p, fromMaybe (assert `failure` mpath) $ accessBfs bfs p) ))