module Game.LambdaHack.Client.StrategyAction
( targetStrategy, actionStrategy, visibleFoes
) where
import Control.Monad
import qualified Data.EnumMap.Strict as EM
import Data.Function
import Data.List
import Data.Maybe
import qualified Data.Traversable as Traversable
import Game.LambdaHack.Client.Action
import Game.LambdaHack.Client.State
import Game.LambdaHack.Client.Strategy
import Game.LambdaHack.Common.Ability (Ability)
import qualified Game.LambdaHack.Common.Ability as Ability
import Game.LambdaHack.Common.Action
import Game.LambdaHack.Common.Actor
import Game.LambdaHack.Common.ActorState
import qualified Game.LambdaHack.Common.Effect as Effect
import Game.LambdaHack.Common.Faction
import qualified Game.LambdaHack.Common.Feature as F
import Game.LambdaHack.Common.Item
import qualified Game.LambdaHack.Common.Kind as Kind
import Game.LambdaHack.Common.Level
import Game.LambdaHack.Common.Perception
import Game.LambdaHack.Common.Point
import qualified Game.LambdaHack.Common.Random as Random
import Game.LambdaHack.Common.ServerCmd
import Game.LambdaHack.Common.State
import qualified Game.LambdaHack.Common.Tile as Tile
import Game.LambdaHack.Common.Time
import Game.LambdaHack.Common.Vector
import Game.LambdaHack.Content.ActorKind
import Game.LambdaHack.Content.ItemKind
import Game.LambdaHack.Content.RuleKind
import Game.LambdaHack.Content.TileKind as TileKind
import Control.Exception.Assert.Sugar
import Game.LambdaHack.Utils.Frequency
targetStrategy :: MonadClient m
=> ActorId -> [Ability] -> m (Strategy (Maybe Target))
targetStrategy aid factionAbilities = do
btarget <- getsClient $ getTarget aid
fper <- getsClient sfper
reacquireTgt aid factionAbilities btarget fper
visibleFoes :: MonadActionRO m
=> ActorId -> FactionPers -> m [(ActorId, Actor)]
visibleFoes aid fper = do
b <- getsState $ getActorBody aid
assert (not $ bproj b) skip
let per = fper EM.! blid b
fact <- getsState $ \s -> sfactionD s EM.! bfid b
foes <- getsState $ actorNotProjAssocs (isAtWar fact) (blid b)
return $! filter (actorSeesPos per aid . bpos . snd) foes
reacquireTgt :: MonadActionRO m
=> ActorId -> [Ability] -> Maybe Target -> FactionPers
-> m (Strategy (Maybe Target))
reacquireTgt aid factionAbilities btarget fper = do
cops@Kind.COps{coactor=Kind.Ops{okind}} <- getsState scops
b <- getsState $ getActorBody aid
assert (not $ bproj b) skip
lvl@Level{lxsize} <- getsState $ \s -> sdungeon s EM.! blid b
visFoes <- visibleFoes aid fper
actorD <- getsState sactorD
noFoes :: Strategy (Maybe Target) <- do
s <- getState
str <- moveStrategy cops aid s Nothing
return $ (Just . TPos . (bpos b `shift`)) `liftM` str
let per = fper EM.! blid b
mk = okind $ bkind b
actorAbilities = acanDo mk `intersect` factionAbilities
focused = bspeed b <= speedNormal
&& Ability.Chase `elem` actorAbilities
closest :: Strategy (Maybe Target)
closest =
let distB = chessDist lxsize (bpos b)
foeDist = map (\(_, body) -> distB (bpos body)) visFoes
minDist | null foeDist = maxBound
| otherwise = minimum foeDist
minFoes =
filter (\(_, body) -> distB (bpos body) == minDist) visFoes
minTargets = map (\(a, body) ->
Just $ TEnemy a $ bpos body) minFoes
minTgtS = liftFrequency $ uniformFreq "closest" minTargets
in minTgtS .| noFoes .| returN "TCursor" Nothing
reacquire :: Maybe Target -> Strategy (Maybe Target)
reacquire tgt =
case tgt of
Just (TEnemy a ll) | focused ->
case fmap bpos $ EM.lookup a actorD of
Just l | actorSeesPos per aid l ->
returN "TEnemy" $ Just $ TEnemy a l
_ -> if null visFoes
&& bpos b /= ll
then returN "last known" $ Just $ TPos ll
else closest
Just TEnemy{} -> closest
Just (TPos pos) | bpos b == pos -> closest
Just (TPos pos)
| not $ bumpableHere cops lvl False (asight mk) pos ->
closest
Just TPos{} | null visFoes -> returN "TPos" tgt
Just TPos{} -> closest
Nothing -> closest
return $! reacquire btarget
actionStrategy :: MonadClient m
=> ActorId -> [Ability] -> m (Strategy CmdSerTakeTime)
actionStrategy aid factionAbilities = do
disco <- getsClient sdisco
btarget <- getsClient $ getTarget aid
proposeAction disco aid factionAbilities btarget
proposeAction :: MonadActionRO m
=> Discovery -> ActorId -> [Ability] -> Maybe Target
-> m (Strategy CmdSerTakeTime)
proposeAction disco aid factionAbilities btarget = do
Kind.COps{coactor=Kind.Ops{okind}} <- getsState scops
Actor{bkind, bpos, blid} <- getsState $ getActorBody aid
lvl <- getLevel blid
let mk = okind bkind
(fpos, mfAid) =
case btarget of
Just (TEnemy foeAid l) -> (l, Just foeAid)
Just (TPos l) -> (l, Nothing)
Nothing -> (bpos, Nothing)
foeVisible = isJust mfAid
lootHere x = not $ EM.null $ lvl `atI` x
actorAbilities = acanDo mk `intersect` factionAbilities
isDistant = (`elem` [ Ability.Trigger
, Ability.Ranged
, Ability.Tools
, Ability.Chase ])
(prefix, rest) = break isDistant actorAbilities
(distant, suffix) = partition isDistant rest
aFrequency :: MonadActionRO m => Ability -> m (Frequency CmdSerTakeTime)
aFrequency Ability.Trigger = if foeVisible then return mzero
else triggerFreq aid
aFrequency Ability.Ranged = if not foeVisible then return mzero
else rangedFreq disco aid fpos
aFrequency Ability.Tools = if not foeVisible then return mzero
else toolsFreq disco aid
aFrequency Ability.Chase = if fpos == bpos then return mzero
else chaseFreq
aFrequency ab = assert `failure` "unexpected ability"
`twith` (ab, distant, actorAbilities)
chaseFreq :: MonadActionRO m => m (Frequency CmdSerTakeTime)
chaseFreq = do
st <- chase aid (fpos, foeVisible)
return $ scaleFreq 30 $ bestVariant st
aStrategy :: MonadActionRO m => Ability -> m (Strategy CmdSerTakeTime)
aStrategy Ability.Track = track aid
aStrategy Ability.Heal = return mzero
aStrategy Ability.Flee = return mzero
aStrategy Ability.Melee | Just foeAid <- mfAid = melee aid fpos foeAid
aStrategy Ability.Melee = return mzero
aStrategy Ability.Pickup | not foeVisible && lootHere bpos = pickup aid
aStrategy Ability.Pickup = return mzero
aStrategy Ability.Wander = wander aid
aStrategy ab = assert `failure` "unexpected ability"
`twith`(ab, actorAbilities)
sumS abis = do
fs <- mapM aStrategy abis
return $ msum fs
sumF abis = do
fs <- mapM aFrequency abis
return $ msum fs
combineDistant as = fmap liftFrequency $ sumF as
sumPrefix <- sumS prefix
comDistant <- combineDistant distant
sumSuffix <- sumS suffix
return $ sumPrefix .| comDistant .| sumSuffix
.| waitBlockNow aid
waitBlockNow :: ActorId -> Strategy CmdSerTakeTime
waitBlockNow aid = returN "wait" $ WaitSer aid
track :: MonadActionRO m => ActorId -> m (Strategy CmdSerTakeTime)
track aid = do
cops <- getsState scops
b@Actor{bpos, bpath, blid} <- getsState $ getActorBody aid
lvl <- getLevel blid
let clearPath = returN "ClearPathSer" $ SetPathSer aid []
strat = case bpath of
Nothing -> reject
Just [] -> assert `failure` "null path" `twith` (aid, b)
Just (d : _) | not $ accessibleDir cops lvl bpos d -> clearPath
Just lv -> returN "SetPathSer" $ SetPathSer aid lv
return strat
pickup :: MonadActionRO m => ActorId -> m (Strategy CmdSerTakeTime)
pickup aid = do
body@Actor{bpos, blid} <- getsState $ getActorBody aid
lvl <- getLevel blid
actionPickup <- case EM.minViewWithKey $ lvl `atI` bpos of
Nothing -> assert `failure` "pickup of empty pile" `twith` (aid, bpos, lvl)
Just ((iid, k), _) -> do
item <- getsState $ getItemBody iid
let l = if jsymbol item == '$' then Just $ InvChar '$' else Nothing
return $ case assignLetter iid l body of
Just l2 -> returN "pickup" $ PickupSer aid iid k l2
Nothing -> returN "pickup" $ WaitSer aid
return actionPickup
melee :: MonadActionRO m
=> ActorId -> Point -> ActorId -> m (Strategy CmdSerTakeTime)
melee aid fpos foeAid = do
Actor{bpos, blid} <- getsState $ getActorBody aid
Level{lxsize} <- getLevel blid
let foeAdjacent = adjacent lxsize bpos fpos
return $ foeAdjacent .=> returN "melee" (MeleeSer aid foeAid)
triggerFreq :: MonadActionRO m
=> ActorId -> m (Frequency CmdSerTakeTime)
triggerFreq aid = do
cops@Kind.COps{cotile=Kind.Ops{okind}} <- getsState scops
b@Actor{bpos, blid, bfid, boldpos} <- getsState $ getActorBody aid
fact <- getsState $ \s -> sfactionD s EM.! bfid
lvl <- getLevel blid
let spawn = isSpawnFact cops fact
t = lvl `at` bpos
feats = TileKind.tfeature $ okind t
ben feat = case feat of
F.Cause Effect.Escape | spawn -> 0
F.Cause ef -> effectToBenefit cops b ef
_ -> 0
benFeat = zip (map ben feats) feats
recentlyAscended = bpos == boldpos
fast = bspeed b > speedNormal
if recentlyAscended || fast then
return mzero
else
return $ toFreq "triggerFreq" $ [ (benefit, TriggerSer aid (Just feat))
| (benefit, feat) <- benFeat
, benefit > 0 ]
rangedFreq :: MonadActionRO m
=> Discovery -> ActorId -> Point -> m (Frequency CmdSerTakeTime)
rangedFreq disco aid fpos = do
cops@Kind.COps{ coactor=Kind.Ops{okind}
, coitem=Kind.Ops{okind=iokind}
, corule
, cotile
} <- getsState scops
b@Actor{bkind, bpos, bfid, blid, bbag, binv} <- getsState $ getActorBody aid
lvl@Level{lxsize, lysize} <- getLevel blid
let mk = okind bkind
tis = lvl `atI` bpos
fact <- getsState $ \s -> sfactionD s EM.! bfid
foes <- getsState $ actorNotProjList (isAtWar fact) blid
let foesAdj = foesAdjacent lxsize lysize bpos foes
posClear pos1 = Tile.hasFeature cotile F.Clear (lvl `at` pos1)
as <- getsState $ actorList (const True) blid
s <- getState
let eps = 0
bl = bla lxsize lysize eps bpos fpos
permitted = (if aiq mk >= 10 then ritemProject else ritemRanged)
$ Kind.stdRuleset corule
throwFreq bag multi container =
[ ( benefit * multi,
ProjectSer aid fpos eps iid (container iid))
| (iid, i) <- map (\iid -> (iid, getItemBody iid s))
$ EM.keys bag
, let benefit =
case jkind disco i of
Nothing ->
effectToBenefit cops b (jeffect i)
Just _ki ->
let _kik = iokind _ki
_unneeded = isymbol _kik
in effectToBenefit cops b (jeffect i)
, benefit < 0
, jsymbol i `elem` permitted ]
return $ toFreq "throwFreq" $
case bl of
Just (pos1 : _) ->
if not foesAdj
&& asight mk
&& posClear pos1
&& unoccupied as pos1
then throwFreq bbag 3 (actorContainer aid binv)
++ throwFreq tis 6 (const $ CFloor blid bpos)
else []
_ -> []
toolsFreq :: MonadActionRO m
=> Discovery -> ActorId -> m (Frequency CmdSerTakeTime)
toolsFreq disco aid = do
cops@Kind.COps{coactor=Kind.Ops{okind}} <- getsState scops
b@Actor{bkind, bpos, blid, bbag, binv} <- getsState $ getActorBody aid
lvl <- getLevel blid
s <- getState
let tis = lvl `atI` bpos
mk = okind bkind
mastered | aiq mk < 5 = ""
| aiq mk < 10 = "!"
| otherwise = "!?"
useFreq bag multi container =
[ (benefit * multi, ApplySer aid iid (container iid))
| (iid, i) <- map (\iid -> (iid, getItemBody iid s))
$ EM.keys bag
, let benefit =
case jkind disco i of
Nothing -> 30
Just _ki -> effectToBenefit cops b $ jeffect i
, benefit > 0
, jsymbol i `elem` mastered ]
return $ toFreq "useFreq" $
useFreq bbag 1 (actorContainer aid binv)
++ useFreq tis 2 (const $ CFloor blid bpos)
moveStrategy :: MonadActionRO m
=> Kind.COps -> ActorId -> State -> Maybe (Point, Bool)
-> m (Strategy Vector)
moveStrategy cops aid s mFoe =
return $ case mFoe of
Just (fpos, _) ->
let towardsFoe =
let tolerance | adjacent lxsize bpos fpos = 0
| otherwise = 1
foeDir = towards lxsize bpos fpos
in only (\x -> euclidDistSq lxsize foeDir x <= tolerance)
in if fpos == bpos
then reject
else towardsFoe
$ if foeVisible
then moveClear
.| moveOpenable
else moveOpenable
.| moveClear
Nothing ->
let smells =
map (map fst)
$ groupBy ((==) `on` snd)
$ sortBy (flip compare `on` snd)
$ filter (\(_, sm) -> sm > timeZero)
$ map (\x ->
let sml = EM.findWithDefault
timeZero (bpos `shift` x) lsmell
in (x, sml `timeAdd` timeNegate ltime))
sensible
in asmell mk .=> foldr ((.|)
. liftFrequency
. uniformFreq "smell k") reject smells
.| moveOpenable
.| moveClear
where
Kind.COps{cotile, coactor=Kind.Ops{okind}} = cops
lvl@Level{lsmell, lxsize, lysize, ltime} = sdungeon s EM.! blid
Actor{bkind, bpos, boldpos, bfid, blid} = getActorBody aid s
mk = okind bkind
lootHere x = not $ EM.null $ lvl `atI` x
onlyLoot = onlyMoves lootHere
interestHere x = let t = lvl `at` x
ts = map (lvl `at`) $ vicinity lxsize lysize x
in Tile.hasFeature cotile F.Exit t
|| asight mk && Tile.hasFeature cotile F.Suspect t
|| (not (Tile.hasFeature cotile F.Lit t)
&& (x == bpos || accessible cops lvl x bpos)
&& any (Tile.hasFeature cotile F.Lit) ts)
onlyInterest = onlyMoves interestHere
bdirAI | bpos == boldpos = Nothing
| otherwise = Just $ towards lxsize boldpos bpos
onlyKeepsDir k =
only (\x -> maybe True (\d -> euclidDistSq lxsize d x <= k) bdirAI)
onlyKeepsDir_9 = only (\x -> maybe True (\d -> neg x /= d) bdirAI)
foeVisible = fmap snd mFoe == Just True
moveIQ | foeVisible = onlyKeepsDir_9 moveRandomly
| otherwise =
aiq mk > 15 .=> onlyKeepsDir 0 moveRandomly
.| aiq mk > 10 .=> onlyKeepsDir 1 moveRandomly
.| aiq mk > 5 .=> onlyKeepsDir 2 moveRandomly
.| onlyKeepsDir_9 moveRandomly
interestFreq | interestHere bpos =
mzero
| otherwise =
scaleFreq 10 $ bestVariant $ onlyInterest $ onlyKeepsDir 2 moveRandomly
interestIQFreq = interestFreq `mplus` bestVariant moveIQ
moveClear =
onlyMoves (not . bumpableHere cops lvl foeVisible (asight mk)) moveFreely
moveOpenable =
onlyMoves (bumpableHere cops lvl foeVisible (asight mk)) moveFreely
moveNewLoot = onlyLoot (onlyKeepsDir 2 moveRandomly)
moveFreely = moveNewLoot
.| liftFrequency interestIQFreq
.| moveIQ
.| moveRandomly
onlyMoves :: (Point -> Bool) -> Strategy Vector -> Strategy Vector
onlyMoves p = only (\x -> p (bpos `shift` x))
moveRandomly :: Strategy Vector
moveRandomly = liftFrequency $ uniformFreq "moveRandomly" sensible
accessibleHere = accessible cops lvl bpos
fact = sfactionD s EM.! bfid
friends = actorList (not . isAtWar fact) blid s
noFriends | asight mk = unoccupied friends
| otherwise = const True
isSensible l = noFriends l
&& (accessibleHere l
|| bumpableHere cops lvl foeVisible (asight mk) l)
sensible = filter (isSensible . (bpos `shift`)) (moves lxsize)
bumpableHere :: Kind.COps -> Level -> Bool -> Bool -> Point -> Bool
bumpableHere Kind.COps{cotile} lvl foeVisible asight pos =
let t = lvl `at` pos
in Tile.openable cotile t
||
asight && not foeVisible && Tile.hasFeature cotile F.Suspect t
chase :: MonadActionRO m
=> ActorId -> (Point, Bool) -> m (Strategy CmdSerTakeTime)
chase aid foe@(_, foeVisible) = do
cops <- getsState scops
let mFoe = Just foe
fight = not foeVisible
s <- getState
str <- moveStrategy cops aid s mFoe
if fight
then Traversable.mapM (moveRunAid False aid) str
else Traversable.mapM (moveRunAid True aid) str
wander :: MonadActionRO m
=> ActorId -> m (Strategy CmdSerTakeTime)
wander aid = do
cops <- getsState scops
let mFoe = Nothing
s <- getState
str <- moveStrategy cops aid s mFoe
Traversable.mapM (moveRunAid False aid) str
moveRunAid :: MonadActionRO m
=> Bool -> ActorId -> Vector -> m CmdSerTakeTime
moveRunAid run source dir = do
cops@Kind.COps{cotile} <- getsState scops
sb <- getsState $ getActorBody source
let lid = blid sb
lvl <- getLevel lid
let spos = bpos sb
tpos = spos `shift` dir
t = lvl `at` tpos
tgt <- getsState $ posToActor tpos lid
case tgt of
Just target | run ->
if accessible cops lvl spos tpos then
return $ DisplaceSer source target
else
return $ MeleeSer source target
Just target ->
return $ MeleeSer source target
Nothing -> do
if accessible cops lvl spos tpos then
return $ MoveSer source dir
else if not $ EM.null $ lvl `atI` tpos then
assert `failure` "AI causes AlterBlockItem" `twith` (run, source, dir)
else if not (Tile.hasFeature cotile F.Walkable t)
&& (Tile.hasFeature cotile F.Suspect t
|| Tile.openable cotile t
|| Tile.closable cotile t
|| Tile.changeable cotile t) then
return $ AlterSer source tpos Nothing
else
assert `failure` "AI causes MoveNothing or AlterNothing"
`twith` (run, source, dir)
effectToBenefit :: Kind.COps -> Actor -> Effect.Effect Int -> Int
effectToBenefit Kind.COps{coactor=Kind.Ops{okind}} b eff =
let kind = okind $ bkind b
deep k = signum k == signum (fromEnum $ blid b)
in case eff of
Effect.NoEffect -> 0
(Effect.Heal p) -> 10 * min p (Random.maxDice (ahp kind) bhp b)
(Effect.Hurt _ p) -> (p * 10)
Effect.Mindprobe{} -> 0
Effect.Dominate -> 100
(Effect.CallFriend p) -> p * 100
Effect.Summon{} -> 1
(Effect.CreateItem p) -> p * 20
Effect.ApplyPerfume -> 0
Effect.Regeneration{} -> 0
Effect.Searching{} -> 0
(Effect.Ascend k) | deep k -> 500
Effect.Ascend{} -> 1
Effect.Escape -> 1000