{-# LANGUAGE TupleSections #-}
module Game.LambdaHack.Client.AI.PickTargetM
( refreshTarget
#ifdef EXPOSE_INTERNAL
, computeTarget
#endif
) where
import Prelude ()
import Game.LambdaHack.Core.Prelude
import qualified Data.EnumMap.Strict as EM
import qualified Data.EnumSet as ES
import Game.LambdaHack.Client.AI.ConditionM
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.Actor
import Game.LambdaHack.Common.ActorState
import Game.LambdaHack.Common.Faction
import Game.LambdaHack.Common.Item
import Game.LambdaHack.Common.Kind
import Game.LambdaHack.Common.Level
import Game.LambdaHack.Common.MonadStateRead
import Game.LambdaHack.Common.Point
import qualified Game.LambdaHack.Common.PointArray as PointArray
import Game.LambdaHack.Common.State
import qualified Game.LambdaHack.Common.Tile as Tile
import Game.LambdaHack.Common.Time
import Game.LambdaHack.Common.Types
import Game.LambdaHack.Common.Vector
import Game.LambdaHack.Content.ModeKind
import Game.LambdaHack.Content.RuleKind
import Game.LambdaHack.Content.TileKind (isUknownSpace)
import Game.LambdaHack.Core.Frequency
import Game.LambdaHack.Core.Random
import qualified Game.LambdaHack.Definition.Ability as Ability
refreshTarget :: MonadClient m => (ActorId, Actor) -> m (Maybe TgtAndPath)
refreshTarget (aid, body) = do
side <- getsClient sside
let !_A = assert (bfid body == side
`blame` "AI tries to move an enemy actor"
`swith` (aid, body, side)) ()
let !_A = assert (not (bproj body)
`blame` "AI gets to manually move its projectiles"
`swith` (aid, body, side)) ()
mtarget <- computeTarget aid
case mtarget of
Nothing -> do
modifyClient $ \cli -> cli {stargetD = EM.delete aid (stargetD cli)}
return Nothing
Just tgtMPath -> do
modifyClient $ \cli ->
cli {stargetD = EM.insert aid tgtMPath (stargetD cli)}
return mtarget
computeTarget :: forall m. MonadClient m => ActorId -> m (Maybe TgtAndPath)
{-# INLINE computeTarget #-}
computeTarget aid = do
cops@COps{corule=RuleContent{rXmax, rYmax, rnearby}, coTileSpeedup}
<- getsState scops
b <- getsState $ getActorBody aid
mleader <- getsClient sleader
salter <- getsClient salter
actorMaxSkills <- getsState sactorMaxSkills
condInMelee <- condInMeleeM $ blid b
let lalter = salter EM.! blid b
actorMaxSk = actorMaxSkills EM.! aid
alterSkill = Ability.getSk Ability.SkAlter actorMaxSk
lvl <- getLevel $ blid b
let stepAccesible :: [Point] -> Bool
stepAccesible (q : _) =
alterSkill >= fromEnum (lalter PointArray.! q)
stepAccesible [] = False
mtgtMPath <- getsClient $ EM.lookup aid . stargetD
oldTgtUpdatedPath <- case mtgtMPath of
Just TgtAndPath{tapTgt,tapPath=Nothing} ->
Just <$> createPath aid tapTgt
Just tap@TgtAndPath{tapTgt,tapPath=Just AndPath{..}} -> do
mvalidPos <- getsState $ aidTgtToPos aid (blid b) (Just tapTgt)
return $!
if | isNothing mvalidPos -> Nothing
| bpos b == pathGoal->
mtgtMPath
| pathSource == bpos b ->
if stepAccesible pathList then mtgtMPath else Nothing
| otherwise -> case break (== bpos b) pathList of
(crossed, _ : rest) ->
if null rest
then Nothing
else let newPath =
AndPath{ pathSource = bpos b
, pathList = rest
, pathGoal
, pathLen = pathLen - length crossed - 1 }
in if stepAccesible rest
then Just tap{tapPath=Just newPath}
else Nothing
(_, []) -> Nothing
Nothing -> return Nothing
fact <- getsState $ (EM.! bfid b) . sfactionD
allFoes <- getsState $ foeRegularAssocs (bfid b) (blid b)
let canMove = Ability.getSk Ability.SkMove actorMaxSk > 0
|| Ability.getSk Ability.SkDisplace actorMaxSk > 0
|| Ability.getSk Ability.SkProject actorMaxSk > 0
canAlter = Ability.getSk Ability.SkAlter actorMaxSk >= 4
actorMinSk <- getsState $ actorCurrentSkills Nothing aid
condCanProject <-
condCanProjectM (Ability.getSk Ability.SkProject actorMaxSk) aid
let condCanMelee = actorCanMelee actorMaxSkills aid b
condHpTooLow = hpTooLow b actorMaxSk
friends <- getsState $ friendRegularList (bfid b) (blid b)
let canEscape = fcanEscape (gplayer fact)
canSmell = Ability.getSk Ability.SkSmell actorMaxSk > 0
meleeNearby | canEscape = rnearby `div` 2
| otherwise = rnearby
rangedNearby = 2 * meleeNearby
worthTargetting aidE body = do
actorMaxSkE <- getsState $ getActorMaxSkills aidE
factE <- getsState $ (EM.! bfid body) . sfactionD
let attacksFriends = any (adjacent (bpos body) . bpos) friends
nonmoving = Ability.getSk Ability.SkMove actorMaxSkE <= 0
&& bwatch body /= WWake
hasLoot = not (EM.null (beqp body)) || not (EM.null (binv body))
isHero = fhasGender (gplayer factE)
return $! not nonmoving || hasLoot || attacksFriends || isHero
targetableMelee body =
let attacksFriends = any (adjacent (bpos body) . bpos) friends
n | Ability.getSk Ability.SkAggression actorMaxSk >= 2
= rangedNearby
| condInMelee = if attacksFriends then 4 else 2
| otherwise = meleeNearby
in condCanMelee && chessDist (bpos body) (bpos b) <= n
targetableRanged body =
(not condInMelee || Ability.getSk Ability.SkAggression actorMaxSk >= 2)
&& chessDist (bpos body) (bpos b) < rangedNearby
&& condCanProject
targetableEnemy (aidE, body) =
if adjacent (bpos body) (bpos b)
then return True
else do
worth <- worthTargetting aidE body
return $! worth && (targetableRanged body || targetableMelee body)
nearbyFoes <- filterM targetableEnemy allFoes
discoBenefit <- getsClient sdiscoBenefit
fleeD <- getsClient sfleeD
getKind <- getsState $ flip getIidKind
getArItem <- getsState $ flip aspectRecordFromIid
let desirableIid (iid, (k, _)) =
let Benefit{benPickup} = discoBenefit EM.! iid
in desirableItem cops canEscape benPickup
(getArItem iid) (getKind iid) k
desirableBagFloor bag = any desirableIid $ EM.assocs bag
desirableFloor (_, (_, bag)) = desirableBagFloor bag
focused = gearSpeed actorMaxSk < speedWalk || condHpTooLow
couldMoveLastTurn =
let actorSk = if mleader == Just aid then actorMaxSk else actorMinSk
in Ability.getSk Ability.SkMove actorSk > 0
isStuck = actorWaits b && couldMoveLastTurn
slackTactic =
ftactic (gplayer fact)
`elem` [ Ability.TMeleeAndRanged, Ability.TMeleeAdjacent
, Ability.TBlock, Ability.TRoam, Ability.TPatrol ]
setPath :: Target -> m (Maybe TgtAndPath)
setPath tgt = do
let take7 tap@TgtAndPath{tapTgt=TEnemy{}} =
tap
take7 tap@TgtAndPath{tapPath=Just AndPath{..}} =
let path7 = take 7 pathList
vOld = towards (bpos b) pathGoal
pNew = shiftBounded rXmax rYmax (bpos b) vOld
walkable = Tile.isWalkable coTileSpeedup $ lvl `at` pNew
tapTgt = TVector vOld
in if bpos b == pathGoal
|| not walkable
then tap
else TgtAndPath{ tapTgt
, tapPath=Just AndPath{pathList=path7, ..} }
take7 tap = tap
tgtpath <- createPath aid tgt
return $ Just $ if slackTactic then take7 tgtpath else tgtpath
pickNewTarget = pickNewTargetIgnore Nothing
pickNewTargetIgnore :: Maybe ActorId -> m (Maybe TgtAndPath)
pickNewTargetIgnore maidToIgnore = do
let f aidToIgnore = filter ((/= aidToIgnore) . fst) nearbyFoes
notIgnoredFoes = maybe nearbyFoes f maidToIgnore
cfoes <- closestFoes notIgnoredFoes aid
case cfoes of
(_, (aid2, _)) : _ -> setPath $ TEnemy aid2
[] | condInMelee -> return Nothing
[] -> do
citemsRaw <- closestItems aid
let citems = toFreq "closestItems"
$ filter desirableFloor citemsRaw
if nullFreq citems then do
ctriggersRaw <- closestTriggers ViaAnything aid
let ctriggers = toFreq "ctriggers" ctriggersRaw
if nullFreq ctriggers then do
smpos <- if canSmell
then closestSmell aid
else return []
case smpos of
[] -> do
let vToTgt v0 = do
let vFreq = toFreq "vFreq"
$ (20, v0) : map (1,) moves
v <- rndToAction $ frequency vFreq
let pathSource = bpos b
tra = trajectoryToPathBounded
rXmax rYmax pathSource (replicate 7 v)
pathList = map head $ group tra
pathGoal = last pathList
pathLen = length pathList
return $ Just $
TgtAndPath
{ tapTgt = TVector v
, tapPath = if pathLen == 0
then Nothing
else Just AndPath{..} }
oldpos = fromMaybe (bpos b) (boldpos b)
vOld = bpos b `vectorToFrom` oldpos
pNew = shiftBounded rXmax rYmax (bpos b) vOld
if slackTactic && not isStuck
&& isUnit vOld && bpos b /= pNew
&& Tile.isWalkable coTileSpeedup (lvl `at` pNew)
then vToTgt vOld
else do
upos <- closestUnknown aid
case upos of
Nothing -> do
when (canMove && canAlter) $
modifyClient $ \cli -> cli {sexplored =
ES.insert (blid b) (sexplored cli)}
ctriggersRaw2 <- closestTriggers ViaExit aid
let ctriggers2 = toFreq "ctriggers2" ctriggersRaw2
if nullFreq ctriggers2 then do
afoes <- closestFoes allFoes aid
case afoes of
(_, (aid2, _)) : _ ->
setPath $ TEnemy aid2
[] -> do
furthest <- furthestKnown aid
setPath $ TPoint TKnown (blid b) furthest
else do
(p, (p0, bag)) <- rndToAction $ frequency ctriggers2
setPath $ TPoint (TEmbed bag p0) (blid b) p
Just p -> setPath $ TPoint TUnknown (blid b) p
(_, (p, _)) : _ -> setPath $ TPoint TSmell (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
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
updateTgt :: TgtAndPath -> m (Maybe TgtAndPath)
updateTgt TgtAndPath{tapPath=Nothing} = pickNewTarget
updateTgt tap@TgtAndPath{tapPath=Just AndPath{..},tapTgt} = case tapTgt of
TEnemy a -> do
body <- getsState $ getActorBody a
if | (condInMelee
|| not focused && not (null nearbyFoes))
&& a `notElem` map fst nearbyFoes
|| blid body /= blid b
|| actorDying body ->
pickNewTarget
| EM.member aid fleeD -> pickNewTarget
| otherwise -> do
mpath <- getCachePath aid $ bpos body
case mpath of
Nothing -> pickNewTargetIgnore (Just a)
Just AndPath{pathList=[]} -> pickNewTargetIgnore (Just a)
Just AndPath{pathList= q : _} ->
if not condInMelee || not (occupiedBigLvl q lvl)
&& not (occupiedProjLvl q lvl)
then return $ Just tap{tapPath=mpath}
else pickNewTargetIgnore (Just a)
_ | condInMelee -> pickNewTarget
TPoint _ lid _ | lid /= blid b -> pickNewTarget
TPoint tgoal lid pos -> case tgoal of
TEnemyPos _
| bpos b == pos -> tellOthersNothingHere pos
| EM.member aid fleeD -> pickNewTarget
| otherwise -> do
let remainingDist = chessDist (bpos b) pos
if any (\(_, b3) -> chessDist (bpos b) (bpos b3) < remainingDist)
nearbyFoes
then pickNewTarget
else return $ Just tap
_ | not $ null nearbyFoes ->
pickNewTarget
TEmbed bag p -> assert (adjacent pos p) $ do
bag2 <- getsState $ getEmbedBag lid p
if | bag /= bag2 -> pickNewTarget
| adjacent (bpos b) p ->
setPath $ TPoint TKnown lid (bpos b)
| otherwise -> return $ Just tap
TItem bag -> do
bag2 <- getsState $ getFloorBag lid pos
if | bag /= bag2 -> pickNewTarget
| bpos b == pos ->
setPath $ TPoint TKnown lid (bpos b)
| otherwise -> return $ Just tap
TSmell ->
if not canSmell
|| let sml = EM.findWithDefault timeZero pos (lsmell lvl)
in sml <= ltime lvl
then pickNewTarget
else return $ Just tap
TBlock -> do
let t = lvl `at` pos
if isStuck
|| alterSkill < fromEnum (lalter PointArray.! pos)
|| Tile.isWalkable coTileSpeedup t
then pickNewTarget
else return $ Just tap
TUnknown ->
let t = lvl `at` pos
in if lexpl lvl <= lseen lvl
|| not (isUknownSpace t)
then pickNewTarget
else return $ Just tap
TKnown ->
if bpos b == pos
|| isStuck
|| alterSkill < fromEnum (lalter PointArray.! pos)
then pickNewTarget
else return $ Just tap
_ | not $ null nearbyFoes ->
pickNewTarget
TNonEnemy _ | mleader == Just aid ->
pickNewTarget
TNonEnemy a -> do
body <- getsState $ getActorBody a
if blid body /= blid b
then pickNewTarget
else do
mpath <- getCachePath aid $ bpos body
case mpath of
Nothing -> pickNewTarget
Just AndPath{pathList=[]} -> pickNewTarget
_ -> return $ Just tap{tapPath=mpath}
TVector{} -> if pathLen > 1
then return $ Just tap
else pickNewTarget
if canMove
then case oldTgtUpdatedPath of
Nothing -> pickNewTarget
Just tap -> updateTgt tap
else return Nothing