module Game.LambdaHack.Client.AI.PickActorM
( pickActorToMove, setTargetFromTactics
) where
import Prelude ()
import Game.LambdaHack.Core.Prelude
import qualified Data.EnumMap.Strict as EM
import Data.Ratio
import Game.LambdaHack.Client.AI.ConditionM
import Game.LambdaHack.Client.AI.PickTargetM
import Game.LambdaHack.Client.Bfs
import Game.LambdaHack.Client.BfsM
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.Misc
import Game.LambdaHack.Common.MonadStateRead
import Game.LambdaHack.Common.Point
import Game.LambdaHack.Common.State
import Game.LambdaHack.Common.Time
import Game.LambdaHack.Common.Types
import Game.LambdaHack.Content.ModeKind
import Game.LambdaHack.Core.Frequency
import Game.LambdaHack.Core.Random
import qualified Game.LambdaHack.Definition.Ability as Ability
pickActorToMove :: MonadClient m => Maybe ActorId -> m ActorId
{-# INLINE pickActorToMove #-}
pickActorToMove maidToAvoid = do
actorMaxSkills <- getsState sactorMaxSkills
mleader <- getsClient sleader
let oldAid = fromMaybe (error $ "" `showFailure` maidToAvoid) mleader
oldBody <- getsState $ getActorBody oldAid
let side = bfid oldBody
arena = blid oldBody
fact <- getsState $ (EM.! side) . sfactionD
ours <- getsState $ fidActorRegularAssocs side arena
let pickOld = do
void $ refreshTarget (oldAid, oldBody)
return oldAid
oursNotSleeping = filter (\(_, b) -> bwatch b /= WSleep) ours
case oursNotSleeping of
_ |
snd (autoDungeonLevel fact) && isNothing maidToAvoid -> pickOld
[] -> pickOld
[(aidNotSleeping, bNotSleeping)] -> do
void $ refreshTarget (aidNotSleeping, bNotSleeping)
return aidNotSleeping
_ -> do
let refresh aidBody = do
mtgt <- refreshTarget aidBody
return (aidBody, mtgt)
oursTgtRaw <- mapM refresh oursNotSleeping
fleeD <- getsClient sfleeD
let goodGeneric (_, Nothing) = Nothing
goodGeneric (_, Just TgtAndPath{tapPath=Nothing}) = Nothing
goodGeneric ((aid, b), Just tgt) = case maidToAvoid of
Nothing | not (aid == oldAid && actorWaits b) ->
Just ((aid, b), tgt)
Just aidToAvoid | aid /= aidToAvoid ->
Just ((aid, b), tgt)
_ -> Nothing
oursTgt = mapMaybe goodGeneric oursTgtRaw
actorVulnerable ((aid, body), _) = do
condInMelee <- condInMeleeM $ blid body
let actorMaxSk = actorMaxSkills EM.! aid
threatDistL <- getsState $ meleeThreatDistList aid
(fleeL, _) <- fleeList aid
condSupport1 <- condSupport 1 aid
condSupport3 <- condSupport 3 aid
condSolo <- condSoloM aid
canDeAmbientL <- getsState $ canDeAmbientList body
let condCanFlee = not (null fleeL)
speed1_5 = speedScale (3%2) (gearSpeed actorMaxSk)
condCanMelee = actorCanMelee actorMaxSkills aid body
condThreat n = not $ null $ takeWhile ((<= n) . fst) threatDistL
threatAdj = takeWhile ((== 1) . fst) threatDistL
condManyThreatAdj = length threatAdj >= 2
condFastThreatAdj =
any (\(_, (aid2, _)) ->
let actorMaxSk2 = actorMaxSkills EM.! aid2
in gearSpeed actorMaxSk2 > speed1_5)
threatAdj
heavilyDistressed =
deltasSerious (bcalmDelta body)
actorShines = Ability.getSk Ability.SkShine actorMaxSk > 0
aCanDeLightL | actorShines = []
| otherwise = canDeAmbientL
canFleeFromLight =
not $ null $ aCanDeLightL `intersect` map snd fleeL
return $!
not condFastThreatAdj
&& if | condThreat 1 ->
not condCanMelee
|| condManyThreatAdj && not condSupport1 && not condSolo
| not condInMelee
&& (condThreat 2 || condThreat 5 && canFleeFromLight) ->
not condCanMelee
|| not condSupport3 && not condSolo
&& not heavilyDistressed
| otherwise ->
not condInMelee
&& heavilyDistressed
&& not (EM.member aid fleeD)
&& condCanFlee
actorFled ((aid, _), _) = EM.member aid fleeD
actorHearning (_, TgtAndPath{ tapTgt=TPoint TEnemyPos{} _ _
, tapPath=Nothing }) =
return False
actorHearning (_, TgtAndPath{ tapTgt=TPoint TEnemyPos{} _ _
, tapPath=Just AndPath{pathLen} })
| pathLen <= 2 =
return False
actorHearning ((_aid, b), _) = do
allFoes <- getsState $ foeRegularList side (blid b)
let closeFoes = filter ((<= 3) . chessDist (bpos b) . bpos) allFoes
actorHears = deltasHears (bcalmDelta b)
return $! actorHears
&& null closeFoes
actorMeleeing ((aid, _), _) = condAnyFoeAdjM aid
(oursVulnerable, oursSafe) <- partitionM actorVulnerable oursTgt
let (oursFled, oursNotFled) = partition actorFled oursSafe
(oursMeleeing, oursNotMeleeing) <- partitionM actorMeleeing oursNotFled
(oursHearing, oursNotHearing) <- partitionM actorHearning oursNotMeleeing
let actorRanged ((aid, body), _) =
not $ actorCanMelee actorMaxSkills aid body
targetTEnemy (_, TgtAndPath{tapTgt=TEnemy _}) = True
targetTEnemy
( (_, b)
, TgtAndPath{tapTgt=TPoint (TEnemyPos _) lid _} ) =
lid == blid b
targetTEnemy _ = False
actorNoSupport ((aid, _), _) = do
threatDistL <- getsState $ meleeThreatDistList aid
condSupport2 <- condSupport 2 aid
let condThreat n = not $ null $ takeWhile ((<= n) . fst) threatDistL
return $! condThreat 5 && not condSupport2
(oursRanged, oursNotRanged) = partition actorRanged oursNotHearing
(oursTEnemyAll, oursOther) = partition targetTEnemy oursNotRanged
notSwapReady abt@((_, b), _)
(ab2, Just t2@TgtAndPath{tapPath=
Just AndPath{pathList=q : _}}) =
let source = bpos b
tenemy = targetTEnemy abt
tenemy2 = targetTEnemy (ab2, t2)
in not (q == source
|| tenemy && not tenemy2)
notSwapReady _ _ = True
targetBlocked abt@((aid, _), TgtAndPath{tapPath}) = case tapPath of
Just AndPath{pathList= q : _} ->
any (\abt2@((aid2, body2), _) ->
aid2 /= aid
&& bpos body2 == q
&& notSwapReady abt abt2)
oursTgtRaw
_ -> False
(oursTEnemyBlocked, oursTEnemy) =
partition targetBlocked oursTEnemyAll
(oursNoSupportRaw, oursSupportRaw) <-
if length oursTEnemy <= 2
then return ([], oursTEnemy)
else partitionM actorNoSupport oursTEnemy
let (oursNoSupport, oursSupport) =
if length oursSupportRaw <= 1
then ([], oursTEnemy)
else (oursNoSupportRaw, oursSupportRaw)
(oursBlocked, oursPos) =
partition targetBlocked $ oursRanged ++ oursOther
overheadOurs :: ((ActorId, Actor), TgtAndPath) -> Int
overheadOurs ((aid, _), TgtAndPath{tapPath=Nothing}) =
100 + if aid == oldAid then 1 else 0
overheadOurs
abt@( (aid, b)
, TgtAndPath{tapPath=Just AndPath{pathLen=d,pathGoal}} ) =
let maxSpread = 3 + length oursNotSleeping
lDist p = [ chessDist (bpos b2) p
| (aid2, b2) <- oursNotSleeping, aid2 /= aid]
pDist p = let ld = lDist p
in assert (not $ null ld) $ minimum ld
aidDist = pDist (bpos b)
diffDist = pDist pathGoal - aidDist
sign = if diffDist <= 0 then -1 else 1
formationValue =
sign * (abs diffDist `max` maxSpread)
* (aidDist `max` maxSpread) ^ (2 :: Int)
fightValue | targetTEnemy abt =
- fromEnum (bhp b `div` (10 * oneM))
| otherwise = 0
in formationValue `div` 3 + fightValue
+ (if targetBlocked abt then 5 else 0)
+ (case d of
0 -> -400
1 -> -200
_ -> if d < 8 then d `div` 4 else 2 + d `div` 10)
+ (if aid == oldAid then 1 else 0)
positiveOverhead sk =
let ov = 200 - overheadOurs sk
in if ov <= 0 then 1 else ov
candidates = [ oursVulnerable
, oursSupport
, oursNoSupport
, oursPos
, oursFled
, oursMeleeing ++ oursTEnemyBlocked
, oursHearing
, oursBlocked
]
case filter (not . null) candidates of
l : _ -> do
let freq = toFreq "candidates for AI leader"
$ map (positiveOverhead &&& id) l
((aid, b), _) <- rndToAction $ frequency freq
s <- getState
modifyClient $ updateLeader aid s
condInMelee <- condInMeleeM $ blid b
when (ftactic (gplayer fact)
`elem` [Ability.TFollow, Ability.TFollowNoItems]
&& not condInMelee) $
void $ refreshTarget (aid, b)
return aid
_ -> return oldAid
setTargetFromTactics :: MonadClient m => ActorId -> m ()
{-# INLINE setTargetFromTactics #-}
setTargetFromTactics oldAid = do
mleader <- getsClient sleader
let !_A = assert (mleader /= Just oldAid) ()
oldBody <- getsState $ getActorBody oldAid
moldTgt <- getsClient $ EM.lookup oldAid . stargetD
condInMelee <- condInMeleeM $ blid oldBody
let side = bfid oldBody
arena = blid oldBody
fact <- getsState $ (EM.! side) . sfactionD
let explore = void $ refreshTarget (oldAid, oldBody)
setPath mtgt = case (mtgt, moldTgt) of
(Nothing, _) -> return False
( Just TgtAndPath{tapTgt=leaderTapTgt},
Just TgtAndPath{tapTgt=oldTapTgt,tapPath=Just oldTapPath} )
| leaderTapTgt == oldTapTgt
&& bpos oldBody == pathSource oldTapPath -> do
void $ refreshTarget (oldAid, oldBody)
return True
(Just TgtAndPath{tapTgt=leaderTapTgt}, _) -> do
tap <- createPath oldAid leaderTapTgt
case tap of
TgtAndPath{tapPath=Nothing} -> return False
_ -> do
modifyClient $ \cli ->
cli {stargetD = EM.insert oldAid tap (stargetD cli)}
return True
follow = case mleader of
Nothing -> explore
_ | bwatch oldBody == WSleep ->
explore
Just leader -> do
onLevel <- getsState $ memActor leader arena
if not onLevel || condInMelee then explore
else do
mtgt <- getsClient $ EM.lookup leader . stargetD
tgtPathSet <- setPath mtgt
unless tgtPathSet $ do
let nonEnemyPath = Just TgtAndPath { tapTgt = TNonEnemy leader
, tapPath = Nothing }
nonEnemyPathSet <- setPath nonEnemyPath
unless nonEnemyPathSet
explore
case ftactic $ gplayer fact of
Ability.TExplore -> explore
Ability.TFollow -> follow
Ability.TFollowNoItems -> follow
Ability.TMeleeAndRanged -> explore
Ability.TMeleeAdjacent -> explore
Ability.TBlock -> return ()
Ability.TRoam -> explore
Ability.TPatrol -> explore