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
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 }
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
mtgtMPath <- getsClient $ EM.lookup aid . stargetD
oldTgtUpdatedPath <- case mtgtMPath of
Just (tgt, Nothing) ->
createPath aid tgt
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)
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 <- 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)
canEscape <- factionCanEscape (bfid b)
explored <- getsClient sexplored
smellRadius <- sumOrganEqpClient IK.EqpSlotAddSmell aid
let canSmell = smellRadius > 0
meleeNearby | canEscape = 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 =
fst <$> totalUsefulness cops b activeItems fact (itemToF iid k)
desirableItem iid item k
| canEscape = itemUsefulness iid k /= Just 0
|| IK.Precious `elem` jfeature item
| otherwise =
let use = itemUsefulness iid k
preciousWithoutSlot item2 =
IK.Precious `elem` jfeature item2
&& isNothing (strengthEqpSlot item2)
in use /= Just 0
&& not (isNothing use
&& preciousWithoutSlot item)
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 aid 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
[] | 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
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 permit -> do
body <- getsState $ getActorBody a
if not focused
&& a `notElem` map fst nearbyFoes
|| blid body /= blid b
|| actorDying body
|| permit
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 permit ->
if lid /= blid b
|| chessDist (bpos b) p >= nearby
|| permit
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
bag <- getsState $ getCBag $ CFloor lid pos
if lid /= blid b
|| (EM.findWithDefault 0 AbMoveItem actorSk <= 0
|| not (desirableBag bag))
&& (not canSmell
|| pos == bpos b
|| 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
&& not (Tile.isSuspect cotile t)
else
not (null allFoes)
||
(not (Tile.isEscape cotile t)
|| not allExplored)
&& (EM.findWithDefault 0 AbTrigger actorSk <= 0
|| pos == bpos b
|| not (Tile.isStair cotile t))
&& 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) ))