Skip to content

HTTPS clone URL

Subversion checkout URL

You can clone with HTTPS or Subversion.

Download ZIP
Browse files

monsters stored on intmap, not time-sorted list; close #34 (for the l…

…ast time)

Asymptotic complexity is the same: finding first monster to move is linear,
but previously inserting the monster back into the time-sorted list was linear.
  • Loading branch information...
commit 6097568cf810b9e325b3d372f50f2c914da96529 1 parent 8937a50
@Mikolaj Mikolaj authored
View
70 src/Actions.hs
@@ -73,7 +73,6 @@ quitGame =
endTargeting :: Bool -> Action ()
endTargeting accept = do
ptype <- gets (mtype . getPlayerBody)
- monsters <- gets (lmonsters . slevel)
target <- gets (mtarget . getPlayerBody)
returnLn <- gets (creturnLn . scursor)
lvlswitch returnLn -- return to the original level of the player
@@ -151,8 +150,8 @@ continueRun dir =
loc <- gets (mloc . getPlayerBody)
per <- currentPerception
msg <- currentMessage
- let lvl@(Level { lmonsters = ms, lmap = lmap, lheroes = hs }) = slevel state
- mslocs = S.fromList (L.map mloc ms)
+ let lvl@(Level { lmap = lmap, lheroes = hs }) = slevel state
+ mslocs = S.fromList (L.map mloc (levelMonsterList state))
t = lmap `at` loc -- tile at current location
monstersVisible = not (S.null (mslocs `S.intersection` pvisible per))
newsReported = not (L.null msg)
@@ -283,21 +282,22 @@ actorOpenClose :: Actor ->
actorOpenClose actor v o dir =
do
state <- get
+ lmap <- gets (lmap . slevel)
+ pl <- gets splayer
let txt = if o then "open" else "closed"
- let Level { lmonsters = ms, lmap = lmap } = slevel state
- hms = levelHeroList state ++ ms
+ let hms = levelHeroList state ++ levelMonsterList state
let loc = mloc (getActor state actor)
- let isHero = case actor of AHero _ -> True ; _ -> False
- let isVerbose = v && isHero
+ let isPlayer = actor == pl
+ let isVerbose = v && isPlayer
let dloc = shift loc dir -- location we act upon
in case lmap `at` dloc of
Tile d@(Door hv o') []
- | secret o' && isHero -> -- door is secret, cannot be opened or closed by hero
+ | secret o' && isPlayer -> -- door is secret, cannot be opened or closed by the player
neverMind isVerbose
| maybe o ((|| not o) . (> 10)) o' ->
-- door is in unsuitable state
abortIfWith isVerbose ("already " ++ txt)
- | not (unoccupied hms lmap dloc) ->
+ | not (unoccupied hms dloc) ->
-- door is blocked by a movable
abortIfWith isVerbose "blocked"
| otherwise -> -- door can be opened / closed
@@ -429,13 +429,13 @@ fleeDungeon =
cycleHero :: Action ()
cycleHero =
do
- hs <- gets (lheroes . slevel)
pl <- gets splayer
+ hs <- gets (lheroes . slevel)
let i = case pl of AHero n -> n ; _ -> 0
- (lt, gt) = IM.split i hs
- case IM.keys gt ++ IM.keys lt of
+ (lt, gt) = L.splitAt i (IM.assocs hs)
+ case gt ++ lt of
[] -> abortWith "Cannot select another hero on this level."
- ni : _ -> assertTrue $ selectHero (AHero ni)
+ (ni, _) : _ -> assertTrue $ selectHero (AHero ni)
-- | Selects a hero based on the number (actor, actually).
-- Focuses on the hero if level changed. False, if nothing to do.
@@ -524,16 +524,15 @@ targetMonster :: Action ()
targetMonster = do
per <- currentPerception
target <- gets (mtarget . getPlayerBody)
- level <- gets slevel
- let i1 = case target of
- TEnemy (AMonster i) -> i + 1
+ ms <- gets (lmonsters . slevel)
+ let i = case target of
+ TEnemy (AMonster n) -> n + 1
_ -> 0
- ms = L.zip (lmonsters level) [0..]
- (lt, gt) = L.splitAt i1 ms
- lf = L.filter (\ (m, _) -> S.member (mloc m) (pvisible per)) (gt ++ lt)
+ (lt, gt) = L.splitAt i (IM.assocs ms)
+ lf = L.filter (\ (_, m) -> S.member (mloc m) (pvisible per)) (gt ++ lt)
tgt = case lf of
[] -> target -- no monsters in sight, stick to last target
- (_, ni) : _ -> TEnemy (AMonster ni) -- pick the next monster
+ (ni, _) : _ -> TEnemy (AMonster ni) -- pick the next monster
updatePlayerBody (\ p -> p { mtarget = tgt })
setCursor tgt
@@ -576,12 +575,11 @@ doLook =
loc <- gets (clocation . scursor)
state <- get
lmap <- gets (lmap . slevel)
- ms <- gets (lmonsters . slevel)
per <- currentPerception
target <- gets (mtarget . getPlayerBody)
let monsterMsg =
if S.member loc (pvisible per)
- then case L.find (\ m -> mloc m == loc) ms of
+ then case L.find (\ m -> mloc m == loc) (levelMonsterList state) of
Just m -> subjectMovable (mtype m) ++ " is here. "
Nothing -> ""
else ""
@@ -726,16 +724,8 @@ actorPickupItem actor =
m { mitems = nitems, mletter = maxLetter l (mletter movable) }
Nothing -> abortIfWith isPlayer "you cannot carry any more"
--- TODO: when monsters have unique ids, update monsters on other levels, too
-updateAnyActor :: Actor -> -- ^ who to update
- (Movable -> Movable) -> -- ^ the update
- Action ()
-updateAnyActor (AHero n) f = modify (updateAnyHero f n)
-updateAnyActor (AMonster n) f =
- do
- monsters <- gets (lmonsters . slevel)
- let (_, ms) = updateMonster f n monsters
- modify (updateLevel (updateMonsters (const ms)))
+updateAnyActor :: Actor -> (Movable -> Movable) -> Action ()
+updateAnyActor actor f = modify (updateAnyActorBody actor f)
updatePlayerBody :: (Hero -> Hero) -> Action ()
updatePlayerBody f = do
@@ -820,17 +810,17 @@ moveOrAttack allowAttacks autoOpen actor dir
-- We start by looking at the target position.
state <- get
pl <- gets splayer
- ms <- gets (lmonsters . slevel)
lmap <- gets (lmap . slevel)
- khs <- gets (IM.assocs . lheroes . slevel)
+ khs <- gets (IM.assocs . lheroes . slevel)
+ kms <- gets (IM.assocs . lmonsters . slevel)
let sm = getActor state actor
sloc = mloc sm -- source location
tloc = sloc `shift` dir -- target location
tgt = case L.find (\ (_, m) -> mloc m == tloc) khs of
Just (i, _) -> Just (AHero i)
Nothing ->
- case L.findIndex (\ m -> mloc m == tloc) ms of
- Just i -> Just (AMonster i)
+ case L.find (\ (_, m) -> mloc m == tloc) kms of
+ Just (i, _) -> Just (AMonster i)
Nothing -> Nothing
case tgt of
Just target ->
@@ -845,7 +835,7 @@ moveOrAttack allowAttacks autoOpen actor dir
Nothing ->
if accessible lmap sloc tloc then do
-- perform the move
- updateAnyActor actor (\ m -> m { mloc = tloc })
+ updateAnyActor actor $ \ m -> m { mloc = tloc }
when (actor == pl) $ message $ lookAt False state lmap tloc ""
else if autoOpen then
-- try to open a door
@@ -914,8 +904,8 @@ actorRunActor source target = do
state <- get
let sloc = mloc $ getActor state source -- source location
tloc = mloc $ getActor state target -- target location
- updateAnyActor source (\ m -> m { mloc = tloc })
- updateAnyActor target (\ m -> m { mloc = sloc })
+ updateAnyActor source $ \ m -> m { mloc = tloc }
+ updateAnyActor target $ \ m -> m { mloc = sloc }
case target of
AHero _ -> do
case source of
@@ -941,7 +931,7 @@ advanceTime :: Actor -> Action ()
advanceTime actor =
do
time <- gets stime
- updateAnyActor actor (\ m -> m { mtime = time + mspeed m })
+ updateAnyActor actor $ \ m -> m { mtime = time + mspeed m }
-- | Possibly regenerate HP for the given actor.
regenerate :: Actor -> Action ()
View
4 src/Actor.hs
@@ -3,8 +3,8 @@ module Actor where
import Control.Monad
import Data.Binary
-data Actor = AHero Int -- ^ hero serial number
- | AMonster Int -- ^ offset in monster list
+data Actor = AHero Int -- ^ hero index (on the lheroes intmap)
+ | AMonster Int -- ^ monster index (on the lmonsters intmap)
deriving (Show, Eq)
instance Binary Actor where
View
2  src/Display2.hs
@@ -5,6 +5,7 @@ module Display2 (module Display, module Display2) where
import Data.Set as S
import Data.List as L
import Data.Map as M
+import qualified Data.IntMap as IM
import Control.Monad.State hiding (State) -- for MonadIO, seems to be portable between mtl-1 and 2
import Message
@@ -167,6 +168,7 @@ displayLevel session per
(n,over) = stringByLocation (sy+1) overlay -- n is the number of overlay screens
gold = maybe 0 (icount . fst) $ findItem (\ i -> iletter i == Just '$') pitems
hs = levelHeroList state
+ ms = levelMonsterList state
disp n msg =
display ((0,0),sz) session
(\ loc -> let tile = nlmap `lAt` loc
View
25 src/Dungeon.hs
@@ -94,7 +94,7 @@ emptyRoom addWallsRnd cfg@(LevelConfig { levelSize = (sy,sx) }) nm =
do
let lmap = digRoom Light ((1,1),(sy-1,sx-1)) (emptyLMap (sy,sx))
let smap = M.fromList [ ((y,x),-100) | y <- [0..sy], x <- [0..sx] ]
- let lvl = Level nm lmEmpty (sy,sx) [] smap lmap ""
+ let lvl = Level nm lmEmpty (sy,sx) lmEmpty smap lmap ""
-- locations of the stairs
su <- findLoc lvl (const floor)
sd <- findLoc lvl (\ l t -> floor t
@@ -109,7 +109,7 @@ emptyRoom addWallsRnd cfg@(LevelConfig { levelSize = (sy,sx) }) nm =
maybe id (\ l -> M.insert sd (newTile (Stairs Light Down l))) ld $
(\lmap -> foldl' addItem lmap is) $
lmap
- level lu ld = Level nm lmEmpty (sy,sx) [] smap (flmap lu ld) "bigroom"
+ level lu ld = Level nm lmEmpty (sy,sx) lmEmpty smap (flmap lu ld) "bigroom"
return (level, su, sd)
-- | For a bigroom level: Create a level consisting of only one, empty room.
@@ -225,7 +225,7 @@ rogueRoom cfg nm =
let lmap :: LMap
lmap = foldr digCorridor (foldr (\ (r, dl) m -> digRoom dl r m)
(emptyLMap (levelSize cfg)) dlrooms) cs
- let lvl = Level nm lmEmpty (levelSize cfg) [] smap lmap ""
+ let lvl = Level nm lmEmpty (levelSize cfg) lmEmpty smap lmap ""
-- convert openings into doors
dlmap <- fmap M.fromList . mapM
(\ o@((y,x),(t,r)) ->
@@ -262,7 +262,7 @@ rogueRoom cfg nm =
maybe id (\ l -> M.update (\ (t,r) -> Just $ newTile (Stairs (toDL $ light t) Down l)) sd) ld $
foldr (\ (l,it) f -> M.update (\ (t,r) -> Just (t { titems = it : titems t }, r)) l . f) id is
dlmap
- in Level nm lmEmpty (levelSize cfg) [] smap flmap meta, su, sd)
+ in Level nm lmEmpty (levelSize cfg) lmEmpty smap flmap meta, su, sd)
rollItems :: LevelConfig -> Level -> Loc -> Rnd [(Loc, Item)]
rollItems cfg lvl ploc =
@@ -308,14 +308,19 @@ digRoom dl ((y0,x0),(y1,x1)) l
-- TODO: do the functions below belong in this module?
-- | Create a new monster in the level, at a random position.
addMonster :: State -> Rnd Level
-addMonster state@(State { slevel = lvl@(Level { lmonsters = ms,
- lmap = lmap }) }) =
+addMonster state@(State { slevel = lvl@(Level { lmap = lmap }),
+ sdungeon = Dungeon m }) =
do
+ let hs = levelHeroList state
+ ms = levelMonsterList state
rc <- monsterGenChance (lname lvl) ms
if rc
then
do
- let hs = levelHeroList state
+ let f lvl = let mms = lmonsters lvl
+ in if IM.null mms then -1 else fst (IM.findMax mms)
+ maxes = L.map f (lvl : M.elems m)
+ ni = 1 + L.maximum maxes
-- TODO: new monsters should always be generated in a place that isn't
-- visible by the player (if possible -- not possible for bigrooms)
-- levels with few rooms are dangerous, because monsters may spawn
@@ -326,14 +331,14 @@ addMonster state@(State { slevel = lvl@(Level { lmonsters = ms,
(\ l t -> floor t
&& L.all (\pl -> distance (mloc pl, l) > 400) hs)
m <- newMonster sm monsterFrequency
- return (updateMonsters (const (m : ms)) lvl)
+ return (updateMonsters (IM.insert ni m) lvl)
else return lvl
-- | Create a new hero in the level, close to the player.
addHero :: Loc -> Int -> String -> State -> Int -> State
-addHero ploc hp name state@(State { slevel = lvl@(Level { lmap = map }) }) n =
+addHero ploc hp name state@(State { slevel = Level { lmap = map } }) n =
let hs = levelHeroList state
- ms = lmonsters lvl
+ ms = levelMonsterList state
places = ploc : L.nub (concatMap surroundings places)
good l = open (map `at` l) && not (l `L.elem` L.map mloc (hs ++ ms))
place = fromMaybe (error "no place for a hero") $ L.find good places
View
29 src/Level.hs
@@ -70,8 +70,7 @@ instance Binary Dungeon where
put (Dungeon dng) = put (M.elems dng)
get = liftM dungeon get
--- | A dungeon location is a level together with a location on
--- that level.
+-- | A dungeon location is a level together with a location on that level.
type DungeonLoc = (LevelName, Loc)
type LMovables = IM.IntMap Movable
@@ -80,7 +79,7 @@ data Level = Level
{ lname :: LevelName,
lheroes :: LMovables, -- ^ all but the current selected hero on the level
lsize :: (Y,X),
- lmonsters :: [Monster],
+ lmonsters :: LMovables, -- ^ all monsters on the level
lsmell :: SMap,
lmap :: LMap,
lmeta :: String }
@@ -92,17 +91,7 @@ updateLMap f lvl = lvl { lmap = f (lmap lvl) }
updateSMap :: (SMap -> SMap) -> Level -> Level
updateSMap f lvl = lvl { lsmell = f (lsmell lvl) }
-updateMonster :: (Monster -> Monster) -> Int -> [Monster] ->
- (Monster, [Monster])
-updateMonster f n ms =
- case splitAt n ms of
- (pre, x : post) -> let m = f x
- mtimeChanged = mtime x /= mtime m
- in (m, if mtimeChanged then snd (insertMonster m (pre ++ post))
- else pre ++ [m] ++ post)
- xs -> error "updateMonster"
-
-updateMonsters :: ([Monster] -> [Monster]) -> Level -> Level
+updateMonsters :: (LMovables -> LMovables) -> Level -> Level
updateMonsters f lvl = lvl { lmonsters = f (lmonsters lvl) }
updateHeroes :: (LMovables -> LMovables) -> Level -> Level
@@ -115,17 +104,17 @@ instance Binary Level where
put (Level nm hs sz@(sy,sx) ms lsmell lmap lmeta) =
do
put nm
+ put hs
put sz
put ms
- put hs
put [ lsmell ! (y,x) | y <- [0..sy], x <- [0..sx] ]
put [ lmap ! (y,x) | y <- [0..sy], x <- [0..sx] ]
put lmeta
get = do
nm <- get
+ hs <- get
sz@(sy,sx) <- get
ms <- get
- hs <- get
xs <- get
let lsmell = M.fromList (zip [ (y,x) | y <- [0..sy], x <- [0..sx] ] xs)
xs <- get
@@ -363,10 +352,9 @@ posToDir D = [up]
posToDir DR = [upleft]
posToDir O = moves
--- checks for the presence of monsters (and items); it does *not* check
--- if the tile is open ...
-unoccupied :: [Movable] -> LMap -> Loc -> Bool
-unoccupied movables _lmap loc =
+-- Checks for the presence of movables. Does *not* check if the tile is open.
+unoccupied :: [Movable] -> Loc -> Bool
+unoccupied movables loc =
all (\ m -> mloc m /= loc) movables
-- check whether one location is accessible from the other
@@ -436,7 +424,6 @@ grid (ny,nx) ((y0,x0),(y1,x1)) =
(y0 + (yd * (y + 1) `div` ny - 1), x0 + (xd * (x + 1) `div` nx - 1))))
| x <- [0..nx-1], y <- [0..ny-1] ]
-
connectGrid :: (Y,X) -> Rnd [((Y,X),(Y,X))]
connectGrid (ny,nx) =
do
View
11 src/Monster.hs
@@ -142,17 +142,6 @@ newMonster loc ftp =
speed FastEye = 4
speed Nose = 11
--- | Insert a monster in an mtime-sorted list of monsters.
--- Returns the position of the inserted monster and the new list.
-insertMonster :: Monster -> [Monster] -> (Int, [Monster])
-insertMonster = insertMonster' 0
- where
- insertMonster' n m [] = (n, [m])
- insertMonster' n m (m':ms)
- | mtime m <= mtime m' = (n, m : m' : ms)
- | otherwise = let (n', ms') = insertMonster' (n + 1) m ms
- in (n', m' : ms')
-
viewMovable :: MovableType -> Bool -> (Char, Attr -> Attr)
viewMovable (Hero symbol name) r = (symbol,
if r
View
34 src/State.hs
@@ -61,7 +61,6 @@ defaultState pl ploc dng lvl =
-- All the other actor and level operations only consider the current level.
-- | Finds an actor body on any level. Error if not found.
-
findActorAnyLevel :: Actor -> State -> Maybe (LevelName, Movable)
findActorAnyLevel actor state@(State { slevel = lvl,
sdungeon = Dungeon m }) =
@@ -69,8 +68,7 @@ findActorAnyLevel actor state@(State { slevel = lvl,
fmap (\ m -> (lname lvl, m)) $
case actor of
AHero n -> IM.lookup n (lheroes lvl)
- AMonster n -> let l = lmonsters lvl
- in if L.length l <= n then Nothing else Just $ l !! n
+ AMonster n -> IM.lookup n (lmonsters lvl)
in listToMaybe $ mapMaybe chk (lvl : M.elems m)
getPlayerBody :: State -> Movable
@@ -86,13 +84,14 @@ allHeroesAnyLevel state =
L.map (\ (i, _) -> (AHero i, ln)) (IM.assocs hs)
in L.concatMap one (slevel state : M.elems m)
-updateAnyHero :: (Hero -> Hero) -> Int -> State -> State
-updateAnyHero f ni state =
- case findActorAnyLevel (AHero ni) state of
+updateAnyActorBody :: Actor -> (Movable -> Movable) -> State -> State
+updateAnyActorBody actor f state =
+ case findActorAnyLevel actor state of
Just (ln, _) ->
- let upd = IM.adjust f ni
- in updateAnyLevel (updateHeroes upd) ln state
- Nothing -> error $ "updateAnyHero: hero " ++ show ni ++ " not found"
+ case actor of
+ AHero n -> updateAnyLevel (updateHeroes $ IM.adjust f n) ln state
+ AMonster n -> updateAnyLevel (updateMonsters $ IM.adjust f n) ln state
+ Nothing -> error "updateAnyActorBody"
updateAnyLevel :: (Level -> Level) -> LevelName -> State -> State
updateAnyLevel f ln state@(State { slevel = level,
@@ -104,28 +103,29 @@ updateAnyLevel f ln state@(State { slevel = level,
getActor :: State -> Actor -> Movable
getActor (State { slevel = lvl }) a =
case a of
- AHero n -> lheroes lvl IM.! n
- AMonster n -> lmonsters lvl !! n
+ AHero n -> lheroes lvl IM.! n
+ AMonster n -> lmonsters lvl IM.! n
-- | Removes the actor, if present, from the current level.
deleteActor :: Actor -> State -> State
deleteActor a =
case a of
- AHero n -> updateLevel (updateHeroes (IM.delete n))
- AMonster n -> let del l = L.take n l ++ L.drop (n + 1) l
- in updateLevel (updateMonsters del)
+ AHero n -> updateLevel (updateHeroes (IM.delete n))
+ AMonster n -> updateLevel (updateMonsters (IM.delete n))
-- | Add actor to the current level.
insertActor :: Actor -> Movable -> State -> State
insertActor a m =
case a of
- AHero n -> updateLevel (updateHeroes (IM.insert n m))
- AMonster n -> let ins l = L.take n l ++ m : L.drop n l
- in updateLevel (updateMonsters ins)
+ AHero n -> updateLevel (updateHeroes (IM.insert n m))
+ AMonster n -> updateLevel (updateMonsters (IM.insert n m))
levelHeroList :: State -> [Hero]
levelHeroList (State { slevel = Level { lheroes = hs } }) = IM.elems hs
+levelMonsterList :: State -> [Hero]
+levelMonsterList (State { slevel = Level { lmonsters = ms } }) = IM.elems ms
+
updateCursor :: (Cursor -> Cursor) -> State -> State
updateCursor f s = s { scursor = f (scursor s) }
View
25 src/StrategyState.hs
@@ -3,6 +3,7 @@ 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 Geometry
import Level
@@ -11,11 +12,13 @@ import Random
import Perception
import Strategy
import State
+import Actor
-strategy :: Monster -> State -> Perception -> Strategy Dir
-strategy m@(Movable { mtype = mt, mloc = me, mdir = mdir })
- (state@(State { stime = time,
- slevel = Level { lmonsters = ms, lsmell = nsmap, lmap = lmap } }))
+strategy :: Actor -> State -> Perception -> Strategy Dir
+strategy actor
+ state@(State { stime = time,
+ slevel = Level { lsmell = nsmap,
+ lmap = lmap } })
per =
case mt of
Eye -> slowEye
@@ -27,19 +30,21 @@ strategy m@(Movable { mtype = mt, mloc = me, mdir = mdir })
-- if the hero is visible by the monster -- this is more efficient, but
-- is not correct with the Shadow FOV (the other FOVs are symmetrical)
-- TODO: set monster targets and then prefer targets to other heroes
- hs = levelHeroList state
+ Movable { mtype = mt, mloc = me, mdir = mdir } = getActor state actor
+ delState = deleteActor actor state
+ hs = levelHeroList delState
+ ms = levelMonsterList delState
-- 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.
- hms = if L.null hs then ms else hs
- hlocs = L.map mloc hms
- hds = L.sort $ L.map (\ l -> (distance (me, l), l)) hlocs
+ enemyLocs = L.map mloc $ if L.null hs then ms else hs
+ enemyDist = L.sort $ L.map (\ l -> (distance (me, l), l)) enemyLocs
-- Below, "player" is the hero (or a monster, if no heroes on this level)
-- chased by the monster ("ploc" is his location, etc.).
-- As soon as the monster hits, this hero becomes really the currently
-- selected hero.
-- We have to sort the list to avoid bias towards the currently selected
-- hero; instead monsters will prefer heroes with smaller locations.
- ploc = case hds of
+ ploc = case enemyDist of
[] -> Nothing
(_, ploc) : _ -> Just ploc
-- TODO: currently even invisible heroes are targeted if _any_ hero
@@ -52,7 +57,7 @@ strategy m@(Movable { mtype = mt, mloc = me, mdir = mdir })
lootPresent = (\ x -> not $ L.null $ titems $ lmap `at` x)
onlyLootPresent = onlyMoves lootPresent me
onlyPreservesDir = only (\ x -> maybe True (\ d -> distance (neg d, x) > 1) mdir)
- onlyUnoccupied = onlyMoves (unoccupied ms lmap) me
+ onlyUnoccupied = onlyMoves (unoccupied ms) me
onlyAccessible = onlyMoves (accessible lmap me) me
-- Monsters don't see doors more secret than that. Enforced when actually
-- opening doors, too, so that monsters don't cheat.
View
55 src/Turn.hs
@@ -2,7 +2,10 @@ module Turn where
import Control.Monad
import Control.Monad.State hiding (State)
+import Data.List as L
import Data.Map as M
+import qualified Data.Ord as Ord
+import qualified Data.IntMap as IM
import qualified Data.Char as Char
import Action
@@ -84,45 +87,33 @@ handleMonsters :: Action ()
handleMonsters =
do
debug "handleMonsters"
- ms <- gets (lmonsters . slevel)
time <- gets stime
- case ms of
- [] -> nextMove
- (m@(Movable { mtime = mt }) : rest)
- | mt > time -> -- no monster is ready for another move
- nextMove
- | otherwise -> -- monster m should move; we temporarily remove m from the level
- -- TODO: removal isn't nice. Actor numbers currently change during
- -- a move. This could be cleaned up.
- -- Note: however this has a nice side-effect: monsters
- -- move in reversed order wrt the previous turn,
- -- so there is 2 times less changes of focus
- -- (in particular hero selection) in case of two
- -- simultaneous battles.
- do
- modify (updateLevel (updateMonsters (const rest)))
- handleMonster m
+ ms <- gets (lmonsters . slevel)
+ if IM.null ms
+ then nextMove
+ else let order = Ord.comparing (mtime . snd)
+ (i, m) = L.minimumBy order (IM.assocs ms)
+ in if mtime m > time
+ then nextMove -- no monster is ready for another move
+ else handleMonster (AMonster i)
-- | Handle the move of a single monster.
--- Precondition: monster must not currently be in the monster list of the level.
-handleMonster :: Monster -> Action ()
-handleMonster m =
+handleMonster :: Actor -> Action ()
+handleMonster actor =
do
debug "handleMonster"
state <- get
- let time = stime state
- let ms = lmonsters (slevel state)
+ time <- gets stime
per <- currentPerception
- -- run the AI; it currently returns a direction; TODO: it should return an action
- dir <- liftIO $ rndToIO $ frequency (head (runStrategy (strategy m state per .| wait)))
- let waiting = dir == (0,0)
- let nmdir = if waiting then Nothing else Just dir
- -- advance time and reinsert monster
- let nm = m { mtime = time + mspeed m, mdir = nmdir }
- let (act, nms) = insertMonster nm ms
- modify (updateLevel (updateMonsters (const nms)))
- let actor = AMonster act
- try $ -- if the following action aborts, we just continue
+ -- run the AI; it currently returns a direction
+ -- TODO: it should return an action
+ dir <- liftIO $ rndToIO $
+ frequency (head (runStrategy (strategy actor state per .| wait)))
+ let waiting = dir == (0,0)
+ let nmdir = if waiting then Nothing else Just dir
+ -- advance time and update monster
+ updateAnyActor actor $ \ m -> m { mtime = time + mspeed m, mdir = nmdir }
+ try $ -- if the following action aborts, we just continue
if waiting
then
-- monster is not moving, let's try to pick up an object
Please sign in to comment.
Something went wrong with that request. Please try again.