    -- | Generation of caves (not yet inhabited dungeon levels) from cave kinds.
    module Game.LambdaHack.Server.DungeonGen.Cave
      ( Cave(..), buildCave
    #ifdef EXPOSE_INTERNAL
        -- * Internal operations
      , pickOpening
    #endif
      ) where

    import Prelude ()

    import Game.LambdaHack.Core.Prelude

    import qualified Data.EnumMap.Strict as EM
    import qualified Data.EnumSet as ES
    import           Data.Key (mapWithKeyM)
    import           Data.Word (Word32)

    import           Game.LambdaHack.Common.Area
    import           Game.LambdaHack.Common.Kind
    import           Game.LambdaHack.Common.Point
    import qualified Game.LambdaHack.Common.Tile as Tile
    import           Game.LambdaHack.Common.Vector
    import           Game.LambdaHack.Content.CaveKind
    import           Game.LambdaHack.Content.PlaceKind
    import           Game.LambdaHack.Content.TileKind (TileKind)
    import qualified Game.LambdaHack.Core.Dice as Dice
    import           Game.LambdaHack.Core.Random
    import           Game.LambdaHack.Definition.Defs
    import           Game.LambdaHack.Server.DungeonGen.AreaRnd
    import           Game.LambdaHack.Server.DungeonGen.Place

    -- | The type of caves (not yet inhabited dungeon levels).
    data Cave = Cave
      { Cave -> ContentId CaveKind
    dkind   :: ContentId CaveKind  -- ^ the kind of the cave
      , Cave -> Area
    darea   :: Area                -- ^ map area of the cave
      , Cave -> TileMapEM
    dmap    :: TileMapEM           -- ^ tile kinds in the cave
      , Cave -> EnumMap Point Place
    dstairs :: EM.EnumMap Point Place
                                       -- ^ stair places indexed by their center
      , Cave -> EnumMap Point PlaceEntry
    dentry  :: EM.EnumMap Point PlaceEntry
                                       -- ^ room entrances in the cave
      , Cave -> Bool
    dnight  :: Bool                -- ^ whether the cave is dark
      }
      deriving Y -> Cave -> ShowS
    [Cave] -> ShowS
    Cave -> String
    (Y -> Cave -> ShowS)
    -> (Cave -> String) -> ([Cave] -> ShowS) -> Show Cave
    forall a.
    (Y -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
    $cshowsPrec :: Y -> Cave -> ShowS
    showsPrec :: Y -> Cave -> ShowS
    $cshow :: Cave -> String
    show :: Cave -> String
    $cshowList :: [Cave] -> ShowS
    showList :: [Cave] -> ShowS
    Show

    {- |
    Generate a cave using an algorithm inspired by the original Rogue,
    as follows (in gross simplification):

    * 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 some of the 9 grid cells a 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, because not each cell holds a room.
    -}
    buildCave :: COps                -- ^ content definitions
              -> Dice.AbsDepth       -- ^ depth of the level to generate
              -> Dice.AbsDepth       -- ^ absolute depth
              -> Area                -- ^ map area of the cave
              -> Word32              -- ^ secret tile seed
              -> ContentId CaveKind  -- ^ cave kind to use for generation
              -> (X, Y)              -- ^ the dimensions of the grid of places
              -> EM.EnumMap Point SpecialArea  -- ^ pos of stairs, etc.
              -> [Point]             -- ^ boot positions to be treated as fixed
              -> Rnd Cave
    buildCave :: COps
    -> AbsDepth
    -> AbsDepth
    -> Area
    -> Word32
    -> ContentId CaveKind
    -> (Y, Y)
    -> EnumMap Point SpecialArea
    -> [Point]
    -> Rnd Cave
    buildCave cops :: COps
    cops@COps{ContentData CaveKind
    cocave :: ContentData CaveKind
    cocave :: COps -> ContentData CaveKind
    cocave, ContentData PlaceKind
    coplace :: ContentData PlaceKind
    coplace :: COps -> ContentData PlaceKind
    coplace, ContentData TileKind
    cotile :: ContentData TileKind
    cotile :: COps -> ContentData TileKind
    cotile, TileSpeedup
    coTileSpeedup :: TileSpeedup
    coTileSpeedup :: COps -> TileSpeedup
    coTileSpeedup}
              AbsDepth
    ldepth AbsDepth
    totalDepth Area
    darea Word32
    dsecret ContentId CaveKind
    dkind lgr :: (Y, Y)
    lgr@(Y
    gx, Y
    gy) EnumMap Point SpecialArea
    gs [Point]
    bootExtra = do
      let kc :: CaveKind
    kc@CaveKind{Bool
    Y
    [Y]
    Freqs ItemKind
    Freqs PlaceKind
    Freqs CaveKind
    Rational
    Text
    DiceXY
    Dice
    GroupName TileKind
    InitSleep
    cname :: Text
    cfreq :: Freqs CaveKind
    cXminSize :: Y
    cYminSize :: Y
    ccellSize :: DiceXY
    cminPlaceSize :: DiceXY
    cmaxPlaceSize :: DiceXY
    cdarkOdds :: Dice
    cnightOdds :: Dice
    cauxConnects :: Rational
    cmaxVoid :: Rational
    cdoorChance :: Rational
    copenChance :: Rational
    chidden :: Y
    cactorCoeff :: Y
    cactorFreq :: Freqs ItemKind
    citemNum :: Dice
    citemFreq :: Freqs ItemKind
    cplaceFreq :: Freqs PlaceKind
    cpassable :: Bool
    clabyrinth :: Bool
    cdefTile :: GroupName TileKind
    cdarkCorTile :: GroupName TileKind
    clitCorTile :: GroupName TileKind
    cwallTile :: GroupName TileKind
    ccornerTile :: GroupName TileKind
    cfenceTileN :: GroupName TileKind
    cfenceTileE :: GroupName TileKind
    cfenceTileS :: GroupName TileKind
    cfenceTileW :: GroupName TileKind
    cfenceApart :: Bool
    cminStairDist :: Y
    cmaxStairsNum :: Dice
    cescapeFreq :: Freqs PlaceKind
    cstairFreq :: Freqs PlaceKind
    cstairAllowed :: Freqs PlaceKind
    cskip :: [Y]
    cinitSleep :: InitSleep
    cdesc :: Text
    cdesc :: CaveKind -> Text
    cinitSleep :: CaveKind -> InitSleep
    cskip :: CaveKind -> [Y]
    cstairAllowed :: CaveKind -> Freqs PlaceKind
    cstairFreq :: CaveKind -> Freqs PlaceKind
    cescapeFreq :: CaveKind -> Freqs PlaceKind
    cmaxStairsNum :: CaveKind -> Dice
    cminStairDist :: CaveKind -> Y
    cfenceApart :: CaveKind -> Bool
    cfenceTileW :: CaveKind -> GroupName TileKind
    cfenceTileS :: CaveKind -> GroupName TileKind
    cfenceTileE :: CaveKind -> GroupName TileKind
    cfenceTileN :: CaveKind -> GroupName TileKind
    ccornerTile :: CaveKind -> GroupName TileKind
    cwallTile :: CaveKind -> GroupName TileKind
    clitCorTile :: CaveKind -> GroupName TileKind
    cdarkCorTile :: CaveKind -> GroupName TileKind
    cdefTile :: CaveKind -> GroupName TileKind
    clabyrinth :: CaveKind -> Bool
    cpassable :: CaveKind -> Bool
    cplaceFreq :: CaveKind -> Freqs PlaceKind
    citemFreq :: CaveKind -> Freqs ItemKind
    citemNum :: CaveKind -> Dice
    cactorFreq :: CaveKind -> Freqs ItemKind
    cactorCoeff :: CaveKind -> Y
    chidden :: CaveKind -> Y
    copenChance :: CaveKind -> Rational
    cdoorChance :: CaveKind -> Rational
    cmaxVoid :: CaveKind -> Rational
    cauxConnects :: CaveKind -> Rational
    cnightOdds :: CaveKind -> Dice
    cdarkOdds :: CaveKind -> Dice
    cmaxPlaceSize :: CaveKind -> DiceXY
    cminPlaceSize :: CaveKind -> DiceXY
    ccellSize :: CaveKind -> DiceXY
    cYminSize :: CaveKind -> Y
    cXminSize :: CaveKind -> Y
    cfreq :: CaveKind -> Freqs CaveKind
    cname :: CaveKind -> Text
    ..} = ContentData CaveKind -> ContentId CaveKind -> CaveKind
    forall a. ContentData a -> ContentId a -> a
    okind ContentData CaveKind
    cocave ContentId CaveKind
    dkind
      darkCorTile <- ContentId TileKind
    -> Maybe (ContentId TileKind) -> ContentId TileKind
    forall a. a -> Maybe a -> a
    fromMaybe (String -> ContentId TileKind
    forall a. (?callStack::CallStack) => String -> a
    error (String -> ContentId TileKind) -> String -> ContentId TileKind
    forall a b. (a -> b) -> a -> b
    $ String
    "" String -> GroupName TileKind -> String
    forall v. Show v => String -> v -> String
    `showFailure` GroupName TileKind
    cdarkCorTile)
                     (Maybe (ContentId TileKind) -> ContentId TileKind)
    -> StateT SMGen Identity (Maybe (ContentId TileKind))
    -> StateT SMGen Identity (ContentId TileKind)
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> ContentData TileKind
    -> GroupName TileKind
    -> (TileKind -> Bool)
    -> StateT SMGen Identity (Maybe (ContentId TileKind))
    forall a.
    Show a =>
    ContentData a
    -> GroupName a -> (a -> Bool) -> Rnd (Maybe (ContentId a))
    opick ContentData TileKind
    cotile GroupName TileKind
    cdarkCorTile (Bool -> TileKind -> Bool
    forall a b. a -> b -> a
    const Bool
    True)
      litCorTile <- fromMaybe (error $ "" `showFailure` clitCorTile)
                    <$> opick cotile clitCorTile (const True)
      dnight <- oddsDice ldepth totalDepth cnightOdds
      let createPlaces = do
            minPlaceSize <- AbsDepth -> AbsDepth -> DiceXY -> Rnd (Y, Y)
    castDiceXY AbsDepth
    ldepth AbsDepth
    totalDepth DiceXY
    cminPlaceSize
            maxPlaceSize <- castDiceXY ldepth totalDepth cmaxPlaceSize
            let mergeFixed :: EM.EnumMap Point SpecialArea
                           -> (Point, SpecialArea)
                           -> EM.EnumMap Point SpecialArea
                mergeFixed !EnumMap Point SpecialArea
    gs0 (!Point
    i, !SpecialArea
    special) =
                  let mergeSpecial :: Area -> Point -> (Area -> SpecialArea) -> EnumMap Point SpecialArea
    mergeSpecial Area
    ar Point
    p2 Area -> SpecialArea
    f =
                        case Point -> EnumMap Point SpecialArea -> Maybe SpecialArea
    forall k a. Enum k => k -> EnumMap k a -> Maybe a
    EM.lookup Point
    p2 EnumMap Point SpecialArea
    gs0 of
                          Just (SpecialArea Area
    ar2) ->
                            let aSum :: Area
    aSum = Area -> Area -> Area
    sumAreas Area
    ar Area
    ar2
                                sp :: SpecialArea
    sp = SpecialArea -> Point -> SpecialArea
    SpecialMerged (Area -> SpecialArea
    f Area
    aSum) Point
    p2
                            in Point
    -> SpecialArea
    -> EnumMap Point SpecialArea
    -> EnumMap Point SpecialArea
    forall k a. Enum k => k -> a -> EnumMap k a -> EnumMap k a
    EM.insert Point
    i SpecialArea
    sp (EnumMap Point SpecialArea -> EnumMap Point SpecialArea)
    -> EnumMap Point SpecialArea -> EnumMap Point SpecialArea
    forall a b. (a -> b) -> a -> b
    $ Point -> EnumMap Point SpecialArea -> EnumMap Point SpecialArea
    forall k a. Enum k => k -> EnumMap k a -> EnumMap k a
    EM.delete Point
    p2 EnumMap Point SpecialArea
    gs0
                          Maybe SpecialArea
    _ -> EnumMap Point SpecialArea
    gs0
                      mergable :: X -> Y -> Maybe HV
                      mergable :: Y -> Y -> Maybe HV
    mergable Y
    x Y
    y = case Point -> EnumMap Point SpecialArea -> Maybe SpecialArea
    forall k a. Enum k => k -> EnumMap k a -> Maybe a
    EM.lookup (Y -> Y -> Point
    Point Y
    x Y
    y) EnumMap Point SpecialArea
    gs0 of
                        Just (SpecialArea Area
    ar) ->
                          let (Point
    _, Y
    xspan, Y
    yspan) = Area -> (Point, Y, Y)
    spanArea Area
    ar
                              isFixed :: Point -> Bool
    isFixed Point
    p =
                                Point
    p Point -> [Point] -> Bool
    forall a. Eq a => a -> [a] -> Bool
    forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
    `elem` [Point]
    bootExtra
                                Bool -> Bool -> Bool
    || case EnumMap Point SpecialArea
    gs EnumMap Point SpecialArea -> Point -> SpecialArea
    forall k a. Enum k => EnumMap k a -> k -> a
    EM.! Point
    p of
                                     SpecialFixed{} -> Bool
    True
                                     SpecialArea
    _ -> Bool
    False
                          in if -- Limit (the aggresive) merging of normal places
                                -- and leave extra place for merging stairs.
                                | (Point -> Bool) -> [Point] -> Bool
    forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
    any Point -> Bool
    isFixed
                                  ([Point] -> Bool) -> [Point] -> Bool
    forall a b. (a -> b) -> a -> b
    $ Y -> Y -> Point -> [Point]
    vicinityCardinal Y
    gx Y
    gy (Y -> Y -> Point
    Point Y
    x Y
    y) -> Maybe HV
    forall a. Maybe a
    Nothing
                                -- Bias: prefer extending vertically.
                                -- Not @-2@, but @-4@, to merge aggressively.
                                | Y
    yspan Y -> Y -> Y
    forall a. Num a => a -> a -> a
    - Y
    4 Y -> Y -> Bool
    forall a. Ord a => a -> a -> Bool
    < (Y, Y) -> Y
    forall a b. (a, b) -> b
    snd (Y, Y)
    minPlaceSize -> HV -> Maybe HV
    forall a. a -> Maybe a
    Just HV
    Vert
                                | Y
    xspan Y -> Y -> Y
    forall a. Num a => a -> a -> a
    - Y
    4 Y -> Y -> Bool
    forall a. Ord a => a -> a -> Bool
    < (Y, Y) -> Y
    forall a b. (a, b) -> a
    fst (Y, Y)
    minPlaceSize -> HV -> Maybe HV
    forall a. a -> Maybe a
    Just HV
    Horiz
                                | Bool
    otherwise -> Maybe HV
    forall a. Maybe a
    Nothing
                        Maybe SpecialArea
    _ -> Maybe HV
    forall a. Maybe a
    Nothing
                  in case SpecialArea
    special of
                    SpecialArea Area
    ar -> case Y -> Y -> Maybe HV
    mergable (Point -> Y
    px Point
    i) (Point -> Y
    py Point
    i) of
                      Maybe HV
    Nothing -> EnumMap Point SpecialArea
    gs0
                      Just HV
    hv -> case HV
    hv of
                        -- Bias; vertical minimal sizes are smaller.
                        --
                        -- The commented out cases never happen, because @mergable@
                        -- is symmetric and we proceed top-left to bottom-right.
                        --
                        -- Vert | py i - 1 >= 0
                        --        && mergable (px i) (py i - 1) == Just Vert ->
                        --        mergeSpecial ar i{py = py i - 1} SpecialArea
                        HV
    Vert | Point -> Y
    py Point
    i Y -> Y -> Y
    forall a. Num a => a -> a -> a
    + Y
    1 Y -> Y -> Bool
    forall a. Ord a => a -> a -> Bool
    < Y
    gy
                               Bool -> Bool -> Bool
    && Y -> Y -> Maybe HV
    mergable (Point -> Y
    px Point
    i) (Point -> Y
    py Point
    i Y -> Y -> Y
    forall a. Num a => a -> a -> a
    + Y
    1) Maybe HV -> Maybe HV -> Bool
    forall a. Eq a => a -> a -> Bool
    == HV -> Maybe HV
    forall a. a -> Maybe a
    Just HV
    Vert ->
                               Area -> Point -> (Area -> SpecialArea) -> EnumMap Point SpecialArea
    mergeSpecial Area
    ar Point
    i{py = py i + 1} Area -> SpecialArea
    SpecialArea
                        -- Horiz | px i - 1 >= 0
                        --         && mergable (px i - 1) (py i) == Just Horiz ->
                        --         mergeSpecial ar i{px = px i - 1} SpecialArea
                        HV
    Horiz | Point -> Y
    px Point
    i Y -> Y -> Y
    forall a. Num a => a -> a -> a
    + Y
    1 Y -> Y -> Bool
    forall a. Ord a => a -> a -> Bool
    < Y
    gx
                                Bool -> Bool -> Bool
    && Y -> Y -> Maybe HV
    mergable (Point -> Y
    px Point
    i Y -> Y -> Y
    forall a. Num a => a -> a -> a
    + Y
    1) (Point -> Y
    py Point
    i) Maybe HV -> Maybe HV -> Bool
    forall a. Eq a => a -> a -> Bool
    == HV -> Maybe HV
    forall a. a -> Maybe a
    Just HV
    Horiz ->
                                Area -> Point -> (Area -> SpecialArea) -> EnumMap Point SpecialArea
    mergeSpecial Area
    ar Point
    i{px = px i + 1} Area -> SpecialArea
    SpecialArea
                        HV
    _ -> EnumMap Point SpecialArea
    gs0
                    SpecialFixed Point
    p Freqs PlaceKind
    placeGroup Area
    ar ->
                      -- If single merge is sufficient to extend the fixed place
                      -- to full size, and the merge is possible, we perform it.
                      -- An empty inner list signifies some merge is needed,
                      -- but not possible, and then we abort and don't waste space.
                      let (Y
    x0, Y
    y0, Y
    x1, Y
    y1) = Area -> (Y, Y, Y, Y)
    fromArea Area
    ar
                          dy :: Y
    dy = Y
    3  -- arbitrary, matches common content
                          dx :: Y
    dx = Y
    5  -- arbitrary, matches common content
                          vics :: [[Point]]
                          vics :: [[Point]]
    vics = [ [Point
    i {py = py i - 1} | Point -> Y
    py Point
    i Y -> Y -> Y
    forall a. Num a => a -> a -> a
    - Y
    1 Y -> Y -> Bool
    forall a. Ord a => a -> a -> Bool
    >= Y
    0]  -- possible
                                 | Point -> Y
    py Point
    p Y -> Y -> Y
    forall a. Num a => a -> a -> a
    - Y
    y0 Y -> Y -> Bool
    forall a. Ord a => a -> a -> Bool
    < Y
    dy ]  -- needed
                                 [[Point]] -> [[Point]] -> [[Point]]
    forall a. [a] -> [a] -> [a]
    ++ [ [Point
    i {py = py i + 1} | Point -> Y
    py Point
    i Y -> Y -> Y
    forall a. Num a => a -> a -> a
    + Y
    1 Y -> Y -> Bool
    forall a. Ord a => a -> a -> Bool
    < Y
    gy]
                                    | Y
    y1 Y -> Y -> Y
    forall a. Num a => a -> a -> a
    - Point -> Y
    py Point
    p Y -> Y -> Bool
    forall a. Ord a => a -> a -> Bool
    < Y
    dy ]
                                 [[Point]] -> [[Point]] -> [[Point]]
    forall a. [a] -> [a] -> [a]
    ++ [ [Point
    i {px = px i - 1} | Point -> Y
    px Point
    i Y -> Y -> Y
    forall a. Num a => a -> a -> a
    - Y
    1 Y -> Y -> Bool
    forall a. Ord a => a -> a -> Bool
    >= Y
    0]
                                    | Point -> Y
    px Point
    p Y -> Y -> Y
    forall a. Num a => a -> a -> a
    - Y
    x0 Y -> Y -> Bool
    forall a. Ord a => a -> a -> Bool
    < Y
    dx ]
                                 [[Point]] -> [[Point]] -> [[Point]]
    forall a. [a] -> [a] -> [a]
    ++ [ [Point
    i {px = px i + 1} | Point -> Y
    px Point
    i Y -> Y -> Y
    forall a. Num a => a -> a -> a
    + Y
    1 Y -> Y -> Bool
    forall a. Ord a => a -> a -> Bool
    < Y
    gx]
                                    | Y
    x1 Y -> Y -> Y
    forall a. Num a => a -> a -> a
    - Point -> Y
    px Point
    p Y -> Y -> Bool
    forall a. Ord a => a -> a -> Bool
    < Y
    dx ]
                      in case [[Point]]
    vics of
                        [[Point
    p2]] -> Area -> Point -> (Area -> SpecialArea) -> EnumMap Point SpecialArea
    mergeSpecial Area
    ar Point
    p2 (Point -> Freqs PlaceKind -> Area -> SpecialArea
    SpecialFixed Point
    p Freqs PlaceKind
    placeGroup)
                        [[Point]]
    _ -> EnumMap Point SpecialArea
    gs0
                    SpecialMerged{} -> String -> EnumMap Point SpecialArea
    forall a. (?callStack::CallStack) => String -> a
    error (String -> EnumMap Point SpecialArea)
    -> String -> EnumMap Point SpecialArea
    forall a b. (a -> b) -> a -> b
    $ String
    "" String
    -> (EnumMap Point SpecialArea, EnumMap Point SpecialArea, Point)
    -> String
    forall v. Show v => String -> v -> String
    `showFailure` (EnumMap Point SpecialArea
    gs, EnumMap Point SpecialArea
    gs0, Point
    i)
                gs2 = (EnumMap Point SpecialArea
     -> (Point, SpecialArea) -> EnumMap Point SpecialArea)
    -> EnumMap Point SpecialArea
    -> [(Point, SpecialArea)]
    -> EnumMap Point SpecialArea
    forall b a. (b -> a -> b) -> b -> [a] -> b
    forall (t :: * -> *) b a.
    Foldable t =>
    (b -> a -> b) -> b -> t a -> b
    foldl' EnumMap Point SpecialArea
    -> (Point, SpecialArea) -> EnumMap Point SpecialArea
    mergeFixed EnumMap Point SpecialArea
    gs ([(Point, SpecialArea)] -> EnumMap Point SpecialArea)
    -> [(Point, SpecialArea)] -> EnumMap Point SpecialArea
    forall a b. (a -> b) -> a -> b
    $ EnumMap Point SpecialArea -> [(Point, SpecialArea)]
    forall k a. Enum k => EnumMap k a -> [(k, a)]
    EM.assocs EnumMap Point SpecialArea
    gs
            voidPlaces <- do
              let gridArea = Area -> Maybe Area -> Area
    forall a. a -> Maybe a -> a
    fromMaybe (String -> Area
    forall a. (?callStack::CallStack) => String -> a
    error (String -> Area) -> String -> Area
    forall a b. (a -> b) -> a -> b
    $ String
    "" String -> (Y, Y) -> String
    forall v. Show v => String -> v -> String
    `showFailure` (Y, Y)
    lgr)
                             (Maybe Area -> Area) -> Maybe Area -> Area
    forall a b. (a -> b) -> a -> b
    $ (Y, Y, Y, Y) -> Maybe Area
    toArea (Y
    0, Y
    0, Y
    gx Y -> Y -> Y
    forall a. Num a => a -> a -> a
    - Y
    1, Y
    gy Y -> Y -> Y
    forall a. Num a => a -> a -> a
    - Y
    1)
                  voidNum = Rational -> Y
    forall b. Integral b => Rational -> b
    forall a b. (RealFrac a, Integral b) => a -> b
    round (Rational -> Y) -> Rational -> Y
    forall a b. (a -> b) -> a -> b
    $
                    Rational
    cmaxVoid Rational -> Rational -> Rational
    forall a. Num a => a -> a -> a
    * (Y -> Rational
    forall a b. (Integral a, Num b) => a -> b
    fromIntegralWrap :: Int -> Rational) (EnumMap Point SpecialArea -> Y
    forall k a. EnumMap k a -> Y
    EM.size EnumMap Point SpecialArea
    gs2)
                  isOrdinaryArea Point
    p = case Point
    p Point -> EnumMap Point SpecialArea -> Maybe SpecialArea
    forall k a. Enum k => k -> EnumMap k a -> Maybe a
    `EM.lookup` EnumMap Point SpecialArea
    gs2 of
                    Just SpecialArea{} -> Bool
    True
                    Maybe SpecialArea
    _ -> Bool
    False
              reps <- replicateM voidNum (pointInArea gridArea)
                        -- repetitions are OK; variance is low anyway
              return $! ES.fromList $ filter isOrdinaryArea reps
            let decidePlace :: Bool
                            -> ( TileMapEM
                               , EM.EnumMap Point (Place, Area)
                               , EM.EnumMap Point Place )
                            -> (Point, SpecialArea)
                            -> Rnd ( TileMapEM
                                   , EM.EnumMap Point (Place, Area)
                                   , EM.EnumMap Point Place )
                decidePlace Bool
    noVoid (!TileMapEM
    m, !EnumMap Point (Place, Area)
    qls, !EnumMap Point Place
    qstairs) (!Point
    i, !SpecialArea
    special) =
                  case SpecialArea
    special of
                    SpecialArea Area
    ar -> do
                      -- Reserved for corridors and the global fence.
                      let innerArea :: Area
    innerArea = Area -> Maybe Area -> Area
    forall a. a -> Maybe a -> a
    fromMaybe (String -> Area
    forall a. (?callStack::CallStack) => String -> a
    error (String -> Area) -> String -> Area
    forall a b. (a -> b) -> a -> b
    $ String
    "" String -> (Point, Area) -> String
    forall v. Show v => String -> v -> String
    `showFailure` (Point
    i, Area
    ar))
                                      (Maybe Area -> Area) -> Maybe Area -> Area
    forall a b. (a -> b) -> a -> b
    $ Area -> Maybe Area
    shrink Area
    ar
                          !_A0 :: Maybe Area
    _A0 = Area -> Maybe Area
    shrink Area
    innerArea
                          !_A1 :: ()
    _A1 = Bool -> () -> ()
    forall a. (?callStack::CallStack) => Bool -> a -> a
    assert (Maybe Area -> Bool
    forall a. Maybe a -> Bool
    isJust Maybe Area
    _A0 Bool -> (Area, EnumMap Point SpecialArea, CaveKind) -> Bool
    forall v. Show v => Bool -> v -> Bool
    `blame` (Area
    innerArea, EnumMap Point SpecialArea
    gs, CaveKind
    kc)) ()
                      if Bool -> Bool
    not Bool
    noVoid Bool -> Bool -> Bool
    && Point
    i Point -> EnumSet Point -> Bool
    forall k. Enum k => k -> EnumSet k -> Bool
    `ES.member` EnumSet Point
    voidPlaces
                      then do
                        qarea <- Area -> Rnd Area
    mkVoidRoom Area
    innerArea
                        let qkind = ContentId PlaceKind
    deadEndId
                            qmap = EnumMap k a
    forall k a. EnumMap k a
    EM.empty
                            qfence = EnumMap k a
    forall k a. EnumMap k a
    EM.empty
                        return (m, EM.insert i (Place{..}, ar) qls, qstairs)
                      else do
                        r <- (Y, Y) -> (Y, Y) -> Area -> Rnd Area
    mkRoom (Y, Y)
    minPlaceSize (Y, Y)
    maxPlaceSize Area
    innerArea
                        place <- buildPlace cops kc dnight darkCorTile litCorTile
                                            ldepth totalDepth dsecret
                                            r (Just innerArea) []
                        return ( EM.unions [qmap place, qfence place, m]
                               , EM.insert i (place, ar) qls
                               , qstairs )
                    SpecialFixed Point
    p Freqs PlaceKind
    placeFreq Area
    ar -> do
                      -- Reserved for corridors and the global fence.
                      let innerArea :: Area
    innerArea = Area -> Maybe Area -> Area
    forall a. a -> Maybe a -> a
    fromMaybe (String -> Area
    forall a. (?callStack::CallStack) => String -> a
    error (String -> Area) -> String -> Area
    forall a b. (a -> b) -> a -> b
    $ String
    "" String -> (Point, Area) -> String
    forall v. Show v => String -> v -> String
    `showFailure` (Point
    i, Area
    ar))
                                      (Maybe Area -> Area) -> Maybe Area -> Area
    forall a b. (a -> b) -> a -> b
    $ Area -> Maybe Area
    shrink Area
    ar
                          !_A0 :: Maybe Area
    _A0 = Area -> Maybe Area
    shrink Area
    innerArea
                          !_A1 :: ()
    _A1 = Bool -> () -> ()
    forall a. (?callStack::CallStack) => Bool -> a -> a
    assert (Maybe Area -> Bool
    forall a. Maybe a -> Bool
    isJust Maybe Area
    _A0 Bool -> (Area, EnumMap Point SpecialArea, CaveKind) -> Bool
    forall v. Show v => Bool -> v -> Bool
    `blame` (Area
    innerArea, EnumMap Point SpecialArea
    gs2, CaveKind
    kc)) ()
                          !_A2 :: ()
    _A2 = Bool -> () -> ()
    forall a. (?callStack::CallStack) => Bool -> a -> a
    assert (Area -> Point -> Bool
    inside (Maybe Area -> Area
    forall a. (?callStack::CallStack) => Maybe a -> a
    fromJust Maybe Area
    _A0) Point
    p
                                         Bool -> (Point, Area, EnumMap Point SpecialArea) -> Bool
    forall v. Show v => Bool -> v -> Bool
    `blame` (Point
    p, Area
    innerArea, EnumMap Point SpecialArea
    gs)) ()
                          r :: Area
    r = (Y, Y) -> Area -> Point -> Area
    mkFixed (Y, Y)
    maxPlaceSize Area
    innerArea Point
    p
                          !_A3 :: ()
    _A3 = Bool -> () -> ()
    forall a. (?callStack::CallStack) => Bool -> a -> a
    assert (Maybe Area -> Bool
    forall a. Maybe a -> Bool
    isJust (Area -> Maybe Area
    shrink Area
    r)
                                         Bool
    -> (Area, Area, Point, Area, EnumMap Point SpecialArea,
        EnumMap Point SpecialArea, EnumMap Point (Place, Area), CaveKind)
    -> Bool
    forall v. Show v => Bool -> v -> Bool
    `blame` ( Area
    r, Area
    ar, Point
    p, Area
    innerArea, EnumMap Point SpecialArea
    gs
                                                 , EnumMap Point SpecialArea
    gs2, EnumMap Point (Place, Area)
    qls, CaveKind
    kc )) ()
                      place <- COps
    -> CaveKind
    -> Bool
    -> ContentId TileKind
    -> ContentId TileKind
    -> AbsDepth
    -> AbsDepth
    -> Word32
    -> Area
    -> Maybe Area
    -> Freqs PlaceKind
    -> Rnd Place
    buildPlace COps
    cops CaveKind
    kc Bool
    dnight ContentId TileKind
    darkCorTile ContentId TileKind
    litCorTile
                                 AbsDepth
    ldepth AbsDepth
    totalDepth Word32
    dsecret Area
    r Maybe Area
    forall a. Maybe a
    Nothing Freqs PlaceKind
    placeFreq
                      return ( EM.unions [qmap place, qfence place, m]
                             , EM.insert i (place, ar) qls
                             , EM.insert p place qstairs )
                    SpecialMerged SpecialArea
    sp Point
    p2 -> do
                      (lplaces, dplaces, dstairs) <-
                        Bool
    -> (TileMapEM, EnumMap Point (Place, Area), EnumMap Point Place)
    -> (Point, SpecialArea)
    -> Rnd
         (TileMapEM, EnumMap Point (Place, Area), EnumMap Point Place)
    decidePlace Bool
    True (TileMapEM
    m, EnumMap Point (Place, Area)
    qls, EnumMap Point Place
    qstairs) (Point
    i, SpecialArea
    sp)
                      return ( lplaces
                             , EM.insert p2 (dplaces EM.! i) dplaces
                             , dstairs )
            places <- foldlM' (decidePlace False) (EM.empty, EM.empty, EM.empty)
                      $ EM.assocs gs2
            return (voidPlaces, lgr, places)
      (voidPlaces, lgrid, (lplaces, dplaces, dstairs)) <- createPlaces
      let lcorridorsFun :: Rnd ( EM.EnumMap Point ( ContentId TileKind
                                                  , ContentId PlaceKind )
                               , TileMapEM )
          lcorridorsFun = do
            connects <- EnumSet Point -> (Y, Y) -> Rnd [(Point, Point)]
    connectGrid EnumSet Point
    voidPlaces (Y, Y)
    lgrid
            addedConnects <- do
              let cauxNum =
                    Rational -> Y
    forall b. Integral b => Rational -> b
    forall a b. (RealFrac a, Integral b) => a -> b
    round (Rational -> Y) -> Rational -> Y
    forall a b. (a -> b) -> a -> b
    $ Rational
    cauxConnects Rational -> Rational -> Rational
    forall a. Num a => a -> a -> a
    * (Y -> Rational
    forall a b. (Integral a, Num b) => a -> b
    fromIntegralWrap :: Int -> Rational)
                                             ((Y -> Y -> Y) -> (Y, Y) -> Y
    forall a b c. (a -> b -> c) -> (a, b) -> c
    uncurry Y -> Y -> Y
    forall a. Num a => a -> a -> a
    (*) (Y, Y)
    lgrid)
              cns <- map head . group . sort
                     <$> replicateM cauxNum (randomConnection lgrid)
              -- This allows connections through a single void room,
              -- if a non-void room on both ends.
              let notDeadEnd (Point
    p, Point
    q) =
                    if | Point
    p Point -> EnumSet Point -> Bool
    forall k. Enum k => k -> EnumSet k -> Bool
    `ES.member` EnumSet Point
    voidPlaces ->
                         Point
    q Point -> EnumSet Point -> Bool
    forall k. Enum k => k -> EnumSet k -> Bool
    `ES.notMember` EnumSet Point
    voidPlaces Bool -> Bool -> Bool
    && Point -> Bool
    sndInCns Point
    p
                       | Point
    q Point -> EnumSet Point -> Bool
    forall k. Enum k => k -> EnumSet k -> Bool
    `ES.member` EnumSet Point
    voidPlaces -> Point -> Bool
    fstInCns Point
    q
                       | Bool
    otherwise -> Bool
    True
                  sndInCns Point
    p = ((Point, Point) -> Bool) -> [(Point, Point)] -> Bool
    forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
    any (\(Point
    p0, Point
    q0) ->
                    Point
    q0 Point -> Point -> Bool
    forall a. Eq a => a -> a -> Bool
    == Point
    p Bool -> Bool -> Bool
    && Point
    p0 Point -> EnumSet Point -> Bool
    forall k. Enum k => k -> EnumSet k -> Bool
    `ES.notMember` EnumSet Point
    voidPlaces) [(Point, Point)]
    cns
                  fstInCns Point
    q = ((Point, Point) -> Bool) -> [(Point, Point)] -> Bool
    forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
    any (\(Point
    p0, Point
    q0) ->
                    Point
    p0 Point -> Point -> Bool
    forall a. Eq a => a -> a -> Bool
    == Point
    q Bool -> Bool -> Bool
    && Point
    q0 Point -> EnumSet Point -> Bool
    forall k. Enum k => k -> EnumSet k -> Bool
    `ES.notMember` EnumSet Point
    voidPlaces) [(Point, Point)]
    cns
              return $! filter notDeadEnd cns
            let allConnects = [(Point, Point)]
    connects [(Point, Point)] -> [(Point, Point)] -> [(Point, Point)]
    forall a. Eq a => [a] -> [a] -> [a]
    `union` [(Point, Point)]
    addedConnects
                connectPos :: (Point, Point)
                           -> Rnd (Maybe ( ContentId PlaceKind
                                         , Corridor
                                         , ContentId PlaceKind ))
                connectPos (Point
    p0, Point
    p1) = do
                  let (Place
    place0, Area
    area0) = EnumMap Point (Place, Area)
    dplaces EnumMap Point (Place, Area) -> Point -> (Place, Area)
    forall k a. Enum k => EnumMap k a -> k -> a
    EM.! Point
    p0
                      (Place
    place1, Area
    area1) = EnumMap Point (Place, Area)
    dplaces EnumMap Point (Place, Area) -> Point -> (Place, Area)
    forall k a. Enum k => EnumMap k a -> k -> a
    EM.! Point
    p1
                      savePlaces :: Corridor -> (ContentId PlaceKind, Corridor, ContentId PlaceKind)
    savePlaces Corridor
    cor = (Place -> ContentId PlaceKind
    qkind Place
    place0, Corridor
    cor, Place -> ContentId PlaceKind
    qkind Place
    place1)
                  connected <- (Area, Fence, Area) -> (Area, Fence, Area) -> Rnd (Maybe Corridor)
    connectPlaces
                    (Place -> Area
    qarea Place
    place0, PlaceKind -> Fence
    pfence (PlaceKind -> Fence) -> PlaceKind -> Fence
    forall a b. (a -> b) -> a -> b
    $ ContentData PlaceKind -> ContentId PlaceKind -> PlaceKind
    forall a. ContentData a -> ContentId a -> a
    okind ContentData PlaceKind
    coplace (Place -> ContentId PlaceKind
    qkind Place
    place0), Area
    area0)
                    (Place -> Area
    qarea Place
    place1, PlaceKind -> Fence
    pfence (PlaceKind -> Fence) -> PlaceKind -> Fence
    forall a b. (a -> b) -> a -> b
    $ ContentData PlaceKind -> ContentId PlaceKind -> PlaceKind
    forall a. ContentData a -> ContentId a -> a
    okind ContentData PlaceKind
    coplace (Place -> ContentId PlaceKind
    qkind Place
    place1), Area
    area1)
                  return $! savePlaces <$> connected
            cs <- catMaybes <$> mapM connectPos allConnects
            let pickedCorTile = if Bool
    dnight then ContentId TileKind
    darkCorTile else ContentId TileKind
    litCorTile
                digCorridorSection :: a -> Point -> Point -> EM.EnumMap Point a
                digCorridorSection a
    a Point
    p1 Point
    p2 =
                  [(Point, a)] -> EnumMap Point a
    forall k a. Enum k => [(k, a)] -> EnumMap k a
    EM.fromList ([(Point, a)] -> EnumMap Point a)
    -> [(Point, a)] -> EnumMap Point a
    forall a b. (a -> b) -> a -> b
    $ [Point] -> [a] -> [(Point, a)]
    forall a b. [a] -> [b] -> [(a, b)]
    zip (Point -> Point -> [Point]
    fromTo Point
    p1 Point
    p2) (a -> [a]
    forall a. a -> [a]
    repeat a
    a)
                digCorridor (ContentId PlaceKind
    sqkind, (Point
    p1, Point
    p2, Point
    p3, Point
    p4), ContentId PlaceKind
    tqkind) =
                  ( EnumMap Point (ContentId TileKind, ContentId PlaceKind)
    -> EnumMap Point (ContentId TileKind, ContentId PlaceKind)
    -> EnumMap Point (ContentId TileKind, ContentId PlaceKind)
    forall k a. EnumMap k a -> EnumMap k a -> EnumMap k a
    EM.union ((ContentId TileKind, ContentId PlaceKind)
    -> Point
    -> Point
    -> EnumMap Point (ContentId TileKind, ContentId PlaceKind)
    forall a. a -> Point -> Point -> EnumMap Point a
    digCorridorSection (ContentId TileKind
    pickedCorTile, ContentId PlaceKind
    sqkind) Point
    p1 Point
    p2)
                             ((ContentId TileKind, ContentId PlaceKind)
    -> Point
    -> Point
    -> EnumMap Point (ContentId TileKind, ContentId PlaceKind)
    forall a. a -> Point -> Point -> EnumMap Point a
    digCorridorSection (ContentId TileKind
    pickedCorTile, ContentId PlaceKind
    tqkind) Point
    p3 Point
    p4)
                  , ContentId TileKind -> Point -> Point -> TileMapEM
    forall a. a -> Point -> Point -> EnumMap Point a
    digCorridorSection ContentId TileKind
    pickedCorTile Point
    p2 Point
    p3 )
                (lplOuter, lInner) = unzip $ map digCorridor cs
            return (EM.unions lplOuter, EM.unions lInner)
      (lplcorOuter, lcorInner) <- lcorridorsFun
      -- The hacks below are instead of unionWithKeyM, which is costly.
      let mergeCor Point
    _ ContentId TileKind
    pl (ContentId TileKind
    cor, ContentId PlaceKind
    pk) = if TileSpeedup -> ContentId TileKind -> Bool
    Tile.isWalkable TileSpeedup
    coTileSpeedup ContentId TileKind
    pl
                                    then Maybe (ContentId TileKind, ContentId TileKind, ContentId PlaceKind)
    forall a. Maybe a
    Nothing  -- tile already open
                                    else (ContentId TileKind, ContentId TileKind, ContentId PlaceKind)
    -> Maybe
         (ContentId TileKind, ContentId TileKind, ContentId PlaceKind)
    forall a. a -> Maybe a
    Just (ContentId TileKind
    pl, ContentId TileKind
    cor, ContentId PlaceKind
    pk)
          {-# INLINE intersectionWithKeyMaybe #-}
          intersectionWithKeyMaybe k -> a -> b -> Maybe c
    combine =
            (k -> a -> b -> Maybe c)
    -> (EnumMap k a -> EnumMap k c)
    -> (EnumMap k b -> EnumMap k c)
    -> EnumMap k a
    -> EnumMap k b
    -> EnumMap k c
    forall k a b c.
    Enum k =>
    (k -> a -> b -> Maybe c)
    -> (EnumMap k a -> EnumMap k c)
    -> (EnumMap k b -> EnumMap k c)
    -> EnumMap k a
    -> EnumMap k b
    -> EnumMap k c
    EM.mergeWithKey k -> a -> b -> Maybe c
    combine (EnumMap k c -> EnumMap k a -> EnumMap k c
    forall a b. a -> b -> a
    const EnumMap k c
    forall k a. EnumMap k a
    EM.empty) (EnumMap k c -> EnumMap k b -> EnumMap k c
    forall a b. a -> b -> a
    const EnumMap k c
    forall k a. EnumMap k a
    EM.empty)
          interCor = (Point
     -> ContentId TileKind
     -> (ContentId TileKind, ContentId PlaceKind)
     -> Maybe
          (ContentId TileKind, ContentId TileKind, ContentId PlaceKind))
    -> TileMapEM
    -> EnumMap Point (ContentId TileKind, ContentId PlaceKind)
    -> EnumMap
         Point (ContentId TileKind, ContentId TileKind, ContentId PlaceKind)
    forall {k} {a} {b} {c}.
    Enum k =>
    (k -> a -> b -> Maybe c)
    -> EnumMap k a -> EnumMap k b -> EnumMap k c
    intersectionWithKeyMaybe Point
    -> ContentId TileKind
    -> (ContentId TileKind, ContentId PlaceKind)
    -> Maybe
         (ContentId TileKind, ContentId TileKind, ContentId PlaceKind)
    mergeCor TileMapEM
    lplaces EnumMap Point (ContentId TileKind, ContentId PlaceKind)
    lplcorOuter  -- fast
      doorMap <- foldlM' (pickOpening cops kc lplaces litCorTile dsecret) EM.empty
                         (EM.assocs interCor)  -- very small
      let subArea = Area -> Maybe Area -> Area
    forall a. a -> Maybe a -> a
    fromMaybe (String -> Area
    forall a. (?callStack::CallStack) => String -> a
    error (String -> Area) -> String -> Area
    forall a b. (a -> b) -> a -> b
    $ String
    "" String -> CaveKind -> String
    forall v. Show v => String -> v -> String
    `showFailure` CaveKind
    kc) (Maybe Area -> Area) -> Maybe Area -> Area
    forall a b. (a -> b) -> a -> b
    $ Area -> Maybe Area
    shrink Area
    darea
      fence <- buildFenceRnd cops
                             cfenceTileN cfenceTileE cfenceTileS cfenceTileW subArea
      -- The obscured tile, e.g., scratched wall, stays on the server forever,
      -- only the suspect variant on client gets replaced by this upon searching.
      let sub2Area = Area -> Maybe Area -> Area
    forall a. a -> Maybe a -> a
    fromMaybe (String -> Area
    forall a. (?callStack::CallStack) => String -> a
    error (String -> Area) -> String -> Area
    forall a b. (a -> b) -> a -> b
    $ String
    "" String -> CaveKind -> String
    forall v. Show v => String -> v -> String
    `showFailure` CaveKind
    kc) (Maybe Area -> Area) -> Maybe Area -> Area
    forall a b. (a -> b) -> a -> b
    $ Area -> Maybe Area
    shrink Area
    subArea
          sub3Area = Area -> Maybe Area -> Area
    forall a. a -> Maybe a -> a
    fromMaybe (String -> Area
    forall a. (?callStack::CallStack) => String -> a
    error (String -> Area) -> String -> Area
    forall a b. (a -> b) -> a -> b
    $ String
    "" String -> CaveKind -> String
    forall v. Show v => String -> v -> String
    `showFailure` CaveKind
    kc) (Maybe Area -> Area) -> Maybe Area -> Area
    forall a b. (a -> b) -> a -> b
    $ Area -> Maybe Area
    shrink Area
    sub2Area
          likelySecret = Area -> Point -> Bool
    inside Area
    sub3Area
          obscure Point
    p ContentId TileKind
    t = if Y -> Y -> Word32 -> Point -> Bool
    isChancePos Y
    1 Y
    chidden Word32
    dsecret Point
    p Bool -> Bool -> Bool
    && Point -> Bool
    likelySecret Point
    p
                        then ContentData TileKind
    -> ContentId TileKind -> StateT SMGen Identity (ContentId TileKind)
    Tile.obscureAs ContentData TileKind
    cotile ContentId TileKind
    t
                        else ContentId TileKind -> StateT SMGen Identity (ContentId TileKind)
    forall a. a -> StateT SMGen Identity a
    forall (m :: * -> *) a. Monad m => a -> m a
    return ContentId TileKind
    t
      lplacesObscured <- mapWithKeyM obscure lplaces
      let lcorOuter = ((ContentId TileKind, ContentId PlaceKind) -> ContentId TileKind)
    -> EnumMap Point (ContentId TileKind, ContentId PlaceKind)
    -> TileMapEM
    forall a b k. (a -> b) -> EnumMap k a -> EnumMap k b
    EM.map (ContentId TileKind, ContentId PlaceKind) -> ContentId TileKind
    forall a b. (a, b) -> a
    fst EnumMap Point (ContentId TileKind, ContentId PlaceKind)
    lplcorOuter
          aroundFence Place{TileMapEM
    ContentId PlaceKind
    Area
    qfence :: Place -> TileMapEM
    qmap :: Place -> TileMapEM
    qarea :: Place -> Area
    qkind :: Place -> ContentId PlaceKind
    qkind :: ContentId PlaceKind
    qarea :: Area
    qmap :: TileMapEM
    qfence :: TileMapEM
    ..} =
            if PlaceKind -> Fence
    pfence (ContentData PlaceKind -> ContentId PlaceKind -> PlaceKind
    forall a. ContentData a -> ContentId a -> a
    okind ContentData PlaceKind
    coplace ContentId PlaceKind
    qkind) Fence -> [Fence] -> Bool
    forall a. Eq a => a -> [a] -> Bool
    forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
    `elem` [Fence
    FFloor, Fence
    FGround]
            then (ContentId TileKind -> PlaceEntry)
    -> TileMapEM -> EnumMap Point PlaceEntry
    forall a b k. (a -> b) -> EnumMap k a -> EnumMap k b
    EM.map (PlaceEntry -> ContentId TileKind -> PlaceEntry
    forall a b. a -> b -> a
    const (PlaceEntry -> ContentId TileKind -> PlaceEntry)
    -> PlaceEntry -> ContentId TileKind -> PlaceEntry
    forall a b. (a -> b) -> a -> b
    $ ContentId PlaceKind -> PlaceEntry
    PAround ContentId PlaceKind
    qkind) TileMapEM
    qfence
            else EnumMap Point PlaceEntry
    forall k a. EnumMap k a
    EM.empty
          pickRepresentant Place{TileMapEM
    ContentId PlaceKind
    Area
    qfence :: Place -> TileMapEM
    qmap :: Place -> TileMapEM
    qarea :: Place -> Area
    qkind :: Place -> ContentId PlaceKind
    qkind :: ContentId PlaceKind
    qarea :: Area
    qmap :: TileMapEM
    qfence :: TileMapEM
    ..} =
            let (Point
    representant, Y
    _, Y
    _) = Area -> (Point, Y, Y)
    spanArea Area
    qarea
            in Point -> PlaceEntry -> EnumMap Point PlaceEntry
    forall k a. Enum k => k -> a -> EnumMap k a
    EM.singleton Point
    representant (PlaceEntry -> EnumMap Point PlaceEntry)
    -> PlaceEntry -> EnumMap Point PlaceEntry
    forall a b. (a -> b) -> a -> b
    $ ContentId PlaceKind -> PlaceEntry
    PExists ContentId PlaceKind
    qkind
          dentry = [EnumMap Point PlaceEntry] -> EnumMap Point PlaceEntry
    forall k a. [EnumMap k a] -> EnumMap k a
    EM.unions ([EnumMap Point PlaceEntry] -> EnumMap Point PlaceEntry)
    -> [EnumMap Point PlaceEntry] -> EnumMap Point PlaceEntry
    forall a b. (a -> b) -> a -> b
    $
            [((ContentId TileKind, ContentId TileKind, ContentId PlaceKind)
     -> PlaceEntry)
    -> EnumMap
         Point (ContentId TileKind, ContentId TileKind, ContentId PlaceKind)
    -> EnumMap Point PlaceEntry
    forall a b k. (a -> b) -> EnumMap k a -> EnumMap k b
    EM.map (\(ContentId TileKind
    _, ContentId TileKind
    _, ContentId PlaceKind
    pk) -> ContentId PlaceKind -> PlaceEntry
    PEntry ContentId PlaceKind
    pk) EnumMap
      Point (ContentId TileKind, ContentId TileKind, ContentId PlaceKind)
    interCor]
            [EnumMap Point PlaceEntry]
    -> [EnumMap Point PlaceEntry] -> [EnumMap Point PlaceEntry]
    forall a. [a] -> [a] -> [a]
    ++ ((Place, Area) -> EnumMap Point PlaceEntry)
    -> [(Place, Area)] -> [EnumMap Point PlaceEntry]
    forall a b. (a -> b) -> [a] -> [b]
    map (\(Place
    place, Area
    _) -> Place -> EnumMap Point PlaceEntry
    aroundFence Place
    place) (EnumMap Point (Place, Area) -> [(Place, Area)]
    forall k a. EnumMap k a -> [a]
    EM.elems EnumMap Point (Place, Area)
    dplaces)
            [EnumMap Point PlaceEntry]
    -> [EnumMap Point PlaceEntry] -> [EnumMap Point PlaceEntry]
    forall a. [a] -> [a] -> [a]
    ++ -- for @FNone@ fences with walkable tiles on the edges
               -- that may have no intersection with corridots,
               -- particularly if @X@ is used
               ((Place, Area) -> EnumMap Point PlaceEntry)
    -> [(Place, Area)] -> [EnumMap Point PlaceEntry]
    forall a b. (a -> b) -> [a] -> [b]
    map (\(Place
    place, Area
    _) -> Place -> EnumMap Point PlaceEntry
    pickRepresentant Place
    place) (EnumMap Point (Place, Area) -> [(Place, Area)]
    forall k a. EnumMap k a -> [a]
    EM.elems EnumMap Point (Place, Area)
    dplaces)
          dmap = [TileMapEM] -> TileMapEM
    forall k a. [EnumMap k a] -> EnumMap k a
    EM.unions [TileMapEM
    doorMap, TileMapEM
    lplacesObscured, TileMapEM
    lcorOuter, TileMapEM
    lcorInner, TileMapEM
    fence]
            -- order matters
      return $! Cave {..}

    pickOpening :: COps -> CaveKind -> TileMapEM -> ContentId TileKind -> Word32
                -> EM.EnumMap Point (ContentId TileKind)
                -> ( Point
                   , (ContentId TileKind, ContentId TileKind, ContentId PlaceKind) )
                -> Rnd (EM.EnumMap Point (ContentId TileKind))
    pickOpening :: COps
    -> CaveKind
    -> TileMapEM
    -> ContentId TileKind
    -> Word32
    -> TileMapEM
    -> (Point,
        (ContentId TileKind, ContentId TileKind, ContentId PlaceKind))
    -> Rnd TileMapEM
    pickOpening COps{ContentData TileKind
    cotile :: COps -> ContentData TileKind
    cotile :: ContentData TileKind
    cotile, TileSpeedup
    coTileSpeedup :: COps -> TileSpeedup
    coTileSpeedup :: TileSpeedup
    coTileSpeedup}
                CaveKind{Rational
    cdoorChance :: CaveKind -> Rational
    cdoorChance :: Rational
    cdoorChance, Rational
    copenChance :: CaveKind -> Rational
    copenChance :: Rational
    copenChance, Y
    chidden :: CaveKind -> Y
    chidden :: Y
    chidden}
                TileMapEM
    lplaces ContentId TileKind
    litCorTile Word32
    dsecret
                !TileMapEM
    acc (Point
    pos, (ContentId TileKind
    pl, ContentId TileKind
    cor, ContentId PlaceKind
    _)) = do
      let nicerCorridor :: ContentId TileKind
    nicerCorridor =
            if TileSpeedup -> ContentId TileKind -> Bool
    Tile.isLit TileSpeedup
    coTileSpeedup ContentId TileKind
    cor then ContentId TileKind
    cor
            else -- If any cardinally adjacent walkable room tile is lit,
                 -- make the opening lit, as well.
                 let roomTileLit :: Point -> Bool
    roomTileLit Point
    p =
                       case Point -> TileMapEM -> Maybe (ContentId TileKind)
    forall k a. Enum k => k -> EnumMap k a -> Maybe a
    EM.lookup Point
    p TileMapEM
    lplaces of
                         Maybe (ContentId TileKind)
    Nothing -> Bool
    False
                         Just ContentId TileKind
    tile -> TileSpeedup -> ContentId TileKind -> Bool
    Tile.isWalkable TileSpeedup
    coTileSpeedup ContentId TileKind
    tile
                                      Bool -> Bool -> Bool
    && TileSpeedup -> ContentId TileKind -> Bool
    Tile.isLit TileSpeedup
    coTileSpeedup ContentId TileKind
    tile
                     vic :: [Point]
    vic = Point -> [Point]
    vicinityCardinalUnsafe Point
    pos
                 in if (Point -> Bool) -> [Point] -> Bool
    forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
    any Point -> Bool
    roomTileLit [Point]
    vic then ContentId TileKind
    litCorTile else ContentId TileKind
    cor
          vicAll :: [Point]
    vicAll = Point -> [Point]
    vicinityUnsafe Point
    pos
          vicNewTiles :: [ContentId TileKind]
    vicNewTiles = (Point -> Maybe (ContentId TileKind))
    -> [Point] -> [ContentId TileKind]
    forall a b. (a -> Maybe b) -> [a] -> [b]
    mapMaybe (Point -> TileMapEM -> Maybe (ContentId TileKind)
    forall k a. Enum k => k -> EnumMap k a -> Maybe a
    `EM.lookup` TileMapEM
    acc) [Point]
    vicAll
      newTile <- case [ContentId TileKind]
    vicNewTiles of
        ContentId TileKind
    vicNewTile : [ContentId TileKind]
    _ -> ContentId TileKind -> StateT SMGen Identity (ContentId TileKind)
    forall a. a -> StateT SMGen Identity a
    forall (m :: * -> *) a. Monad m => a -> m a
    return ContentId TileKind
    vicNewTile  -- disallow a door beside an opening
        [] -> do
          -- Openings have a certain chance to be doors and doors have a certain
          -- chance to be open.
          rd <- Rational -> Rnd Bool
    chance Rational
    cdoorChance
          if rd then do
            let hidden = ContentData TileKind -> ContentId TileKind -> ContentId TileKind
    Tile.buildAs ContentData TileKind
    cotile ContentId TileKind
    pl
            doorTrappedId <- Tile.revealAs cotile hidden
            let !_A = Bool -> () -> ()
    forall a. (?callStack::CallStack) => Bool -> a -> a
    assert (ContentData TileKind -> ContentId TileKind -> ContentId TileKind
    Tile.buildAs ContentData TileKind
    cotile ContentId TileKind
    doorTrappedId ContentId TileKind -> ContentId TileKind -> Bool
    forall a. Eq a => a -> a -> Bool
    == ContentId TileKind
    doorTrappedId) ()
            -- Not all solid tiles can hide a door (or any other openable tile),
            -- so @doorTrappedId@ may in fact not be a door at all, hence the check.
            if Tile.isOpenable coTileSpeedup doorTrappedId then do  -- door created
              ro <- chance copenChance
              if ro
              then Tile.openTo cotile doorTrappedId
              else if isChancePos 1 chidden dsecret pos
                   then return doorTrappedId  -- server will hide it
                   else do
                     doorOpenId <- Tile.openTo cotile doorTrappedId
                     Tile.closeTo cotile doorOpenId  -- mail do nothing; OK
            else return doorTrappedId  -- assume this is what content enforces
          else return nicerCorridor
      return $! EM.insert pos newTile acc