module Game.LambdaHack.Server.DungeonGen.Cave
( TileMapXY, ItemFloorXY, Cave(..), buildCave
) where
import Control.Monad
import qualified Data.EnumMap.Strict as EM
import qualified Data.List as L
import Game.LambdaHack.Common.Area
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.Misc
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.TileKind
import Game.LambdaHack.Server.DungeonGen.AreaRnd
import Game.LambdaHack.Server.DungeonGen.Place hiding (TileMapXY)
import qualified Game.LambdaHack.Server.DungeonGen.Place as Place
type TileMapXY = Place.TileMapXY
type ItemFloorXY = EM.EnumMap PointXY (Item, Int)
data Cave = Cave
{ dkind :: !(Kind.Id CaveKind)
, dmap :: TileMapXY
, ditem :: ItemFloorXY
, dplaces :: [Place]
}
deriving Show
buildCave :: Kind.COps
-> Int
-> Int
-> Kind.Id CaveKind
-> Rnd Cave
buildCave cops@Kind.COps{ cotile=cotile@Kind.Ops{ opick
, ouniqGroup }
, cocave=Kind.Ops{okind} }
ln depth ci = do
let kc@CaveKind{..} = okind ci
lgrid@(gx, gy) <- rollDiceXY cgrid
lminplace <- rollDiceXY cminPlaceSize
let gs = grid lgrid (0, 0, cxsize 1, cysize 1)
mandatory1 <- replicateM (cnonVoidMin `div` 2) $
xyInArea (0, 0, gx `div` 3, gy 1)
mandatory2 <- replicateM (cnonVoidMin `divUp` 2) $
xyInArea (gx 1 (gx `div` 3), 0, gx 1, gy 1)
places0 <- mapM (\ (i, r) -> do
rv <- chance cvoidChance
r' <- if rv && i `notElem` (mandatory1 ++ mandatory2)
then mkVoidRoom r
else mkRoom lminplace r
return (i, r')) gs
connects <- connectGrid lgrid
addedConnects <-
if gx * gy > 1
then let caux = round $ cauxConnects * fromIntegral (gx * gy)
in replicateM caux (randomConnection lgrid)
else return []
let allConnects = L.union connects addedConnects
places = EM.fromList places0
cs <- mapM (\ (p0, p1) -> do
let r0 = places EM.! p0
r1 = places EM.! p1
connectPlaces r0 r1) allConnects
let hardRockId = ouniqGroup "hard rock"
fenceBounds = (1, 1, cxsize 2, cysize 2)
fence = buildFence hardRockId fenceBounds
pickedCorTile <- opick ccorridorTile (const True)
let addPl (m, pls) (_, (x0, _, x1, _)) | x0 == x1 = return (m, pls)
addPl (m, pls) (_, r) = do
(tmap, place) <- buildPlace cops kc pickedCorTile ln depth r
return (EM.union tmap m, place : pls)
(lplaces, dplaces) <- foldM addPl (fence, []) places0
let lcorridors = EM.unions (L.map (digCorridors pickedCorTile) cs)
let lm = EM.unionWith (mergeCorridor cotile) lcorridors lplaces
dmap <-
let f l (p, t) =
if not $ Tile.hasFeature cotile F.Suspect t
then return l
else do
rd <- chance cdoorChance
if not rd
then return $ EM.insert p pickedCorTile l
else do
doorClosedId <- Tile.changeTo cotile t
doorOpenId <- Tile.changeTo cotile doorClosedId
ro <- chance copenChance
if not ro
then return $ EM.insert p doorClosedId l
else return $ EM.insert p doorOpenId l
in foldM f lm (EM.assocs lm)
let cave = Cave
{ dkind = ci
, ditem = EM.empty
, dmap
, dplaces
}
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.hiddenAs cotile