module Game.LambdaHack.Client.AI.ConditionM
( condAimEnemyPresentM
, condAimEnemyRememberedM
, condTgtNonmovingM
, condAnyFoeAdjM
, condAdjTriggerableM
, condBlocksFriendsM
, condFloorWeaponM
, condNoEqpWeaponM
, condCanProjectM
, condProjectListM
, condDesirableFloorItemM
, condSupport
, benAvailableItems
, hinders
, benGroundItems
, desirableItem
, meleeThreatDistList
, condShineWouldBetrayM
, fleeList
) where
import Prelude ()
import Game.LambdaHack.Common.Prelude
import qualified Data.EnumMap.Strict as EM
import Data.Ord
import Game.LambdaHack.Client.Bfs
import Game.LambdaHack.Client.CommonM
import Game.LambdaHack.Client.MonadClient
import Game.LambdaHack.Client.State
import qualified Game.LambdaHack.Common.Ability as Ability
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.Kind as Kind
import Game.LambdaHack.Common.Level
import Game.LambdaHack.Common.Misc
import Game.LambdaHack.Common.MonadStateRead
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
condAimEnemyPresentM :: MonadClient m => ActorId -> m Bool
condAimEnemyPresentM aid = do
btarget <- getsClient $ getTarget aid
return $ case btarget of
Just (TEnemy _ permit) -> not permit
_ -> False
condAimEnemyRememberedM :: MonadClient m => ActorId -> m Bool
condAimEnemyRememberedM aid = do
b <- getsState $ getActorBody aid
btarget <- getsClient $ getTarget aid
return $ case btarget of
Just (TPoint (TEnemyPos _ permit) lid _) | lid == blid b -> not permit
_ -> False
condTgtNonmovingM :: MonadClient m => ActorId -> m Bool
condTgtNonmovingM aid = do
btarget <- getsClient $ getTarget aid
case btarget of
Just (TEnemy enemy _) -> do
actorMaxSk <- maxActorSkillsClient enemy
return $ EM.findWithDefault 0 Ability.AbMove actorMaxSk <= 0
_ -> return False
condAnyFoeAdjM :: MonadStateRead m => ActorId -> m Bool
condAnyFoeAdjM aid = getsState $ anyFoeAdj aid
condAdjTriggerableM :: MonadStateRead m => ActorId -> m Bool
condAdjTriggerableM aid = do
b <- getsState $ getActorBody aid
lvl <- getLevel $ blid b
let hasTriggerable p = p `EM.member` lembed lvl
return $ any hasTriggerable $ vicinityUnsafe $ bpos b
meleeThreatDistList :: MonadClient m => ActorId -> m [(Int, (ActorId, Actor))]
meleeThreatDistList aid = do
actorAspect <- getsClient sactorAspect
b <- getsState $ getActorBody aid
fact <- getsState $ (EM.! bfid b) . sfactionD
allAtWar <- getsState $ actorRegularAssocs (isAtWar fact) (blid b)
let strongActor (aid2, b2) =
let ar = actorAspect EM.! aid2
actorMaxSkE = aSkills ar
nonmoving = EM.findWithDefault 0 Ability.AbMove actorMaxSkE <= 0
in not (hpTooLow b2 ar || nonmoving)
&& actorCanMelee actorAspect aid2 b2
allThreats = filter strongActor allAtWar
addDist (aid2, b2) = (chessDist (bpos b) (bpos b2), (aid2, b2))
return $ sortBy (comparing fst) $ map addDist allThreats
condBlocksFriendsM :: MonadClient m => ActorId -> m Bool
condBlocksFriendsM aid = do
b <- getsState $ getActorBody aid
ours <- getsState $ fidActorRegularIds (bfid b) (blid b)
targetD <- getsClient stargetD
let blocked aid2 = aid2 /= aid &&
case EM.lookup aid2 targetD of
Just TgtAndPath{tapPath=AndPath{pathList=q : _}} | q == bpos b -> True
_ -> False
return $ any blocked ours
condFloorWeaponM :: MonadClient m => ActorId -> m Bool
condFloorWeaponM aid = do
floorAssocs <- getsState $ getActorAssocs aid CGround
let lootIsWeapon = any (isMelee . snd) floorAssocs
return lootIsWeapon
condNoEqpWeaponM :: MonadClient m => ActorId -> m Bool
condNoEqpWeaponM aid = do
eqpAssocs <- getsState $ getActorAssocs aid CEqp
return $ all (not . isMelee . snd) eqpAssocs
condCanProjectM :: MonadClient m => Int -> ActorId -> m Bool
condCanProjectM skill aid = do
benList <- condProjectListM skill aid
return $ not $ null benList
condProjectListM :: MonadClient m
=> Int -> ActorId
-> m [(Maybe Benefit, CStore, ItemId, ItemFull)]
condProjectListM skill aid = do
b <- getsState $ getActorBody aid
condShineWouldBetray <- condShineWouldBetrayM aid
condAimEnemyPresent <- condAimEnemyPresentM aid
actorAspect <- getsClient sactorAspect
let ar = fromMaybe (assert `failure` aid) (EM.lookup aid actorAspect)
calmE = calmEnough b ar
condNotCalmEnough = not calmE
heavilyDistressed =
deltaSerious (bcalmDelta b)
hind = hinders condShineWouldBetray condAimEnemyPresent
heavilyDistressed condNotCalmEnough b ar
q (mben, _, _, itemFull) =
let (bInEqp, bFling) = case mben of
Just Benefit{benInEqp, benFling} -> (benInEqp, benFling)
Nothing -> (goesIntoEqp $ itemBase itemFull, -10)
in bFling < 0
&& (not bInEqp
|| not (isMelee $ itemBase itemFull)
&& hind itemFull)
&& permittedProjectAI skill calmE itemFull
benList <- benAvailableItems aid $ [CEqp, CInv, CGround] ++ [CSha | calmE]
return $ filter q benList
benAvailableItems :: MonadClient m
=> ActorId -> [CStore]
-> m [(Maybe Benefit, CStore, ItemId, ItemFull)]
benAvailableItems aid cstores = do
itemToF <- itemToFullClient
b <- getsState $ getActorBody aid
discoBenefit <- getsClient sdiscoBenefit
s <- getState
let ben cstore bag =
[ (mben, cstore, iid, itemFull)
| (iid, kit) <- EM.assocs bag
, let itemFull = itemToF iid kit
mben = EM.lookup iid discoBenefit ]
benCStore cs = ben cs $ getBodyStoreBag b cs s
return $ concatMap benCStore cstores
hinders :: Bool -> Bool -> Bool -> Bool -> Actor -> AspectRecord -> ItemFull
-> Bool
hinders condShineWouldBetray condAimEnemyPresent
heavilyDistressed condNotCalmEnough
body ar itemFull =
let itemShine = 0 < aShine (aspectRecordFull itemFull)
itemShineBad = condShineWouldBetray && itemShine
in
(condAimEnemyPresent || condNotCalmEnough || heavilyDistressed)
&& itemShineBad
|| bspeed body ar > speedWalk
&& not (isMelee $ itemBase itemFull)
&& 0 > aHurtMelee (aspectRecordFull itemFull)
condDesirableFloorItemM :: MonadClient m => ActorId -> m Bool
condDesirableFloorItemM aid = do
benItemL <- benGroundItems aid
return $ not $ null benItemL
benGroundItems :: MonadClient m
=> ActorId
-> m [(Maybe Benefit, CStore, ItemId, ItemFull)]
benGroundItems aid = do
b <- getsState $ getActorBody aid
fact <- getsState $ (EM.! bfid b) . sfactionD
let canEsc = fcanEscape (gplayer fact)
isDesirable (mben, _, _, itemFull) =
desirableItem canEsc (benPickup <$> mben) (itemBase itemFull)
benList <- benAvailableItems aid [CGround]
return $ filter isDesirable benList
desirableItem :: Bool -> Maybe Int -> Item -> Bool
desirableItem canEsc mpickupSum item =
if canEsc
then fromMaybe 10 mpickupSum > 0
|| IK.Precious `elem` jfeature item
else
let preciousNotUseful =
IK.Precious `elem` jfeature item
&& IK.Equipable `notElem` jfeature item
in fromMaybe 10 mpickupSum > 0
&& not preciousNotUseful
condSupport :: MonadClient m => Int -> ActorId -> m Bool
condSupport param aid = do
actorAspect <- getsClient sactorAspect
b <- getsState $ getActorBody aid
btarget <- getsClient $ getTarget aid
mtgtPos <- case btarget of
Nothing -> return Nothing
Just target -> aidTgtToPos aid (blid b) target
condAimEnemyPresent <- condAimEnemyPresentM aid
condAimEnemyRemembered <- condAimEnemyRememberedM aid
fact <- getsState $ (EM.! bfid b) . sfactionD
let friendlyFid fid = fid == bfid b || isAllied fact fid
ar = actorAspect EM.! aid
friends <- getsState $ actorRegularAssocs friendlyFid (blid b)
let approaching = case mtgtPos of
Just tgtPos | condAimEnemyPresent || condAimEnemyRemembered ->
\b2 -> chessDist (bpos b2) tgtPos <= 1 + param
_ -> const False
closeEnough b2 = let dist = chessDist (bpos b) (bpos b2)
in dist > 0 && (dist <= param || approaching b2)
closeAndStrong (aid2, b2) = closeEnough b2
&& actorCanMelee actorAspect aid2 b2
closeAndStrongFriends = filter closeAndStrong friends
suport = length closeAndStrongFriends >= param - aAggression ar
|| length friends <= 1
return suport
condShineWouldBetrayM :: MonadClient m => ActorId -> m Bool
condShineWouldBetrayM aid = do
b <- getsState $ getActorBody aid
aInAmbient <- getsState $ actorInAmbient b
return $ not aInAmbient
fleeList :: MonadClient m => ActorId -> m ([(Int, Point)], [(Int, Point)])
fleeList aid = do
Kind.COps{coTileSpeedup} <- getsState scops
mtgtMPath <- getsClient $ EM.lookup aid . stargetD
let etgtPath = case mtgtMPath of
Just TgtAndPath{ tapPath=tapPath@AndPath{pathList}
, tapTgt } -> case tapTgt of
TEnemy{} -> Left tapPath
TPoint TEnemyPos{} _ _ -> Left tapPath
_ -> Right pathList
_ -> Right []
b <- getsState $ getActorBody aid
allFoes <- getsState $ warActorRegularList (bfid b) (blid b)
lvl@Level{lxsize, lysize} <- getLevel $ blid b
s <- getState
let posFoes = map bpos allFoes
myVic = vicinity lxsize lysize $ bpos b
dist p | null posFoes = 100
| otherwise = minimum $ map (chessDist p) posFoes
dVic = map (dist &&& id) myVic
accUnocc p = Tile.isWalkable coTileSpeedup (lvl `at` p)
&& null (posToAssocs p (blid b) s)
accVic = filter (accUnocc . snd) dVic
gtVic = filter ((> dist (bpos b)) . fst) accVic
eqVic = filter ((== dist (bpos b)) . fst) accVic
ltVic = filter ((< dist (bpos b)) . fst) accVic
rewardPath mult (d, p) = case etgtPath of
Right tgtPath | p `elem` tgtPath ->
(100 * mult * d, p)
Right tgtPath | any (adjacent p) tgtPath ->
(10 * mult * d, p)
Left AndPath{pathGoal} | bpos b /= pathGoal ->
let venemy = towards (bpos b) pathGoal
vflee = towards (bpos b) p
sq = euclidDistSqVector venemy vflee
skew = case compare sq 2 of
GT -> 100 * sq
EQ -> 10 * sq
LT -> sq
in (mult * skew * d, p)
_ -> (mult * d, p)
goodVic = map (rewardPath 10000) gtVic
++ map (rewardPath 100) eqVic
badVic = map (rewardPath 1) ltVic
return (goodVic, badVic)