{-# LANGUAGE TupleSections #-}
module Game.LambdaHack.Client.AI.PickTargetM
( refreshTarget
#ifdef EXPOSE_INTERNAL
, computeTarget
#endif
) where
import Prelude ()
import Game.LambdaHack.Common.Prelude
import qualified Data.EnumMap.Lazy as LEM
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.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.ItemAspect as IA
import Game.LambdaHack.Common.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"
`swith` (aid, body, side)) ()
let !_A = assert (isNothing (btrajectory body) && not (bproj body)
`blame` "AI gets to manually move its trajectory actors"
`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{coTileSpeedup} <- getsState scops
b <- getsState $ getActorBody aid
mleader <- getsClient sleader
scondInMelee <- getsClient scondInMelee
salter <- getsClient salter
actorAspect <- getsState sactorAspect
let lalter = salter EM.! blid b
condInMelee = scondInMelee LEM.! blid b
stdRuleset = getStdRuleset cops
nearby = rnearby stdRuleset
ar = fromMaybe (error $ "" `showFailure` aid) (EM.lookup aid actorAspect)
actorMaxSk = IA.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 <- getsState $ 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 -> error $ "" `showFailure` tap
Nothing -> return Nothing
fact <- getsState $ (EM.! bfid b) . sfactionD
allFoes <- getsState $ foeRegularAssocs (bfid b) (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
condCanProject <-
condCanProjectM (EM.findWithDefault 0 AbProject actorMaxSk) aid
condEnoughGear <- condEnoughGearM aid
let condCanMelee = actorCanMelee actorAspect aid b
condHpTooLow = hpTooLow b ar
friends <- getsState $ friendRegularList (bfid b) (blid b)
let canEscape = fcanEscape (gplayer fact)
canSmell = IA.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 | IA.aAggression ar >= 2 = rangedNearby
| 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 || IA.aAggression ar >= 2)
&& chessDist (bpos body) (bpos b) < rangedNearby
&& condCanProject
targetableEnemy (aidE, body) = do
tMelee <- targetableMelee aidE body
return $! targetableRanged body || tMelee
nearbyFoes <- filterM targetableEnemy allFoes
isStairPos <- getsState $ \s lid p -> isStair lid p s
discoBenefit <- getsClient sdiscoBenefit
fleeD <- getsClient sfleeD
s <- getState
getKind <- getsState $ flip getIidKind
let desirableBagFloor bag = any (\iid ->
let Benefit{benPickup} = discoBenefit EM.! iid
in desirableItem canEscape benPickup (getKind iid)) $ EM.keys bag
desirableFloor (_, (_, bag)) = desirableBagFloor bag
focused = gearSpeed 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 (Maybe 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 $ Just $ take7 tgtpath
pickNewTarget :: m (Maybe TgtAndPath)
pickNewTarget = do
cfoes <- closestFoes nearbyFoes aid
case cfoes of
(_, (aid2, _)) : _ -> setPath $ TEnemy aid2 False
[] | condInMelee -> return Nothing
[] -> 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 $ Just $
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 <- closestUnknown aid
case upos of
Nothing -> do
modifyClient $ \cli -> cli {sexplored =
ES.insert (blid b) (sexplored cli)}
explored <- getsClient sexplored
let allExplored =
ES.size explored == EM.size dungeon
if allExplored || 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
followingWrong permit =
permit && (condInMelee
|| mleader == Just aid)
updateTgt :: TgtAndPath -> m (Maybe TgtAndPath)
updateTgt TgtAndPath{tapPath=NoPath} = pickNewTarget
updateTgt _ | EM.member aid fleeD = pickNewTarget
updateTgt tap@TgtAndPath{tapPath=AndPath{..},tapTgt} = case tapTgt of
TEnemy a permit -> do
body <- getsState $ getActorBody a
if | (condInMelee
|| not focused && not (null nearbyFoes))
&& a `notElem` map fst nearbyFoes
|| blid body /= blid b
|| actorDying body ->
pickNewTarget
| followingWrong permit -> pickNewTarget
| bpos body == pathGoal ->
return $ Just tap
| otherwise -> do
mpath <- getCachePath aid $ bpos body
case mpath of
NoPath -> pickNewTarget
AndPath{pathLen=0} -> pickNewTarget
AndPath{} -> return $ Just 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
| followingWrong permit -> pickNewTarget
| otherwise -> return $ Just 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 $ Just tap
TItem bag -> do
bag2 <- getsState $ getFloorBag lid pos
if | bag /= bag2 -> pickNewTarget
| bpos b == pos ->
setPath $ TPoint TAny lid (bpos b)
| otherwise -> return $ Just tap
TSmell ->
let lvl2 = sdungeon s EM.! lid
in if not canSmell
|| let sml = EM.findWithDefault timeZero pos (lsmell lvl2)
in sml <= ltime lvl2
then pickNewTarget
else return $ Just tap
TUnknown ->
let lvl2 = sdungeon s EM.! lid
t = lvl2 `at` pos
in if lexpl lvl2 <= lseen lvl2
|| not (isUknownSpace t)
|| condEnoughGear && tileAdj (isStairPos lid) pos
then pickNewTarget
else return $ Just tap
TKnown -> do
explored <- getsClient sexplored
let allExplored = ES.size explored == EM.size dungeon
lvl2 = sdungeon s EM.! lid
if bpos b == pos
|| isStuck
|| alterSkill < fromEnum (lalter PointArray.! pos)
|| Tile.isWalkable coTileSpeedup (lvl2 `at` pos)
&& not allExplored
then pickNewTarget
else return $ Just tap
TAny -> pickNewTarget
TVector{} -> if pathLen > 1
then return $ Just tap
else pickNewTarget
if canMove
then case oldTgtUpdatedPath of
Nothing -> pickNewTarget
Just tap -> updateTgt tap
else return $ Just $ TgtAndPath (TEnemy aid True) NoPath