LambdaHack-0.1.20110918: src/StrategyState.hs
module StrategyState where
import Data.List as L
import Data.Map as M
import Data.Set as S
import qualified Data.IntMap as IM
import Data.Maybe
import Control.Monad
import Control.Monad.State hiding (State)
import Control.Exception (assert)
import Geometry
import Level
import Actor
import ActorState
import ActorKind
import Random
import Perception
import Strategy
import State
import Action
import Actions
import ItemAction
import qualified ItemKind
import Item
import qualified Effect
-- import Debug.Trace
strategy :: ActorId -> State -> Perceptions -> Strategy (Action ())
strategy actor
oldState@(State { scursor = cursor,
splayer = pl,
stime = time,
slevel = Level { lname = ln,
lsmell = nsmap,
lmap = lmap } })
per =
-- trace (show time ++ ": " ++ show actor) $
strategy
where
Actor { akind = mk, aloc = me, adir = adir,
atarget = tgt, aitems = items } =
getActor actor oldState
delState = deleteActor actor oldState
enemyVisible a l =
-- We assume monster sight is infravision, so light has no significance.
bsight mk && actorReachesActor a actor l me per Nothing ||
-- Any enemy is visible if adjacent (e. g., a monster player).
memActor a delState && adjacent me l
-- If no heroes on the level, monsters go at each other. TODO: let them
-- earn XP by killing each other to make this dangerous to the player.
hs = L.map (\ (i, m) -> (AHero i, aloc m)) $
IM.assocs $ lheroes $ slevel delState
ms = L.map (\ (i, m) -> (AMonster i, aloc m)) $
IM.assocs $ lmonsters $ slevel delState
-- Below, "foe" is the hero (or a monster, or loc) chased by the actor.
(newTgt, floc) =
case tgt of
TEnemy a ll | focusedMonster ->
case findActorAnyLevel a delState of
Just (_, m) ->
let l = aloc m
in if enemyVisible a l
then (TEnemy a l, Just l)
else if isJust (snd closest) || me == ll
then closest -- prefer visible foes
else (tgt, Just ll) -- last known location of enemy
Nothing -> closest -- enemy dead, monsters can feel it
TLoc loc -> if me == loc
then closest
else (tgt, Just loc) -- ignore everything and go to loc
_ -> closest
closest =
let hsAndTraitor = if isAMonster pl
then (pl, aloc $ getPlayerBody delState) : hs
else hs
foes = if L.null hsAndTraitor then ms else hsAndTraitor
-- We assume monster sight is infravision, so light has no effect.
foeVisible = L.filter (\ (a, l) -> enemyVisible a l) foes
foeDist = L.map (\ (a, l) -> (distance (me, l), l, a)) foeVisible
in case foeDist of
[] -> (TCursor, Nothing)
_ -> let (_, l, a) = L.minimum foeDist
in (TEnemy a l, Just l)
onlyFoe = onlyMoves (maybe (const False) (==) floc) me
towardsFoe = case floc of
Nothing -> const mzero
Just loc ->
let foeDir = towards (me, loc)
in only (\ x -> distance (foeDir, x) <= 1)
lootHere = (\ x -> not $ L.null $ titems $ lmap `at` x)
onlyLoot = onlyMoves lootHere me
exitHere = (\ x -> let t = lmap `at` x in open t && reflects t)
onlyExit = onlyMoves exitHere me
onlyKeepsDir k = only (\ x -> maybe True (\ d -> distance (d, x) <= k) adir)
onlyKeepsDir_9 = only (\ x -> maybe True (\ d -> neg x /= d) adir)
onlyNoMs = onlyMoves (unoccupied (levelMonsterList delState)) me
-- Monsters don't see doors more secret than that. Enforced when actually
-- opening doors, too, so that monsters don't cheat. TODO: remove the code
-- duplication, though.
openPower = case strongestItem items "ring" of
Just i -> biq mk + ipower i
Nothing -> biq mk
openableHere = openable openPower lmap
onlyOpenable = onlyMoves openableHere me
accessibleHere = accessible lmap me
onlySensible = onlyMoves (\ l -> accessibleHere l || openableHere l) me
focusedMonster = biq mk > 10
smells =
L.map fst $
L.sortBy (\ (_, s1) (_, s2) -> compare s2 s1) $
L.filter (\ (_, s) -> s > 0) $
L.map (\ x -> (x, nsmap ! (me `shift` x) - time `max` 0)) moves
fromDir allowAttacks d = dirToAction actor newTgt allowAttacks `liftM` d
strategy =
fromDir True (onlyFoe moveFreely)
.| isJust floc .=> liftFrequency (msum freqs)
.| lootHere me .=> actionPickup
.| fromDir True moveAround
actionPickup = return $ actorPickupItem actor
tis = titems $ lmap `at` me
freqs = [applyFreq items 1, applyFreq tis 2,
throwFreq items 2, throwFreq tis 5, towardsFreq]
applyFreq is multi = Frequency
[ (benefit * multi, actionApply (ItemKind.jname ik) i)
| i <- is,
let ik = ItemKind.getIK (ikind i),
let benefit =
(1 + ipower i) * Effect.effectToBenefit (ItemKind.jeffect ik),
benefit > 0,
bsight mk || not (ItemKind.jname ik == "scroll")]
actionApply groupName item =
applyGroupItem actor (applyToVerb groupName) item
throwFreq is multi = if not $ bsight mk then mzero else Frequency
[ (benefit * multi, actionThrow (ItemKind.jname ik) i)
| i <- is,
let ik = ItemKind.getIK (ikind i),
let benefit =
- (1 + ipower i) * Effect.effectToBenefit (ItemKind.jeffect ik),
benefit > 0,
-- Wasting swords would be too cruel to the player.
not (ItemKind.jname ik == "sword")]
actionThrow groupName item =
zapGroupItem actor (fromJust floc) (zapToVerb groupName) item
towardsFreq =
let freqs = runStrategy $ fromDir False moveTowards
in if bsight mk && not (L.null freqs)
then scale 30 $ head freqs
else mzero
moveTowards = onlySensible $ onlyNoMs (towardsFoe moveFreely)
moveAround =
onlySensible $
(if bsight mk then onlyNoMs else id) $
bsmell mk .=> L.foldr (.|) reject (L.map return smells)
.| onlyOpenable moveFreely
.| moveFreely
moveFreely = onlyLoot moveRandomly
.| onlyExit (onlyKeepsDir 2 moveRandomly)
.| biq mk > 15 .=> onlyKeepsDir 0 moveRandomly
.| biq mk > 10 .=> onlyKeepsDir 1 moveRandomly
.| biq mk > 5 .=> onlyKeepsDir 2 moveRandomly
.| onlyKeepsDir_9 moveRandomly
.| moveRandomly
dirToAction :: ActorId -> Target -> Bool -> Dir -> Action ()
dirToAction actor tgt allowAttacks dir =
assert (dir /= (0,0)) $ do
-- set new direction
updateAnyActor actor $ \ m -> m { adir = Just dir, atarget = tgt }
-- perform action
tryWith (advanceTime actor) $
-- if the following action aborts, we just advance the time and continue
-- TODO: ensure time is taken for other aborted actions in this file
moveOrAttack allowAttacks True actor dir
onlyMoves :: (Dir -> Bool) -> Loc -> Strategy Dir -> Strategy Dir
onlyMoves p l = only (\ x -> p (l `shift` x))
moveRandomly :: Strategy Dir
moveRandomly = liftFrequency $ uniform moves
wait :: ActorId -> Strategy (Action ())
wait actor = return $ advanceTime actor