module Game.LambdaHack.Client.AI.ConditionClient
( condTgtEnemyPresentM
, condTgtEnemyRememberedM
, condTgtEnemyAdjFriendM
, condTgtNonmovingM
, condAnyFoeAdjM
, condHpTooLowM
, condOnTriggerableM
, condBlocksFriendsM
, condFloorWeaponM
, condNoEqpWeaponM
, condEnoughGearM
, condCanProjectM
, condNotCalmEnoughM
, condDesirableFloorItemM
, condMeleeBadM
, condLightBetraysM
, benAvailableItems
, hinders
, benGroundItems
, desirableItem
, threatDistList
, fleeList
) where
import Control.Applicative
import Control.Arrow ((&&&))
import Control.Exception.Assert.Sugar
import Control.Monad
import qualified Data.EnumMap.Strict as EM
import Data.List
import Data.Maybe
import Data.Ord
import Game.LambdaHack.Client.AI.Preferences
import Game.LambdaHack.Client.CommonClient
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 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 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
condTgtEnemyPresentM :: MonadClient m => ActorId -> m Bool
condTgtEnemyPresentM aid = do
btarget <- getsClient $ getTarget aid
return $! case btarget of
Just (TEnemy _ permit) -> not permit
_ -> False
condTgtEnemyRememberedM :: MonadClient m => ActorId -> m Bool
condTgtEnemyRememberedM aid = do
b <- getsState $ getActorBody aid
btarget <- getsClient $ getTarget aid
return $! case btarget of
Just (TEnemyPos _ lid _ permit) | lid == blid b -> not permit
_ -> False
condTgtEnemyAdjFriendM :: MonadClient m => ActorId -> m Bool
condTgtEnemyAdjFriendM aid = do
btarget <- getsClient $ getTarget aid
case btarget of
Just (TEnemy enemy _) -> do
be <- getsState $ getActorBody enemy
b <- getsState $ getActorBody aid
fact <- getsState $ (EM.! bfid b) . sfactionD
let friendlyFid fid = fid == bfid b || isAllied fact fid
friends <- getsState $ actorRegularList friendlyFid (blid b)
return $ any (adjacent (bpos be) . bpos) friends
_ -> return False
condTgtNonmovingM :: MonadClient m => ActorId -> m Bool
condTgtNonmovingM aid = do
btarget <- getsClient $ getTarget aid
case btarget of
Just (TEnemy enemy _) -> do
activeItems <- activeItemsClient enemy
let actorMaxSkE = sumSkills activeItems
return $! EM.findWithDefault 0 Ability.AbMove actorMaxSkE <= 0
_ -> return False
condAnyFoeAdjM :: MonadStateRead m => ActorId -> m Bool
condAnyFoeAdjM aid = do
b <- getsState $ getActorBody aid
fact <- getsState $ (EM.! bfid b) . sfactionD
allFoes <- getsState $ actorRegularList (isAtWar fact) (blid b)
return $ any (adjacent (bpos b) . bpos) allFoes
condHpTooLowM :: MonadClient m => ActorId -> m Bool
condHpTooLowM aid = do
b <- getsState $ getActorBody aid
activeItems <- activeItemsClient aid
return $! hpTooLow b activeItems
condOnTriggerableM :: MonadStateRead m => ActorId -> m Bool
condOnTriggerableM aid = do
Kind.COps{cotile} <- getsState scops
b <- getsState $ getActorBody aid
lvl <- getLevel $ blid b
let t = lvl `at` bpos b
return $! not $ null $ Tile.causeEffects cotile t
threatDistList :: MonadClient m => ActorId -> m [(Int, (ActorId, Actor))]
threatDistList aid = do
b <- getsState $ getActorBody aid
fact <- getsState $ (EM.! bfid b) . sfactionD
allAtWar <- getsState $ actorRegularAssocs (isAtWar fact) (blid b)
let strongActor (aid2, b2) = do
activeItems <- activeItemsClient aid2
let actorMaxSkE = sumSkills activeItems
nonmoving = EM.findWithDefault 0 Ability.AbMove actorMaxSkE <= 0
return $! not $ (hpTooLow b2 activeItems || nonmoving)
allThreats <- filterM strongActor allAtWar
let 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 $ actorRegularAssocs (== bfid b) (blid b)
targetD <- getsClient stargetD
let blocked (aid2, _) = aid2 /= aid &&
case EM.lookup aid2 targetD of
Just (_, Just (_ : q : _, _)) | q == bpos b -> True
_ -> False
return $ any blocked ours
condFloorWeaponM :: MonadClient m => ActorId -> m Bool
condFloorWeaponM aid = do
floorAssocs <- fullAssocsClient aid [CGround]
let lootIsWeapon = any (isMeleeEqp . snd) floorAssocs
return lootIsWeapon
condNoEqpWeaponM :: MonadClient m => ActorId -> m Bool
condNoEqpWeaponM aid = do
allAssocs <- fullAssocsClient aid [CEqp]
return $ all (not . isMelee . snd) allAssocs
condEnoughGearM :: MonadClient m => ActorId -> m Bool
condEnoughGearM aid = do
eqpAssocs <- fullAssocsClient aid [CEqp]
invAssocs <- fullAssocsClient aid [CInv]
return $ any (isMelee . snd) eqpAssocs
|| length (eqpAssocs ++ invAssocs) >= 5
condCanProjectM :: MonadClient m => Bool -> ActorId -> m Bool
condCanProjectM maxSkills aid = do
actorSk <- if maxSkills
then do
activeItems <- activeItemsClient aid
return $! sumSkills activeItems
else
actorSkillsClient aid
let skill = EM.findWithDefault 0 Ability.AbProject actorSk
q _ itemFull b activeItems =
either (const False) id
$ permittedProject " " False skill itemFull b activeItems
benList <- benAvailableItems aid q [CEqp, CInv, CGround]
let missiles = filter (maybe True ((< 0) . snd) . fst . fst) benList
return $ not (null missiles)
benAvailableItems :: MonadClient m
=> ActorId
-> (Maybe Int -> ItemFull -> Actor -> [ItemFull] -> Bool)
-> [CStore]
-> m [( (Maybe (Int, Int), (Int, CStore))
, (ItemId, ItemFull) )]
benAvailableItems aid permitted cstores = do
cops <- getsState scops
itemToF <- itemToFullClient
b <- getsState $ getActorBody aid
activeItems <- activeItemsClient aid
fact <- getsState $ (EM.! bfid b) . sfactionD
condAnyFoeAdj <- condAnyFoeAdjM aid
condLightBetrays <- condLightBetraysM aid
condTgtEnemyPresent <- condTgtEnemyPresentM aid
condNotCalmEnough <- condNotCalmEnoughM aid
let ben cstore bag =
[ ((benefit, (k, cstore)), (iid, itemFull))
| (iid, kit@(k, _)) <- EM.assocs bag
, let itemFull = itemToF iid kit
benefit = totalUsefulness cops b activeItems fact itemFull
hind = hinders condAnyFoeAdj condLightBetrays
condTgtEnemyPresent condNotCalmEnough
b activeItems itemFull
, permitted (fst <$> benefit) itemFull b activeItems
&& (cstore /= CEqp || hind) ]
benCStore cs = do
bag <- getsState $ getActorBag aid cs
return $! ben cs bag
perBag <- mapM benCStore cstores
return $ concat perBag
hinders :: Bool -> Bool -> Bool -> Bool -> Actor -> [ItemFull] -> ItemFull
-> Bool
hinders condAnyFoeAdj condLightBetrays condTgtEnemyPresent
condNotCalmEnough
body activeItems itemFull =
let itemLit = isJust $ strengthFromEqpSlot IK.EqpSlotAddLight itemFull
in
bspeed body activeItems > speedNormal
&& (condNotCalmEnough && itemLit
|| 0 > fromMaybe 0 (strengthFromEqpSlot IK.EqpSlotAddHurtMelee
itemFull)
|| 0 > fromMaybe 0 (strengthFromEqpSlot IK.EqpSlotAddHurtRanged
itemFull))
|| let heavilyDistressed =
deltaSerious (bcalmDelta body)
in condNotCalmEnough
&& (heavilyDistressed || condTgtEnemyPresent)
&& condLightBetrays && not condAnyFoeAdj
&& itemLit
condNotCalmEnoughM :: MonadClient m => ActorId -> m Bool
condNotCalmEnoughM aid = do
b <- getsState $ getActorBody aid
activeItems <- activeItemsClient aid
return $! not (calmEnough b activeItems)
condDesirableFloorItemM :: MonadClient m => ActorId -> m Bool
condDesirableFloorItemM aid = do
benItemL <- benGroundItems aid
return $ not $ null benItemL
benGroundItems :: MonadClient m
=> ActorId
-> m [( (Maybe (Int, Int)
, (Int, CStore)), (ItemId, ItemFull) )]
benGroundItems aid = do
b <- getsState $ getActorBody aid
canEscape <- factionCanEscape (bfid b)
benAvailableItems aid (\use itemFull _ _ ->
desirableItem canEscape use itemFull) [CGround]
desirableItem :: Bool -> Maybe Int -> ItemFull -> Bool
desirableItem canEsc use itemFull =
let item = itemBase itemFull
freq = case itemDisco itemFull of
Nothing -> []
Just ItemDisco{itemKind} -> IK.ifreq itemKind
in if canEsc
then use /= Just 0
|| IK.Precious `elem` jfeature item
else
let preciousWithoutSlot =
IK.Precious `elem` jfeature item
&& isNothing (strengthEqpSlot item)
in use /= Just 0
&& not (isNothing use
&& preciousWithoutSlot)
&& maybe True (<= 0) (lookup "gem" freq)
condMeleeBadM :: MonadClient m => ActorId -> m Bool
condMeleeBadM aid = do
b <- getsState $ getActorBody aid
btarget <- getsClient $ getTarget aid
mtgtPos <- aidTgtToPos aid (blid b) btarget
condTgtEnemyPresent <- condTgtEnemyPresentM aid
condTgtEnemyRemembered <- condTgtEnemyRememberedM aid
fact <- getsState $ (EM.! bfid b) . sfactionD
activeItems <- activeItemsClient aid
let condNoUsableWeapon = all (not . isMelee) activeItems
friendlyFid fid = fid == bfid b || isAllied fact fid
friends <- getsState $ actorRegularAssocs friendlyFid (blid b)
friendlyFacts <-
getsState $ map snd . filter (friendlyFid . fst) . EM.assocs . sfactionD
Level{lactorFreq} <- getLevel $ blid b
let freqNames = map fst lactorFreq
factNames = map (fgroup . gplayer) friendlyFacts
spawnerOnLvl = any (`elem` freqNames) factNames
closeEnough b2 = let dist = chessDist (bpos b) (bpos b2)
in dist > 0 && (dist <= 2 || approaching b2)
approaching = case mtgtPos of
Just tgtPos | condTgtEnemyPresent || condTgtEnemyRemembered ->
\b1 -> chessDist (bpos b1) tgtPos <= 3
_ -> const False
closeFriends = filter (closeEnough . snd) friends
strongActor (aid2, b2) = do
activeItems2 <- activeItemsClient aid2
let condUsableWeapon2 = any isMelee activeItems2
actorMaxSk2 = sumSkills activeItems2
canMelee2 = EM.findWithDefault 0 Ability.AbMelee actorMaxSk2 > 0
hpGood = not $ hpTooLow b2 activeItems2
return $! hpGood && condUsableWeapon2 && canMelee2
strongCloseFriends <- filterM strongActor closeFriends
let noFriendlyHelp = length closeFriends < 3
&& null strongCloseFriends
&& (length friends > 1
|| spawnerOnLvl)
&& not (hpHuge b)
let actorMaxSk = sumSkills activeItems
return $ condNoUsableWeapon
|| EM.findWithDefault 0 Ability.AbMelee actorMaxSk <= 0
|| noFriendlyHelp
condLightBetraysM :: MonadClient m => ActorId -> m Bool
condLightBetraysM aid = do
b <- getsState $ getActorBody aid
eqpItems <- map snd <$> fullAssocsClient aid [CEqp]
let actorEqpShines = sumSlotNoFilter IK.EqpSlotAddLight eqpItems > 0
aInAmbient <- getsState $ actorInAmbient b
return $! not aInAmbient
&& actorEqpShines
fleeList :: MonadClient m => ActorId -> m ([(Int, Point)], [(Int, Point)])
fleeList aid = do
cops <- getsState scops
mtgtMPath <- getsClient $ EM.lookup aid . stargetD
let tgtPath = case mtgtMPath of
Just (TEnemy{}, _) -> []
Just (TEnemyPos{}, _) -> []
Just (_, Just (_ : path, _)) -> path
_ -> []
b <- getsState $ getActorBody aid
fact <- getsState $ \s -> sfactionD s EM.! bfid b
allFoes <- getsState $ actorRegularList (isAtWar fact) (blid b)
lvl@Level{lxsize, lysize} <- getLevel $ blid b
let posFoes = map bpos allFoes
accessibleHere = accessible cops lvl $ bpos b
myVic = vicinity lxsize lysize $ bpos b
dist p | null posFoes = assert `failure` b
| otherwise = minimum $ map (chessDist p) posFoes
dVic = map (dist &&& id) myVic
accVic = filter (accessibleHere . 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)
| p `elem` tgtPath = (100 * mult * d, p)
| any (\q -> chessDist p q == 1) tgtPath = (10 * mult * d, p)
| otherwise = (mult * d, p)
goodVic = map (rewardPath 10000) gtVic
++ map (rewardPath 100) eqVic
badVic = map (rewardPath 1) ltVic
return (goodVic, badVic)