module Game.LambdaHack.Client.AI.HandleAbilityClient
( actionStrategy
) where
import Control.Applicative
import Control.Arrow (second)
import Control.Exception.Assert.Sugar
import Control.Monad
import qualified Data.EnumMap.Strict as EM
import qualified Data.EnumSet as ES
import Data.Function
import Data.List
import qualified Data.Map.Strict as M
import Data.Maybe
import Data.Ord
import Data.Ratio
import Data.Text (Text)
import Game.LambdaHack.Client.AI.ConditionClient
import Game.LambdaHack.Client.AI.Preferences
import Game.LambdaHack.Client.AI.Strategy
import Game.LambdaHack.Client.BfsClient
import Game.LambdaHack.Client.CommonClient
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.Perception
import Game.LambdaHack.Common.Point
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
import qualified Game.LambdaHack.Content.TileKind as TK
type ToAny a = Strategy (RequestTimed a) -> Strategy RequestAnyAbility
toAny :: ToAny a
toAny strat = RequestAnyAbility <$> strat
actionStrategy :: forall m. MonadClient m
=> ActorId -> m (Strategy RequestAnyAbility)
actionStrategy aid = do
body <- getsState $ getActorBody aid
activeItems <- activeItemsClient aid
fact <- getsState $ (EM.! bfid body) . sfactionD
condTgtEnemyPresent <- condTgtEnemyPresentM aid
condTgtEnemyRemembered <- condTgtEnemyRememberedM aid
condTgtEnemyAdjFriend <- condTgtEnemyAdjFriendM aid
condAnyFoeAdj <- condAnyFoeAdjM aid
threatDistL <- threatDistList aid
condHpTooLow <- condHpTooLowM aid
condOnTriggerable <- condOnTriggerableM aid
condBlocksFriends <- condBlocksFriendsM aid
condNoEqpWeapon <- condNoEqpWeaponM aid
let condNoUsableWeapon = all (not . isMelee) activeItems
condEnoughGear <- condEnoughGearM aid
condFloorWeapon <- condFloorWeaponM aid
condCanProject <- condCanProjectM False aid
condNotCalmEnough <- condNotCalmEnoughM aid
condDesirableFloorItem <- condDesirableFloorItemM aid
condMeleeBad <- condMeleeBadM aid
condTgtNonmoving <- condTgtNonmovingM aid
aInAmbient <- getsState $ actorInAmbient body
explored <- getsClient sexplored
(fleeL, badVic) <- fleeList aid
let lidExplored = ES.member (blid body) explored
panicFleeL = fleeL ++ badVic
actorShines = sumSlotNoFilter IK.EqpSlotAddLight activeItems > 0
condThreatAdj = not $ null $ takeWhile ((== 1) . fst) threatDistL
condThreatAtHand = not $ null $ takeWhile ((<= 2) . fst) threatDistL
condThreatNearby = not $ null $ takeWhile ((<= 9) . fst) threatDistL
speed1_5 = speedScale (3%2) (bspeed body activeItems)
condFastThreatAdj = any (\(_, (_, b)) -> bspeed b activeItems > speed1_5)
$ takeWhile ((== 1) . fst) threatDistL
heavilyDistressed =
deltaSerious (bcalmDelta body)
let actorMaxSk = sumSkills activeItems
abInMaxSkill ab = EM.findWithDefault 0 ab actorMaxSk > 0
stratToFreq :: MonadStateRead m
=> 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
, condHpTooLow && not condAnyFoeAdj
&& not condOnTriggerable )
, ( [AbTrigger], (toAny :: ToAny 'AbTrigger)
<$> trigger aid True
, condOnTriggerable
&& ((condNotCalmEnough || condHpTooLow)
&& condThreatNearby && not condTgtEnemyPresent
|| condMeleeBad && condThreatAdj) )
, ( [AbDisplace]
, displaceFoe aid
, condBlocksFriends && condAnyFoeAdj
&& not condOnTriggerable && not condDesirableFloorItem )
, ( [AbMoveItem], (toAny :: ToAny 'AbMoveItem)
<$> pickup aid True
, condNoEqpWeapon && condFloorWeapon && not condHpTooLow
&& abInMaxSkill AbMelee )
, ( [AbMelee], (toAny :: ToAny 'AbMelee)
<$> meleeBlocker aid
, condAnyFoeAdj
|| not (abInMaxSkill AbDisplace)
&& fleaderMode (gplayer fact) == LeaderNull
&& condTgtEnemyPresent )
, ( [AbTrigger], (toAny :: ToAny 'AbTrigger)
<$> trigger aid False
, condOnTriggerable && not condDesirableFloorItem
&& (lidExplored || condEnoughGear)
&& not condTgtEnemyPresent )
, ( [AbMove]
, flee aid fleeL
, condMeleeBad && not condFastThreatAdj
&& not (heavilyDistressed
&& abInMaxSkill AbMelee
&& not condNoUsableWeapon)
&& condThreatAtHand )
, ( [AbDisplace]
, displaceBlocker aid
, not condDesirableFloorItem )
, ( [AbMoveItem], (toAny :: ToAny 'AbMoveItem)
<$> equipItems aid
, not (condAnyFoeAdj
|| condDesirableFloorItem
|| condNotCalmEnough) )
]
distant :: [([Ability], m (Frequency RequestAnyAbility), Bool)]
distant =
[ ( [AbMoveItem]
, stratToFreq 20000 $ (toAny :: ToAny 'AbMoveItem)
<$> yieldUnneeded aid
, True )
, ( [AbProject]
, stratToFreq 2 $ (toAny :: ToAny 'AbProject)
<$> projectItem aid
, condTgtEnemyPresent && condCanProject && not condOnTriggerable )
, ( [AbApply]
, stratToFreq 2 $ (toAny :: ToAny 'AbApply)
<$> applyItem aid ApplyAll
, (condTgtEnemyPresent || condThreatNearby)
&& not condOnTriggerable )
, ( [AbMove]
, stratToFreq (if not condTgtEnemyPresent
then 3
else if condTgtNonmoving
then 0
else if condTgtEnemyAdjFriend
then 1000
else 100)
$ chase aid True (condMeleeBad && condThreatNearby
&& not aInAmbient && not actorShines)
, (condTgtEnemyPresent || condTgtEnemyRemembered)
&& not (condDesirableFloorItem && not condThreatAtHand)
&& abInMaxSkill AbMelee
&& not condNoUsableWeapon )
]
suffix =
[ ( [AbMelee], (toAny :: ToAny 'AbMelee)
<$> meleeAny aid
, condAnyFoeAdj )
, ( [AbMove]
, flee aid panicFleeL
, condAnyFoeAdj )
, ( [AbMoveItem], (toAny :: ToAny 'AbMoveItem)
<$> pickup aid False
, not condThreatAtHand )
, ( [AbMoveItem], (toAny :: ToAny 'AbMoveItem)
<$> unEquipItems aid
, True )
, ( [AbMove]
, chase aid True (condTgtEnemyPresent
&& not (heavilyDistressed
&& abInMaxSkill AbMelee
&& not condNoUsableWeapon)
&& condMeleeBad && condThreatNearby
&& not aInAmbient && not actorShines)
, not (condTgtNonmoving && condThreatAtHand) )
]
fallback =
[ ( [AbWait], (toAny :: ToAny 'AbWait)
<$> waitBlockNow
, True )
]
actorSk <- actorSkillsClient aid
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
activeItems <- activeItemsClient aid
let calmE = calmEnough b activeItems
isWeapon (_, (_, itemFull)) = isMeleeEqp itemFull
filterWeapon | onlyWeapon = filter isWeapon
| otherwise = id
prepareOne (oldN, l4) ((_, (k, _)), (iid, itemFull)) =
let n = oldN + k
(newN, toCStore)
| calmE && goesIntoSha itemFull = (oldN, CSha)
| goesIntoEqp itemFull && eqpOverfull b n =
(oldN, if calmE then CSha else CInv)
| goesIntoEqp itemFull = (n, CEqp)
| otherwise = (oldN, CInv)
in (newN, (iid, k, CGround, toCStore) : 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
cops <- getsState scops
body <- getsState $ getActorBody aid
activeItems <- activeItemsClient aid
let calmE = calmEnough body activeItems
fact <- getsState $ (EM.! bfid body) . sfactionD
eqpAssocs <- fullAssocsClient aid [CEqp]
invAssocs <- fullAssocsClient aid [CInv]
shaAssocs <- fullAssocsClient aid [CSha]
condAnyFoeAdj <- condAnyFoeAdjM aid
condLightBetrays <- condLightBetraysM aid
condTgtEnemyPresent <- condTgtEnemyPresentM aid
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)
filterNeeded (_, itemFull) =
not $ unneeded cops condAnyFoeAdj condLightBetrays
condTgtEnemyPresent (not calmE)
body activeItems fact itemFull
bestThree = bestByEqpSlot (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.EqpSlotPeriodic = False
toShare _ = True
yieldUnneeded :: MonadClient m
=> ActorId -> m (Strategy (RequestTimed 'AbMoveItem))
yieldUnneeded aid = do
cops <- getsState scops
body <- getsState $ getActorBody aid
activeItems <- activeItemsClient aid
let calmE = calmEnough body activeItems
fact <- getsState $ (EM.! bfid body) . sfactionD
eqpAssocs <- fullAssocsClient aid [CEqp]
condAnyFoeAdj <- condAnyFoeAdjM aid
condLightBetrays <- condLightBetraysM aid
condTgtEnemyPresent <- condTgtEnemyPresentM aid
let yieldSingleUnneeded (iidEqp, itemEqp) =
let csha = if calmE then CSha else CInv
in if harmful cops body activeItems fact itemEqp
then [(iidEqp, itemK itemEqp, CEqp, CInv)]
else if hinders condAnyFoeAdj condLightBetrays
condTgtEnemyPresent (not calmE)
body activeItems itemEqp
then [(iidEqp, itemK itemEqp, CEqp, csha)]
else []
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
cops <- getsState scops
body <- getsState $ getActorBody aid
activeItems <- activeItemsClient aid
let calmE = calmEnough body activeItems
fact <- getsState $ (EM.! bfid body) . sfactionD
eqpAssocs <- fullAssocsClient aid [CEqp]
invAssocs <- fullAssocsClient aid [CInv]
shaAssocs <- fullAssocsClient aid [CSha]
condAnyFoeAdj <- condAnyFoeAdjM aid
condLightBetrays <- condLightBetraysM aid
condTgtEnemyPresent <- condTgtEnemyPresentM aid
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
filterNeeded (_, itemFull) =
not $ unneeded cops condAnyFoeAdj condLightBetrays
condTgtEnemyPresent (not calmE)
body activeItems fact itemFull
bestThree =
bestByEqpSlot eqpAssocs invAssocs (filter filterNeeded 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)]
-> M.Map (IK.EqpSlot, Text) [(ItemId, ItemFull)]
groupByEqpSlot is =
let f (iid, itemFull) = case strengthEqpSlot $ itemBase itemFull of
Nothing -> Nothing
Just es -> Just (es, [(iid, itemFull)])
withES = mapMaybe f is
in M.fromListWith (++) withES
bestByEqpSlot :: [(ItemId, ItemFull)]
-> [(ItemId, ItemFull)]
-> [(ItemId, ItemFull)]
-> [((IK.EqpSlot, Text)
, ( [(Int, (ItemId, ItemFull))]
, [(Int, (ItemId, ItemFull))]
, [(Int, (ItemId, ItemFull))] ) )]
bestByEqpSlot eqpAssocs invAssocs shaAssocs =
let eqpMap = M.map (\g -> (g, [], [])) $ groupByEqpSlot eqpAssocs
invMap = M.map (\g -> ([], g, [])) $ groupByEqpSlot invAssocs
shaMap = M.map (\g -> ([], [], g)) $ groupByEqpSlot shaAssocs
appendThree (g1, g2, g3) (h1, h2, h3) = (g1 ++ h1, g2 ++ h2, g3 ++ h3)
eqpInvShaMap = M.unionsWith appendThree [eqpMap, invMap, shaMap]
bestSingle = strongestSlot
bestThree (eqpSlot, _) (g1, g2, g3) = (bestSingle eqpSlot g1,
bestSingle eqpSlot g2,
bestSingle eqpSlot g3)
in M.assocs $ M.mapWithKey bestThree eqpInvShaMap
harmful :: Kind.COps -> Actor -> [ItemFull] -> Faction -> ItemFull -> Bool
harmful cops body activeItems fact itemFull =
maybe False (\(u, _) -> u <= 0)
(totalUsefulness cops body activeItems fact itemFull)
unneeded :: Kind.COps -> Bool -> Bool -> Bool -> Bool
-> Actor -> [ItemFull] -> Faction -> ItemFull
-> Bool
unneeded cops condAnyFoeAdj condLightBetrays
condTgtEnemyPresent condNotCalmEnough
body activeItems fact itemFull =
harmful cops body activeItems fact itemFull
|| hinders condAnyFoeAdj condLightBetrays
condTgtEnemyPresent condNotCalmEnough
body activeItems itemFull
|| let calm10 = calmEnough10 body activeItems
itemLit = isJust $ strengthFromEqpSlot IK.EqpSlotAddLight itemFull
in itemLit && not calm10
meleeBlocker :: MonadClient m => ActorId -> m (Strategy (RequestTimed 'AbMelee))
meleeBlocker aid = do
b <- getsState $ getActorBody aid
fact <- getsState $ (EM.! bfid b) . sfactionD
actorSk <- actorSkillsClient aid
mtgtMPath <- getsClient $ EM.lookup aid . stargetD
case mtgtMPath of
Just (_, Just (_ : q : _, (goal, _))) -> do
let maim | adjacent (bpos b) goal = Just goal
| adjacent (bpos b) q = Just q
| otherwise = Nothing
lBlocker <- case maim of
Nothing -> return []
Just aim -> getsState $ posToActors aim (blid b)
case lBlocker of
(aid2, _) : _ -> do
body2 <- getsState $ getActorBody aid2
if not (actorDying body2)
&& (not (bproj body2)
&& isAtWar fact (bfid body2)
|| EM.findWithDefault 0 AbDisplace actorSk <= 0
&& fleaderMode (gplayer fact) == LeaderNull
&& EM.findWithDefault 0 AbMove actorSk > 0
&& bhp body2 < bhp b)
then do
mel <- maybeToList <$> pickWeaponClient aid aid2
return $! liftFrequency $ uniformFreq "melee in the way" mel
else 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
allFoes <- getsState $ actorRegularAssocs (isAtWar fact) (blid b)
let adjFoes = filter (adjacent (bpos b) . bpos . snd) allFoes
mels <- mapM (pickWeaponClient aid . fst) adjFoes
let freq = uniformFreq "melee adjacent" $ catMaybes mels
return $! liftFrequency freq
trigger :: MonadClient m
=> ActorId -> Bool -> m (Strategy (RequestTimed 'AbTrigger))
trigger aid fleeViaStairs = do
cops@Kind.COps{cotile=Kind.Ops{okind}} <- getsState scops
dungeon <- getsState sdungeon
explored <- getsClient sexplored
b <- getsState $ getActorBody aid
activeItems <- activeItemsClient aid
fact <- getsState $ (EM.! bfid b) . sfactionD
let lid = blid b
lvl <- getLevel lid
unexploredD <- unexploredDepth
s <- getState
let lidExplored = ES.member lid explored
allExplored = ES.size explored == EM.size dungeon
t = lvl `at` bpos b
feats = TK.tfeature $ okind t
ben feat = case feat of
TK.Cause (IK.Ascend k) -> do
(lid2, pos2) <- getsState $ whereTo lid (bpos b) k . sdungeon
per <- getPerFid lid2
let canSee = ES.member (bpos b) (totalVisible per)
aimless = ftactic (gplayer fact) `elem` [TRoam, TPatrol]
easier = signum k /= signum (fromEnum lid)
unexpForth = unexploredD (signum k) lid
unexpBack = unexploredD ( signum k) lid
expBenefit
| aimless = 100
| unexpForth =
if easier
|| not unexpBack
&& lidExplored
then 1000
else 0
| not lidExplored = 0
| unexpBack = 0
| not $ null $ lescape lvl = 0
| otherwise = 2
actorsThere = posToActors pos2 lid2 s
return $!
if boldpos b == Just (bpos b)
&& boldlid b == lid2
then 0
else let eben = case actorsThere of
[] | canSee -> expBenefit
_ -> min 1 expBenefit
in if fleeViaStairs
then 1000 * eben + 1
else eben
TK.Cause ef@IK.Escape{} -> return $
if not (fcanEscape $ gplayer fact) || not allExplored
then 0
else effectToBenefit cops b activeItems fact ef
TK.Cause ef | not fleeViaStairs ->
return $! effectToBenefit cops b activeItems fact ef
_ -> return 0
benFeats <- mapM ben feats
let benFeat = zip benFeats feats
return $! liftFrequency $ toFreq "trigger"
[ (benefit, ReqTrigger (Just feat))
| (benefit, feat) <- benFeat
, benefit > 0 ]
projectItem :: MonadClient m => ActorId -> m (Strategy (RequestTimed 'AbProject))
projectItem aid = do
btarget <- getsClient $ getTarget aid
b <- getsState $ getActorBody aid
mfpos <- aidTgtToPos aid (blid b) btarget
seps <- getsClient seps
case (btarget, mfpos) of
(_, Just fpos) | chessDist (bpos b) fpos == 1 -> return reject
(Just TEnemy{}, Just fpos) -> do
mnewEps <- makeLine False b fpos seps
case mnewEps of
Just newEps -> do
actorSk <- actorSkillsClient aid
let skill = EM.findWithDefault 0 AbProject actorSk
let q _ itemFull b2 activeItems =
either (const False) id
$ permittedProject " " False skill itemFull b2 activeItems
activeItems <- activeItemsClient aid
let calmE = calmEnough b activeItems
stores = [CEqp, CInv, CGround] ++ [CSha | calmE]
benList <- benAvailableItems aid q stores
localTime <- getsState $ getLocalTime (blid b)
let coeff CGround = 2
coeff COrgan = 3
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))
durable = IK.Durable `elem` jfeature itemBase
durableBonus = if durable
then 2
else 1
benR = durableBonus
* coeff cstore
* case mben of
Nothing -> 1
Just (_, ben) -> ben
* (if recharged then 1 else 0)
in if
not (isMeleeEqp itemFull)
&& benR < 0
&& trange >= chessDist (bpos b) fpos
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 <- actorSkillsClient aid
b <- getsState $ getActorBody aid
localTime <- getsState $ getLocalTime (blid b)
let skill = EM.findWithDefault 0 AbApply actorSk
q _ itemFull _ activeItems =
let freq = case itemDisco itemFull of
Nothing -> []
Just ItemDisco{itemKind} -> IK.ifreq itemKind
in maybe True (<= 0) (lookup "gem" freq)
&& either (const False) id
(permittedApply " " localTime skill itemFull b activeItems)
activeItems <- activeItemsClient aid
let calmE = calmEnough b activeItems
stores = [CEqp, CInv, CGround] ++ [CSha | calmE]
benList <- benAvailableItems aid q stores
organs <- mapM (getsState . getItemBody) $ EM.keys $ borgan b
let itemLegal itemFull = case applyGroup of
ApplyFirstAid ->
let getP (IK.RefillHP p) _ | p > 0 = True
getP (IK.OverfillHP p) _ | p > 0 = True
getP _ acc = acc
in case itemDisco itemFull of
Just ItemDisco{itemAE=Just ItemAspectEffect{jeffects}} ->
foldr getP False jeffects
_ -> False
ApplyAll -> True
coeff CGround = 2
coeff COrgan = 3
coeff CEqp = 100000
coeff CInv = 1
coeff CSha = 1
fTool ((mben, (_, cstore)), (iid, itemFull@ItemFull{itemBase})) =
let durableBonus = if IK.Durable `elem` jfeature itemBase
then 5
else 1
oldGrps = map (toGroupName . jname) organs
createOrganAgain =
let newGrps = strengthCreateOrgan itemFull
in not $ null $ intersect newGrps oldGrps
dropOrganVoid =
let newGrps = strengthDropOrgan itemFull
hasDropOrgan = not $ null newGrps
in hasDropOrgan && null (newGrps `intersect` oldGrps)
benR = case mben of
Nothing -> 0
Just (_, ben) -> ben
* (if not createOrganAgain then 1 else 0)
* (if not dropOrganVoid then 1 else 0)
* durableBonus
* coeff cstore
in if itemLegal itemFull && benR > 0
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 True aid) str
displaceFoe :: MonadClient m => ActorId -> m (Strategy RequestAnyAbility)
displaceFoe aid = do
cops <- getsState scops
b <- getsState $ getActorBody aid
lvl <- getLevel $ blid b
fact <- getsState $ (EM.! bfid b) . sfactionD
let friendlyFid fid = fid == bfid b || isAllied fact fid
friends <- getsState $ actorRegularList friendlyFid (blid b)
allFoes <- getsState $ actorRegularAssocs (isAtWar fact) (blid b)
let accessibleHere = accessible cops lvl $ bpos b
displaceable body =
adjacent (bpos body) (bpos b) && accessibleHere (bpos body)
nFriends body = length $ filter (adjacent (bpos body) . bpos) friends
nFrHere = nFriends b + 1
qualifyActor (aid2, body2) = do
activeItems <- activeItemsClient aid2
dEnemy <- getsState $ dispEnemy aid aid2 activeItems
let nFr = nFriends body2
return $! if displaceable body2 && dEnemy && nFr < nFrHere
then Just (nFr * nFr, bpos body2 `vectorToFrom` bpos b)
else Nothing
vFoes <- mapM qualifyActor allFoes
let str = liftFrequency $ toFreq "displaceFoe" $ catMaybes vFoes
mapStrategyM (moveOrRunAid True aid) str
displaceBlocker :: MonadClient m => ActorId -> m (Strategy RequestAnyAbility)
displaceBlocker aid = do
mtgtMPath <- getsClient $ EM.lookup aid . stargetD
str <- case mtgtMPath of
Just (_, Just (p : q : _, _)) -> displaceTowards aid p q
_ -> return reject
mapStrategyM (moveOrRunAid True aid) str
displaceTowards :: MonadClient m
=> ActorId -> Point -> Point -> m (Strategy Vector)
displaceTowards aid source target = do
cops <- getsState scops
b <- getsState $ getActorBody aid
let !_A = assert (source == bpos b && adjacent source target) ()
lvl <- getLevel $ blid b
if boldpos b /= Just target
&& accessible cops lvl source target then do
mleader <- getsClient _sleader
mBlocker <- getsState $ posToActors target (blid b)
case mBlocker of
[] -> return reject
[(aid2, b2)] | Just aid2 /= mleader -> do
mtgtMPath <- getsClient $ EM.lookup aid2 . stargetD
case mtgtMPath of
Just (tgt, Just (p : q : rest, (goal, len)))
| q == source && p == target
|| waitedLastTurn b2 -> do
let newTgt = if q == source && p == target
then Just (tgt, Just (q : rest, (goal, len 1)))
else Nothing
modifyClient $ \cli ->
cli {stargetD = EM.alter (const newTgt) aid (stargetD cli)}
return $! returN "displace friend" $ target `vectorToFrom` source
Just _ -> return reject
Nothing -> do
tfact <- getsState $ (EM.! bfid b2) . sfactionD
activeItems <- activeItemsClient aid2
dEnemy <- getsState $ dispEnemy aid aid2 activeItems
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 doDisplace avoidAmbient = do
Kind.COps{cotile} <- 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 cotile (lvl `at` pos)
str <- case mtgtMPath of
Just (_, Just (p : q : _, (goal, _))) | not $ avoidAmbient && isAmbient q ->
moveTowards aid p q goal (fleaderMode (gplayer fact) == LeaderNull)
_ -> return reject
mapStrategyM (moveOrRunAid doDisplace aid) str
moveTowards :: MonadClient m
=> ActorId -> Point -> Point -> Point -> Bool -> m (Strategy Vector)
moveTowards aid source target goal relaxed = do
cops@Kind.COps{cotile} <- getsState scops
b <- getsState $ getActorBody aid
actorSk <- actorSkillsClient aid
let 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)) ()
lvl <- getLevel $ blid b
fact <- getsState $ (EM.! bfid b) . sfactionD
friends <- getsState $ actorList (not . isAtWar fact) $ blid b
let noFriends = unoccupied friends
accessibleHere = accessible cops lvl source
bumpableHere p =
let t = lvl `at` p
in alterSkill >= 1
&& (Tile.isOpenable cotile t
|| Tile.isSuspect cotile t
|| Tile.isChangeable cotile t)
enterableHere p = accessibleHere p || bumpableHere p
if noFriends target && enterableHere target then
return $! returN "moveTowards adjacent" $ target `vectorToFrom` source
else do
let goesBack v = maybe False (\oldpos -> v == oldpos `vectorToFrom` source)
(boldpos b)
nonincreasing p = chessDist source goal >= chessDist p goal
isSensible p = (relaxed || nonincreasing p)
&& noFriends p
&& enterableHere p
sensible = [ ((goesBack v, 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
=> Bool -> ActorId -> Vector -> m (Maybe RequestAnyAbility)
moveOrRunAid run source dir = do
cops@Kind.COps{cotile} <- getsState scops
sb <- getsState $ getActorBody source
actorSk <- actorSkillsClient source
let lid = blid sb
lvl <- getLevel lid
let skill = EM.findWithDefault 0 AbAlter actorSk
spos = bpos sb
tpos = spos `shift` dir
t = lvl `at` tpos
tgts <- getsState $ posToActors tpos lid
case tgts of
[(target, b2)] | run -> do
tfact <- getsState $ (EM.! bfid b2) . sfactionD
activeItems <- activeItemsClient target
dEnemy <- getsState $ dispEnemy source target activeItems
if boldpos sb == Just tpos && not (waitedLastTurn sb)
|| not (accessible cops lvl spos tpos)
then return Nothing
else if isAtWar tfact (bfid sb) && not dEnemy
then do
wps <- pickWeaponClient source target
case wps of
Nothing -> return Nothing
Just wp -> return $! Just $ RequestAnyAbility wp
else return $! Just $ RequestAnyAbility $ ReqDisplace target
(target, _) : _ -> do
wps <- pickWeaponClient source target
case wps of
Nothing -> return Nothing
Just wp -> return $! Just $ RequestAnyAbility wp
[]
| accessible cops lvl spos tpos ->
return $! Just $ RequestAnyAbility $ ReqMove dir
| skill < 1 ->
assert `failure` "AI causes AlterUnskilled" `twith` (run, source, dir)
| EM.member tpos $ lfloor lvl ->
assert `failure` "AI causes AlterBlockItem" `twith` (run, source, dir)
| not (Tile.isWalkable cotile t)
&& (Tile.isSuspect cotile t
|| Tile.isOpenable cotile t
|| Tile.isClosable cotile t
|| Tile.isChangeable cotile t) ->
return $! Just $ RequestAnyAbility $ ReqAlter tpos Nothing
| otherwise ->
assert `failure` "AI causes MoveNothing or AlterNothing"
`twith` (run, source, dir)