{-# LANGUAGE TupleSections #-}
module Game.LambdaHack.Client.AI.PickTargetM
( refreshTarget
#ifdef EXPOSE_INTERNAL
, targetStrategy
#endif
) where
import Prelude ()
import Game.LambdaHack.Common.Prelude
import qualified Data.EnumMap.Strict as EM
import qualified Data.EnumSet as ES
import Game.LambdaHack.Client.AI.ConditionM
import Game.LambdaHack.Client.AI.Strategy
import Game.LambdaHack.Client.Bfs
import Game.LambdaHack.Client.BfsM
import Game.LambdaHack.Client.CommonM
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.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 qualified Game.LambdaHack.Common.PointArray as PointArray
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
import Game.LambdaHack.Content.RuleKind
import Game.LambdaHack.Content.TileKind (isUknownSpace)
refreshTarget :: MonadClient m => (ActorId, Actor) -> m (Maybe TgtAndPath)
{-# INLINE refreshTarget #-}
refreshTarget (aid, body) = do
side <- getsClient sside
let !_A = assert (bfid body == side
`blame` "AI tries to move an enemy actor"
`twith` (aid, body, side)) ()
let !_A = assert (isNothing (btrajectory body) && not (bproj body)
`blame` "AI gets to manually move its projectiles"
`twith` (aid, body, side)) ()
stratTarget <- targetStrategy aid
if nullStrategy stratTarget then do
modifyClient $ \cli -> cli {stargetD = EM.delete aid (stargetD cli)}
return Nothing
else do
tgtMPath <- rndToAction $ frequency $ bestVariant stratTarget
modifyClient $ \cli ->
cli {stargetD = EM.insert aid tgtMPath (stargetD cli)}
return $ Just tgtMPath
targetStrategy :: forall m. MonadClient m
=> ActorId -> m (Strategy TgtAndPath)
{-# INLINE targetStrategy #-}
targetStrategy aid = do
Kind.COps{corule, coTileSpeedup} <- getsState scops
b <- getsState $ getActorBody aid
mleader <- getsClient _sleader
scondInMelee <- getsClient scondInMelee
salter <- getsClient salter
actorAspect <- getsClient sactorAspect
let lalter = salter EM.! blid b
condInMelee = fromMaybe (assert `failure` condInMelee)
(scondInMelee EM.! blid b)
stdRuleset = Kind.stdRuleset corule
nearby = rnearby stdRuleset
ar = fromMaybe (assert `failure` aid) (EM.lookup aid actorAspect)
actorMaxSk = aSkills ar
alterSkill = EM.findWithDefault 0 AbAlter actorMaxSk
lvl@Level{lxsize, lysize} <- getLevel $ blid b
let stepAccesible :: AndPath -> Bool
stepAccesible AndPath{pathList=q : _} =
alterSkill >= fromEnum (lalter PointArray.! q)
stepAccesible _ = False
mtgtMPath <- getsClient $ EM.lookup aid . stargetD
oldTgtUpdatedPath <- case mtgtMPath of
Just TgtAndPath{tapTgt,tapPath=NoPath} ->
Just <$> createPath aid tapTgt
Just tap@TgtAndPath{..} -> do
mvalidPos <- aidTgtToPos aid (blid b) tapTgt
if | isNothing mvalidPos -> return Nothing
| bpos b == pathGoal tapPath ->
return mtgtMPath
| otherwise -> return $! case tapPath of
AndPath{pathList=q : rest,..} -> case chessDist (bpos b) q of
0 ->
let newPath = AndPath{ pathList = rest
, pathGoal
, pathLen = pathLen - 1 }
in if stepAccesible newPath
then Just tap{tapPath=newPath}
else Nothing
1 ->
if stepAccesible tapPath
then mtgtMPath
else Nothing
_ -> Nothing
AndPath{pathList=[],..}->
Nothing
NoPath -> assert `failure` ()
Nothing -> return Nothing
fact <- getsState $ (EM.! bfid b) . sfactionD
allFoes <- getsState $ actorRegularAssocs (isAtWar fact) (blid b)
dungeon <- getsState sdungeon
let canMove = EM.findWithDefault 0 AbMove actorMaxSk > 0
|| EM.findWithDefault 0 AbDisplace actorMaxSk > 0
|| EM.findWithDefault 0 AbProject actorMaxSk > 0
actorMinSk <- getsState $ actorSkills Nothing aid ar
condCanProject <-
condCanProjectM (EM.findWithDefault 0 AbProject actorMaxSk) aid
condEnoughGear <- condEnoughGearM aid
let condCanMelee = actorCanMelee actorAspect aid b
condHpTooLow = hpTooLow b ar
friends <- getsState $ friendlyActorRegularList (bfid b) (blid b)
let canEscape = fcanEscape (gplayer fact)
canSmell = aSmell ar > 0
meleeNearby | canEscape = nearby `div` 2
| otherwise = nearby
rangedNearby = 2 * meleeNearby
targetableMelee aidE body = do
actorMaxSkE <- maxActorSkillsClient aidE
let attacksFriends = any (adjacent (bpos body) . bpos) friends
n | condInMelee = if attacksFriends then 4 else 0
| otherwise = meleeNearby
nonmoving = EM.findWithDefault 0 AbMove actorMaxSkE <= 0
return $
case chessDist (bpos body) (bpos b) of
1 -> True
cd -> condCanMelee && cd <= n && (not nonmoving || attacksFriends)
targetableRanged body =
not condInMelee
&& chessDist (bpos body) (bpos b) < rangedNearby
&& condCanProject
targetableEnemy (aidE, body) = do
tMelee <- targetableMelee aidE body
return $! targetableRanged body || tMelee
nearbyFoes <- filterM targetableEnemy allFoes
explored <- getsClient sexplored
isStairPos <- getsState $ \s lid p -> isStair lid p s
discoBenefit <- getsClient sdiscoBenefit
s <- getState
let lidExplored = ES.member (blid b) explored
desirableBagFloor bag = any (\iid ->
let item = getItemBody iid s
benPick = benPickup <$> EM.lookup iid discoBenefit
in desirableItem canEscape benPick item) $ EM.keys bag
desirableFloor (_, (_, bag)) = desirableBagFloor bag
focused = bspeed b ar < speedWalk || condHpTooLow
couldMoveLastTurn =
let actorSk = if mleader == Just aid then actorMaxSk else actorMinSk
in EM.findWithDefault 0 AbMove actorSk > 0
isStuck = waitedLastTurn b && couldMoveLastTurn
slackTactic =
ftactic (gplayer fact)
`elem` [TMeleeAndRanged, TMeleeAdjacent, TBlock, TRoam, TPatrol]
setPath :: Target -> m (Strategy TgtAndPath)
setPath tgt = do
let take7 tap@TgtAndPath{tapTgt=TEnemy{}} =
tap
take7 tap@TgtAndPath{tapTgt,tapPath=AndPath{..}} =
if slackTactic then
let path7 = take 7 pathList
vtgt | bpos b == pathGoal = tapTgt
| otherwise = TVector $ towards (bpos b) pathGoal
in TgtAndPath{tapTgt=vtgt, tapPath=AndPath{pathList=path7, ..}}
else tap
take7 tap = tap
tgtpath <- createPath aid tgt
return $! returN "setPath" $ take7 tgtpath
pickNewTarget :: m (Strategy TgtAndPath)
pickNewTarget = do
cfoes <- closestFoes nearbyFoes aid
case cfoes of
(_, (aid2, _)) : _ -> setPath $ TEnemy aid2 False
[] | condInMelee -> return reject
[] -> do
smpos <- if canSmell
then closestSmell aid
else return []
case smpos of
[] -> do
citemsRaw <- closestItems aid
let citems = toFreq "closestItems"
$ filter desirableFloor citemsRaw
if nullFreq citems then do
ctriggersRaw <- closestTriggers ViaAnything aid
let ctriggers = toFreq "closestTriggers" ctriggersRaw
if nullFreq ctriggers then do
let vToTgt v0 = do
let vFreq = toFreq "vFreq"
$ (20, v0) : map (1,) moves
v <- rndToAction $ frequency vFreq
let pathSource = bpos b
tra = trajectoryToPathBounded
lxsize lysize pathSource (replicate 7 v)
pathList = nub tra
pathGoal = last pathList
pathLen = length pathList
return $! returN "tgt with no exploration"
TgtAndPath
{ tapTgt = TVector v
, tapPath = if pathLen == 0
then NoPath
else AndPath{..} }
oldpos = fromMaybe originPoint (boldpos b)
vOld = bpos b `vectorToFrom` oldpos
pNew = shiftBounded lxsize lysize (bpos b) vOld
if slackTactic && not isStuck
&& isUnit vOld && bpos b /= pNew
&& Tile.isWalkable coTileSpeedup (lvl `at` pNew)
then vToTgt vOld
else do
upos <- if lidExplored
then return Nothing
else closestUnknown aid
case upos of
Nothing -> do
explored2 <- getsClient sexplored
let allExplored2 = ES.size explored2
== EM.size dungeon
if allExplored2 || nullFreq ctriggers then do
afoes <- closestFoes allFoes aid
case afoes of
(_, (aid2, _)) : _ ->
setPath $ TEnemy aid2 False
[] ->
if nullFreq ctriggers then do
furthest <- furthestKnown aid
setPath $ TPoint TKnown (blid b) furthest
else do
(p, (p0, bag)) <-
rndToAction $ frequency ctriggers
setPath $ TPoint (TEmbed bag p0) (blid b) p
else do
(p, (p0, bag)) <-
rndToAction $ frequency ctriggers
setPath $ TPoint (TEmbed bag p0) (blid b) p
Just p -> setPath $ TPoint TUnknown (blid b) p
else do
(p, (p0, bag)) <- rndToAction $ frequency ctriggers
setPath $ TPoint (TEmbed bag p0) (blid b) p
else do
(p, bag) <- rndToAction $ frequency citems
setPath $ TPoint (TItem bag) (blid b) p
(_, (p, _)) : _ -> setPath $ TPoint TSmell (blid b) p
tellOthersNothingHere pos = do
let f TgtAndPath{tapTgt} = case tapTgt of
TPoint _ lid p -> p /= pos || lid /= blid b
_ -> True
modifyClient $ \cli -> cli {stargetD = EM.filter f (stargetD cli)}
pickNewTarget
tileAdj :: (Point -> Bool) -> Point -> Bool
tileAdj f p = any f $ vicinityUnsafe p
updateTgt :: TgtAndPath -> m (Strategy TgtAndPath)
updateTgt TgtAndPath{tapPath=NoPath} = pickNewTarget
updateTgt tap@TgtAndPath{tapPath=AndPath{..},tapTgt} = case tapTgt of
TEnemy a permit -> do
body <- getsState $ getActorBody a
if | (condInMelee || not focused)
&& a `notElem` map fst nearbyFoes
|| blid body /= blid b
|| actorDying body
|| permit
&& (condInMelee
|| mleader == Just aid) ->
pickNewTarget
| bpos body == pathGoal ->
return $! returN "TEnemy" tap
| otherwise -> do
mpath <- getCachePath aid $ bpos body
case mpath of
NoPath -> pickNewTarget
AndPath{pathLen=0} -> pickNewTarget
AndPath{} -> return $! returN "TEnemy" tap{tapPath=mpath}
_ | condInMelee -> pickNewTarget
TPoint _ lid _ | lid /= blid b -> pickNewTarget
TPoint tgoal lid pos -> case tgoal of
_ | not $ null nearbyFoes ->
pickNewTarget
TEnemyPos _ permit
| bpos b == pos -> tellOthersNothingHere pos
| permit
&& (condInMelee
|| mleader == Just aid) ->
pickNewTarget
| otherwise -> return $! returN "TEnemyPos" tap
TEmbed bag p -> assert (adjacent pos p) $ do
bag2 <- getsState $ getEmbedBag lid p
if | bag /= bag2 -> pickNewTarget
| adjacent (bpos b) p ->
setPath $ TPoint TAny lid (bpos b)
| otherwise -> return $! returN "TEmbed" tap
TItem bag -> do
bag2 <- getsState $ getFloorBag lid pos
if | bag /= bag2 -> pickNewTarget
| bpos b == pos ->
setPath $ TPoint TAny lid (bpos b)
| otherwise -> return $! returN "TItem" tap
TSmell ->
if not canSmell
|| let sml = EM.findWithDefault timeZero pos (lsmell lvl)
in sml <= ltime lvl
then pickNewTarget
else return $! returN "TSmell" tap
TUnknown ->
let t = lvl `at` pos
in if lidExplored
|| not (isUknownSpace t)
|| condEnoughGear && tileAdj (isStairPos lid) pos
then pickNewTarget
else return $! returN "TUnknown" tap
TKnown ->
if bpos b == pos
|| isStuck
|| alterSkill < fromEnum (lalter PointArray.! pos)
then pickNewTarget
else return $! returN "TKnown" tap
TAny -> pickNewTarget
TVector{} -> if pathLen > 1
then return $! returN "TVector" tap
else pickNewTarget
if canMove
then case oldTgtUpdatedPath of
Nothing -> pickNewTarget
Just tap -> updateTgt tap
else return $! returN "NoMove" $ TgtAndPath (TEnemy aid True) NoPath