{-# LANGUAGE DataKinds #-}
module Game.LambdaHack.Client.AI.HandleAbilityM
( actionStrategy
#ifdef EXPOSE_INTERNAL
, ApplyItemGroup
, waitBlockNow, pickup, equipItems, toShare, yieldUnneeded, unEquipItems
, groupByEqpSlot, bestByEqpSlot, harmful, meleeBlocker, meleeAny
, trigger, projectItem, applyItem, flee
, displaceFoe, displaceBlocker, displaceTowards
, chase, moveTowards, moveOrRunAid
#endif
) where
import Prelude ()
import Game.LambdaHack.Common.Prelude
import qualified Data.EnumMap.Strict as EM
import qualified Data.EnumSet as ES
import Data.Function
import Data.Ord
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.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 Game.LambdaHack.Common.ItemStrongest
import qualified Game.LambdaHack.Common.Kind as 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.Request
import Game.LambdaHack.Common.State
import qualified Game.LambdaHack.Common.Tile as Tile
import Game.LambdaHack.Common.Time
import Game.LambdaHack.Common.Vector
import qualified Game.LambdaHack.Content.ItemKind as IK
import Game.LambdaHack.Content.ModeKind
type ToAny a = Strategy (RequestTimed a) -> Strategy RequestAnyAbility
toAny :: ToAny a
toAny strat = RequestAnyAbility <$> strat
actionStrategy :: forall m. MonadClient m
=> ActorId -> Bool -> m (Strategy RequestAnyAbility)
{-# INLINE actionStrategy #-}
actionStrategy aid retry = do
body <- getsState $ getActorBody aid
scondInMelee <- getsClient scondInMelee
let condInMelee = fromMaybe (error $ "" `showFailure` condInMelee)
(scondInMelee EM.! blid body)
condAimEnemyPresent <- condAimEnemyPresentM aid
condAimEnemyRemembered <- condAimEnemyRememberedM aid
condAnyFoeAdj <- condAnyFoeAdjM aid
threatDistL <- meleeThreatDistList aid
(fleeL, badVic) <- fleeList aid
condSupport1 <- condSupport 1 aid
condSupport2 <- condSupport 2 aid
canDeAmbientL <- getsState $ canDeAmbientList body
actorSk <- currentSkillsClient aid
condCanProject <-
condCanProjectM (EM.findWithDefault 0 AbProject actorSk) aid
condAdjTriggerable <- condAdjTriggerableM aid
condBlocksFriends <- condBlocksFriendsM aid
condNoEqpWeapon <- condNoEqpWeaponM aid
condEnoughGear <- condEnoughGearM aid
condFloorWeapon <- condFloorWeaponM aid
condDesirableFloorItem <- condDesirableFloorItemM aid
condTgtNonmoving <- condTgtNonmovingM aid
explored <- getsClient sexplored
actorAspect <- getsClient sactorAspect
let ar = fromMaybe (error $ "" `showFailure` aid) (EM.lookup aid actorAspect)
lidExplored = ES.member (blid body) explored
panicFleeL = fleeL ++ badVic
condHpTooLow = hpTooLow body ar
condNotCalmEnough = not (calmEnough body ar)
speed1_5 = speedScale (3%2) (bspeed body ar)
condCanMelee = actorCanMelee actorAspect aid body
condMeleeBad1 = not (condSupport1 && condCanMelee)
condMeleeBad2 = not (condSupport2 && condCanMelee)
condThreat n = not $ null $ takeWhile ((<= n) . fst) threatDistL
threatAdj = takeWhile ((== 1) . fst) threatDistL
condManyThreatAdj = length threatAdj >= 2
condFastThreatAdj =
any (\(_, (aid2, b2)) ->
let ar2 = actorAspect EM.! aid2
in bspeed b2 ar2 > speed1_5)
threatAdj
heavilyDistressed =
deltaSerious (bcalmDelta body)
actorShines = aShine ar > 0
aCanDeLightL | actorShines = []
| otherwise = canDeAmbientL
aCanDeLight = not $ null aCanDeLightL
canFleeFromLight = not $ null $ aCanDeLightL `intersect` map snd fleeL
actorMaxSk = aSkills ar
abInMaxSkill ab = EM.findWithDefault 0 ab actorMaxSk > 0
stratToFreq :: Int -> m (Strategy RequestAnyAbility)
-> m (Frequency RequestAnyAbility)
stratToFreq scale mstrat = do
st <- mstrat
return $! if scale == 0
then mzero
else scaleFreq scale $ bestVariant st
prefix, suffix :: [([Ability], m (Strategy RequestAnyAbility), Bool)]
prefix =
[ ( [AbApply], (toAny :: ToAny 'AbApply)
<$> applyItem aid ApplyFirstAid
, not condAnyFoeAdj && condHpTooLow)
, ( [AbAlter], (toAny :: ToAny 'AbAlter)
<$> trigger aid ViaStairs
, condAdjTriggerable && not condAimEnemyPresent
&& ((condNotCalmEnough || condHpTooLow)
&& condMeleeBad2 && condThreat 1
|| (lidExplored || condEnoughGear)
&& not condDesirableFloorItem) )
, ( [AbDisplace]
, displaceFoe aid
, condAnyFoeAdj && condBlocksFriends)
, ( [AbMoveItem], (toAny :: ToAny 'AbMoveItem)
<$> pickup aid True
, condNoEqpWeapon
&& condFloorWeapon && not condHpTooLow
&& abInMaxSkill AbMelee )
, ( [AbAlter], (toAny :: ToAny 'AbAlter)
<$> trigger aid ViaEscape
, condAdjTriggerable && not condAimEnemyPresent
&& not condDesirableFloorItem )
, ( [AbMove]
, flee aid fleeL
,
not condFastThreatAdj
&& if | condThreat 1 -> not condCanMelee
|| condManyThreatAdj && not condSupport1
| not condInMelee
&& (condThreat 2 || condThreat 5 && canFleeFromLight) ->
not condCanMelee
|| not condSupport2 && not heavilyDistressed
| condThreat 5 ->
False
| otherwise ->
not condInMelee
&& heavilyDistressed
&& (not condCanProject || canFleeFromLight) )
, ( [AbMelee], (toAny :: ToAny 'AbMelee)
<$> meleeBlocker aid
, condAnyFoeAdj
|| not (abInMaxSkill AbDisplace)
&& condAimEnemyPresent )
, ( [AbAlter], (toAny :: ToAny 'AbAlter)
<$> trigger aid ViaNothing
, not condInMelee
&& condAdjTriggerable && not condAimEnemyPresent )
, ( [AbDisplace]
, displaceBlocker aid retry
, retry || not condDesirableFloorItem )
, ( [AbMelee], (toAny :: ToAny 'AbMelee)
<$> meleeAny aid
, condAnyFoeAdj )
, ( [AbMove]
, flee aid panicFleeL
, condAnyFoeAdj )
]
distant :: [([Ability], m (Frequency RequestAnyAbility), Bool)]
distant =
[ ( [AbMoveItem]
, stratToFreq (if condInMelee then 2 else 20000)
$ (toAny :: ToAny 'AbMoveItem)
<$> yieldUnneeded aid
, True )
, ( [AbMoveItem]
, stratToFreq 1 $ (toAny :: ToAny 'AbMoveItem)
<$> equipItems aid
, not (condInMelee
|| condDesirableFloorItem
|| condNotCalmEnough
|| heavilyDistressed) )
, ( [AbProject]
, stratToFreq (if condTgtNonmoving then 20 else 3)
$ (toAny :: ToAny 'AbProject)
<$> projectItem aid
, condAimEnemyPresent && not condInMelee )
, ( [AbApply]
, stratToFreq 1 $ (toAny :: ToAny 'AbApply)
<$> applyItem aid ApplyAll
, condAimEnemyPresent || condThreat 9 )
, ( [AbMove]
, 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)
&& (not (condThreat 2)
|| heavilyDistressed
|| not condMeleeBad1)
&& not condDesirableFloorItem) )
]
suffix =
[ ( [AbMoveItem], (toAny :: ToAny 'AbMoveItem)
<$> pickup aid False
, not condInMelee )
, ( [AbMoveItem], (toAny :: ToAny 'AbMoveItem)
<$> unEquipItems aid
, not condInMelee )
, ( [AbMove]
, chase aid (not condInMelee
&& heavilyDistressed
&& aCanDeLight) retry
, if condInMelee then condCanMelee && condAimEnemyPresent
else not (condThreat 2) || not condMeleeBad1 )
]
fallback =
[ ( [AbWait], (toAny :: ToAny 'AbWait)
<$> waitBlockNow
, True )
]
let abInSkill ab = EM.findWithDefault 0 ab actorSk > 0
checkAction :: ([Ability], m a, Bool) -> Bool
checkAction (abts, _, cond) = all 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
combineDistant as = liftFrequency <$> sumF as
sumPrefix <- sumS prefix
comDistant <- combineDistant distant
sumSuffix <- sumS suffix
sumFallback <- sumS fallback
return $! sumPrefix .| comDistant .| sumSuffix .| sumFallback
waitBlockNow :: MonadClient m => m (Strategy (RequestTimed 'AbWait))
waitBlockNow = return $! returN "wait" ReqWait
pickup :: MonadClient m
=> ActorId -> Bool -> m (Strategy (RequestTimed 'AbMoveItem))
pickup aid onlyWeapon = do
benItemL <- benGroundItems aid
b <- getsState $ getActorBody aid
actorAspect <- getsClient sactorAspect
let ar = fromMaybe (error $ "" `showFailure` aid) (EM.lookup aid actorAspect)
calmE = calmEnough b ar
isWeapon (_, _, _, itemFull) = isMelee $ itemBase itemFull
filterWeapon | onlyWeapon = filter isWeapon
| otherwise = id
prepareOne (oldN, l4) (mben, _, iid, ItemFull{..}) =
let prep newN toCStore = (newN, (iid, itemK, CGround, toCStore) : l4)
inEqp = maybe (goesIntoEqp itemBase) benInEqp mben
n = oldN + itemK
in if | calmE && goesIntoSha itemBase && not onlyWeapon ->
prep oldN CSha
| inEqp && eqpOverfull b n ->
if onlyWeapon then (oldN, l4)
else prep oldN (if calmE then CSha else CInv)
| inEqp ->
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 'AbMoveItem))
equipItems aid = do
body <- getsState $ getActorBody aid
actorAspect <- getsClient sactorAspect
let ar = fromMaybe (error $ "" `showFailure` aid) (EM.lookup aid actorAspect)
calmE = calmEnough body ar
eqpAssocs <- fullAssocsClient aid [CEqp]
invAssocs <- fullAssocsClient aid [CInv]
shaAssocs <- fullAssocsClient aid [CSha]
condShineWouldBetray <- condShineWouldBetrayM aid
condAimEnemyPresent <- condAimEnemyPresentM aid
discoBenefit <- getsClient sdiscoBenefit
let improve :: CStore
-> (Int, [(ItemId, Int, CStore, CStore)])
-> ( IK.EqpSlot
, ( [(Int, (ItemId, ItemFull))]
, [(Int, (ItemId, ItemFull))] ) )
-> (Int, [(ItemId, Int, CStore, CStore)])
improve fromCStore (oldN, l4) (slot, (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, _) : _)
| not (eqpOverfull body n)
&& (vInv > vEqp || not (toShare slot)) ->
(n, (iidInv, 1, fromCStore, CEqp) : l4)
_ -> (oldN, l4)
heavilyDistressed =
deltaSerious (bcalmDelta body)
filterNeeded (_, itemFull) =
not $ hinders condShineWouldBetray condAimEnemyPresent
heavilyDistressed (not calmE) body ar itemFull
bestThree = bestByEqpSlot discoBenefit
(filter filterNeeded eqpAssocs)
(filter filterNeeded invAssocs)
(filter filterNeeded shaAssocs)
bEqpInv = foldl' (improve CInv) (0, [])
$ map (\(slot, (eqp, inv, _)) ->
(slot, (inv, eqp))) bestThree
bEqpBoth | calmE =
foldl' (improve CSha) bEqpInv
$ map (\(slot, (eqp, _, sha)) ->
(slot, (sha, eqp))) bestThree
| otherwise = bEqpInv
(_, prepared) = bEqpBoth
return $! if null prepared
then reject
else returN "equipItems" $ ReqMoveItems prepared
toShare :: IK.EqpSlot -> Bool
toShare IK.EqpSlotMiscBonus = False
toShare IK.EqpSlotMiscAbility = False
toShare _ = True
yieldUnneeded :: MonadClient m
=> ActorId -> m (Strategy (RequestTimed 'AbMoveItem))
yieldUnneeded aid = do
body <- getsState $ getActorBody aid
actorAspect <- getsClient sactorAspect
let ar = fromMaybe (error $ "" `showFailure` aid) (EM.lookup aid actorAspect)
calmE = calmEnough body ar
eqpAssocs <- fullAssocsClient aid [CEqp]
condShineWouldBetray <- condShineWouldBetrayM aid
condAimEnemyPresent <- condAimEnemyPresentM aid
discoBenefit <- getsClient sdiscoBenefit
let heavilyDistressed =
deltaSerious (bcalmDelta body)
csha = if calmE then CSha else CInv
yieldSingleUnneeded (iidEqp, itemEqp) =
if | harmful discoBenefit iidEqp ->
[(iidEqp, itemK itemEqp, CEqp, CInv)]
| hinders condShineWouldBetray condAimEnemyPresent
heavilyDistressed (not calmE)
body ar itemEqp ->
[(iidEqp, itemK itemEqp, 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 'AbMoveItem))
unEquipItems aid = do
body <- getsState $ getActorBody aid
actorAspect <- getsClient sactorAspect
let ar = fromMaybe (error $ "" `showFailure` aid) (EM.lookup aid actorAspect)
calmE = calmEnough body ar
eqpAssocs <- fullAssocsClient aid [CEqp]
invAssocs <- fullAssocsClient aid [CInv]
shaAssocs <- fullAssocsClient aid [CSha]
discoBenefit <- getsClient sdiscoBenefit
let improve :: CStore -> ( IK.EqpSlot
, ( [(Int, (ItemId, ItemFull))]
, [(Int, (ItemId, ItemFull))] ) )
-> [(ItemId, Int, CStore, CStore)]
improve fromCStore (slot, (bestSha, bestEOrI)) =
case (bestSha, bestEOrI) of
_ | not (toShare slot)
&& fromCStore == CEqp
&& not (eqpOverfull body 1) ->
[]
(_, (vEOrI, (iidEOrI, _)) : _) | (toShare slot || fromCStore == CInv)
&& getK bestEOrI > 1
&& betterThanSha vEOrI bestSha ->
[(iidEOrI, getK bestEOrI - 1, fromCStore, CSha)]
(_, _ : (vEOrI, (iidEOrI, _)) : _) | (toShare slot
|| fromCStore == CInv)
&& betterThanSha vEOrI bestSha ->
[(iidEOrI, getK bestEOrI, fromCStore, CSha)]
(_, (vEOrI, (_, _)) : _) | fromCStore == CEqp
&& eqpOverfull body 1
&& worseThanSha vEOrI bestSha ->
[(fst $ snd $ last bestEOrI, 1, fromCStore, CSha)]
_ -> []
getK [] = 0
getK ((_, (_, itemFull)) : _) = itemK itemFull
betterThanSha _ [] = True
betterThanSha vEOrI ((vSha, _) : _) = vEOrI > vSha
worseThanSha _ [] = False
worseThanSha vEOrI ((vSha, _) : _) = vEOrI < vSha
bestThree = bestByEqpSlot discoBenefit eqpAssocs invAssocs shaAssocs
bInvSha = concatMap
(improve CInv . (\(slot, (_, inv, sha)) ->
(slot, (sha, inv)))) bestThree
bEqpSha = concatMap
(improve CEqp . (\(slot, (eqp, _, sha)) ->
(slot, (sha, eqp)))) bestThree
prepared = if calmE then bInvSha ++ bEqpSha else []
return $! if null prepared
then reject
else returN "unEquipItems" $ ReqMoveItems prepared
groupByEqpSlot :: [(ItemId, ItemFull)]
-> EM.EnumMap IK.EqpSlot [(ItemId, ItemFull)]
groupByEqpSlot is =
let f (iid, itemFull) = case strengthEqpSlot itemFull of
Nothing -> Nothing
Just es -> Just (es, [(iid, itemFull)])
withES = mapMaybe f is
in EM.fromListWith (++) withES
bestByEqpSlot :: DiscoveryBenefit
-> [(ItemId, ItemFull)]
-> [(ItemId, ItemFull)]
-> [(ItemId, ItemFull)]
-> [(IK.EqpSlot
, ( [(Int, (ItemId, ItemFull))]
, [(Int, (ItemId, ItemFull))]
, [(Int, (ItemId, ItemFull))] ) )]
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.assocs $ EM.mapWithKey bestThree eqpInvShaMap
harmful :: DiscoveryBenefit -> ItemId -> Bool
harmful discoBenefit iid =
maybe False (not . benInEqp) (EM.lookup iid discoBenefit)
meleeBlocker :: MonadClient m => ActorId -> m (Strategy (RequestTimed 'AbMelee))
meleeBlocker aid = do
b <- getsState $ getActorBody aid
actorAspect <- getsClient sactorAspect
let ar = fromMaybe (error $ "" `showFailure` aid) (EM.lookup aid actorAspect)
fact <- getsState $ (EM.! bfid b) . sfactionD
actorSk <- currentSkillsClient aid
mtgtMPath <- getsClient $ EM.lookup aid . stargetD
case mtgtMPath of
Just TgtAndPath{ tapTgt=TEnemy{}
, tapPath=AndPath{pathList=q : _, pathGoal} }
| q == pathGoal -> return reject
Just TgtAndPath{tapPath=AndPath{pathList=q : _, pathGoal}} -> do
let maim | adjacent (bpos b) pathGoal = Just pathGoal
| adjacent (bpos b) q = Just q
| otherwise = Nothing
lBlocker <- case maim of
Nothing -> return []
Just aim -> getsState $ posToAssocs aim (blid b)
case lBlocker of
(aid2, body2) : _ -> do
let ar2 = fromMaybe (error $ "" `showFailure` aid2)
(EM.lookup aid2 actorAspect)
if | actorDying body2
|| bproj body2
&& EM.findWithDefault 0 AbDisplace actorSk <= 0 ->
return reject
| isAtWar fact (bfid body2)
|| (bfid body2 == bfid b
|| isAllied fact (bfid body2))
&& EM.findWithDefault 0 AbDisplace actorSk <= 0
&& EM.findWithDefault 0 AbMove actorSk > 0
&& 3 * bhp body2 < bhp b
&& bspeed body2 ar2 <= bspeed b ar -> 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 'AbMelee))
meleeAny aid = do
b <- getsState $ getActorBody aid
fact <- getsState $ (EM.! bfid b) . sfactionD
adjacentAssocs <- getsState $ actorAdjacentAssocs b
let foe (_, b2) = not (bproj b2) && isAtWar fact (bfid b2) && bhp b2 > 0
adjFoes = filter foe adjacentAssocs
btarget <- getsClient $ getTarget aid
mtarget <- case btarget of
Just (TEnemy aid2 _) -> do
b2 <- getsState $ getActorBody aid2
return $! if adjacent (bpos b2) (bpos b) && foe (aid2, b2)
then Just (aid2, b2)
else Nothing
_ -> return Nothing
let adjTargets = maybe adjFoes return mtarget
mels <- mapM (pickWeaponClient aid . fst) adjTargets
let freq = uniformFreq "melee adjacent" $ catMaybes mels
return $! liftFrequency freq
trigger :: MonadClient m
=> ActorId -> FleeViaStairsOrEscape
-> m (Strategy (RequestTimed 'AbAlter))
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 $ vicinityUnsafe (bpos b)
efeat <- embedBenefit fleeVia aid pbags
return $! liftFrequency $ toFreq "trigger"
[ (benefit, ReqAlter pos)
| (benefit, (pos, _)) <- efeat ]
projectItem :: MonadClient m
=> ActorId -> m (Strategy (RequestTimed 'AbProject))
projectItem aid = do
btarget <- getsClient $ getTarget aid
b <- getsState $ getActorBody aid
mfpos <- case btarget of
Nothing -> return Nothing
Just target -> aidTgtToPos aid (blid b) target
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 = EM.findWithDefault 0 AbProject actorSk
benList <- condProjectListM skill aid
localTime <- getsState $ getLocalTime (blid b)
let coeff CGround = 2
coeff COrgan = error $ "" `showFailure` benList
coeff CEqp = 100000
coeff CInv = 1
coeff CSha = 1
fRanged (mben, cstore, iid, itemFull@ItemFull{itemBase}) =
let recharged = hasCharge localTime itemFull
trange = totalRange itemBase
bestRange =
chessDist (bpos b) fpos + 2
rangeMult =
10 + max 0 (10 - abs (trange - bestRange))
benR = coeff cstore
* case mben of
Nothing -> -10
Just Benefit{benFling} -> benFling
in if trange >= chessDist (bpos b) fpos && recharged
then Just ( - benR * rangeMult `div` 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 'AbApply))
applyItem aid applyGroup = do
actorSk <- currentSkillsClient aid
b <- getsState $ getActorBody aid
condShineWouldBetray <- condShineWouldBetrayM aid
condAimEnemyPresent <- condAimEnemyPresentM aid
localTime <- getsState $ getLocalTime (blid b)
actorAspect <- getsClient sactorAspect
let ar = fromMaybe (error $ "" `showFailure` aid) (EM.lookup aid actorAspect)
calmE = calmEnough b ar
condNotCalmEnough = not calmE
heavilyDistressed =
deltaSerious (bcalmDelta b)
skill = EM.findWithDefault 0 AbApply actorSk
hind = hinders condShineWouldBetray condAimEnemyPresent
heavilyDistressed condNotCalmEnough b ar
permittedActor =
either (const False) id
. permittedApply localTime skill calmE " "
q (mben, _, _, itemFull) =
let freq = case itemDisco itemFull of
Nothing -> []
Just ItemDisco{itemKind} -> IK.ifreq itemKind
durable = IK.Durable `elem` jfeature (itemBase itemFull)
(bInEqp, bApply) = case mben of
Just Benefit{benInEqp, benApply} -> (benInEqp, benApply)
Nothing -> (goesIntoEqp $ itemBase itemFull, 0)
in bApply > 0
&& (not bInEqp
|| durable
|| not (isMelee $ itemBase itemFull)
&& hind itemFull)
&& permittedActor itemFull
&& maybe True (<= 0) (lookup "gem" freq)
stores = [CEqp, CInv, CGround] ++ [CSha | calmE]
benList <- benAvailableItems aid stores
organs <- mapM (getsState . getItemBody) $ EM.keys $ borgan b
let hasGrps = mapMaybe (\item -> if jweight item == 0
then Just $ toGroupName $ jname item
else Nothing) organs
itemLegal itemFull =
let getP (IK.RefillHP p) | p > 0 = True
getP _ = False
firstAidItem = case itemDisco itemFull of
Just ItemDisco{itemKind} -> any getP $ IK.ieffects itemKind
_ -> False
in if applyGroup == ApplyFirstAid
then firstAidItem
else not $ hpEnough b ar && firstAidItem
coeff CGround = 2
coeff COrgan = error $ "" `showFailure` benList
coeff CEqp = 1
coeff CInv = 1
coeff CSha = 1
fTool benAv@(mben, cstore, iid, itemFull@ItemFull{itemBase}) =
let onlyVoidlyDropsOrgan =
let dropsGrps = strengthDropOrgan itemFull
hasDropOrgan = not $ null dropsGrps
f eff = [eff | IK.forApplyEffect eff]
in hasDropOrgan
&& (null hasGrps
|| toGroupName "temporary condition" `notElem` dropsGrps
&& null (dropsGrps `intersect` hasGrps))
&& length (strengthEffect f itemFull) == 1
durable = IK.Durable `elem` jfeature itemBase
benR = case mben of
Nothing -> 0
Just Benefit{benApply} ->
benApply
* if cstore == CEqp && not durable
then 100000
else coeff cstore
in if q benAv && itemLegal itemFull && not onlyVoidlyDropsOrgan
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 RequestAnyAbility)
flee aid fleeL = do
b <- getsState $ getActorBody aid
let vVic = map (second (`vectorToFrom` bpos b)) fleeL
str = liftFrequency $ toFreq "flee" vVic
mapStrategyM (moveOrRunAid aid) str
displaceFoe :: MonadClient m => ActorId -> m (Strategy RequestAnyAbility)
displaceFoe aid = do
Kind.COps{coTileSpeedup} <- getsState scops
b <- getsState $ getActorBody aid
lvl <- getLevel $ blid b
fact <- getsState $ (EM.! bfid b) . sfactionD
friends <- getsState $ friendlyActorRegularList (bfid b) (blid b)
adjacentAssocs <- getsState $ actorAdjacentAssocs b
let foe (_, b2) = not (bproj b2) && isAtWar fact (bfid b2) && bhp b2 > 0
adjFoes = filter foe adjacentAssocs
displaceable body =
Tile.isWalkable coTileSpeedup (lvl `at` bpos body)
nFriends body = length $ filter (adjacent (bpos body) . bpos) friends
nFrNew = nFriends b + 1
qualifyActor (aid2, body2) = do
actorMaxSk <- maxActorSkillsClient aid2
dEnemy <- getsState $ dispEnemy aid aid2 actorMaxSk
let nFrOld = nFriends body2
return $! if displaceable body2 && dEnemy && nFrOld < nFrNew
then Just (nFrOld * nFrOld, bpos body2 `vectorToFrom` bpos b)
else Nothing
vFoes <- mapM qualifyActor adjFoes
let str = liftFrequency $ toFreq "displaceFoe" $ catMaybes vFoes
mapStrategyM (moveOrRunAid aid) str
displaceBlocker :: MonadClient m
=> ActorId -> Bool -> m (Strategy RequestAnyAbility)
displaceBlocker aid retry = do
b <- getsState $ getActorBody aid
mtgtMPath <- getsClient $ EM.lookup aid . stargetD
str <- case mtgtMPath of
Just TgtAndPath{ tapTgt=TEnemy{}
, tapPath=AndPath{pathList=q : _, pathGoal} }
| q == pathGoal && not retry ->
return reject
Just TgtAndPath{tapPath=AndPath{pathList=q : _}}
| adjacent (bpos b) q ->
displaceTowards aid q retry
_ -> return reject
mapStrategyM (moveOrRunAid aid) str
displaceTowards :: MonadClient m
=> ActorId -> Point -> Bool -> m (Strategy Vector)
displaceTowards aid target retry = do
Kind.COps{coTileSpeedup} <- getsState scops
b <- getsState $ getActorBody aid
let source = bpos b
let !_A = assert (adjacent source target) ()
lvl <- getLevel $ blid b
if boldpos b /= Just target
&& Tile.isWalkable coTileSpeedup (lvl `at` target) then do
mleader <- getsClient _sleader
mBlocker <- getsState $ posToAssocs target (blid b)
case mBlocker of
[] -> return reject
[(aid2, b2)] | Just aid2 /= mleader -> do
mtgtMPath <- getsClient $ EM.lookup aid2 . stargetD
enemyTgt <- condAimEnemyPresentM aid
enemyPos <- condAimEnemyRememberedM aid
enemyTgt2 <- condAimEnemyPresentM aid2
enemyPos2 <- condAimEnemyRememberedM aid2
case mtgtMPath of
Just TgtAndPath{tapPath=AndPath{pathList=q : _}}
| q == source
|| retry
&& not (boldpos b == Just target
&& not (waitedLastTurn b))
|| (enemyTgt || enemyPos) && not (enemyTgt2 || enemyPos2) ->
return $! returN "displace friend" $ target `vectorToFrom` source
Just _ -> return reject
Nothing -> do
tfact <- getsState $ (EM.! bfid b2) . sfactionD
actorMaxSk <- maxActorSkillsClient aid2
dEnemy <- getsState $ dispEnemy aid aid2 actorMaxSk
if not (isAtWar tfact (bfid b)) || dEnemy then
return $! returN "displace other" $ target `vectorToFrom` source
else return reject
_ -> return reject
else return reject
chase :: MonadClient m
=> ActorId -> Bool -> Bool -> m (Strategy RequestAnyAbility)
chase aid avoidAmbient retry = do
Kind.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)
str <- case mtgtMPath of
Just TgtAndPath{tapPath=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 = EM.findWithDefault 0 AbAlter actorSk
!_A = assert (source == bpos b
`blame` (source, bpos b, aid, b, goal)) ()
!_B = assert (adjacent source target
`blame` (source, target, aid, b, goal)) ()
fact <- getsState $ (EM.! bfid b) . sfactionD
salter <- getsClient salter
let noF = isAtWar fact . bfid
noFriends <- getsState $ \s p -> all (noF . snd) $ posToAssocs 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 adjacent" $ 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 = sortBy (comparing 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 RequestAnyAbility)
moveOrRunAid source dir = do
Kind.COps{coTileSpeedup} <- getsState scops
sb <- getsState $ getActorBody source
actorSk <- currentSkillsClient source
let lid = blid sb
lvl <- getLevel lid
let alterSkill = EM.findWithDefault 0 AbAlter actorSk
spos = bpos sb
tpos = spos `shift` dir
t = lvl `at` tpos
tgts <- getsState $ posToAssocs tpos lid
case tgts of
[(target, b2)] -> do
tfact <- getsState $ (EM.! bfid b2) . sfactionD
actorMaxSk <- maxActorSkillsClient target
dEnemy <- getsState $ dispEnemy source target actorMaxSk
if | boldpos sb == Just tpos && not (waitedLastTurn sb)
|| not (Tile.isWalkable coTileSpeedup $ lvl `at` tpos) ->
return Nothing
| isAtWar tfact (bfid sb) && not dEnemy -> do
wps <- pickWeaponClient source target
case wps of
Nothing -> return Nothing
Just wp -> return $ Just $ RequestAnyAbility wp
| otherwise ->
return $ Just $ RequestAnyAbility $ ReqDisplace target
(target, _) : _ -> do
wps <- pickWeaponClient source target
case wps of
Nothing -> return Nothing
Just wp -> return $ Just $ RequestAnyAbility wp
[]
| Tile.isWalkable coTileSpeedup $ lvl `at` tpos ->
return $ Just $ RequestAnyAbility $ ReqMove dir
| alterSkill < Tile.alterMinWalk coTileSpeedup t ->
error $ "AI causes AlterUnwalked" `showFailure` (source, dir)
| EM.member tpos $ lfloor lvl ->
error $ "AI causes AlterBlockItem" `showFailure` (source, dir)
| otherwise ->
return $ Just $ RequestAnyAbility $ ReqAlter tpos