-- | Generation of caves (not yet inhabited dungeon levels) from cave kinds. module Game.LambdaHack.Server.DungeonGen.Cave ( TileMapXY, ItemFloorXY, Cave(..), buildCave ) where import Control.Arrow ((&&&)) import Control.Monad import qualified Data.EnumMap.Strict as EM import qualified Data.List as L import Data.Maybe import qualified Game.LambdaHack.Common.Feature as F import Game.LambdaHack.Common.Item import qualified Game.LambdaHack.Common.Kind as Kind import Game.LambdaHack.Common.PointXY import Game.LambdaHack.Common.Random import qualified Game.LambdaHack.Common.Tile as Tile import Game.LambdaHack.Content.CaveKind import Game.LambdaHack.Content.PlaceKind import Game.LambdaHack.Content.TileKind import Game.LambdaHack.Server.DungeonGen.Area import Game.LambdaHack.Server.DungeonGen.AreaRnd import Game.LambdaHack.Server.DungeonGen.Place hiding (TileMapXY) import qualified Game.LambdaHack.Server.DungeonGen.Place as Place import Control.Exception.Assert.Sugar -- | The map of tile kinds in a cave. -- The map is sparse. The default tile that eventually fills the empty spaces -- is specified in the cave kind specification with @cdefTile@. type TileMapXY = Place.TileMapXY -- | The map of starting items in tiles of a cave. The map is sparse. -- Unspecified tiles have no starting items. type ItemFloorXY = EM.EnumMap PointXY (Item, Int) -- | The type of caves (not yet inhabited dungeon levels). data Cave = Cave { dkind :: !(Kind.Id CaveKind) -- ^ the kind of the cave , dmap :: !TileMapXY -- ^ tile kinds in the cave , ditem :: !ItemFloorXY -- ^ starting items in the cave , dplaces :: ![Place] -- ^ places generated in the cave , dnight :: !Bool -- ^ whether the cave is dark } deriving Show {- Rogue cave is generated by an algorithm inspired by the original Rogue, as follows: * The available area is divided into a grid, e.g, 3 by 3, where each of the 9 grid cells has approximately the same size. * In each of the 9 grid cells one room is placed at a random position and with a random size, but larger than The minimum size, e.g, 2 by 2 floor tiles. * Rooms that are on horizontally or vertically adjacent grid cells may be connected by a corridor. Corridors consist of 3 segments of straight lines (either "horizontal, vertical, horizontal" or "vertical, horizontal, vertical"). They end in openings in the walls of the room they connect. It is possible that one or two of the 3 segments have length 0, such that the resulting corridor is L-shaped or even a single straight line. * Corridors are generated randomly in such a way that at least every room on the grid is connected, and a few more might be. It is not sufficient to always connect all adjacent rooms. -} -- TODO: fix identifier naming and split, after the code grows some more -- | Cave generation by an algorithm inspired by the original Rogue, buildCave :: Kind.COps -- ^ content definitions -> Int -- ^ depth of the level to generate -> Int -- ^ maximum depth of the dungeon -> Kind.Id CaveKind -- ^ cave kind to use for generation -> Rnd Cave buildCave cops@Kind.COps{ cotile=cotile@Kind.Ops{ opick , ouniqGroup } , cocave=Kind.Ops{okind} , coplace=Kind.Ops{okind=pokind} } ln depth ci = do let kc@CaveKind{..} = okind ci lgrid@(gx, gy) <- castDiceXY cgrid -- Make sure that in caves not filled with rock, there is a passage -- across the cave, even if a single room blocks most of the cave. let fullArea = fromMaybe (assert `failure` kc) $ toArea (0, 0, cxsize - 1, cysize - 1) subFullArea = fromMaybe (assert `failure` kc) $ toArea (1, 1, cxsize - 2, cysize - 2) area | gx == 1 || gy == 1 = subFullArea | otherwise = fullArea gs = grid lgrid area (addedConnects, voidPlaces) <- do if gx * gy > 1 then do let fractionOfPlaces r = round $ r * fromIntegral (gx * gy) cauxNum = fractionOfPlaces cauxConnects addedC <- replicateM cauxNum (randomConnection lgrid) let gridArea = fromMaybe (assert `failure` lgrid) $ toArea (0, 0, gx - 1, gy - 1) voidNum = fractionOfPlaces cmaxVoid voidPl <- replicateM voidNum $ xyInArea gridArea -- repetitions are OK return (addedC, voidPl) else return ([], []) minPlaceSize <- castDiceXY cminPlaceSize maxPlaceSize <- castDiceXY cmaxPlaceSize places0 <- mapM (\ (i, r) -> do -- Reserved for corridors and the global fence. let innerArea = fromMaybe (assert `failure` (i, r)) $ shrink r r' <- if i `elem` voidPlaces then fmap Left $ mkVoidRoom innerArea else fmap Right $ mkRoom minPlaceSize maxPlaceSize innerArea return (i, r')) gs let hardRockId = ouniqGroup "outer fence" fence = buildFence hardRockId subFullArea dnight <- chanceDeep ln depth cnightChance darkCorTile <- fmap (fromMaybe $ assert `failure` cdarkCorTile) $ opick cdarkCorTile (const True) litCorTile <- fmap (fromMaybe $ assert `failure` clitCorTile) $ opick clitCorTile (const True) let pickedCorTile = if dnight then darkCorTile else litCorTile addPl (m, pls, qls) (i, Left r) = return (m, pls, (i, Left r) : qls) addPl (m, pls, qls) (i, Right r) = do (tmap, place) <- buildPlace cops kc darkCorTile litCorTile ln depth r return (EM.union tmap m, place : pls, (i, Right (r, place)) : qls) (lplaces, dplaces, qplaces0) <- foldM addPl (fence, [], []) places0 connects <- connectGrid lgrid let allConnects = L.union connects addedConnects -- no duplicates qplaces = EM.fromList qplaces0 cs <- mapM (\(p0, p1) -> do let shrinkPlace (r, Place{qkind}) = case shrink r of Nothing -> (r, r) -- FNone place of x and/or y size 1 Just sr -> case pfence $ pokind qkind of FFloor -> -- Avoid corridors touching the floor fence, -- but let them merge with the fence. case shrink sr of Nothing -> (sr, r) Just mergeArea -> (mergeArea, r) _ -> (sr, sr) shrinkForFence = either (id &&& id) shrinkPlace rr0 = shrinkForFence $ qplaces EM.! p0 rr1 = shrinkForFence $ qplaces EM.! p1 connectPlaces rr0 rr1) allConnects let lcorridors = EM.unions (L.map (digCorridors pickedCorTile) cs) lm = EM.unionWith (mergeCorridor cotile) lcorridors lplaces -- Convert wall openings into doors, possibly. let f l (p, t) = if not $ Tile.hasFeature cotile F.Suspect t then return l -- no opening to start with else do -- Openings have a certain chance to be doors -- and doors have a certain chance to be open. rd <- chance cdoorChance if not rd then return $ EM.insert p pickedCorTile l -- opening kept else do ro <- chance copenChance doorClosedId <- Tile.revealAs cotile t if not ro then return $ EM.insert p doorClosedId l else do doorOpenId <- Tile.openTo cotile doorClosedId return $ EM.insert p doorOpenId l dmap <- foldM f lm (EM.assocs lm) let cave = Cave { dkind = ci , ditem = EM.empty , dmap , dplaces , dnight } return cave digCorridors :: Kind.Id TileKind -> Corridor -> TileMapXY digCorridors tile (p1:p2:ps) = EM.union corPos (digCorridors tile (p2:ps)) where corXY = fromTo p1 p2 corPos = EM.fromList $ L.zip corXY (repeat tile) digCorridors _ _ = EM.empty mergeCorridor :: Kind.Ops TileKind -> Kind.Id TileKind -> Kind.Id TileKind -> Kind.Id TileKind mergeCorridor cotile _ = Tile.hideAs cotile