Browse files

gut out Actor module, to avoid cyclic dependencies later

  • Loading branch information...
1 parent 5c58cf0 commit aba4fc27d0296c1206dbde69317d2793c0bcb7b9 @Mikolaj Mikolaj committed Mar 9, 2011
Showing with 19 additions and 39 deletions.
  1. +1 −1 src/Actions.hs
  2. +0 −38 src/Actor.hs
  3. +10 −0 src/Level.hs
  4. +8 −0 src/State.hs
View
2 src/Actions.hs
@@ -11,7 +11,7 @@ import Data.Set as S
import System.Time
import Action
-import Actor hiding (updateActor)
+import Actor
import Display2 hiding (display)
import Dungeon
import Geometry
View
38 src/Actor.hs
@@ -1,44 +1,6 @@
module Actor where
-import qualified Data.IntMap as IM
-
-import Level
-import Monster
-import State
-
data Actor = AHero Int -- ^ hero serial number
| AMonster Int -- ^ offset in monster list
| APlayer -- ^ currently player-controlled hero
deriving (Show, Eq)
-
-getActor :: State -> Actor -> Movable
-getActor (State { slevel = lvl, splayer = p }) a =
- case a of
- AHero n -> if n == heroNumber p then p else lheroes lvl IM.! n
- AMonster n -> lmonsters lvl !! n
- APlayer -> p
-
-updateActor :: (Movable -> Movable) -> -- the update
- (Movable -> State -> IO a) -> -- continuation
- Actor -> -- who to update
- State -> IO a -- transformed continuation
-updateActor f k (AHero n) state =
- let s = updateAnyHero f n state
- in case findHeroLevel n state of
- Just (_, h) -> k h s
- Nothing -> error "updateActor(Hero)"
-updateActor f k (AMonster n) state@(State { slevel = lvl, splayer = p }) =
- let (m,ms) = updateMonster f n (lmonsters lvl)
- in k m (updateLevel (updateMonsters (const ms)) state)
-updateActor f k APlayer state@(State { slevel = lvl, splayer = p }) =
- k p (updatePlayer f state)
-
-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"
View
10 src/Level.hs
@@ -92,6 +92,16 @@ 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 f lvl = lvl { lmonsters = f (lmonsters lvl) }
View
8 src/State.hs
@@ -8,6 +8,7 @@ import Control.Monad
import Data.Binary
import qualified Config
+import Actor
import Monster
import Geometry
import Level
@@ -53,6 +54,13 @@ defaultState player dng lvl =
lvl
(Config.defaultCP)
+getActor :: State -> Actor -> Movable
+getActor (State { slevel = lvl, splayer = p }) a =
+ case a of
+ AHero n -> if n == heroNumber p then p else lheroes lvl IM.! n
+ AMonster n -> lmonsters lvl !! n
+ APlayer -> p
+
updatePlayer :: (Hero -> Hero) -> State -> State
updatePlayer f s = s { splayer = f (splayer s) }

0 comments on commit aba4fc2

Please sign in to comment.