module Game.LambdaHack.StrategyAction
( targetStrategy, strategy
) where
import qualified Data.List as L
import qualified Data.IntMap as IM
import Data.Maybe
import Data.Function
import Control.Monad
import Control.Monad.State hiding (State, state)
import Control.Arrow
import qualified Data.Text as T
import Game.LambdaHack.Utils.Assert
import Game.LambdaHack.Ability (Ability)
import qualified Game.LambdaHack.Ability as Ability
import Game.LambdaHack.Point
import Game.LambdaHack.Vector
import Game.LambdaHack.Level
import Game.LambdaHack.Actor
import Game.LambdaHack.ActorState
import Game.LambdaHack.Content.ActorKind
import Game.LambdaHack.Utils.Frequency
import Game.LambdaHack.Perception
import Game.LambdaHack.Strategy
import Game.LambdaHack.State
import Game.LambdaHack.Action
import Game.LambdaHack.Msg
import Game.LambdaHack.EffectAction
import Game.LambdaHack.Actions
import Game.LambdaHack.ItemAction
import Game.LambdaHack.Content.ItemKind
import Game.LambdaHack.Content.RuleKind
import Game.LambdaHack.Item
import qualified Game.LambdaHack.Effect as Effect
import qualified Game.LambdaHack.Tile as Tile
import qualified Game.LambdaHack.Kind as Kind
import qualified Game.LambdaHack.Feature as F
import Game.LambdaHack.Time
import qualified Game.LambdaHack.Color as Color
targetStrategy :: Kind.COps -> ActorId -> State -> Perception -> [Ability]
-> Strategy Target
targetStrategy cops actor state@State{splayer = pl} per factionAbilities =
retarget btarget
where
Kind.COps{ cotile
, coactor=coactor@Kind.Ops{okind}
} = cops
lvl@Level{lxsize} = slevel state
actorBody@Actor{ bkind, bloc = me, btarget, bfaction } =
getActor actor state
mk = okind bkind
enemyVisible a l =
asight mk
&& actorSeesActor cotile per lvl actor a me l pl
|| adjacent lxsize me l
&& (asmell mk || asight mk)
actorAbilities = acanDo (okind bkind) `L.intersect` factionAbilities
focused = actorSpeed coactor actorBody <= speedNormal
&& Ability.Chase `elem` actorAbilities
retarget :: Target -> Strategy Target
retarget tgt =
case tgt of
TPath _ -> returN "TPath" tgt
TEnemy a ll | focused
&& memActor a state
&& not (isAHero state actor && a == pl) ->
let l = bloc $ getActor a state
in if enemyVisible a l
then returN "TEnemy" $ TEnemy a l
else if null visibleFoes
&& me /= ll
then returN "last known" $ TLoc ll
else closest
TEnemy _ _ -> closest
TLoc loc | me == loc -> closest
TLoc _ | null visibleFoes -> returN "TLoc" tgt
TLoc _ -> closest
TCursor -> closest
hs = hostileAssocs bfaction lvl
foes = if isAHero state actor
then L.filter ((pl /=) . fst) hs
else if not (isAHero state pl) && memActor pl state
then (pl, getPlayerBody state) : hs
else hs
visibleFoes = L.filter (uncurry enemyVisible) (L.map (second bloc) foes)
closest :: Strategy Target
closest =
let foeDist = L.map (\ (_, l) -> chessDist lxsize me l) visibleFoes
minDist = L.minimum foeDist
minFoes =
L.filter (\ (_, l) -> chessDist lxsize me l == minDist) visibleFoes
minTargets = map (\ (a, l) -> TEnemy a l) minFoes
minTgtS = liftFrequency $ uniformFreq "closest" minTargets
in minTgtS .| noFoes .| returN "TCursor" TCursor
noFoes :: Strategy Target
noFoes =
(TLoc . (me `shift`)) `liftM` moveStrategy cops actor state Nothing
strategy :: Kind.COps -> ActorId -> State -> [Ability] -> Strategy (Action ())
strategy cops actor state factionAbilities =
sumS prefix .| combineDistant distant .| sumS suffix
.| waitBlockNow actor
where
Kind.COps{coactor=Kind.Ops{okind}} = cops
Actor{ bkind, bloc, btarget } = getActor actor state
(floc, foeVisible) = case btarget of
TEnemy _ l -> (l, True)
TLoc l -> (l, False)
TPath _ -> (bloc, False)
TCursor -> (bloc, False)
combineDistant = liftFrequency . sumF
aFrequency :: Ability -> Frequency (Action ())
aFrequency Ability.Ranged = if foeVisible
then rangedFreq cops actor state floc
else mzero
aFrequency Ability.Tools = if foeVisible
then toolsFreq cops actor state
else mzero
aFrequency Ability.Chase = if (floc /= bloc)
then chaseFreq
else mzero
aFrequency _ = assert `failure` distant
chaseFreq =
scaleFreq 30 $ bestVariant $ chase cops actor state (floc, foeVisible)
aStrategy :: Ability -> Strategy (Action ())
aStrategy Ability.Track = track cops actor state
aStrategy Ability.Heal = mzero
aStrategy Ability.Flee = mzero
aStrategy Ability.Melee = foeVisible .=> melee actor state floc
aStrategy Ability.Pickup = not foeVisible .=> pickup actor state
aStrategy Ability.Wander = wander cops actor state
aStrategy _ = assert `failure` actorAbilities
actorAbilities = acanDo (okind bkind) `L.intersect` factionAbilities
isDistant = (`elem` [Ability.Ranged, Ability.Tools, Ability.Chase])
(prefix, rest) = L.break isDistant actorAbilities
(distant, suffix) = L.partition isDistant rest
sumS = msum . map aStrategy
sumF = msum . map aFrequency
dirToAction :: ActorId -> Bool -> Vector -> Action ()
dirToAction actor allowAttacks dir = do
updateAnyActor actor $ \ m -> m { bdir = Just (dir, 0) }
tryWith (\ msg -> if T.null msg
then return ()
else assert `failure` msg <> "in AI") $ do
moveOrAttack allowAttacks actor dir
waitBlockNow :: ActorId -> Strategy (Action ())
waitBlockNow actor = returN "wait" $ setWaitBlock actor
dieNow :: ActorId -> Strategy (Action ())
dieNow actor = returN "die" $ do
bitems <- gets (getActorItem actor)
Actor{bloc} <- gets (getActor actor)
modify (updateLevel (dropItemsAt bitems bloc))
modify (deleteActor actor)
track :: Kind.COps -> ActorId -> State -> Strategy (Action ())
track cops actor state =
strat
where
lvl = slevel state
Actor{ bloc, btarget, bhp } = getActor actor state
darkenActor = updateAnyActor actor $ \ m -> m {bcolor = Just Color.BrBlack}
dieOrReset | bhp <= 0 = dieNow actor
| otherwise =
returN "reset TPath" $ updateAnyActor actor
$ \ m -> m {btarget = TCursor}
strat = case btarget of
TPath [] -> dieOrReset
TPath (d : _) | not $ accessible cops lvl bloc (shift bloc d) -> dieOrReset
TPath [d] -> returN "last TPath" $ do
darkenActor
updateAnyActor actor $ \ m -> m { btarget = TPath [] }
dirToAction actor True d
TPath (d : lv) -> returN "follow TPath" $ do
updateAnyActor actor $ \ m -> m { btarget = TPath lv }
dirToAction actor True d
_ -> reject
pickup :: ActorId -> State -> Strategy (Action ())
pickup actor state =
lootHere bloc .=> actionPickup
where
lvl = slevel state
Actor{bloc} = getActor actor state
lootHere x = not $ L.null $ lvl `atI` x
actionPickup = returN "pickup" $ actorPickupItem actor
melee :: ActorId -> State -> Point -> Strategy (Action ())
melee actor state floc =
foeAdjacent .=> (returN "melee" $ dirToAction actor True dir)
where
Level{lxsize} = slevel state
Actor{bloc} = getActor actor state
foeAdjacent = adjacent lxsize bloc floc
dir = displacement bloc floc
rangedFreq :: Kind.COps -> ActorId -> State -> Point -> Frequency (Action ())
rangedFreq cops actor state@State{splayer = pl} floc =
toFreq "throwFreq" $
if not foesAdj
&& asight mk
&& accessible cops lvl bloc loc1
&& isNothing (locToActor loc1 state)
then throwFreq bitems 3 ++ throwFreq tis 6
else []
where
Kind.COps{ coactor=Kind.Ops{okind}
, coitem=Kind.Ops{okind=iokind}
, corule
} = cops
lvl@Level{lxsize, lysize} = slevel state
Actor{ bkind, bloc, bfaction } = getActor actor state
bitems = getActorItem actor state
mk = okind bkind
tis = lvl `atI` bloc
hs = hostileAssocs bfaction lvl
foes = if isAHero state actor
then L.filter ((pl /=) . fst) hs
else if not (isAHero state pl) && memActor pl state
then (pl, getPlayerBody state) : hs
else hs
foesAdj = foesAdjacent lxsize lysize bloc (map snd foes)
eps = 0
bl = bla lxsize lysize eps bloc floc
loc1 = case bl of
Nothing -> bloc
Just [] -> bloc
Just (lbl:_) -> lbl
throwFreq is multi =
[ (benefit * multi,
projectGroupItem actor floc (iverbProject ik) i)
| i <- is,
let ik = iokind (jkind i),
let benefit = (1 + jpower i) * Effect.effectToBenefit (ieffect ik),
benefit > 0,
isymbol ik `elem` (ritemProject $ Kind.stdRuleset corule)]
toolsFreq :: Kind.COps -> ActorId -> State -> Frequency (Action ())
toolsFreq cops actor state =
toFreq "quaffFreq" $ quaffFreq bitems 1 ++ quaffFreq tis 2
where
Kind.COps{coitem=Kind.Ops{okind=iokind}} = cops
lvl = slevel state
Actor{bloc} = getActor actor state
bitems = getActorItem actor state
tis = lvl `atI` bloc
quaffFreq is multi =
[ (benefit * multi, applyGroupItem actor (iverbApply ik) i)
| i <- is,
let ik = iokind (jkind i),
let benefit = (1 + jpower i) * Effect.effectToBenefit (ieffect ik),
benefit > 0, isymbol ik == '!']
moveStrategy :: Kind.COps -> ActorId -> State -> Maybe (Point, Bool)
-> Strategy Vector
moveStrategy cops actor state mFoe =
case mFoe of
Just (floc, foeVisible) ->
let towardsFoe =
let foeDir = towards lxsize bloc floc
tolerance | isUnit lxsize foeDir = 0
| otherwise = 1
in only (\ x -> euclidDistSq lxsize foeDir x <= tolerance)
in if floc == bloc
then reject
else towardsFoe
$ if foeVisible
then moveClear
.| moveOpenable
else moveOpenable
.| moveClear
Nothing ->
let smells =
map (map fst)
$ L.groupBy ((==) `on` snd)
$ L.sortBy (flip compare `on` snd)
$ L.filter (\ (_, s) -> s > timeZero)
$ L.map (\ x ->
let sml = IM.findWithDefault
timeZero (bloc `shift` x) lsmell
in (x, sml `timeAdd` timeNegate ltime))
sensible
in asmell mk .=> L.foldr ((.|)
. liftFrequency
. uniformFreq "smell k") reject smells
.| moveOpenable
.| moveClear
where
Kind.COps{ cotile
, coactor=Kind.Ops{okind}
, coitem
} = cops
lvl@Level{lsmell, lxsize, lysize, ltime} = slevel state
Actor{ bkind, bloc, bdir, bfaction } = getActor actor state
bitems = getActorItem actor state
mk = okind bkind
lootHere x = not $ L.null $ lvl `atI` x
onlyLoot = onlyMoves lootHere bloc
interestHere x = let t = lvl `at` x
ts = map (lvl `at`) $ vicinity lxsize lysize x
in Tile.hasFeature cotile F.Exit t
|| (not (Tile.hasFeature cotile F.Lit t)
&& L.any (Tile.hasFeature cotile F.Lit) ts)
onlyInterest = onlyMoves interestHere bloc
onlyKeepsDir k =
only (\ x -> maybe True (\ (d, _) -> euclidDistSq lxsize d x <= k) bdir)
onlyKeepsDir_9 = only (\ x -> maybe True (\ (d, _) -> neg x /= d) bdir)
moveIQ = aiq mk > 15 .=> onlyKeepsDir 0 moveRandomly
.| aiq mk > 10 .=> onlyKeepsDir 1 moveRandomly
.| aiq mk > 5 .=> onlyKeepsDir 2 moveRandomly
.| onlyKeepsDir_9 moveRandomly
interestFreq | interestHere bloc =
mzero
| otherwise =
scaleFreq 5 $ bestVariant $ onlyInterest $ onlyKeepsDir 2 moveRandomly
interestIQFreq = interestFreq `mplus` bestVariant moveIQ
moveClear = onlyMoves (not . openableHere) bloc moveFreely
moveOpenable = onlyMoves openableHere bloc moveFreely
moveFreely = onlyLoot moveRandomly
.| liftFrequency interestIQFreq
.| moveIQ
.| moveRandomly
onlyMoves :: (Point -> Bool) -> Point -> Strategy Vector -> Strategy Vector
onlyMoves p l = only (\ x -> p (l `shift` x))
moveRandomly :: Strategy Vector
moveRandomly = liftFrequency $ uniformFreq "moveRandomly" sensible
openPower = timeScale timeTurn $
case strongestSearch coitem bitems of
Just i -> aiq mk + jpower i
Nothing -> aiq mk
openableHere = openable cotile lvl openPower
accessibleHere = accessible cops lvl bloc
noFriends | asight mk = unoccupied (factionList [bfaction] state)
| otherwise = const True
isSensible l = noFriends l && (accessibleHere l || openableHere l)
sensible = filter (isSensible . (bloc `shift`)) (moves lxsize)
chase :: Kind.COps -> ActorId -> State -> (Point, Bool) -> Strategy (Action ())
chase cops actor state foe@(_, foeVisible) =
let mFoe = Just foe
fight = not foeVisible
in dirToAction actor fight `liftM` moveStrategy cops actor state mFoe
wander :: Kind.COps -> ActorId -> State -> Strategy (Action ())
wander cops actor state =
let mFoe = Nothing
in dirToAction actor True `liftM` moveStrategy cops actor state mFoe