module Game.LambdaHack.StrategyAction
( strategy, wait
) where
import qualified Data.List as L
import qualified Data.IntMap as IM
import Data.Maybe
import Control.Monad
import Control.Arrow
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.Actions
import Game.LambdaHack.ItemAction
import Game.LambdaHack.Content.ItemKind
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
strategy :: Kind.COps -> ActorId -> State -> Perception -> Strategy (Action ())
strategy cops actor oldState@State{splayer = pl, stime = time} per =
strat
where
Kind.COps{ cotile
, coactor=Kind.Ops{okind}
, coitem=coitem@Kind.Ops{okind=iokind}
} = cops
lvl@Level{lsmell = nsmap, lxsize, lysize} = slevel oldState
Actor { bkind = ak, bloc = me, bdir = ad, btarget = tgt } =
getActor actor oldState
items = getActorItem actor oldState
mk = okind ak
delState = deleteActor actor oldState
enemyVisible a l =
asight mk && monsterSeesHero cotile per lvl actor a me l ||
adjacent lxsize me l
hs = L.map (AHero *** bloc) $
IM.assocs $ lheroes $ slevel delState
ms = L.map (AMonster *** bloc) $
IM.assocs $ lmonsters $ slevel delState
(newTgt, floc, foeVisible) =
case tgt of
TEnemy a ll | focusedMonster ->
if memActor a delState
then let l = bloc $ getActor a delState
in if enemyVisible a l
then (TEnemy a l, Just l, True)
else if isJust (case closest of (_, m, _) -> m) || me == ll
then closest
else (tgt, Just ll, False)
else closest
TLoc loc -> if me == loc
then closest
else (tgt, Just loc, False)
_ -> closest
closest =
let hsAndTraitor = if isAMonster pl && memActor pl delState
then (pl, bloc $ getPlayerBody delState) : hs
else hs
foes = if L.null hsAndTraitor then ms else hsAndTraitor
visible = L.filter (uncurry enemyVisible) foes
foeDist = L.map (\ (a, l) -> (chessDist lxsize me l, l, a)) visible
in case foeDist of
[] -> (TCursor, Nothing, False)
_ -> let (_, l, a) = L.minimum foeDist
in (TEnemy a l, Just l, True)
onlyFoe = onlyMoves (maybe (const False) (==) floc) me
towardsFoe = case floc of
Nothing -> const mzero
Just loc ->
let foeDir = towards lxsize me loc
in only (\ x -> euclidDistSq lxsize foeDir x <= 1)
lootHere x = not $ L.null $ lvl `atI` x
onlyLoot = onlyMoves lootHere me
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 me
onlyKeepsDir k =
only (\ x -> maybe True (\ (d, _) -> euclidDistSq lxsize d x <= k) ad)
onlyKeepsDir_9 = only (\ x -> maybe True (\ (d, _) -> neg x /= d) ad)
onlyNoMs = onlyMoves (unoccupied (levelMonsterList delState)) me
openPower = Tile.SecretStrength $
case strongestSearch coitem items of
Just i -> aiq mk + jpower i
Nothing -> aiq mk
openableHere = openable cotile lvl openPower
onlyOpenable = onlyMoves openableHere me
accessibleHere = accessible cops lvl me
onlySensible = onlyMoves (\ l -> accessibleHere l || openableHere l) me
focusedMonster = aspeed mk >= 10
movesNotBack = maybe id (\ (d, _) -> L.filter (/= neg d)) ad $ moves lxsize
smells =
L.map fst $
L.sortBy (\ (_, s1) (_, s2) -> compare s2 s1) $
L.filter (\ (_, s) -> s > 0) $
L.map (\ x -> let sm = Tile.smelltime $ IM.findWithDefault
(Tile.SmellTime 0) (me `shift` x) nsmap
in (x, (sm time) `max` 0)) movesNotBack
attackDir d = dirToAction actor newTgt True `liftM` d
moveDir d = dirToAction actor newTgt False `liftM` d
strat =
foeVisible .=> attackDir (onlyFoe moveFreely)
.| foeVisible .=> liftFrequency (msum seenFreqs)
.| lootHere me .=> actionPickup
.| moveDir moveTowards
.| attackDir moveAround
actionPickup = return $ actorPickupItem actor
tis = lvl `atI` me
seenFreqs = [applyFreq items 1, applyFreq tis 2,
throwFreq items 3, throwFreq tis 6] ++ towardsFreq
applyFreq is multi = toFreq
[ (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,
asight mk || isymbol ik == '!']
throwFreq is multi = if adjacent lxsize me (fromJust floc) || not (asight mk)
then mzero
else toFreq
[ (benefit * multi,
projectGroupItem actor (fromJust floc) (iverbProject ik) i)
| i <- is,
let ik = iokind (jkind i),
let benefit =
(1 + jpower i) * Effect.effectToBenefit (ieffect ik),
benefit > 0,
isymbol ik /= ')']
towardsFreq = map (scaleFreq 30) $ runStrategy $ moveDir moveTowards
moveTowards = onlySensible $ onlyNoMs (towardsFoe moveFreely)
moveAround =
onlySensible $
(if asight mk then onlyNoMs else id) $
asmell mk .=> L.foldr ((.|) . return) reject smells
.| onlyOpenable moveFreely
.| moveFreely
moveIQ = aiq mk > 15 .=> onlyKeepsDir 0 moveRandomly
.| aiq mk > 10 .=> onlyKeepsDir 1 moveRandomly
.| aiq mk > 5 .=> onlyKeepsDir 2 moveRandomly
.| onlyKeepsDir_9 moveRandomly
interestFreq =
if interestHere me
then []
else map (scaleFreq 3)
(runStrategy $ onlyInterest (onlyKeepsDir 2 moveRandomly))
interestIQFreq = interestFreq ++ runStrategy moveIQ
moveFreely = onlyLoot moveRandomly
.| liftFrequency (msum interestIQFreq)
.| moveRandomly
onlyMoves :: (Point -> Bool) -> Point -> Strategy Vector -> Strategy Vector
onlyMoves p l = only (\ x -> p (l `shift` x))
moveRandomly :: Strategy Vector
moveRandomly = liftFrequency $ uniformFreq (moves lxsize)
dirToAction :: ActorId -> Target -> Bool -> Vector -> Action ()
dirToAction actor tgt allowAttacks dir = do
updateAnyActor actor $ \ m -> m { bdir = Just (dir, 0), btarget = tgt }
tryWith (advanceTime actor) $
moveOrAttack allowAttacks actor dir
wait :: ActorId -> Strategy (Action ())
wait actor = return $ advanceTime actor