module Game.LambdaHack.Client.AI.PickActionM
( pickAction
#ifdef EXPOSE_INTERNAL
, actionStrategy, waitBlockNow, yellNow
, pickup, equipItems, yieldUnneeded, unEquipItems
, groupByEqpSlot, bestByEqpSlot, harmful, meleeBlocker, meleeAny
, trigger, projectItem, ApplyItemGroup, applyItem, flee
, displaceFoe, displaceBlocker, displaceTgt
, chase, moveTowards, moveOrRunAid
#endif
) where
import Prelude ()
import Game.LambdaHack.Core.Prelude
import Data.Either
import qualified Data.EnumMap.Strict as EM
import qualified Data.EnumSet as ES
import Data.Function
import Data.Ratio
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.Request
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 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.ReqFailure
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 qualified Game.LambdaHack.Content.ItemKind as IK
import Game.LambdaHack.Content.ModeKind
import Game.LambdaHack.Core.Frequency
import Game.LambdaHack.Core.Random
import Game.LambdaHack.Definition.Ability
import qualified Game.LambdaHack.Definition.Ability as Ability
import Game.LambdaHack.Definition.Defs
pickAction :: MonadClient m => ActorId -> Bool -> m RequestTimed
{-# INLINE pickAction #-}
pickAction aid retry = do
side <- getsClient sside
body <- getsState $ getActorBody aid
let !_A = assert (bfid body == side
`blame` "AI tries to move enemy actor"
`swith` (aid, bfid body, side)) ()
let !_A = assert (not (bproj body)
`blame` "AI gets to manually move its projectiles"
`swith` (aid, bfid body, side)) ()
stratAction <- actionStrategy aid retry
let bestAction = bestVariant stratAction
!_A = assert (not (nullFreq bestAction)
`blame` "no AI action for actor"
`swith` (stratAction, aid, body)) ()
rndToAction $ frequency bestAction
actionStrategy :: forall m. MonadClient m
=> ActorId -> Bool -> m (Strategy RequestTimed)
{-# INLINE actionStrategy #-}
actionStrategy aid retry = do
mleader <- getsClient sleader
body <- getsState $ getActorBody aid
condInMelee <- condInMeleeM $ blid body
condAimEnemyPresent <- condAimEnemyPresentM aid
condAimEnemyNoMelee <- condAimEnemyNoMeleeM aid
condAimEnemyRemembered <- condAimEnemyRememberedM aid
condAimNonEnemyPresent <- condAimNonEnemyPresentM aid
condAimCrucial <- condAimCrucialM aid
condAnyFoeAdj <- condAnyFoeAdjM aid
threatDistL <- getsState $ meleeThreatDistList aid
(fleeL, badVic) <- fleeList aid
modifyClient $ \cli -> cli {sfleeD = EM.delete aid (sfleeD cli)}
condSupport1 <- condSupport 1 aid
condSupport3 <- condSupport 3 aid
condSolo <- condSoloM aid
canDeAmbientL <- getsState $ canDeAmbientList body
actorSk <- currentSkillsClient aid
condCanProject <- condCanProjectM (getSk SkProject actorSk) aid
condAdjTriggerable <- condAdjTriggerableM aid
condBlocksFriends <- condBlocksFriendsM aid
condNoEqpWeapon <- condNoEqpWeaponM aid
condEnoughGear <- condEnoughGearM aid
condFloorWeapon <- condFloorWeaponM aid
condDesirableFloorItem <- condDesirableFloorItemM aid
condTgtNonmovingEnemy <- condTgtNonmovingEnemyM aid
explored <- getsClient sexplored
actorMaxSkills <- getsState sactorMaxSkills
friends <- getsState $ friendRegularList (bfid body) (blid body)
let anyFriendOnLevelAwake = any (\b ->
bwatch b /= WSleep && bpos b /= bpos body) friends
actorMaxSk = actorMaxSkills EM.! aid
prefersSleepWhenAwake = case bwatch body of
WSleep -> Ability.getSk Ability.SkMoveItem actorMaxSk <= -10
_ -> prefersSleep actorMaxSk
mayFallAsleep = not condAimEnemyRemembered
&& mayContinueSleep
&& canSleep actorSk
mayContinueSleep = not condAimEnemyPresent
&& not (hpFull body actorSk)
&& not uneasy
&& not condAnyFoeAdj
&& (anyFriendOnLevelAwake
|| prefersSleepWhenAwake)
dozes = case bwatch body of
WWait n -> n > 0
_ -> False
&& mayFallAsleep
&& Just aid /= mleader
lidExplored = ES.member (blid body) explored
panicFleeL = fleeL ++ badVic
condHpTooLow = hpTooLow body actorMaxSk
heavilyDistressed =
deltasSerious (bcalmDelta body)
condNotCalmEnough = not (calmEnough body actorMaxSk)
uneasy = heavilyDistressed || condNotCalmEnough
speed1_5 = speedScale (3%2) (gearSpeed actorMaxSk)
condCanMelee = actorCanMelee actorMaxSkills aid body
condMeleeBad = not ((condSolo || condSupport1) && condCanMelee)
condThreat n = not $ null $ takeWhile ((<= n) . fst) threatDistL
threatAdj = takeWhile ((== 1) . fst) threatDistL
condManyThreatAdj = length threatAdj >= 2
condFastThreatAdj =
any (\(_, (aid2, _)) ->
let ar2 = actorMaxSkills EM.! aid2
in gearSpeed ar2 > speed1_5)
threatAdj
actorShines = Ability.getSk SkShine actorMaxSk > 0
aCanDeLightL | actorShines = []
| otherwise = canDeAmbientL
aCanDeLight = not $ null aCanDeLightL
canFleeFromLight = not $ null $ aCanDeLightL `intersect` map snd fleeL
abInMaxSkill sk = getSk sk actorMaxSk > 0
runSkills = [SkMove, SkDisplace]
stratToFreq :: Int
-> m (Strategy RequestTimed)
-> m (Frequency RequestTimed)
stratToFreq scale mstrat = do
st <- mstrat
return $! if scale == 0
then mzero
else scaleFreq scale $ bestVariant st
prefix, suffix:: [([Skill], m (Strategy RequestTimed), Bool)]
prefix =
[ ( [SkApply]
, applyItem aid ApplyFirstAid
, not condAnyFoeAdj && condHpTooLow)
, ( [SkAlter]
, trigger aid ViaStairs
, condAdjTriggerable && not condAimEnemyPresent
&& ((condNotCalmEnough || condHpTooLow)
&& condMeleeBad && condThreat 1
|| (lidExplored || condEnoughGear)
&& not condDesirableFloorItem) )
, ( [SkDisplace]
, displaceFoe aid
, condAnyFoeAdj && condBlocksFriends)
, ( [SkMoveItem]
, pickup aid True
, condNoEqpWeapon
&& condFloorWeapon && not condHpTooLow
&& abInMaxSkill SkMelee )
, ( [SkAlter]
, trigger aid ViaEscape
, condAdjTriggerable && not condAimEnemyPresent
&& not condDesirableFloorItem )
, ( runSkills
, flee aid fleeL
,
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
| condThreat 5
|| not condInMelee && condAimEnemyNoMelee && condCanMelee ->
False
| otherwise ->
not condInMelee
&& heavilyDistressed
&& (not condCanProject || canFleeFromLight) )
, ( [SkMelee]
, meleeBlocker aid
, condAnyFoeAdj
|| not (abInMaxSkill SkDisplace)
&& condAimEnemyPresent )
, ( [SkAlter]
, trigger aid ViaNothing
, not condInMelee
&& condAdjTriggerable && not condAimEnemyPresent )
, ( [SkDisplace]
, displaceBlocker aid retry
, retry || not condDesirableFloorItem )
, ( [SkMelee]
, meleeAny aid
, condAnyFoeAdj )
, ( runSkills
, flee aid panicFleeL
, condAnyFoeAdj )
]
distant :: [([Skill], m (Frequency RequestTimed), Bool)]
distant =
[ ( [SkMoveItem]
, stratToFreq (if condInMelee then 2 else 20000)
$ yieldUnneeded aid
, True )
, ( [SkMoveItem]
, stratToFreq 1
$ equipItems aid
, not (condInMelee
|| condDesirableFloorItem
|| uneasy) )
, ( [SkProject]
, stratToFreq (if condTgtNonmovingEnemy then 20 else 3)
$ projectItem aid
, condAimEnemyPresent && not condInMelee )
, ( [SkApply]
, stratToFreq 1
$ applyItem aid ApplyAll
, condAimEnemyPresent || condThreat 9 )
, ( runSkills
, stratToFreq (if | condInMelee ->
400
| not condAimEnemyPresent ->
2
| otherwise ->
20)
$ chase aid (not condInMelee
&& (condThreat 12 || heavilyDistressed)
&& aCanDeLight) retry
, condCanMelee
&& (if condInMelee then condAimEnemyPresent
else (condAimEnemyPresent
|| condAimEnemyRemembered
|| condAimNonEnemyPresent)
&& (not (condThreat 2)
|| heavilyDistressed
|| not condMeleeBad)
&& not condDesirableFloorItem) )
]
suffix =
[ ( [SkMoveItem]
, pickup aid False
, not condInMelee && not dozes )
, ( [SkMoveItem]
, unEquipItems aid
, not condInMelee && not dozes )
, ( [SkWait]
, waitBlockNow
, bwatch body `notElem` [WSleep, WWake]
&& mayFallAsleep
&& prefersSleep actorMaxSk
&& not condAimCrucial)
, ( runSkills
, chase aid (not condInMelee
&& heavilyDistressed
&& aCanDeLight) retry
, not dozes
&& if condInMelee
then condCanMelee && condAimEnemyPresent
else not (condThreat 2) || not condMeleeBad )
]
fallback =
[ ( [SkWait]
, case bwatch body of
WSleep -> yellNow
_ -> waitBlockNow
, True )
, ( runSkills
, chase aid (not condInMelee
&& heavilyDistressed
&& aCanDeLight) True
, not condInMelee || condCanMelee && condAimEnemyPresent )
, ( [SkDisplace]
, displaceBlocker aid True
, True )
, ( []
, yellNow
, True )
]
let abInSkill sk = getSk sk actorSk > 0
checkAction :: ([Skill], m a, Bool) -> Bool
checkAction (abts, _, cond) = (null abts || any abInSkill abts) && cond
sumS abAction = do
let as = filter checkAction abAction
strats <- mapM (\(_, m, _) -> m) as
return $! msum strats
sumF abFreq = do
let as = filter checkAction abFreq
strats <- mapM (\(_, m, _) -> m) as
return $! msum strats
combineWeighted as = liftFrequency <$> sumF as
sumPrefix <- sumS prefix
comDistant <- combineWeighted distant
sumSuffix <- sumS suffix
sumFallback <- sumS fallback
return $! if bwatch body == WSleep
&& abInSkill SkWait
&& mayContinueSleep
then returN "sleep" ReqWait
else sumPrefix .| comDistant .| sumSuffix .| sumFallback
waitBlockNow :: MonadClient m => m (Strategy RequestTimed)
waitBlockNow = return $! returN "wait" ReqWait
yellNow :: MonadClient m => m (Strategy RequestTimed)
yellNow = return $! returN "yell" ReqYell
pickup :: MonadClient m => ActorId -> Bool -> m (Strategy RequestTimed)
pickup aid onlyWeapon = do
benItemL <- benGroundItems aid
b <- getsState $ getActorBody aid
actorMaxSk <- getsState $ getActorMaxSkills aid
let calmE = calmEnough b actorMaxSk
isWeapon (_, _, _, itemFull, _) =
IA.checkFlag Ability.Meleeable $ aspectRecordFull itemFull
filterWeapon | onlyWeapon = filter isWeapon
| otherwise = id
prepareOne (oldN, l4)
(Benefit{benInEqp}, _, iid, itemFull, (itemK, _)) =
let prep newN toCStore = (newN, (iid, itemK, CGround, toCStore) : l4)
n = oldN + itemK
arItem = aspectRecordFull itemFull
in if | calmE && IA.goesIntoSha arItem && not onlyWeapon ->
prep oldN CSha
| benInEqp && eqpOverfull b n ->
if onlyWeapon then (oldN, l4)
else prep oldN (if calmE then CSha else CInv)
| benInEqp ->
prep n CEqp
| not onlyWeapon ->
prep oldN CInv
| otherwise -> (oldN, l4)
(_, prepared) = foldl' prepareOne (0, []) $ filterWeapon benItemL
return $! if null prepared then reject
else returN "pickup" $ ReqMoveItems prepared
equipItems :: MonadClient m => ActorId -> m (Strategy RequestTimed)
equipItems aid = do
body <- getsState $ getActorBody aid
actorMaxSk <- getsState $ getActorMaxSkills aid
let calmE = calmEnough body actorMaxSk
eqpAssocs <- getsState $ kitAssocs aid [CEqp]
invAssocs <- getsState $ kitAssocs aid [CInv]
shaAssocs <- getsState $ kitAssocs aid [CSha]
condShineWouldBetray <- condShineWouldBetrayM aid
condAimEnemyPresent <- condAimEnemyPresentM aid
discoBenefit <- getsClient sdiscoBenefit
let improve :: CStore
-> (Int, [(ItemId, Int, CStore, CStore)])
-> ( [(Int, (ItemId, ItemFullKit))]
, [(Int, (ItemId, ItemFullKit))] )
-> (Int, [(ItemId, Int, CStore, CStore)])
improve fromCStore (oldN, l4) (bestInv, bestEqp) =
let n = 1 + oldN
in case (bestInv, bestEqp) of
((_, (iidInv, _)) : _, []) | not (eqpOverfull body n) ->
(n, (iidInv, 1, fromCStore, CEqp) : l4)
((vInv, (iidInv, _)) : _, (vEqp, _) : _)
| vInv > vEqp && not (eqpOverfull body n) ->
(n, (iidInv, 1, fromCStore, CEqp) : l4)
_ -> (oldN, l4)
heavilyDistressed =
deltasSerious (bcalmDelta body)
filterNeeded (_, (itemFull, _)) =
not $ hinders condShineWouldBetray condAimEnemyPresent
heavilyDistressed (not calmE) actorMaxSk itemFull
bestThree = bestByEqpSlot discoBenefit
(filter filterNeeded eqpAssocs)
(filter filterNeeded invAssocs)
(filter filterNeeded shaAssocs)
bEqpInv = foldl' (improve CInv) (0, [])
$ map (\(eqp, inv, _) -> (inv, eqp)) bestThree
bEqpBoth | calmE =
foldl' (improve CSha) bEqpInv
$ map (\(eqp, _, sha) -> (sha, eqp)) bestThree
| otherwise = bEqpInv
(_, prepared) = bEqpBoth
return $! if null prepared
then reject
else returN "equipItems" $ ReqMoveItems prepared
yieldUnneeded :: MonadClient m => ActorId -> m (Strategy RequestTimed)
yieldUnneeded aid = do
body <- getsState $ getActorBody aid
actorMaxSk <- getsState $ getActorMaxSkills aid
let calmE = calmEnough body actorMaxSk
eqpAssocs <- getsState $ kitAssocs aid [CEqp]
condShineWouldBetray <- condShineWouldBetrayM aid
condAimEnemyPresent <- condAimEnemyPresentM aid
discoBenefit <- getsClient sdiscoBenefit
let heavilyDistressed =
deltasSerious (bcalmDelta body)
csha = if calmE then CSha else CInv
yieldSingleUnneeded (iidEqp, (itemEqp, (itemK, _))) =
if | harmful discoBenefit iidEqp ->
[(iidEqp, itemK, CEqp, CInv)]
| hinders condShineWouldBetray condAimEnemyPresent
heavilyDistressed (not calmE) actorMaxSk itemEqp ->
[(iidEqp, itemK, CEqp, csha)]
| otherwise -> []
yieldAllUnneeded = concatMap yieldSingleUnneeded eqpAssocs
return $! if null yieldAllUnneeded
then reject
else returN "yieldUnneeded" $ ReqMoveItems yieldAllUnneeded
unEquipItems :: MonadClient m => ActorId -> m (Strategy RequestTimed)
unEquipItems aid = do
body <- getsState $ getActorBody aid
actorMaxSk <- getsState $ getActorMaxSkills aid
let calmE = calmEnough body actorMaxSk
eqpAssocs <- getsState $ kitAssocs aid [CEqp]
invAssocs <- getsState $ kitAssocs aid [CInv]
shaAssocs <- getsState $ kitAssocs aid [CSha]
condShineWouldBetray <- condShineWouldBetrayM aid
condAimEnemyPresent <- condAimEnemyPresentM aid
discoBenefit <- getsClient sdiscoBenefit
let improve :: CStore -> ( [(Int, (ItemId, ItemFullKit))]
, [(Int, (ItemId, ItemFullKit))] )
-> [(ItemId, Int, CStore, CStore)]
improve fromCStore (bestSha, bestEOrI) =
case bestEOrI of
((vEOrI, (iidEOrI, bei)) : _) | getK bei > 1
&& betterThanSha vEOrI bestSha ->
[(iidEOrI, getK bei - 1, fromCStore, CSha)]
(_ : (vEOrI, (iidEOrI, bei)) : _) | betterThanSha vEOrI bestSha ->
[(iidEOrI, getK bei, fromCStore, CSha)]
((vEOrI, (_, _)) : _) | fromCStore == CEqp
&& eqpOverfull body 1
&& worseThanSha vEOrI bestSha ->
[(fst $ snd $ last bestEOrI, 1, fromCStore, CSha)]
_ -> []
getK (_, (itemK, _)) = itemK
betterThanSha _ [] = True
betterThanSha vEOrI ((vSha, _) : _) = vEOrI > vSha
worseThanSha _ [] = False
worseThanSha vEOrI ((vSha, _) : _) = vEOrI < vSha
heavilyDistressed =
deltasSerious (bcalmDelta body)
filterNeeded (_, (itemFull, _)) =
not $ hinders condShineWouldBetray condAimEnemyPresent
heavilyDistressed (not calmE) actorMaxSk itemFull
bestThree = bestByEqpSlot discoBenefit eqpAssocs invAssocs
(filter filterNeeded shaAssocs)
bInvSha = concatMap
(improve CInv . (\(_, inv, sha) -> (sha, inv))) bestThree
bEqpSha = concatMap
(improve CEqp . (\(eqp, _, sha) -> (sha, eqp))) bestThree
prepared = if calmE then bInvSha ++ bEqpSha else []
return $! if null prepared
then reject
else returN "unEquipItems" $ ReqMoveItems prepared
groupByEqpSlot :: [(ItemId, ItemFullKit)]
-> EM.EnumMap EqpSlot [(ItemId, ItemFullKit)]
groupByEqpSlot is =
let f (iid, itemFullKit) =
let arItem = aspectRecordFull $ fst itemFullKit
in case IA.aEqpSlot arItem of
Nothing -> Nothing
Just es -> Just (es, [(iid, itemFullKit)])
withES = mapMaybe f is
in EM.fromListWith (++) withES
bestByEqpSlot :: DiscoveryBenefit
-> [(ItemId, ItemFullKit)]
-> [(ItemId, ItemFullKit)]
-> [(ItemId, ItemFullKit)]
-> [( [(Int, (ItemId, ItemFullKit))]
, [(Int, (ItemId, ItemFullKit))]
, [(Int, (ItemId, ItemFullKit))] )]
bestByEqpSlot discoBenefit eqpAssocs invAssocs shaAssocs =
let eqpMap = EM.map (\g -> (g, [], [])) $ groupByEqpSlot eqpAssocs
invMap = EM.map (\g -> ([], g, [])) $ groupByEqpSlot invAssocs
shaMap = EM.map (\g -> ([], [], g)) $ groupByEqpSlot shaAssocs
appendThree (g1, g2, g3) (h1, h2, h3) = (g1 ++ h1, g2 ++ h2, g3 ++ h3)
eqpInvShaMap = EM.unionsWith appendThree [eqpMap, invMap, shaMap]
bestSingle = strongestSlot discoBenefit
bestThree eqpSlot (g1, g2, g3) = (bestSingle eqpSlot g1,
bestSingle eqpSlot g2,
bestSingle eqpSlot g3)
in EM.elems $ EM.mapWithKey bestThree eqpInvShaMap
harmful :: DiscoveryBenefit -> ItemId -> Bool
harmful discoBenefit iid =
not $ benInEqp $ discoBenefit EM.! iid
meleeBlocker :: MonadClient m => ActorId -> m (Strategy RequestTimed)
meleeBlocker aid = do
b <- getsState $ getActorBody aid
actorMaxSk <- getsState $ getActorMaxSkills aid
fact <- getsState $ (EM.! bfid b) . sfactionD
actorSk <- currentSkillsClient aid
mtgtMPath <- getsClient $ EM.lookup aid . stargetD
case mtgtMPath of
Just TgtAndPath{ tapTgt=TEnemy{}
, tapPath=Just AndPath{pathList=q : _, pathGoal} }
| q == pathGoal -> return reject
Just TgtAndPath{tapPath=Just AndPath{pathList=q : _, pathGoal}} -> do
lvl <- getLevel (blid b)
let maim | adjacent (bpos b) pathGoal = Just pathGoal
| adjacent (bpos b) q = Just q
| otherwise = Nothing
lBlocker = case maim of
Nothing -> []
Just aim -> posToAidsLvl aim lvl
case lBlocker of
aid2 : _ -> do
body2 <- getsState $ getActorBody aid2
actorMaxSk2 <- getsState $ getActorMaxSkills aid2
if | actorDying body2
|| bproj body2
&& getSk SkDisplace actorSk > 0 ->
return reject
| isFoe (bfid b) fact (bfid body2)
|| isFriend (bfid b) fact (bfid body2)
&& getSk SkDisplace actorSk <= 0
&& getSk SkMove actorSk > 0
&& 3 * bhp body2 < bhp b
&& gearSpeed actorMaxSk2 <= gearSpeed actorMaxSk -> do
mel <- maybeToList <$> pickWeaponClient aid aid2
return $! liftFrequency $ uniformFreq "melee in the way" mel
| otherwise -> return reject
[] -> return reject
_ -> return reject
meleeAny :: MonadClient m => ActorId -> m (Strategy RequestTimed)
meleeAny aid = do
b <- getsState $ getActorBody aid
fact <- getsState $ (EM.! bfid b) . sfactionD
adjBigAssocs <- getsState $ adjacentBigAssocs b
let foe (_, b2) = isFoe (bfid b) fact (bfid b2) && bhp b2 > 0
adjFoes = map fst $ filter foe adjBigAssocs
btarget <- getsClient $ getTarget aid
mtargets <- case btarget of
Just (TEnemy aid2) -> do
b2 <- getsState $ getActorBody aid2
return $! if adjacent (bpos b2) (bpos b) && foe (aid2, b2)
then Just [aid2]
else Nothing
_ -> return Nothing
let adjTargets = fromMaybe adjFoes mtargets
mels <- mapM (pickWeaponClient aid) adjTargets
let freq = uniformFreq "melee adjacent" $ catMaybes mels
return $! liftFrequency freq
trigger :: MonadClient m
=> ActorId -> FleeViaStairsOrEscape
-> m (Strategy RequestTimed)
trigger aid fleeVia = do
b <- getsState $ getActorBody aid
lvl <- getLevel (blid b)
let f pos = case EM.lookup pos $ lembed lvl of
Nothing -> Nothing
Just bag -> Just (pos, bag)
pbags = mapMaybe f $ bpos b : vicinityUnsafe (bpos b)
efeat <- embedBenefit fleeVia aid pbags
return $! liftFrequency $ toFreq "trigger"
[ (ceiling benefit, ReqAlter pos)
| (benefit, (pos, _)) <- efeat ]
projectItem :: MonadClient m => ActorId -> m (Strategy RequestTimed)
projectItem aid = do
btarget <- getsClient $ getTarget aid
b <- getsState $ getActorBody aid
mfpos <- getsState $ aidTgtToPos aid (blid b) btarget
seps <- getsClient seps
case (btarget, mfpos) of
(_, Just fpos) | adjacent (bpos b) fpos -> return reject
(Just TEnemy{}, Just fpos) -> do
mnewEps <- makeLine False b fpos seps
case mnewEps of
Just newEps -> do
actorSk <- currentSkillsClient aid
let skill = getSk SkProject actorSk
benList <- condProjectListM skill aid
localTime <- getsState $ getLocalTime (blid b)
let coeff CGround = 2
coeff COrgan = error $ "" `showFailure` benList
coeff CEqp = 1000
coeff CInv = 1
coeff CSha = 1
fRanged (Benefit{benFling}, cstore, iid, itemFull, kit) =
let recharged = hasCharge localTime itemFull kit
arItem = aspectRecordFull itemFull
trange = IA.totalRange arItem $ itemKind itemFull
bestRange =
chessDist (bpos b) fpos + 2
rangeMult =
10 + max 0 (10 - abs (trange - bestRange))
benR = coeff cstore * benFling
in if trange >= chessDist (bpos b) fpos && recharged
then Just ( - ceiling (benR * fromIntegral rangeMult / 10)
, ReqProject fpos newEps iid cstore )
else Nothing
benRanged = mapMaybe fRanged benList
return $! liftFrequency $ toFreq "projectItem" benRanged
_ -> return reject
_ -> return reject
data ApplyItemGroup = ApplyAll | ApplyFirstAid
deriving Eq
applyItem :: MonadClient m
=> ActorId -> ApplyItemGroup -> m (Strategy RequestTimed)
applyItem aid applyGroup = do
actorSk <- currentSkillsClient aid
b <- getsState $ getActorBody aid
condShineWouldBetray <- condShineWouldBetrayM aid
condAimEnemyPresent <- condAimEnemyPresentM aid
localTime <- getsState $ getLocalTime (blid b)
actorMaxSk <- getsState $ getActorMaxSkills aid
let calmE = calmEnough b actorMaxSk
condNotCalmEnough = not calmE
heavilyDistressed =
deltasSerious (bcalmDelta b)
skill = getSk SkApply actorSk
hind = hinders condShineWouldBetray condAimEnemyPresent
heavilyDistressed condNotCalmEnough actorMaxSk
permittedActor itemFull kit =
either (const False) id
$ permittedApply localTime skill calmE itemFull kit
disqualify :: Bool -> IK.Effect -> Bool
disqualify _ IK.PolyItem = True
disqualify _ IK.RerollItem = True
disqualify _ IK.DupItem = True
disqualify _ IK.Identify = True
disqualify durable IK.Summon{} =
durable && (bcalm b < xM 30 || condNotCalmEnough)
disqualify durable (IK.OneOf l) = any (disqualify durable) l
disqualify durable (IK.Composite l) = any (disqualify durable) l
disqualify _ _ = False
q (Benefit{benInEqp}, _, _, itemFull@ItemFull{itemKind}, kit) =
let arItem = aspectRecordFull itemFull
durable = IA.checkFlag Durable arItem
in (not benInEqp
|| durable
|| not (IA.checkFlag Ability.Meleeable arItem)
&& hind itemFull)
&& permittedActor itemFull kit
&& not (any (disqualify durable) $ IK.ieffects itemKind)
&& not (IA.isHumanTrinket itemKind)
stores = [CEqp, CInv, CGround] ++ [CSha | calmE]
discoBenefit <- getsClient sdiscoBenefit
benList <- getsState $ benAvailableItems discoBenefit aid stores
getKind <- getsState $ flip getIidKind
let (myBadGrps, myGoodGrps) = partitionEithers $ mapMaybe (\iid ->
let itemKind = getKind iid
in if isJust $ lookup "condition" $ IK.ifreq itemKind
then Just $ if benInEqp (discoBenefit EM.! iid)
then Left $ toGroupName $ IK.iname itemKind
else Right $ toGroupName $ IK.iname itemKind
else Nothing) (EM.keys $ borgan b)
coeff CGround = 2
coeff COrgan = error $ "" `showFailure` benList
coeff CEqp = 1
coeff CInv = 1
coeff CSha = 1
fTool benAv@( Benefit{benApply}, cstore, iid
, itemFull@ItemFull{itemKind}, _ ) =
let
getHP (IK.RefillHP p) | p > 0 = True
getHP (IK.Composite l) = any getHP l
getHP _ = False
heals = any getHP $ IK.ieffects itemKind
dropsGrps = IK.getDropOrgans itemKind
dropsBadOrgans =
not (null myBadGrps)
&& ("condition" `elem` dropsGrps
|| not (null (dropsGrps `intersect` myBadGrps)))
dropsImpressed =
"impressed" `elem` myBadGrps
&& ("condition" `elem` dropsGrps
|| "impressed" `elem` dropsGrps)
dropsGoodOrgans =
not (null myGoodGrps)
&& ("condition" `elem` dropsGrps
|| not (null (dropsGrps `intersect` myGoodGrps)))
wastesDrop = not dropsBadOrgans && not (null dropsGrps)
wastesHP = hpEnough b actorMaxSk && heals
durable = IA.checkFlag Durable $ aspectRecordFull itemFull
situationalBenApply =
if | dropsBadOrgans -> if dropsImpressed
then benApply + 1000
else benApply + 20
| wastesDrop || wastesHP -> benApply - 10
| otherwise -> benApply
benR = ceiling situationalBenApply
* if cstore == CEqp && not durable
then 1000
else coeff cstore
canApply = situationalBenApply > 0 && case applyGroup of
ApplyFirstAid -> q benAv && (heals || dropsImpressed)
ApplyAll -> q benAv
&& not dropsGoodOrgans
&& (dropsImpressed || not wastesHP)
in if canApply
then Just (benR, ReqApply iid cstore)
else Nothing
benTool = mapMaybe fTool benList
return $! liftFrequency $ toFreq "applyItem" benTool
flee :: MonadClient m
=> ActorId -> [(Int, Point)] -> m (Strategy RequestTimed)
flee aid fleeL = do
b <- getsState $ getActorBody aid
modifyClient $ \cli -> cli {sfleeD = EM.insert aid (bpos b) (sfleeD cli)}
let vVic = map (second (`vectorToFrom` bpos b)) fleeL
str = liftFrequency $ toFreq "flee" vVic
mapStrategyM (moveOrRunAid aid) str
displaceFoe :: MonadClient m => ActorId -> m (Strategy RequestTimed)
displaceFoe aid = do
COps{coTileSpeedup} <- getsState scops
b <- getsState $ getActorBody aid
lvl <- getLevel $ blid b
fact <- getsState $ (EM.! bfid b) . sfactionD
friends <- getsState $ friendRegularList (bfid b) (blid b)
adjBigAssocs <- getsState $ adjacentBigAssocs b
let foe (_, b2) = isFoe (bfid b) fact (bfid b2)
adjFoes = filter foe adjBigAssocs
walkable p =
Tile.isWalkable coTileSpeedup (lvl `at` p)
notLooping body p =
boldpos body /= Just p || actorWaits body
nFriends body = length $ filter (adjacent (bpos body) . bpos) friends
nFrNew = nFriends b + 1
qualifyActor (aid2, body2) = do
let tpos = bpos body2
case posToAidsLvl tpos lvl of
[_] -> do
actorMaxSk <- getsState $ getActorMaxSkills aid2
dEnemy <- getsState $ dispEnemy aid aid2 actorMaxSk
let nFrOld = nFriends body2
return $! if walkable (bpos body2)
&& dEnemy && nFrOld < nFrNew
&& notLooping b (bpos body2)
then Just (nFrOld * nFrOld, ReqDisplace aid2)
else Nothing
_ -> return Nothing
foes <- mapM qualifyActor adjFoes
return $! liftFrequency $ toFreq "displaceFoe" $ catMaybes foes
displaceBlocker :: MonadClient m => ActorId -> Bool -> m (Strategy RequestTimed)
displaceBlocker aid retry = do
b <- getsState $ getActorBody aid
actorMaxSkills <- getsState sactorMaxSkills
let condCanMelee = actorCanMelee actorMaxSkills aid b
mtgtMPath <- getsClient $ EM.lookup aid . stargetD
case mtgtMPath of
Just TgtAndPath{ tapTgt=TEnemy{}
, tapPath=Just AndPath{pathList=q : _, pathGoal} }
| q == pathGoal
&& not (retry && condCanMelee) ->
return reject
Just TgtAndPath{tapPath=Just AndPath{pathList=q : _}}
| adjacent (bpos b) q ->
displaceTgt aid q retry
_ -> return reject
displaceTgt :: MonadClient m
=> ActorId -> Point -> Bool -> m (Strategy RequestTimed)
displaceTgt source tpos retry = do
COps{coTileSpeedup} <- getsState scops
b <- getsState $ getActorBody source
let !_A = assert (adjacent (bpos b) tpos) ()
lvl <- getLevel $ blid b
let walkable p =
Tile.isWalkable coTileSpeedup (lvl `at` p)
notLooping body p =
boldpos body /= Just p || actorWaits body
if walkable tpos && notLooping b tpos then do
mleader <- getsClient sleader
case posToAidsLvl tpos lvl of
[] -> return reject
[aid2] | Just aid2 /= mleader -> do
b2 <- getsState $ getActorBody aid2
mtgtMPath <- getsClient $ EM.lookup aid2 . stargetD
enemyTgt <- condAimEnemyPresentM source
enemyPos <- condAimEnemyRememberedM source
enemyTgt2 <- condAimEnemyPresentM aid2
enemyPos2 <- condAimEnemyRememberedM aid2
case mtgtMPath of
Just TgtAndPath{tapPath=Just AndPath{pathList=q : _}}
| q == bpos b
|| bwatch b2 `elem` [WSleep, WWake]
|| retry
&& not (boldpos b == Just tpos
&& not (actorWaits b))
|| (enemyTgt || enemyPos) && not (enemyTgt2 || enemyPos2) ->
return $! returN "displace friend" $ ReqDisplace aid2
Just _ | bwatch b2 `notElem` [WSleep, WWake] -> return reject
_ -> do
tfact <- getsState $ (EM.! bfid b2) . sfactionD
actorMaxSk <- getsState $ getActorMaxSkills aid2
dEnemy <- getsState $ dispEnemy source aid2 actorMaxSk
if not (isFoe (bfid b2) tfact (bfid b)) || dEnemy then
return $! returN "displace other" $ ReqDisplace aid2
else return reject
_ -> return reject
else return reject
chase :: MonadClient m => ActorId -> Bool -> Bool -> m (Strategy RequestTimed)
chase aid avoidAmbient retry = do
COps{coTileSpeedup} <- getsState scops
body <- getsState $ getActorBody aid
fact <- getsState $ (EM.! bfid body) . sfactionD
mtgtMPath <- getsClient $ EM.lookup aid . stargetD
lvl <- getLevel $ blid body
let isAmbient pos = Tile.isLit coTileSpeedup (lvl `at` pos)
&& Tile.isWalkable coTileSpeedup (lvl `at` pos)
str <- case mtgtMPath of
Just TgtAndPath{tapPath=Just AndPath{pathList=q : _, ..}}
| pathGoal == bpos body -> return reject
| not $ avoidAmbient && isAmbient q ->
moveTowards aid q pathGoal (fleaderMode (gplayer fact) == LeaderNull
|| retry)
_ -> return reject
if avoidAmbient && nullStrategy str
then chase aid False retry
else mapStrategyM (moveOrRunAid aid) str
moveTowards :: MonadClient m
=> ActorId -> Point -> Point -> Bool -> m (Strategy Vector)
moveTowards aid target goal relaxed = do
b <- getsState $ getActorBody aid
actorSk <- currentSkillsClient aid
let source = bpos b
alterSkill = getSk SkAlter actorSk
!_A = assert (adjacent source target
`blame` (source, target, aid, b, goal)) ()
fact <- getsState $ (EM.! bfid b) . sfactionD
salter <- getsClient salter
noFriends <- getsState $ \s p ->
all (isFoe (bfid b) fact . bfid . snd)
(posToAidAssocs p (blid b) s)
let lalter = salter EM.! blid b
enterableHere p = alterSkill >= fromEnum (lalter PointArray.! p)
if noFriends target && enterableHere target then
return $! returN "moveTowards target" $ target `vectorToFrom` source
else do
let goesBack p = Just p == boldpos b
nonincreasing p = chessDist source goal >= chessDist p goal
isSensible | relaxed = \p -> noFriends p
&& enterableHere p
| otherwise = \p -> nonincreasing p
&& not (goesBack p)
&& noFriends p
&& enterableHere p
sensible = [ ((goesBack p, chessDist p goal), v)
| v <- moves, let p = source `shift` v, isSensible p ]
sorted = sortOn fst sensible
groups = map (map snd) $ groupBy ((==) `on` fst) sorted
freqs = map (liftFrequency . uniformFreq "moveTowards") groups
return $! foldr (.|) reject freqs
moveOrRunAid :: MonadClient m => ActorId -> Vector -> m (Maybe RequestTimed)
moveOrRunAid source dir = do
COps{coTileSpeedup} <- getsState scops
sb <- getsState $ getActorBody source
actorSk <- currentSkillsClient source
let lid = blid sb
lvl <- getLevel lid
let walkable =
Tile.isWalkable coTileSpeedup (lvl `at` tpos)
notLooping body p =
boldpos body /= Just p || actorWaits body
spos = bpos sb
tpos = spos `shift` dir
t = lvl `at` tpos
case posToAidsLvl tpos lvl of
[target] | walkable
&& getSk SkDisplace actorSk > 0
&& notLooping sb tpos -> do
tb <- getsState $ getActorBody target
tfact <- getsState $ (EM.! bfid tb) . sfactionD
actorMaxSk <- getsState $ getActorMaxSkills target
dEnemy <- getsState $ dispEnemy source target actorMaxSk
if isFoe (bfid tb) tfact (bfid sb) && not dEnemy
then return Nothing
else return $ Just $ ReqDisplace target
[] | walkable && getSk SkMove actorSk > 0 ->
return $ Just $ ReqMove dir
[] | not walkable
&& getSk SkAlter actorSk
>= Tile.alterMinWalk coTileSpeedup t
&& EM.notMember tpos (lfloor lvl) ->
return $ Just $ ReqAlter tpos
_ -> return Nothing