LambdaHack-0.1.20110117: src/Dungeon.hs
module Dungeon where
import Prelude hiding (floor)
import Control.Monad
import Data.Map as M
import Data.List as L
import Data.Ratio
import State
import Geometry
import Level
import Monster
import Item
import Random
type Corridor = [(Y,X)]
type Room = Area
-- | Create a random room according to given parameters.
mkRoom :: Int -> -- ^ border columns
(Y,X) -> -- ^ minimum size
Area -> -- ^ this is an area, not the room itself
Rnd Room -- ^ this is the upper-left and lower-right corner of the room
mkRoom bd (ym,xm) ((y0,x0),(y1,x1)) =
do
(ry0,rx0) <- locInArea ((y0 + bd,x0 + bd),(y1 - bd - ym + 1,x1 - bd - xm + 1))
(ry1,rx1) <- locInArea ((ry0 + ym - 1,rx0 + xm - 1),(y1 - bd,x1 - bd))
return ((ry0,rx0),(ry1,rx1))
-- | Create a no-room, i.e., a single corridor field.
mkNoRoom :: Int -> -- ^ border columns
Area -> -- ^ this is an area, not the room itself
Rnd Room -- ^ this is the upper-left and lower-right corner of the room
mkNoRoom bd ((y0,x0),(y1,x1)) =
do
(ry,rx) <- locInArea ((y0 + bd,x0 + bd),(y1 - bd,x1 - bd))
return ((ry,rx),(ry,rx))
-- | Create a corridor, either horizontal or vertical, with
-- a possible intermediate part that is in the opposite direction.
mkCorridor :: HV -> (Loc,Loc) -> Area -> Rnd [(Y,X)] {- straight sections of the corridor -}
mkCorridor hv ((y0,x0),(y1,x1)) b =
do
(ry,rx) <- findLocInArea b (const True)
-- (ry,rx) is intermediate point the path crosses
-- hv decides whether we start in horizontal or vertical direction
case hv of
Horiz -> return [(y0,x0),(y0,rx),(y1,rx),(y1,x1)]
Vert -> return [(y0,x0),(ry,x0),(ry,x1),(y1,x1)]
-- | Try to connect two rooms with a corridor.
-- The condition passed to mkCorridor is tricky; there might not always
-- exist a suitable intermediate point if the rooms are allowed to be close
-- together ...
connectRooms :: Area -> Area -> Rnd [Loc]
connectRooms sa@((sy0,sx0),(sy1,sx1)) ta@((ty0,tx0),(ty1,tx1)) =
do
(sy,sx) <- locInArea sa
(ty,tx) <- locInArea ta
let xok = sx1 < tx0 - 3
let xarea = normalizeArea ((sy,sx1+2),(ty,tx0-2))
let yok = sy1 < ty0 - 3
let yarea = normalizeArea ((sy1+2,sx),(ty0-2,tx))
let xyarea = normalizeArea ((sy1+2,sx1+2),(ty0-2,tx0-2))
(hv,area) <- if xok && yok then fmap (\ hv -> (hv,xyarea)) (binaryChoice Horiz Vert)
else if xok then return (Horiz,xarea)
else return (Vert,yarea)
mkCorridor hv ((sy,sx),(ty,tx)) area
-- | Actually dig a corridor.
digCorridor :: Corridor -> LMap -> LMap
digCorridor (p1:p2:ps) l =
digCorridor (p2:ps) (M.unionWith corridorUpdate newPos l)
where
newPos = M.fromList [ (ps,newTile Corridor) | ps <- fromTo p1 p2 ]
corridorUpdate _ (Tile (Wall hv) is,u) = (Tile (Opening hv) is,u)
corridorUpdate _ (Tile (Opening hv) is,u) = (Tile (Opening hv) is,u)
corridorUpdate _ (Tile (Floor l) is,u) = (Tile (Floor l) is,u)
corridorUpdate (x,u) _ = (x,u)
digCorridor _ l = l
-- | Create a new tile.
newTile :: Terrain -> (Tile, Tile)
newTile t = (Tile t [], Tile Unknown [])
-- | Create a level consisting of only one room. Optionally, insert some walls.
emptyroom :: (Level -> Rnd (LMap -> LMap)) -> LevelConfig ->
LevelName -> Rnd (Maybe (Maybe DungeonLoc) -> Maybe (Maybe DungeonLoc) -> Level, Loc, Loc)
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 (sy,sx) [] smap lmap ""
-- locations of the stairs
su <- findLoc lvl (const floor)
sd <- findLoc lvl (\ l t -> floor t
&& distance (su,l) > minStairsDistance cfg)
is <- rollItems cfg lvl su
addWalls <- addWallsRnd lvl
let addItem lmap (l,it) =
M.update (\ (t,r) -> Just (t { titems = it : titems t }, r)) l lmap
flmap lu ld =
addWalls $
maybe id (\ l -> M.insert su (newTile (Stairs Light Up l))) lu $
maybe id (\ l -> M.insert sd (newTile (Stairs Light Down l))) ld $
(\lmap -> foldl' addItem lmap is) $
lmap
level lu ld = Level nm (sy,sx) [] smap (flmap lu ld) "bigroom"
return (level, su, sd)
-- | For a bigroom level: Create a level consisting of only one, empty room.
bigroom :: LevelConfig ->
LevelName -> Rnd (Maybe (Maybe DungeonLoc) -> Maybe (Maybe DungeonLoc) -> Level, Loc, Loc)
bigroom = emptyroom (\ lvl -> return id)
-- | For a noiseroom level: Create a level consisting of only one room
-- with randomly distributed pillars.
noiseroom :: LevelConfig ->
LevelName -> Rnd (Maybe (Maybe DungeonLoc) -> Maybe (Maybe DungeonLoc) -> Level, Loc, Loc)
noiseroom cfg =
let addWalls lvl = do
rs <- rollPillars cfg lvl
let insertWall lmap l =
case lmap `at` l of
Tile (Floor _) [] -> M.insert l (newTile (Wall O)) lmap
_ -> lmap
return $ \ lmap -> foldl' insertWall lmap rs
in emptyroom addWalls cfg
data LevelConfig =
LevelConfig {
levelGrid :: Rnd (Y,X),
minRoomSize :: Rnd (Y,X),
darkRoomChance :: Rnd Bool,
border :: Int, -- must be at least 2!
levelSize :: (Y,X), -- lower right point
extraConnects :: (Y,X) -> Int,
-- relative to grid
-- (in fact a range, because of duplicate connects)
noRooms :: (Y,X) -> Rnd Int,
-- range, relative to grid
minStairsDistance :: Int, -- must not be too large
doorChance :: Rnd Bool,
doorOpenChance :: Rnd Bool,
doorSecretChance :: Rnd Bool,
doorSecretMax :: Int,
nrItems :: Rnd Int, -- range
depth :: Int -- general indicator of difficulty
}
normalLevelSize :: (Y,X)
normalLevelSize = (22,79)
defaultLevelConfig :: Int -> LevelConfig
defaultLevelConfig d =
LevelConfig {
levelGrid = do
y <- randomR (2,4)
x <- randomR (3,5)
return (y,x),
minRoomSize = return (2,2),
darkRoomChance = chance $ 1%((22 - (2 * fromIntegral d)) `max` 2),
border = 2,
levelSize = normalLevelSize,
extraConnects = \ (y,x) -> (y*x) `div` 3,
noRooms = \ (y,x) -> randomR (0,(y*x) `div` 3),
minStairsDistance = 676,
doorChance = chance $ 2%3,
doorOpenChance = chance $ 1%10,
doorSecretChance = chance $ 1%4,
doorSecretMax = 15,
nrItems = randomR (5,10),
depth = d
}
largeLevelConfig :: Int -> LevelConfig
largeLevelConfig d =
(defaultLevelConfig d) {
levelGrid = return (7,10),
levelSize = (77,231),
extraConnects = const 10
}
-- | Create a "normal" dungeon level. Takes a configuration in order
-- to tweak all sorts of data.
level :: LevelConfig ->
LevelName ->
Rnd (Maybe (Maybe DungeonLoc) -> Maybe (Maybe DungeonLoc) ->
Level, Loc, Loc)
level cfg nm =
do
lgrid <- levelGrid cfg
lminroom <- minRoomSize cfg
let gs = M.toList (grid lgrid ((0,0),levelSize cfg))
-- grid locations of "no-rooms"
nrnr <- noRooms cfg lgrid
nr <- replicateM nrnr (do
let (y,x) = lgrid
yg <- randomR (0,y-1)
xg <- randomR (0,x-1)
return (yg,xg))
rs0 <- mapM (\ (i,r) -> do
r' <- if i `elem` nr
then mkNoRoom (border cfg) r
else mkRoom (border cfg) lminroom r
return (i,r')) gs
let rooms :: [(Loc, Loc)]
rooms = L.map snd rs0
dlrooms <- (mapM (\ r -> darkRoomChance cfg >>= \ c -> return (r, toDL (not c))) rooms) :: Rnd [((Loc, Loc), DL)]
let rs = M.fromList rs0
connects <- connectGrid lgrid
addedConnects <- replicateM (extraConnects cfg lgrid) (randomConnection lgrid)
let allConnects = L.nub (addedConnects ++ connects)
cs <- mapM
(\ (p0,p1) -> do
let r0 = rs ! p0
r1 = rs ! p1
connectRooms r0 r1) allConnects
let smap = M.fromList [ ((y,x),-100) | let (sy,sx) = levelSize cfg,
y <- [0..sy], x <- [0..sx] ]
let lmap :: LMap
lmap = foldr digCorridor (foldr (\ (r, dl) m -> digRoom dl r m)
(emptyLMap (levelSize cfg)) dlrooms) cs
let lvl = Level nm (levelSize cfg) [] smap lmap ""
-- convert openings into doors
dlmap <- fmap M.fromList . mapM
(\ o@((y,x),(t,r)) ->
case t of
Tile (Opening hv) _ ->
do
-- openings have a certain chance to be doors;
-- doors have a certain chance to be open; and
-- closed doors have a certain chance to be
-- secret
rb <- doorChance cfg
ro <- doorOpenChance cfg
rs <- if ro then return Nothing
else do rsc <- doorSecretChance cfg
fmap Just
(if rsc then randomR (1, doorSecretMax cfg)
else return 0)
if rb
then return ((y,x),newTile (Door hv rs))
else return o
_ -> return o) .
M.toList $ lmap
-- locations of the stairs
su <- findLoc lvl (const floor)
sd <- findLocTry 1000 lvl
(const floor)
(\ l t -> distance (su,l) > minStairsDistance cfg)
-- determine number of items, items and locations for the items
is <- rollItems cfg lvl su
-- generate map and level from the data
let meta = show allConnects
return (\ lu ld ->
let flmap = maybe id (\ l -> M.update (\ (t,r) -> Just $ newTile (Stairs (toDL $ light t) Up l)) su) lu $
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 (levelSize cfg) [] smap flmap meta, su, sd)
rollItems :: LevelConfig -> Level -> Loc -> Rnd [(Loc, Item)]
rollItems cfg lvl ploc =
do
nri <- nrItems cfg
replicateM nri $
do
t <- newItem (depth cfg) itemFrequency
l <- case itype t of
Sword _ ->
-- swords generated close to monsters; MUAHAHAHA
findLocTry 200 lvl
(const floor)
(\ l t -> distance (ploc, l) > 400)
_ -> findLoc lvl (const floor)
return (l,t)
rollPillars :: LevelConfig -> Level -> Rnd [Loc]
rollPillars cfg lvl =
do
nri <- 100 *~ nrItems cfg
replicateM nri $
do
l <- findLoc lvl (const floor)
return l
emptyLMap :: (Y,X) -> LMap
emptyLMap (my,mx) = M.fromList [ ((y,x),newTile Rock) | x <- [0..mx], y <- [0..my] ]
-- | If the room has size 1, it is assumed to be a no-room, and a single
-- corridor field will be dug instead of a room.
digRoom :: DL -> Room -> LMap -> LMap
digRoom dl ((y0,x0),(y1,x1)) l
| y0 == y1 && x0 == x1 =
M.insert (y0,x0) (newTile Corridor) l
| otherwise =
let rm = M.fromList $ [ ((y,x),newTile (Floor dl)) | x <- [x0..x1], y <- [y0..y1] ]
++ [ ((y,x),newTile (Wall p)) | (x,y,p) <- [(x0-1,y0-1,UL),(x1+1,y0-1,UR),(x0-1,y1+1,DL),(x1+1,y1+1,DR)] ]
++ [ ((y,x),newTile (Wall p)) | x <- [x0..x1], (y,p) <- [(y0-1,U),(y1+1,D)] ]
++ [ ((y,x),newTile (Wall p)) | (x,p) <- [(x0-1,L),(x1+1,R)], y <- [y0..y1] ]
in M.unionWith const rm l
-- | Create a new monster in the level, at a random position.
addMonster :: Level -> Player -> Rnd Level
addMonster lvl@(Level { lmonsters = ms, lmap = lmap })
player@(Monster { mloc = ploc }) =
do
rc <- monsterGenChance (lname lvl) ms
if rc
then do
-- 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
sm <- findLocTry 1000 lvl
(\ l t -> not (l `L.elem` L.map mloc (player : ms))
&& open t)
(\ l t -> distance (ploc, l) > 400
&& floor t)
m <- newMonster sm monsterFrequency
return (updateMonsters (const (m : ms)) lvl)
else return lvl