Permalink
Browse files

new heroes can now easily be generated mid-game

Plus assorted refactorings.
  • Loading branch information...
1 parent 729c0ac commit 5dd6b4694ffcb46677f29e098293b4e071d08359 @Mikolaj Mikolaj committed Mar 25, 2011
Showing with 75 additions and 66 deletions.
  1. +2 −5 src/Actions.hs
  2. +4 −4 src/Dungeon.hs
  3. +1 −1 src/LambdaHack.hs
  4. +7 −7 src/Level.hs
  5. +61 −49 src/MovableAdd.hs
View
@@ -124,11 +124,8 @@ acceptCurrent h = do
moveCursor :: Dir -> Int -> Action ()
moveCursor dir n = do
(sy, sx) <- gets (lsize . slevel)
- let iter :: Int -> (a -> a) -> a -> a -- not in base libs???
- iter 0 _ x = x
- iter k f x = f (iter (k-1) f x)
- upd cursor =
- let (ny, nx) = iter n (`shift` dir) (clocation cursor)
+ let upd cursor =
+ let (ny, nx) = iterate (`shift` dir) (clocation cursor) !! n
cloc = (max 1 $ min ny (sy-1), max 1 $ min nx (sx-1))
in cursor { clocation = cloc }
modify (updateCursor upd)
View
@@ -132,7 +132,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) lmEmpty smap lmap ""
+ let lvl = Level nm emptyParty (sy,sx) emptyParty smap lmap ""
-- locations of the stairs
su <- findLoc lvl (const floor)
sd <- findLoc lvl (\ l t -> floor t
@@ -147,7 +147,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) lmEmpty smap (flmap lu ld) "bigroom"
+ level lu ld = Level nm emptyParty (sy,sx) emptyParty smap (flmap lu ld) "bigroom"
return (level, su, sd)
-- | For a bigroom level: Create a level consisting of only one, empty room.
@@ -261,7 +261,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) lmEmpty smap lmap ""
+ let lvl = Level nm emptyParty (levelSize cfg) emptyParty smap lmap ""
-- convert openings into doors
dlmap <- fmap M.fromList . mapM
(\ o@((y,x),(t,r)) ->
@@ -298,7 +298,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) lmEmpty smap flmap meta, su, sd)
+ in Level nm emptyParty (levelSize cfg) emptyParty smap flmap meta, su, sd)
rollItems :: LevelConfig -> Level -> Loc -> Rnd [(Loc, Item)]
rollItems cfg lvl ploc =
View
@@ -38,7 +38,7 @@ start session = do
(Potion PotionHealing, White) ]
defState = defaultState dng lvl
state = defState { sassocs = assocs, sconfig = config }
- hstate = addHeroes ploc state
+ hstate = initialHeroes ploc state
handlerToIO session hstate msg handle
Left state ->
handlerToIO session state "Welcome back to LambdaHack." handle
View
@@ -34,13 +34,13 @@ levelNumber (LambdaCave n) = n
-- | A dungeon location is a level together with a location on that level.
type DungeonLoc = (LevelName, Loc)
-type LMovables = IM.IntMap Movable
+type Party = IM.IntMap Movable
data Level = Level
{ lname :: LevelName,
- lheroes :: LMovables, -- ^ all but the current selected hero on the level
+ lheroes :: Party, -- ^ all heroes on the level
lsize :: (Y,X),
- lmonsters :: LMovables, -- ^ all monsters on the level
+ lmonsters :: Party, -- ^ all monsters on the level
lsmell :: SMap,
lmap :: LMap,
lmeta :: String }
@@ -52,14 +52,14 @@ updateLMap f lvl = lvl { lmap = f (lmap lvl) }
updateSMap :: (SMap -> SMap) -> Level -> Level
updateSMap f lvl = lvl { lsmell = f (lsmell lvl) }
-updateMonsters :: (LMovables -> LMovables) -> Level -> Level
+updateMonsters :: (Party -> Party) -> Level -> Level
updateMonsters f lvl = lvl { lmonsters = f (lmonsters lvl) }
-updateHeroes :: (LMovables -> LMovables) -> Level -> Level
+updateHeroes :: (Party -> Party) -> Level -> Level
updateHeroes f lvl = lvl { lheroes = f (lheroes lvl) }
-lmEmpty :: LMovables
-lmEmpty = IM.empty
+emptyParty :: Party
+emptyParty = IM.empty
instance Binary Level where
put (Level nm hs sz@(sy,sx) ms lsmell lmap lmeta) =
View
@@ -18,78 +18,90 @@ import MovableKind
import Random
import qualified Config
+-- Generic functions
+
-- 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
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 =
+nearbyFreeLoc :: Loc -> State -> Loc
+nearbyFreeLoc origin state@(State { slevel = Level { lmap = map } }) =
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
+ places = origin : L.nub (concatMap surroundings places)
+ good loc = open (map `at` loc) && not (loc `L.elem` L.map mloc (hs ++ ms))
+ in fromMaybe (error "no nearby free location found") $ L.find good places
--- | 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 }) =
- let f lvl = let mms = lmonsters lvl
+newMovableIndex :: (Level -> Party) -> State -> Int
+newMovableIndex projection (State { slevel = lvl, sdungeon = Dungeon m }) =
+ let f lvl = let mms = projection lvl
in if IM.null mms then -1 else fst (IM.findMax mms)
maxes = L.map f (lvl : M.elems m)
in 1 + L.maximum maxes
+-- Adding heroes
+
+findHeroName :: Config.CP -> Int -> String
+findHeroName config n =
+ let heroName = Config.getOption config "heroes" ("HeroName_" ++ show n)
+ in fromMaybe ("hero number " ++ show n) heroName
+
+-- | Create a new hero on the current level, close to the given location.
+addHero :: Loc -> State -> State
+addHero ploc state =
+ let config = sconfig state
+ n = newMovableIndex lheroes state
+ bHp = Config.get config "heroes" "baseHp"
+ symbol = if n < 1 || n > 9 then '@' else Char.intToDigit n
+ name = findHeroName config n
+ mk = hero {nhpMin = bHp, nhpMax = bHp, nsymbol = symbol, nname = name }
+ loc = nearbyFreeLoc ploc state
+ startHp = bHp `div` (min 10 (n + 1))
+ m = template mk startHp loc
+ in updateLevel (updateHeroes (IM.insert n m)) state
+
+-- | Create a set of initial heroes on the current level, at location ploc.
+initialHeroes :: Loc -> State -> State
+initialHeroes ploc state =
+ let k = 1 + Config.get (sconfig state) "heroes" "extraHeroes"
+ in iterate (addHero ploc) state !! k
+
+-- Adding monsters
+
-- | Chance that a new monster is generated. Currently depends on the
-- number of monsters already present, and on the level. In the future,
-- the strength of the character and the strength of the monsters present
-- could further influence the chance, and the chance could also affect
-- which monster is generated.
-monsterGenChance :: LevelName -> [Movable] -> Rnd Bool
-monsterGenChance (LambdaCave n) ms =
- chance $ 1%(fromIntegral (250 + 200 * (L.length ms - n)) `max` 50)
+monsterGenChance :: LevelName -> Int -> Rnd Bool
+monsterGenChance (LambdaCave depth) numMonsters =
+ chance $ 1%(fromIntegral (250 + 200 * (numMonsters - depth)) `max` 50)
monsterGenChance _ _ = return False
-- | Create a new monster in the level, at a random position.
addMonster :: State -> Rnd Level
addMonster state@(State { slevel = lvl }) = do
let hs = levelHeroList state
ms = levelMonsterList state
- rc <- monsterGenChance (lname lvl) ms
- if rc
- then
- do
- let ni = newMonsterIndex state
- -- 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
- -- in adjacent and unexpected places
- loc <- findLocTry 1000 lvl
- (\ l t -> open t
- && not (l `L.elem` L.map mloc (hs ++ ms)))
- (\ l t -> floor t
- && L.all (\ pl -> distance (mloc pl, l) > 400) hs)
- let fmk = Frequency $ L.zip (L.map nfreq roamingMts) roamingMts
- mk <- frequency fmk
- hp <- randomR (nhpMin mk, nhpMax mk)
- let m = template mk hp loc
- return (updateMonsters (IM.insert ni m) lvl)
- else return lvl
+ rc <- monsterGenChance (lname lvl) (L.length ms)
+ if not rc
+ then return lvl
+ else do
+ let ni = newMovableIndex lmonsters state
+ -- 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
+ -- in adjacent and unexpected places
+ loc <- findLocTry 1000 lvl
+ (\ l t -> open t
+ && not (l `L.elem` L.map mloc (hs ++ ms)))
+ (\ l t -> floor t
+ && L.all (\ pl -> distance (mloc pl, l) > 400) hs)
+ let fmk = Frequency $ L.zip (L.map nfreq roamingMts) roamingMts
+ mk <- frequency fmk
+ hp <- randomR (nhpMin mk, nhpMax mk)
+ let m = template mk hp loc
+ return (updateMonsters (IM.insert ni m) lvl)

0 comments on commit 5dd6b46

Please sign in to comment.