Skip to content

HTTPS clone URL

Subversion checkout URL

You can clone with HTTPS or Subversion.

Download ZIP
Browse files

refactor dungeon and movable creation

  • Loading branch information...
commit 729c0ac5dade06197fee11341a12b37c53ff6796 1 parent db79784
@Mikolaj Mikolaj authored
View
4 LambdaHack.cabal
@@ -28,9 +28,9 @@ executable LambdaHack
Display, Dungeon, DungeonState, File,
FOV, FOV.Common, FOV.Digital, FOV.Permissive, FOV.Shadow,
Frequency, Geometry, GeometryRnd, Grammar,
- HeroState, HighScores, Item, ItemState,
+ HighScores, Item, ItemState,
Keys, Keybindings, LambdaHack, Level, LevelState,
- Message, MonsterState, MovableKind, Movable, MovableState,
+ Message, MovableAdd, MovableKind, Movable, MovableState,
Multiline, Perception, Random,
Save, State, Strategy, StrategyState,
Turn, Terrain, Version
View
2  src/Actions.hs
@@ -25,7 +25,7 @@ import Message
import Movable
import MovableState
import MovableKind
-import MonsterState
+import MovableAdd
import Perception
import Random
import State
View
57 src/DungeonState.hs
@@ -8,34 +8,33 @@ import Dungeon
import Random
import qualified Config
--- | Generate the dungeon for a new game, and start the game loop.
-generate :: Config.CP -> Rnd (Loc, Level, Dungeon)
-generate config =
- let matchGenerator n Nothing = rogueRoom -- the default
- matchGenerator n (Just "bigRoom") = bigRoom
- matchGenerator n (Just "noiseRoom") = noiseRoom
- matchGenerator n (Just "rogueRoom") = rogueRoom
- matchGenerator n (Just s) =
- error $ "matchGenerator: unknown: " ++ show n ++ ", " ++ s
+connect ::
+ Maybe (Maybe DungeonLoc) ->
+ [(Maybe (Maybe DungeonLoc) -> Maybe (Maybe DungeonLoc) -> Level, Loc, Loc)] ->
+ [Level]
+connect au [(x,_,_)] = [x au Nothing]
+connect au ((x,_,d):ys@((_,u,_):_)) =
+ let (z:zs) = connect (Just (Just (lname x',d))) ys
+ x' = x au (Just (Just (lname z,u)))
+ in x' : z : zs
+
+matchGenerator n Nothing = rogueRoom -- the default
+matchGenerator n (Just "bigRoom") = bigRoom
+matchGenerator n (Just "noiseRoom") = noiseRoom
+matchGenerator n (Just "rogueRoom") = rogueRoom
+matchGenerator n (Just s) =
+ error $ "matchGenerator: unknown: " ++ show n ++ ", " ++ s
- findGenerator n =
- let ln = "LambdaCave_" ++ show n
- genName = Config.getOption config "dungeon" ln
- in matchGenerator n genName (defaultLevelConfig n) (LambdaCave n)
+findGenerator config n =
+ let ln = "LambdaCave_" ++ show n
+ genName = Config.getOption config "dungeon" ln
+ in matchGenerator n genName (defaultLevelConfig n) (LambdaCave n)
- connect :: Maybe (Maybe DungeonLoc) ->
- [(Maybe (Maybe DungeonLoc) -> Maybe (Maybe DungeonLoc) ->
- Level, Loc, Loc)] ->
- [Level]
- connect au [(x,_,_)] = [x au Nothing]
- connect au ((x,_,d):ys@((_,u,_):_)) =
- let (z:zs) = connect (Just (Just (lname x',d))) ys
- x' = x au (Just (Just (lname z,u)))
- in x' : z : zs
- in
- do
- let depth = Config.get config "dungeon" "depth"
- levels <- mapM findGenerator [1..depth]
- let lvls = connect (Just Nothing) levels
- ploc = ((\ (_,x,_) -> x) (head levels))
- return $ (ploc, head lvls, dungeon (tail lvls))
+-- | Generate the dungeon for a new game.
+generate :: Config.CP -> Rnd (Loc, Level, Dungeon)
+generate config = do
+ let depth = Config.get config "dungeon" "depth"
+ levels <- mapM (findGenerator config) [1..depth]
+ let lvls = connect (Just Nothing) levels
+ ploc = ((\ (_,x,_) -> x) (head levels))
+ return $ (ploc, head lvls, dungeon (tail lvls))
View
44 src/HeroState.hs
@@ -1,44 +0,0 @@
-module HeroState where
-
-import qualified Data.Char as Char
-import Data.List as L
-import qualified Data.IntMap as IM
-import Data.Maybe
-
-import Geometry
-import qualified Config
-import Movable
-import MovableState
-import MovableKind
-import Level
-import State
-
-templateHero :: Char -> String -> Loc -> Int -> Movable
-templateHero symbol name ploc hp =
- let mk = hero {nhpMin = hp, nhpMax = hp, nsymbol = symbol, nname = name }
- in Movable mk hp Nothing TCursor ploc [] 'a' 0
-
--- | Create a new hero on the current level, close to the given location.
-addHero :: Loc -> Int -> String -> State -> Int -> State
-addHero ploc hp name state@(State { slevel = Level { lmap = map } }) n =
- let hs = levelHeroList state
- 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
- symbol = if n < 1 || n > 9 then '@' else Char.intToDigit n
- hero = templateHero symbol name place hp
- in updateLevel (updateHeroes (IM.insert n hero)) state
-
--- | Create a set of new heroes on the current level, at location ploc.
-addHeroes :: Loc -> State -> State
-addHeroes ploc state =
- let config = sconfig state
- findHeroName n =
- let heroName = Config.getOption config "heroes" ("HeroName_" ++ show n)
- in fromMaybe ("hero number " ++ show n) heroName
- k = Config.get config "heroes" "extraHeroes"
- b = Config.get config "heroes" "baseHp"
- hp = k + b `div` (k + 1)
- addNamedHero state n = addHero ploc hp (findHeroName n) state n
- in foldl' addNamedHero state [0..k]
View
2  src/LambdaHack.hs
@@ -11,7 +11,7 @@ import Random
import qualified Save
import Turn
import qualified Config
-import HeroState
+import MovableAdd
import Item
main :: IO ()
View
40 src/MonsterState.hs → src/MovableAdd.hs
@@ -1,10 +1,12 @@
-module MonsterState where
+module MovableAdd where
import Prelude hiding (floor)
import qualified Data.IntMap as IM
import Data.List as L
import Data.Map as M
import Data.Ratio
+import Data.Maybe
+import qualified Data.Char as Char
import Geometry
import State
@@ -14,15 +16,40 @@ import Movable
import MovableState
import MovableKind
import Random
+import qualified Config
-- setting the time of new monsters to 0 makes them able to
-- move immediately after generation; this does not seem like
-- a bad idea, but it would certainly be "more correct" to set
-- the time to the creation time instead
-templateMonster :: MovableKind -> Loc -> Rnd Movable
-templateMonster mk loc = do
- hp <- randomR (nhpMin mk, nhpMax mk)
- return $ Movable mk hp Nothing TCursor loc [] 'a' 0
+template :: MovableKind -> Int -> Loc -> Movable
+template mk hp loc = Movable mk hp Nothing TCursor loc [] 'a' 0
+
+-- | Create a new hero on the current level, close to the given location.
+addHero :: Loc -> Int -> String -> State -> Int -> State
+addHero ploc hp name state@(State { slevel = Level { lmap = map } }) n =
+ let hs = levelHeroList state
+ 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))
+ loc = fromMaybe (error "no place for a hero") $ L.find good places
+ symbol = if n < 1 || n > 9 then '@' else Char.intToDigit n
+ mk = hero {nhpMin = hp, nhpMax = hp, nsymbol = symbol, nname = name }
+ m = template mk hp loc
+ in updateLevel (updateHeroes (IM.insert n m)) state
+
+-- | Create a set of new heroes on the current level, at location ploc.
+addHeroes :: Loc -> State -> State
+addHeroes ploc state =
+ let config = sconfig state
+ findHeroName n =
+ let heroName = Config.getOption config "heroes" ("HeroName_" ++ show n)
+ in fromMaybe ("hero number " ++ show n) heroName
+ k = Config.get config "heroes" "extraHeroes"
+ b = Config.get config "heroes" "baseHp"
+ hp = k + b `div` (k + 1)
+ addNamedHero state n = addHero ploc hp (findHeroName n) state n
+ in foldl' addNamedHero state [0..k]
newMonsterIndex :: State -> Int
newMonsterIndex (State { slevel = lvl, sdungeon = Dungeon m }) =
@@ -62,6 +89,7 @@ addMonster state@(State { slevel = lvl }) = do
&& L.all (\ pl -> distance (mloc pl, l) > 400) hs)
let fmk = Frequency $ L.zip (L.map nfreq roamingMts) roamingMts
mk <- frequency fmk
- m <- templateMonster mk loc
+ hp <- randomR (nhpMin mk, nhpMax mk)
+ let m = template mk hp loc
return (updateMonsters (IM.insert ni m) lvl)
else return lvl
Please sign in to comment.
Something went wrong with that request. Please try again.