module Game.LambdaHack.Client.AI.PickTargetClient
( targetStrategy
) where
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 qualified Game.LambdaHack.Common.Effect as Effect
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.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 Game.LambdaHack.Content.ModeKind
targetStrategy :: forall m. MonadClient m
=> ActorId -> ActorId -> m (Strategy (Target, Maybe PathEtc))
targetStrategy oldLeader aid = do
cops@Kind.COps{cotile=cotile@Kind.Ops{ouniqGroup}} <- getsState scops
itemToF <- itemToFullClient
modifyClient $ \cli -> cli { sbfsD = EM.delete aid (sbfsD cli)
, seps = seps cli + 773 }
b <- getsState $ getActorBody aid
activeItems <- activeItemsClient aid
lvl@Level{lxsize, lysize} <- getLevel $ blid b
let stepAccesible mtgt@(Just (_, (p : q : _ : _, _))) =
if accessible cops lvl p q then mtgt else Nothing
stepAccesible mtgt = mtgt
createPath :: Target -> m (Maybe (Target, PathEtc))
createPath tgt = do
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) ))
mtgtMPath <- getsClient $ EM.lookup aid . stargetD
oldTgtUpdatedPath <- case mtgtMPath of
Just (tgt, Just path) -> do
mvalidPos <- aidTgtToPos aid (blid b) (Just tgt)
if isNothing mvalidPos then return Nothing
else return $! case path of
(p : q : rest, (goal, len)) -> stepAccesible $
if bpos b == p
then Just (tgt, path)
else if bpos b == q
then Just (tgt, (q : rest, (goal, len 1)))
else Nothing
([p], (goal, _)) -> do
assert (p == goal `blame` (aid, b, mtgtMPath)) skip
if bpos b == p then
Just (tgt, path)
else
Nothing
([], _) -> assert `failure` (aid, b, mtgtMPath)
Just (tgt@TEnemyPos{}, Nothing) ->
createPath tgt
Just (_, Nothing) -> return Nothing
Nothing -> return Nothing
assert (not $ bproj b) skip
fact <- getsState $ (EM.! bfid b) . sfactionD
allFoes <- getsState $ actorRegularAssocs (isAtWar fact) (blid b)
dungeon <- getsState sdungeon
itemD <- getsState sitemD
actorSk <- actorSkillsClient aid (Just 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)
fightsSpawners <- fightsAgainstSpawners (bfid b)
explored <- getsClient sexplored
smellRadius <- sumOrganEqpClient Effect.EqpSlotAddSmell aid
let canSmell = smellRadius > 0
meleeNearby | fightsSpawners = nearby `div` 2
| 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
|| any (adjacent (bpos body) . bpos) friends)
targetableEnemy body =
targetableMelee body || targetableRangedOrSpecial body
nearbyFoes = filter (targetableEnemy . snd) allFoes
unknownId = ouniqGroup "unknown space"
itemUsefulness iid k =
case totalUsefulness cops b activeItems fact (itemToF iid k) of
Just (v, _) -> v
Nothing -> 30
desirableItem iid item k
| fightsSpawners = itemUsefulness iid k /= 0
|| Effect.Precious `elem` jfeature item
| otherwise = itemUsefulness iid k /= 0
desirableBag bag = any (\(iid, k) ->
desirableItem iid (itemD EM.! iid) k)
$ EM.assocs bag
desirable (_, (_, Nothing)) = True
desirable (_, (_, Just bag)) = desirableBag bag
focused = bspeed b activeItems < speedNormal || condHpTooLow
setPath :: Target -> m (Strategy (Target, Maybe PathEtc))
setPath tgt = do
mpath <- createPath tgt
return $! returN "pickNewTarget"
$ maybe (tgt, Nothing) (\(t, p) -> (t, Just p)) mpath
pickNewTarget :: m (Strategy (Target, Maybe PathEtc))
pickNewTarget = do
cfoes <- closestFoes nearbyFoes aid
case cfoes of
(_, (aid2, _)) : _ -> setPath $ TEnemy aid2 False
[] -> do
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
[] | not (playerLeader (gplayer fact)) -> 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
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
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 _ -> do
body <- getsState $ getActorBody a
if not focused
&& a `notElem` map fst nearbyFoes
|| blid body /= blid b
|| actorDying body
then pickNewTarget
else if bpos body == fst (snd updatedPath)
then return $! returN "TEnemy" (oldTgt, Just updatedPath)
else do
let p = bpos body
(bfs, mpath) <- getCacheBfsAndPath aid p
case mpath of
Nothing -> pickNewTarget
Just path ->
return $! returN "TEnemy"
(oldTgt, Just ( bpos b : path
, (p, fromMaybe (assert `failure` mpath)
$ accessBfs bfs p) ))
TEnemyPos _ lid p _ ->
if lid /= blid b
|| chessDist (bpos b) p >= nearby
then pickNewTarget
else if p == bpos b
then tellOthersNothingHere p
else return $! returN "TEnemyPos" (oldTgt, Just updatedPath)
_ | not $ null nearbyFoes ->
pickNewTarget
TPoint lid pos -> do
let allExplored = ES.size explored == EM.size dungeon
if lid /= blid b
|| (EM.findWithDefault 0 AbMoveItem actorSk <= 0
|| not (desirableBag (lvl `atI` pos)))
&& (not canSmell
|| pos == bpos b
|| let sml =
EM.findWithDefault timeZero pos (lsmell lvl)
in sml `timeDeltaToFrom` ltime lvl <= Delta timeZero)
&& let t = lvl `at` pos
in if ES.notMember lid explored
then t /= unknownId
&& not (Tile.isSuspect cotile t)
else
not (null allFoes)
||
(EM.findWithDefault 0 AbTrigger actorSk <= 0
|| not (Tile.isEscape cotile t && allExplored))
&& not (pos /= bpos b && Tile.isStair cotile t)
&& let isStuck =
waitedLastTurn b
&& (oldLeader == aid
|| isAllMoveFact cops fact)
in not (pos /= bpos b
&& not isStuck
&& 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