module Game.LambdaHack.Client.AI.PickActorM
( pickActorToMove, setTargetFromTactics
) where
import Prelude ()
import Game.LambdaHack.Common.Prelude
import qualified Data.EnumMap.Lazy as LEM
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.Frequency
import qualified Game.LambdaHack.Common.ItemAspect as IA
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 Game.LambdaHack.Common.Time
import Game.LambdaHack.Content.ModeKind
pickActorToMove :: MonadClient m => Maybe ActorId -> m ActorId
{-# INLINE pickActorToMove #-}
pickActorToMove maidToAvoid = do
actorAspect <- getsState sactorAspect
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 $ filter (isNothing . btrajectory . snd)
. fidActorRegularAssocs side arena
let pickOld = do
void $ refreshTarget (oldAid, oldBody)
return oldAid
case ours of
_ |
snd (autoDungeonLevel fact) && isNothing maidToAvoid
-> pickOld
[] -> error $ "" `showFailure` (oldAid, oldBody)
[_] -> pickOld
_ -> do
let refresh aidBody = do
mtgt <- refreshTarget aidBody
return (aidBody, mtgt)
goodGeneric (_, Nothing) = Nothing
goodGeneric (_, Just TgtAndPath{tapPath=NoPath}) = Nothing
goodGeneric ((aid, b), Just tgt) = case maidToAvoid of
Nothing | not (aid == oldAid && waitedLastTurn b) ->
Just ((aid, b), tgt)
Just aidToAvoid | aid /= aidToAvoid ->
Just ((aid, b), tgt)
_ -> Nothing
oursTgtRaw <- mapM refresh ours
scondInMelee <- getsClient scondInMelee
fleeD <- getsClient sfleeD
let oursTgt = mapMaybe goodGeneric oursTgtRaw
actorVulnerable ((aid, body), _) = do
let condInMelee = scondInMelee LEM.! blid body
ar = fromMaybe (error $ "" `showFailure` aid)
(EM.lookup aid actorAspect)
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 ar)
condCanMelee = actorCanMelee actorAspect aid body
condThreat n = not $ null $ takeWhile ((<= n) . fst) threatDistL
threatAdj = takeWhile ((== 1) . fst) threatDistL
condManyThreatAdj = length threatAdj >= 2
condFastThreatAdj =
any (\(_, (aid2, _)) ->
let ar2 = actorAspect EM.! aid2
in gearSpeed ar2 > speed1_5)
threatAdj
heavilyDistressed =
deltaSerious (bcalmDelta body)
actorShines = IA.aShine ar > 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=NoPath }) =
return False
actorHearning (_, TgtAndPath{ tapTgt=TPoint TEnemyPos{} _ _
, tapPath=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
mildlyDistressed = deltaMild (bcalmDelta b)
return $! mildlyDistressed
&& 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 actorAspect aid body
targetTEnemy (_, TgtAndPath{tapTgt=TEnemy _ permit}) =
not permit
targetTEnemy
( (_, b)
, TgtAndPath{tapTgt=TPoint (TEnemyPos _ permit) lid _} ) =
lid == blid b && not permit
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=
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
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=NoPath}) =
100 + if aid == oldAid then 1 else 0
overheadOurs abt@( (aid, b)
, TgtAndPath{tapPath=AndPath{pathLen=d,pathGoal}} ) =
let maxSpread = 3 + length ours
pDist p = minimum [ chessDist (bpos b2) p
| (aid2, b2) <- ours, aid2 /= aid]
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 ab =
let ov = 200 - overheadOurs ab
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
let condInMelee = scondInMelee LEM.! blid b
when (ftactic (gplayer fact) `elem` [TFollow, 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
scondInMelee <- getsClient scondInMelee
let condInMelee = scondInMelee LEM.! blid oldBody
let side = bfid oldBody
arena = blid oldBody
fact <- getsState $ (EM.! side) . sfactionD
let explore = void $ refreshTarget (oldAid, oldBody)
setPath mtgt = case mtgt of
Nothing -> return False
Just TgtAndPath{tapTgt} -> do
tap <- createPath oldAid tapTgt
case tap of
TgtAndPath{tapPath=NoPath} -> return False
_ -> do
modifyClient $ \cli ->
cli {stargetD = EM.insert oldAid tap (stargetD cli)}
return True
follow = case mleader of
Nothing -> 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
let enemyPath = Just TgtAndPath{ tapTgt = TEnemy leader True
, tapPath = NoPath }
unless tgtPathSet $ do
enemyPathSet <- setPath enemyPath
unless enemyPathSet
explore
case ftactic $ gplayer fact of
TExplore -> explore
TFollow -> follow
TFollowNoItems -> follow
TMeleeAndRanged -> explore
TMeleeAdjacent -> explore
TBlock -> return ()
TRoam -> explore
TPatrol -> explore