module Game.LambdaHack.Client.AI.PickTargetClient
( targetStrategy, createPath
) where
import Control.Applicative
import Control.Exception.Assert.Sugar
import Control.Monad
import qualified Data.EnumMap.Strict as EM
import qualified Data.EnumSet as ES
import Data.List
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.Frequency
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 -> m (Strategy (Target, Maybe PathEtc))
targetStrategy 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 = invalidateBfs 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
let !_A = assert (p == goal `blame` (aid, b, mtgtMPath)) ()
if bpos b == p then
Just (tgt, path)
else
Nothing
([], _) -> assert `failure` (aid, b, mtgtMPath)
Nothing -> return Nothing
let !_A = assert (not $ bproj b) ()
fact <- getsState $ (EM.! bfid b) . sfactionD
allFoes <- getsState $ actorRegularAssocs (isAtWar fact) (blid b)
dungeon <- getsState sdungeon
let actorMaxSk = sumSkills activeItems
actorMinSk <- getsState $ actorSkills Nothing aid activeItems
condCanProject <- condCanProjectM True aid
condHpTooLow <- condHpTooLowM aid
condEnoughGear <- condEnoughGearM aid
condMeleeBad <- condMeleeBadM 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 condNoUsableWeapon = all (not . isMelee) activeItems
lidExplored = ES.member (blid b) explored
allExplored = ES.size explored == EM.size dungeon
canSmell = smellRadius > 0
meleeNearby | canEscape = nearby `div` 2
| otherwise = nearby
rangedNearby = 2 * meleeNearby
targetableMelee aidE body = do
activeItemsE <- activeItemsClient aidE
let actorMaxSkE = sumSkills activeItemsE
attacksFriends = any (adjacent (bpos body) . bpos) friends
n = if attacksFriends then rangedNearby else meleeNearby
nonmoving = EM.findWithDefault 0 AbMove actorMaxSkE <= 0
return $
chessDist (bpos body) (bpos b) < n
&& not condNoUsableWeapon
&& EM.findWithDefault 0 AbMelee actorMaxSk > 0
&& not (hpTooLow b activeItems)
&& not (nonmoving && condMeleeBad)
targetableRangedOrSpecial body =
chessDist (bpos body) (bpos b) < rangedNearby
&& condCanProject
targetableEnemy (aidE, body) = do
tMelee <- targetableMelee aidE body
return $! targetableRangedOrSpecial body || tMelee
nearbyFoes <- filterM targetableEnemy allFoes
let unknownId = ouniqGroup "unknown space"
itemUsefulness itemFull =
fst <$> totalUsefulness cops b activeItems fact itemFull
desirableBag bag = any (\(iid, k) ->
let itemFull = itemToF iid k
use = itemUsefulness itemFull
in desirableItem canEscape use itemFull) $ EM.assocs bag
desirable (_, (_, Nothing)) = True
desirable (_, (_, Just bag)) = desirableBag bag
focused = bspeed b activeItems < speedNormal || condHpTooLow
couldMoveLastTurn =
let axtorSk = if (fst <$> gleader fact) == Just aid
then actorMaxSk
else actorMinSk
in EM.findWithDefault 0 AbMove axtorSk > 0
isStuck = waitedLastTurn b && couldMoveLastTurn
slackTactic = ftactic (gplayer fact) `elem` [TBlock, TRoam, TPatrol]
setPath :: Target -> m (Strategy (Target, Maybe PathEtc))
setPath tgt = do
mpath <- createPath aid tgt
let take5 (TEnemy{}, pgl) =
(tgt, Just pgl)
take5 (_, pgl@(path, (goal, _))) =
if slackTactic then
let path5 = take 5 path
vtgt | bpos b == goal = tgt
| otherwise = TVector $ towards (bpos b) goal
in (vtgt, Just (path5, (last path5, length path5 1)))
else (tgt, Just pgl)
return $! returN "setPath" $ maybe (tgt, Nothing) take5 mpath
pickNewTarget :: m (Strategy (Target, Maybe PathEtc))
pickNewTarget = do
ctriggers <- closestTriggers Nothing aid
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
let ctriggersEarly =
if EM.findWithDefault 0 AbTrigger actorMaxSk > 0
&& condEnoughGear
then ctriggers
else mzero
if nullFreq ctriggersEarly then do
citems <-
if EM.findWithDefault 0 AbMoveItem actorMaxSk > 0
then closestItems aid
else return []
case filter desirable citems of
[] -> do
let vToTgt v0 = do
let vFreq = toFreq "vFreq"
$ (20, v0) : map (1,) moves
v <- rndToAction $ frequency vFreq
let tra = trajectoryToPathBounded
lxsize lysize (bpos b) (replicate 7 v)
path = nub $ bpos b : tra
return $! returN "tgt with no exploration"
( TVector v
, if length path == 1
then Nothing
else Just (path, (last path, length path 1)) )
vOld = bpos b `vectorToFrom` boldpos b
pNew = shiftBounded lxsize lysize (bpos b) vOld
if slackTactic && not isStuck
&& isUnit vOld && bpos b /= pNew
&& accessible cops lvl (bpos b) pNew
then vToTgt vOld
else do
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
let ctriggersMiddle =
if EM.findWithDefault 0 AbTrigger
actorMaxSk > 0
&& not allExplored
then ctriggers
else mzero
if nullFreq ctriggersMiddle then do
afoes <- closestFoes allFoes aid
case afoes of
(_, (aid2, _)) : _ ->
setPath $ TEnemy aid2 False
[] -> do
if nullFreq ctriggers then do
furthest <- furthestKnown aid
setPath $ TPoint (blid b) furthest
else do
p <- rndToAction $ frequency ctriggers
setPath $ TPoint (blid b) p
else do
p <- rndToAction $ frequency ctriggers
setPath $ TPoint (blid b) p
p : _ -> setPath $ TPoint (blid b) p
Just p -> setPath $ TPoint (blid b) p
(_, (p, _)) : _ -> setPath $ TPoint (blid b) p
else do
p <- rndToAction $ frequency ctriggers
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
| lid /= blid b
|| chessDist (bpos b) p >= nearby
|| permit
-> pickNewTarget
| p == bpos b -> tellOthersNothingHere p
| otherwise ->
return $! returN "TEnemyPos" (oldTgt, Just updatedPath)
_ | not $ null nearbyFoes ->
pickNewTarget
TPoint lid pos -> do
bag <- getsState $ getCBag $ CFloor lid pos
let t = lvl `at` pos
if lid /= blid b
||
(EM.findWithDefault 0 AbMoveItem actorMaxSk <= 0
|| not (desirableBag bag))
&&
(pos == bpos b
|| (not canSmell
|| let sml = EM.findWithDefault timeZero pos (lsmell lvl)
in sml <= ltime lvl)
&& if not lidExplored
then t /= unknownId
&& not (Tile.isSuspect cotile t)
&& not (condEnoughGear && Tile.isStair cotile t)
else
not (null allFoes)
||
(not (Tile.isEscape cotile t)
|| not allExplored)
&& (EM.findWithDefault 0 AbTrigger actorMaxSk <= 0
|| not (Tile.isStair cotile t))
&& (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) ))