    -- | Operations on the 'Area' type that involve random numbers.
    module Game.LambdaHack.Server.DungeonGen.AreaRnd
      ( -- * Picking points inside areas
        mkFixed, pointInArea, findPointInArea, mkVoidRoom, mkRoom
        -- * Choosing connections
      , connectGrid, randomConnection
        -- * Plotting corridors
      , HV(..), Corridor, connectPlaces
      , SpecialArea(..), grid
    #ifdef EXPOSE_INTERNAL
        -- * Internal operations
      , connectGrid', sortPoint, mkCorridor, borderPlace
    #endif
      ) where

    import Prelude ()

    import Game.LambdaHack.Core.Prelude

    import qualified Data.EnumMap.Strict as EM
    import qualified Data.EnumSet as ES
    import           Data.Functor.Identity (runIdentity)
    import qualified Data.IntSet as IS

    import Game.LambdaHack.Common.Area
    import Game.LambdaHack.Common.Point
    import Game.LambdaHack.Common.Vector
    import Game.LambdaHack.Content.PlaceKind
    import Game.LambdaHack.Core.Random
    import Game.LambdaHack.Definition.Defs

    -- Doesn't respect minimum sizes, because staircases are specified verbatim,
    -- so can't be arbitrarily scaled up.
    -- The size may be one more than what maximal size hint requests,
    -- but this is safe (limited by area size) and makes up for the rigidity
    -- of the fixed room sizes (e.g., that the size is always odd).
    mkFixed :: (X, Y)    -- ^ maximum size
            -> Area      -- ^ the containing area, not the room itself
            -> Point     -- ^ the center point
            -> Area
    mkFixed :: (Key, Key) -> Area -> Point -> Area
    mkFixed (Key
    xMax, Key
    yMax) Area
    area p :: Point
    p@Point{Key
    px :: Key
    py :: Key
    py :: Point -> Key
    px :: Point -> Key
    ..} =
      let (Key
    x0, Key
    y0, Key
    x1, Key
    y1) = Area -> (Key, Key, Key, Key)
    fromArea Area
    area
          xradius :: Key
    xradius = Key -> Key -> Key
    forall a. Ord a => a -> a -> a
    min ((Key
    xMax Key -> Key -> Key
    forall a. Num a => a -> a -> a
    + Key
    1) Key -> Key -> Key
    forall a. Integral a => a -> a -> a
    `div` Key
    2) (Key -> Key) -> Key -> Key
    forall a b. (a -> b) -> a -> b
    $ Key -> Key -> Key
    forall a. Ord a => a -> a -> a
    min (Key
    px Key -> Key -> Key
    forall a. Num a => a -> a -> a
    - Key
    x0) (Key
    x1 Key -> Key -> Key
    forall a. Num a => a -> a -> a
    - Key
    px)
          yradius :: Key
    yradius = Key -> Key -> Key
    forall a. Ord a => a -> a -> a
    min ((Key
    yMax Key -> Key -> Key
    forall a. Num a => a -> a -> a
    + Key
    1) Key -> Key -> Key
    forall a. Integral a => a -> a -> a
    `div` Key
    2) (Key -> Key) -> Key -> Key
    forall a b. (a -> b) -> a -> b
    $ Key -> Key -> Key
    forall a. Ord a => a -> a -> a
    min (Key
    py Key -> Key -> Key
    forall a. Num a => a -> a -> a
    - Key
    y0) (Key
    y1 Key -> Key -> Key
    forall a. Num a => a -> a -> a
    - Key
    py)
          a :: (Key, Key, Key, Key)
    a = (Key
    px Key -> Key -> Key
    forall a. Num a => a -> a -> a
    - Key
    xradius, Key
    py Key -> Key -> Key
    forall a. Num a => a -> a -> a
    - Key
    yradius, Key
    px Key -> Key -> Key
    forall a. Num a => a -> a -> a
    + Key
    xradius, Key
    py Key -> Key -> Key
    forall a. Num a => a -> a -> a
    + Key
    yradius)
      in Area -> Maybe Area -> Area
    forall a. a -> Maybe a -> a
    fromMaybe ([Char] -> Area
    forall a. HasCallStack => [Char] -> a
    error ([Char] -> Area) -> [Char] -> Area
    forall a b. (a -> b) -> a -> b
    $ [Char]
    "" [Char] -> ((Key, Key, Key, Key), Key, Key, Area, Point) -> [Char]
    forall v. Show v => [Char] -> v -> [Char]
    `showFailure` ((Key, Key, Key, Key)
    a, Key
    xMax, Key
    yMax, Area
    area, Point
    p)) (Maybe Area -> Area) -> Maybe Area -> Area
    forall a b. (a -> b) -> a -> b
    $ (Key, Key, Key, Key) -> Maybe Area
    toArea (Key, Key, Key, Key)
    a

    -- | Pick a random point within an area.
    pointInArea :: Area -> Rnd Point
    pointInArea :: Area -> Rnd Point
    pointInArea Area
    area = do
      let (Point Key
    x0 Key
    y0, Key
    xspan, Key
    yspan) = Area -> (Point, Key, Key)
    spanArea Area
    area
      pxy <- Key -> Rnd Key
    forall a. Integral a => a -> Rnd a
    randomR0 (Key
    xspan Key -> Key -> Key
    forall a. Num a => a -> a -> a
    * Key
    yspan Key -> Key -> Key
    forall a. Num a => a -> a -> a
    - Key
    1)
      let Point{..} = punindex xspan pxy
      return $! Point (x0 + px) (y0 + py)

    -- | Find a suitable position in the area, based on random points
    -- and a preference predicate and fallback acceptability predicate.
    findPointInArea :: Area -> (Point -> Maybe Point)
                    -> Int -> (Point -> Maybe Point)
                    -> Rnd (Maybe Point)
    findPointInArea :: Area
    -> (Point -> Maybe Point)
    -> Key
    -> (Point -> Maybe Point)
    -> Rnd (Maybe Point)
    findPointInArea Area
    area Point -> Maybe Point
    g Key
    gnumTries Point -> Maybe Point
    f =
      let (Point Key
    x0 Key
    y0, Key
    xspan, Key
    yspan) = Area -> (Point, Key, Key)
    spanArea Area
    area
          checkPoint :: Applicative m
                     => (Point -> Maybe Point) -> m (Maybe Point) -> Int
                     -> m (Maybe Point)
          {-# INLINE checkPoint #-}
          checkPoint :: forall (m :: * -> *).
    Applicative m =>
    (Point -> Maybe Point) -> m (Maybe Point) -> Key -> m (Maybe Point)
    checkPoint Point -> Maybe Point
    check m (Maybe Point)
    fallback Key
    pxyRelative =
            let Point{Key
    py :: Point -> Key
    px :: Point -> Key
    px :: Key
    py :: Key
    ..} = Key -> Key -> Point
    punindex Key
    xspan Key
    pxyRelative
                pos :: Point
    pos = Key -> Key -> Point
    Point (Key
    x0 Key -> Key -> Key
    forall a. Num a => a -> a -> a
    + Key
    px) (Key
    y0 Key -> Key -> Key
    forall a. Num a => a -> a -> a
    + Key
    py)
            in case Point -> Maybe Point
    check Point
    pos of
              Just Point
    p -> Maybe Point -> m (Maybe Point)
    forall a. a -> m a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure (Maybe Point -> m (Maybe Point)) -> Maybe Point -> m (Maybe Point)
    forall a b. (a -> b) -> a -> b
    $ Point -> Maybe Point
    forall a. a -> Maybe a
    Just Point
    p
              Maybe Point
    Nothing -> m (Maybe Point)
    fallback
          gsearch :: Key -> Rnd (Maybe Point)
    gsearch Key
    0 = Key -> Rnd (Maybe Point)
    fsearch (Key
    xspan Key -> Key -> Key
    forall a. Num a => a -> a -> a
    * Key
    yspan Key -> Key -> Key
    forall a. Num a => a -> a -> a
    * Key
    10)
          gsearch Key
    count = do
            pxy <- Key -> Rnd Key
    forall a. Integral a => a -> Rnd a
    randomR0 (Key
    xspan Key -> Key -> Key
    forall a. Num a => a -> a -> a
    * Key
    yspan Key -> Key -> Key
    forall a. Num a => a -> a -> a
    - Key
    1)
            checkPoint g (gsearch (count - 1)) pxy
          fsearch :: Key -> Rnd (Maybe Point)
    fsearch Key
    0 = Maybe Point -> Rnd (Maybe Point)
    forall a. a -> StateT SMGen Identity a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Maybe Point -> Rnd (Maybe Point))
    -> Maybe Point -> Rnd (Maybe Point)
    forall a b. (a -> b) -> a -> b
    $! Identity (Maybe Point) -> Maybe Point
    forall a. Identity a -> a
    runIdentity (Identity (Maybe Point) -> Maybe Point)
    -> Identity (Maybe Point) -> Maybe Point
    forall a b. (a -> b) -> a -> b
    $ Key -> Identity (Maybe Point)
    searchAll (Key
    xspan Key -> Key -> Key
    forall a. Num a => a -> a -> a
    * Key
    yspan Key -> Key -> Key
    forall a. Num a => a -> a -> a
    - Key
    1)
          fsearch Key
    count = do
            pxy <- Key -> Rnd Key
    forall a. Integral a => a -> Rnd a
    randomR0 (Key
    xspan Key -> Key -> Key
    forall a. Num a => a -> a -> a
    * Key
    yspan Key -> Key -> Key
    forall a. Num a => a -> a -> a
    - Key
    1)
            checkPoint f (fsearch (count - 1)) pxy
          searchAll :: Key -> Identity (Maybe Point)
    searchAll (-1) = Maybe Point -> Identity (Maybe Point)
    forall a. a -> Identity a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure Maybe Point
    forall a. Maybe a
    Nothing
          searchAll Key
    pxyRelative =
            (Point -> Maybe Point)
    -> Identity (Maybe Point) -> Key -> Identity (Maybe Point)
    forall (m :: * -> *).
    Applicative m =>
    (Point -> Maybe Point) -> m (Maybe Point) -> Key -> m (Maybe Point)
    checkPoint Point -> Maybe Point
    f (Key -> Identity (Maybe Point)
    searchAll (Key
    pxyRelative Key -> Key -> Key
    forall a. Num a => a -> a -> a
    - Key
    1)) Key
    pxyRelative
      in Key -> Rnd (Maybe Point)
    gsearch Key
    gnumTries

    -- | Create a void room, i.e., a single point area within the designated area.
    mkVoidRoom :: Area -> Rnd Area
    mkVoidRoom :: Area -> Rnd Area
    mkVoidRoom Area
    area = do
      -- Pass corridors closer to the middle of the grid area, if possible.
      let core :: Area
    core = Area -> Maybe Area -> Area
    forall a. a -> Maybe a -> a
    fromMaybe Area
    area (Maybe Area -> Area) -> Maybe Area -> Area
    forall a b. (a -> b) -> a -> b
    $ Area -> Maybe Area
    shrink Area
    area
      pxy <- Area -> Rnd Point
    pointInArea Area
    core
      return $! trivialArea pxy

    -- | Create a random room according to given parameters.
    mkRoom :: (X, Y)    -- ^ minimum size
           -> (X, Y)    -- ^ maximum size
           -> Area      -- ^ the containing area, not the room itself
           -> Rnd Area
    mkRoom :: (Key, Key) -> (Key, Key) -> Area -> Rnd Area
    mkRoom (Key
    xm, Key
    ym) (Key
    xM, Key
    yM) Area
    area = do
      let (Key
    x0, Key
    y0, Key
    x1, Key
    y1) = Area -> (Key, Key, Key, Key)
    fromArea Area
    area
          xspan :: Key
    xspan = Key
    x1 Key -> Key -> Key
    forall a. Num a => a -> a -> a
    - Key
    x0 Key -> Key -> Key
    forall a. Num a => a -> a -> a
    + Key
    1
          yspan :: Key
    yspan = Key
    y1 Key -> Key -> Key
    forall a. Num a => a -> a -> a
    - Key
    y0 Key -> Key -> Key
    forall a. Num a => a -> a -> a
    + Key
    1
          aW :: (Key, Key, Key, Key)
    aW = (Key -> Key -> Key
    forall a. Ord a => a -> a -> a
    min Key
    xm Key
    xspan, Key -> Key -> Key
    forall a. Ord a => a -> a -> a
    min Key
    ym Key
    yspan, Key -> Key -> Key
    forall a. Ord a => a -> a -> a
    min Key
    xM Key
    xspan, Key -> Key -> Key
    forall a. Ord a => a -> a -> a
    min Key
    yM Key
    yspan)
          areaW :: Area
    areaW = Area -> Maybe Area -> Area
    forall a. a -> Maybe a -> a
    fromMaybe ([Char] -> Area
    forall a. HasCallStack => [Char] -> a
    error ([Char] -> Area) -> [Char] -> Area
    forall a b. (a -> b) -> a -> b
    $ [Char]
    "" [Char] -> (Key, Key, Key, Key) -> [Char]
    forall v. Show v => [Char] -> v -> [Char]
    `showFailure` (Key, Key, Key, Key)
    aW) (Maybe Area -> Area) -> Maybe Area -> Area
    forall a b. (a -> b) -> a -> b
    $ (Key, Key, Key, Key) -> Maybe Area
    toArea (Key, Key, Key, Key)
    aW
      Point xW yW <- Area -> Rnd Point
    pointInArea Area
    areaW  -- roll size
      let a1 = (Key
    x0, Key
    y0, Key -> Key -> Key
    forall a. Ord a => a -> a -> a
    max Key
    x0 (Key
    x1 Key -> Key -> Key
    forall a. Num a => a -> a -> a
    - Key
    xW Key -> Key -> Key
    forall a. Num a => a -> a -> a
    + Key
    1), Key -> Key -> Key
    forall a. Ord a => a -> a -> a
    max Key
    y0 (Key
    y1 Key -> Key -> Key
    forall a. Num a => a -> a -> a
    - Key
    yW Key -> Key -> Key
    forall a. Num a => a -> a -> a
    + Key
    1))
          area1 = Area -> Maybe Area -> Area
    forall a. a -> Maybe a -> a
    fromMaybe ([Char] -> Area
    forall a. HasCallStack => [Char] -> a
    error ([Char] -> Area) -> [Char] -> Area
    forall a b. (a -> b) -> a -> b
    $ [Char]
    "" [Char] -> (Key, Key, Key, Key) -> [Char]
    forall v. Show v => [Char] -> v -> [Char]
    `showFailure` (Key, Key, Key, Key)
    a1) (Maybe Area -> Area) -> Maybe Area -> Area
    forall a b. (a -> b) -> a -> b
    $ (Key, Key, Key, Key) -> Maybe Area
    toArea (Key, Key, Key, Key)
    a1
      Point rx1 ry1 <- pointInArea area1  -- roll top-left corner
      let a3 = (Key
    rx1, Key
    ry1, Key
    rx1 Key -> Key -> Key
    forall a. Num a => a -> a -> a
    + Key
    xW Key -> Key -> Key
    forall a. Num a => a -> a -> a
    - Key
    1, Key
    ry1 Key -> Key -> Key
    forall a. Num a => a -> a -> a
    + Key
    yW Key -> Key -> Key
    forall a. Num a => a -> a -> a
    - Key
    1)
          area3 = Area -> Maybe Area -> Area
    forall a. a -> Maybe a -> a
    fromMaybe ([Char] -> Area
    forall a. HasCallStack => [Char] -> a
    error ([Char] -> Area) -> [Char] -> Area
    forall a b. (a -> b) -> a -> b
    $ [Char]
    "" [Char] -> (Key, Key, Key, Key) -> [Char]
    forall v. Show v => [Char] -> v -> [Char]
    `showFailure` (Key, Key, Key, Key)
    a3) (Maybe Area -> Area) -> Maybe Area -> Area
    forall a b. (a -> b) -> a -> b
    $ (Key, Key, Key, Key) -> Maybe Area
    toArea (Key, Key, Key, Key)
    a3
      return $! area3

    -- Choosing connections between areas in a grid

    -- | Pick a subset of connections between adjacent areas within a grid until
    -- there is only one connected component in the graph of all areas.
    connectGrid :: ES.EnumSet Point -> (X, Y) -> Rnd [(Point, Point)]
    connectGrid :: EnumSet Point -> (Key, Key) -> Rnd [(Point, Point)]
    connectGrid EnumSet Point
    voidPlaces (Key
    nx, Key
    ny) = do
      let unconnected :: EnumSet Point
    unconnected = [Point] -> EnumSet Point
    forall k. Enum k => [k] -> EnumSet k
    ES.fromDistinctAscList [ Key -> Key -> Point
    Point Key
    x Key
    y
                                               | Key
    y <- [Key
    0..Key
    nyKey -> Key -> Key
    forall a. Num a => a -> a -> a
    -Key
    1], Key
    x <- [Key
    0..Key
    nxKey -> Key -> Key
    forall a. Num a => a -> a -> a
    -Key
    1] ]
      -- Candidates are neighbours that are still unconnected. We start with
      -- a random choice.
      p <- [Point] -> Rnd Point
    forall a. [a] -> Rnd a
    oneOf ([Point] -> Rnd Point) -> [Point] -> Rnd Point
    forall a b. (a -> b) -> a -> b
    $ EnumSet Point -> [Point]
    forall k. Enum k => EnumSet k -> [k]
    ES.elems (EnumSet Point -> [Point]) -> EnumSet Point -> [Point]
    forall a b. (a -> b) -> a -> b
    $ EnumSet Point
    unconnected EnumSet Point -> EnumSet Point -> EnumSet Point
    forall k. EnumSet k -> EnumSet k -> EnumSet k
    ES.\\ EnumSet Point
    voidPlaces
      let candidates = Point -> EnumSet Point
    forall k. Enum k => k -> EnumSet k
    ES.singleton Point
    p
      connectGrid' voidPlaces (nx, ny) unconnected candidates []

    connectGrid' :: ES.EnumSet Point -> (X, Y)
                 -> ES.EnumSet Point -> ES.EnumSet Point
                 -> [(Point, Point)]
                 -> Rnd [(Point, Point)]
    connectGrid' :: EnumSet Point
    -> (Key, Key)
    -> EnumSet Point
    -> EnumSet Point
    -> [(Point, Point)]
    -> Rnd [(Point, Point)]
    connectGrid' EnumSet Point
    voidPlaces (Key
    nx, Key
    ny) EnumSet Point
    unconnected EnumSet Point
    candidates ![(Point, Point)]
    acc
      | EnumSet Point
    unconnected EnumSet Point -> EnumSet Point -> Bool
    forall k. EnumSet k -> EnumSet k -> Bool
    `ES.isSubsetOf` EnumSet Point
    voidPlaces = [(Point, Point)] -> Rnd [(Point, Point)]
    forall a. a -> StateT SMGen Identity a
    forall (m :: * -> *) a. Monad m => a -> m a
    return [(Point, Point)]
    acc
      | Bool
    otherwise = do
          let candidatesBest :: EnumSet Point
    candidatesBest = EnumSet Point
    candidates EnumSet Point -> EnumSet Point -> EnumSet Point
    forall k. EnumSet k -> EnumSet k -> EnumSet k
    ES.\\ EnumSet Point
    voidPlaces
          c <- [Point] -> Rnd Point
    forall a. [a] -> Rnd a
    oneOf ([Point] -> Rnd Point) -> [Point] -> Rnd Point
    forall a b. (a -> b) -> a -> b
    $ EnumSet Point -> [Point]
    forall k. Enum k => EnumSet k -> [k]
    ES.elems (EnumSet Point -> [Point]) -> EnumSet Point -> [Point]
    forall a b. (a -> b) -> a -> b
    $ if EnumSet Point -> Bool
    forall k. EnumSet k -> Bool
    ES.null EnumSet Point
    candidatesBest
                                   then EnumSet Point
    candidates
                                   else EnumSet Point
    candidatesBest
          -- potential new candidates:
          let ns = [Point] -> EnumSet Point
    forall k. Enum k => [k] -> EnumSet k
    ES.fromList ([Point] -> EnumSet Point) -> [Point] -> EnumSet Point
    forall a b. (a -> b) -> a -> b
    $ Key -> Key -> Point -> [Point]
    vicinityCardinal Key
    nx Key
    ny Point
    c
              nu = Point -> EnumSet Point -> EnumSet Point
    forall k. Enum k => k -> EnumSet k -> EnumSet k
    ES.delete Point
    c EnumSet Point
    unconnected  -- new unconnected
              -- (new candidates, potential connections):
              (nc, ds) = ES.partition (`ES.member` nu) ns
          new <- if ES.null ds
                 then return id
                 else do
                   d <- oneOf (ES.elems ds)
                   return (sortPoint (c, d) :)
          connectGrid' voidPlaces (nx, ny) nu
            (ES.delete c (candidates `ES.union` nc)) (new acc)

    -- | Sort the sequence of two points, in the derived lexicographic order.
    sortPoint :: (Point, Point) -> (Point, Point)
    sortPoint :: (Point, Point) -> (Point, Point)
    sortPoint (Point
    a, Point
    b) | Point
    a Point -> Point -> Bool
    forall a. Ord a => a -> a -> Bool
    <= Point
    b    = (Point
    a, Point
    b)
                     | Bool
    otherwise = (Point
    b, Point
    a)

    -- | Pick a single random connection between adjacent areas within a grid.
    randomConnection :: (X, Y) -> Rnd (Point, Point)
    randomConnection :: (Key, Key) -> Rnd (Point, Point)
    randomConnection (Key
    nx, Key
    ny) =
      Bool -> Rnd (Point, Point) -> Rnd (Point, Point)
    forall a. HasCallStack => Bool -> a -> a
    assert (Key
    nx Key -> Key -> Bool
    forall a. Ord a => a -> a -> Bool
    > Key
    1 Bool -> Bool -> Bool
    && Key
    ny Key -> Key -> Bool
    forall a. Ord a => a -> a -> Bool
    > Key
    0 Bool -> Bool -> Bool
    || Key
    nx Key -> Key -> Bool
    forall a. Ord a => a -> a -> Bool
    > Key
    0 Bool -> Bool -> Bool
    && Key
    ny Key -> Key -> Bool
    forall a. Ord a => a -> a -> Bool
    > Key
    1 Bool -> (Key, Key) -> Bool
    forall v. Show v => Bool -> v -> Bool
    `blame` (Key
    nx, Key
    ny)) (Rnd (Point, Point) -> Rnd (Point, Point))
    -> Rnd (Point, Point) -> Rnd (Point, Point)
    forall a b. (a -> b) -> a -> b
    $ do
      rb <- [Bool] -> Rnd Bool
    forall a. [a] -> Rnd a
    oneOf [Bool
    False, Bool
    True]
      if rb && nx > 1 || ny <= 1
      then do
        rx <- randomR0 (nx - 2)
        ry <- randomR0 (ny - 1)
        return (Point rx ry, Point (rx+1) ry)
      else do
        rx <- randomR0 (nx - 1)
        ry <- randomR0 (ny - 2)
        return (Point rx ry, Point rx (ry+1))

    -- Plotting individual corridors between two areas

    -- | The choice of horizontal and vertical orientation.
    data HV = Horiz | Vert
      deriving HV -> HV -> Bool
    (HV -> HV -> Bool) -> (HV -> HV -> Bool) -> Eq HV
    forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
    $c== :: HV -> HV -> Bool
    == :: HV -> HV -> Bool
    $c/= :: HV -> HV -> Bool
    /= :: HV -> HV -> Bool
    Eq

    -- | The coordinates of consecutive fields of a corridor.
    type Corridor = (Point, Point, Point, Point)

    -- | Create a corridor, either horizontal or vertical, with
    -- a possible intermediate part that is in the opposite direction.
    -- There might not always exist a good intermediate point
    -- if the places are allowed to be close together
    -- and then we let the intermediate part degenerate.
    mkCorridor :: HV            -- ^ orientation of the starting section
               -> Point         -- ^ starting point
               -> Bool          -- ^ starting is inside @FGround@ or @FFloor@
               -> Point         -- ^ ending point
               -> Bool          -- ^ ending is inside @FGround@ or @FFloor@
               -> Area          -- ^ the area containing the intermediate point
               -> Rnd Corridor  -- ^ straight sections of the corridor
    mkCorridor :: HV -> Point -> Bool -> Point -> Bool -> Area -> Rnd Corridor
    mkCorridor HV
    hv (Point Key
    x0 Key
    y0) Bool
    p0floor (Point Key
    x1 Key
    y1) Bool
    p1floor Area
    area = do
      Point rxRaw ryRaw <- Area -> Rnd Point
    pointInArea Area
    area
      let (sx0, sy0, sx1, sy1) = fromArea area
          -- Avoid corridors that run along @FGround@ or @FFloor@ fence,
          -- unless not possible.
          rx = if | Key
    rxRaw Key -> Key -> Bool
    forall a. Eq a => a -> a -> Bool
    == Key
    sx0 Key -> Key -> Key
    forall a. Num a => a -> a -> a
    + Key
    1 Bool -> Bool -> Bool
    && Bool
    p0floor -> Key
    sx0
                  | Key
    rxRaw Key -> Key -> Bool
    forall a. Eq a => a -> a -> Bool
    == Key
    sx1 Key -> Key -> Key
    forall a. Num a => a -> a -> a
    - Key
    1 Bool -> Bool -> Bool
    && Bool
    p1floor -> Key
    sx1
                  | Bool
    otherwise -> Key
    rxRaw
          ry = if | Key
    ryRaw Key -> Key -> Bool
    forall a. Eq a => a -> a -> Bool
    == Key
    sy0 Key -> Key -> Key
    forall a. Num a => a -> a -> a
    + Key
    1 Bool -> Bool -> Bool
    && Bool
    p0floor -> Key
    sy0
                  | Key
    ryRaw Key -> Key -> Bool
    forall a. Eq a => a -> a -> Bool
    == Key
    sy1 Key -> Key -> Key
    forall a. Num a => a -> a -> a
    - Key
    1 Bool -> Bool -> Bool
    && Bool
    p1floor -> Key
    sy1
                  | Bool
    otherwise -> Key
    ryRaw
      return $! case hv of
        HV
    Horiz -> (Key -> Key -> Point
    Point Key
    x0 Key
    y0, Key -> Key -> Point
    Point Key
    rx Key
    y0, Key -> Key -> Point
    Point Key
    rx Key
    y1, Key -> Key -> Point
    Point Key
    x1 Key
    y1)
        HV
    Vert  -> (Key -> Key -> Point
    Point Key
    x0 Key
    y0, Key -> Key -> Point
    Point Key
    x0 Key
    ry, Key -> Key -> Point
    Point Key
    x1 Key
    ry, Key -> Key -> Point
    Point Key
    x1 Key
    y1)

    -- | Try to connect two interiors of places with a corridor.
    -- Choose entrances some steps away from the edges, if the place
    -- is big enough. Note that with @pfence == FNone@, the inner area considered
    -- is the strict interior of the place, without the outermost tiles.
    --
    -- The corridor connects (touches) the inner areas and the turning point
    -- of the corridor (if any) is outside of the outer areas
    -- and inside the grid areas.
    connectPlaces :: (Area, Fence, Area) -> (Area, Fence, Area)
                  -> Rnd (Maybe Corridor)
    connectPlaces :: (Area, Fence, Area) -> (Area, Fence, Area) -> Rnd (Maybe Corridor)
    connectPlaces (Area
    _, Fence
    _, Area
    sg) (Area
    _, Fence
    _, Area
    tg) | Area
    sg Area -> Area -> Bool
    forall a. Eq a => a -> a -> Bool
    == Area
    tg = Maybe Corridor -> Rnd (Maybe Corridor)
    forall a. a -> StateT SMGen Identity a
    forall (m :: * -> *) a. Monad m => a -> m a
    return Maybe Corridor
    forall a. Maybe a
    Nothing
    connectPlaces s3 :: (Area, Fence, Area)
    s3@(Area
    sqarea, Fence
    spfence, Area
    sg) t3 :: (Area, Fence, Area)
    t3@(Area
    tqarea, Fence
    tpfence, Area
    tg) = do
      let (Area
    sa, Area
    so, Bool
    stiny) = Area -> Fence -> (Area, Area, Bool)
    borderPlace Area
    sqarea Fence
    spfence
          (Area
    ta, Area
    to, Bool
    ttiny) = Area -> Fence -> (Area, Area, Bool)
    borderPlace Area
    tqarea Fence
    tpfence
          trim :: Area -> Area
    trim Area
    area =
            let (Key
    x0, Key
    y0, Key
    x1, Key
    y1) = Area -> (Key, Key, Key, Key)
    fromArea Area
    area
                dx :: Key
    dx = case (Key
    x1 Key -> Key -> Key
    forall a. Num a => a -> a -> a
    - Key
    x0) Key -> Key -> Key
    forall a. Integral a => a -> a -> a
    `div` Key
    2 of
                  Key
    0 -> Key
    0
                  Key
    1 -> Key
    1
                  Key
    2 -> Key
    1
                  Key
    3 -> Key
    1
                  Key
    _ -> Key
    3
                dy :: Key
    dy = case (Key
    y1 Key -> Key -> Key
    forall a. Num a => a -> a -> a
    - Key
    y0) Key -> Key -> Key
    forall a. Integral a => a -> a -> a
    `div` Key
    2 of
                  Key
    0 -> Key
    0
                  Key
    1 -> Key
    1
                  Key
    2 -> Key
    1
                  Key
    3 -> Key
    1
                  Key
    _ -> Key
    3
            in Area -> Maybe Area -> Area
    forall a. a -> Maybe a -> a
    fromMaybe ([Char] -> Area
    forall a. HasCallStack => [Char] -> a
    error ([Char] -> Area) -> [Char] -> Area
    forall a b. (a -> b) -> a -> b
    $ [Char]
    "" [Char]
    -> (Area, (Area, Fence, Area), (Area, Fence, Area)) -> [Char]
    forall v. Show v => [Char] -> v -> [Char]
    `showFailure` (Area
    area, (Area, Fence, Area)
    s3, (Area, Fence, Area)
    t3))
               (Maybe Area -> Area) -> Maybe Area -> Area
    forall a b. (a -> b) -> a -> b
    $ (Key, Key, Key, Key) -> Maybe Area
    toArea (Key
    x0 Key -> Key -> Key
    forall a. Num a => a -> a -> a
    + Key
    dx, Key
    y0 Key -> Key -> Key
    forall a. Num a => a -> a -> a
    + Key
    dy, Key
    x1 Key -> Key -> Key
    forall a. Num a => a -> a -> a
    - Key
    dx, Key
    y1 Key -> Key -> Key
    forall a. Num a => a -> a -> a
    - Key
    dy)
      Point sx sy <- Area -> Rnd Point
    pointInArea (Area -> Rnd Point) -> Area -> Rnd Point
    forall a b. (a -> b) -> a -> b
    $ Area -> Area
    trim Area
    sa
      Point tx ty <- pointInArea $ trim ta
      -- If the place (e.g., void place) is slim (at most 2-tile wide, no fence),
      -- overwrite it with corridor. The place may not even be built (e.g., void)
      -- and the overwrite ensures connections through it are not broken.
      let (_, _, sax1Raw, say1Raw) = fromArea sa  -- inner area
          sslim = Bool
    stiny Bool -> Bool -> Bool
    && Fence
    spfence Fence -> Fence -> Bool
    forall a. Eq a => a -> a -> Bool
    == Fence
    FNone
          (sax1, say1) = if sslim
                         then (sax1Raw - 1, say1Raw - 1)
                         else (sax1Raw, say1Raw)
          (tax0Raw, tay0Raw, _, _) = fromArea ta
          tslim = Bool
    ttiny Bool -> Bool -> Bool
    && Fence
    tpfence Fence -> Fence -> Bool
    forall a. Eq a => a -> a -> Bool
    == Fence
    FNone
          (tax0, tay0) = if tslim
                         then (tax0Raw + 1, tay0Raw + 1)
                         else (tax0Raw, tay0Raw)
          (_, _, sox1, soy1) = fromArea so  -- outer area
          (tox0, toy0, _, _) = fromArea to
          (sgx0, sgy0, sgx1, sgy1) = fromArea sg  -- grid area
          (tgx0, tgy0, tgx1, tgy1) = fromArea tg
          (hv, area, p0, p1)
            | sgx1 == tgx0 =
              let x0 = if Key
    sgy0 Key -> Key -> Bool
    forall a. Ord a => a -> a -> Bool
    <= Key
    ty Bool -> Bool -> Bool
    && Key
    ty Key -> Key -> Bool
    forall a. Ord a => a -> a -> Bool
    <= Key
    sgy1 then Key
    sox1 Key -> Key -> Key
    forall a. Num a => a -> a -> a
    + Key
    1 else Key
    sgx1
                  x1 = if Key
    tgy0 Key -> Key -> Bool
    forall a. Ord a => a -> a -> Bool
    <= Key
    sy Bool -> Bool -> Bool
    && Key
    sy Key -> Key -> Bool
    forall a. Ord a => a -> a -> Bool
    <= Key
    tgy1 then Key
    tox0 Key -> Key -> Key
    forall a. Num a => a -> a -> a
    - Key
    1 else Key
    sgx1
              in case toArea (x0, min sy ty, x1, max sy ty) of
                Just Area
    a -> (HV
    Horiz, Area
    a, Key -> Key -> Point
    Point (Key
    sax1 Key -> Key -> Key
    forall a. Num a => a -> a -> a
    + Key
    1) Key
    sy, Key -> Key -> Point
    Point (Key
    tax0 Key -> Key -> Key
    forall a. Num a => a -> a -> a
    - Key
    1) Key
    ty)
                Maybe Area
    Nothing -> [Char] -> (HV, Area, Point, Point)
    forall a. HasCallStack => [Char] -> a
    error ([Char] -> (HV, Area, Point, Point))
    -> [Char] -> (HV, Area, Point, Point)
    forall a b. (a -> b) -> a -> b
    $ [Char]
    "" [Char]
    -> (Key, Key, Key, Key, (Area, Fence, Area), (Area, Fence, Area))
    -> [Char]
    forall v. Show v => [Char] -> v -> [Char]
    `showFailure` (Key
    sx, Key
    sy, Key
    tx, Key
    ty, (Area, Fence, Area)
    s3, (Area, Fence, Area)
    t3)
            | otherwise = assert (sgy1 == tgy0) $
              let y0 = if Key
    sgx0 Key -> Key -> Bool
    forall a. Ord a => a -> a -> Bool
    <= Key
    tx Bool -> Bool -> Bool
    && Key
    tx Key -> Key -> Bool
    forall a. Ord a => a -> a -> Bool
    <= Key
    sgx1 then Key
    soy1 Key -> Key -> Key
    forall a. Num a => a -> a -> a
    + Key
    1 else Key
    sgy1
                  y1 = if Key
    tgx0 Key -> Key -> Bool
    forall a. Ord a => a -> a -> Bool
    <= Key
    sx Bool -> Bool -> Bool
    && Key
    sx Key -> Key -> Bool
    forall a. Ord a => a -> a -> Bool
    <= Key
    tgx1 then Key
    toy0 Key -> Key -> Key
    forall a. Num a => a -> a -> a
    - Key
    1 else Key
    sgy1
              in case toArea (min sx tx, y0, max sx tx, y1) of
                Just Area
    a -> (HV
    Vert, Area
    a, Key -> Key -> Point
    Point Key
    sx (Key
    say1 Key -> Key -> Key
    forall a. Num a => a -> a -> a
    + Key
    1), Key -> Key -> Point
    Point Key
    tx (Key
    tay0 Key -> Key -> Key
    forall a. Num a => a -> a -> a
    - Key
    1))
                Maybe Area
    Nothing -> [Char] -> (HV, Area, Point, Point)
    forall a. HasCallStack => [Char] -> a
    error ([Char] -> (HV, Area, Point, Point))
    -> [Char] -> (HV, Area, Point, Point)
    forall a b. (a -> b) -> a -> b
    $ [Char]
    "" [Char]
    -> (Key, Key, Key, Key, (Area, Fence, Area), (Area, Fence, Area))
    -> [Char]
    forall v. Show v => [Char] -> v -> [Char]
    `showFailure` (Key
    sx, Key
    sy, Key
    tx, Key
    ty, (Area, Fence, Area)
    s3, (Area, Fence, Area)
    t3)
          nin Point
    p = Bool -> Bool
    not (Bool -> Bool) -> Bool -> Bool
    forall a b. (a -> b) -> a -> b
    $ Area -> Point -> Bool
    inside Area
    sa Point
    p Bool -> Bool -> Bool
    || Area -> Point -> Bool
    inside Area
    ta Point
    p
          !_A = Bool -> () -> ()
    forall a. HasCallStack => Bool -> a -> a
    assert (Bool
    sslim Bool -> Bool -> Bool
    || Bool
    tslim
                        Bool -> Bool -> Bool
    || (Point -> Bool) -> [Point] -> Bool
    forall v. Show v => (v -> Bool) -> [v] -> Bool
    allB Point -> Bool
    nin [Point
    p0, Point
    p1] Bool
    -> (Key, Key, Key, Key, (Area, Fence, Area), (Area, Fence, Area))
    -> Bool
    forall v. Show v => Bool -> v -> Bool
    `blame` (Key
    sx, Key
    sy, Key
    tx, Key
    ty, (Area, Fence, Area)
    s3, (Area, Fence, Area)
    t3)) ()
      cor@(c1, c2, c3, c4) <- mkCorridor hv p0 (sa == so) p1 (ta == to) area
      let !_A2 = Bool -> () -> ()
    forall a. HasCallStack => Bool -> a -> a
    assert (Bool
    sslim Bool -> Bool -> Bool
    || Bool
    tslim Bool -> Bool -> Bool
    || (Point -> Bool) -> [Point] -> Bool
    forall v. Show v => (v -> Bool) -> [v] -> Bool
    allB Point -> Bool
    nin [Point
    c1, Point
    c2, Point
    c3, Point
    c4]
                         Bool
    -> (Corridor, Key, Key, Key, Key, (Area, Fence, Area),
        (Area, Fence, Area))
    -> Bool
    forall v. Show v => Bool -> v -> Bool
    `blame` (Corridor
    cor, Key
    sx, Key
    sy, Key
    tx, Key
    ty, (Area, Fence, Area)
    s3, (Area, Fence, Area)
    t3)) ()
      return $ Just cor

    borderPlace :: Area -> Fence -> (Area, Area, Bool)
    borderPlace :: Area -> Fence -> (Area, Area, Bool)
    borderPlace Area
    qarea Fence
    pfence = case Fence
    pfence of
      Fence
    FWall -> (Area
    qarea, Area -> Area
    expand Area
    qarea, Bool
    False)
      Fence
    FFloor  -> (Area
    qarea, Area
    qarea, Bool
    False)
      Fence
    FGround -> (Area
    qarea, Area
    qarea, Bool
    False)
      Fence
    FNone -> case Area -> Maybe Area
    shrink Area
    qarea of
        Maybe Area
    Nothing -> (Area
    qarea, Area
    qarea, Bool
    True)
        Just Area
    sr -> (Area
    sr, Area
    qarea, Bool
    False)

    data SpecialArea =
        SpecialArea Area
      | SpecialFixed Point (Freqs PlaceKind) Area
      | SpecialMerged SpecialArea Point
      deriving Key -> SpecialArea -> ShowS
    [SpecialArea] -> ShowS
    SpecialArea -> [Char]
    (Key -> SpecialArea -> ShowS)
    -> (SpecialArea -> [Char])
    -> ([SpecialArea] -> ShowS)
    -> Show SpecialArea
    forall a.
    (Key -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
    $cshowsPrec :: Key -> SpecialArea -> ShowS
    showsPrec :: Key -> SpecialArea -> ShowS
    $cshow :: SpecialArea -> [Char]
    show :: SpecialArea -> [Char]
    $cshowList :: [SpecialArea] -> ShowS
    showList :: [SpecialArea] -> ShowS
    Show

    -- | Divide uniformly a larger area into the given number of smaller areas
    -- overlapping at the edges.
    --
    -- The list of fixed centers (some important points inside)
    -- of (non-overlapping) areas is given. Incorporate those,
    -- with as little disruption, as possible.
    -- Assume each of four boundaries of the cave are covered by a fixed centre.
    grid :: EM.EnumMap Point (Freqs PlaceKind) -> [Point] -> Area -> (X, Y)
         -> ((X, Y), EM.EnumMap Point SpecialArea)
    grid :: EnumMap Point (Freqs PlaceKind)
    -> [Point]
    -> Area
    -> (Key, Key)
    -> ((Key, Key), EnumMap Point SpecialArea)
    grid EnumMap Point (Freqs PlaceKind)
    fixedCenters [Point]
    boot Area
    area (Key, Key)
    cellSize =
      let (Key
    x0, Key
    y0, Key
    x1, Key
    y1) = Area -> (Key, Key, Key, Key)
    fromArea Area
    area
          f :: Key -> Key -> Key -> Key -> [Key] -> [(Key, Key, Maybe Key)]
    f Key
    zsize Key
    z1 Key
    n Key
    prev (Key
    c1 : Key
    c2 : [Key]
    rest) =
            let len :: Key
    len = Key
    c2 Key -> Key -> Key
    forall a. Num a => a -> a -> a
    - Key
    c1
                cn :: Key
    cn = Key
    len Key -> Key -> Key
    forall a. Num a => a -> a -> a
    * Key
    n Key -> Key -> Key
    forall a. Integral a => a -> a -> a
    `div` Key
    zsize
            in -- traceShow ( zsize, z1, n, prev, len, cn
               --           , len `div` max 1 (2 * cn) ) $
               if Key
    cn Key -> Key -> Bool
    forall a. Ord a => a -> a -> Bool
    < Key
    2
               then let mid1 :: Key
    mid1 = (Key
    c1 Key -> Key -> Key
    forall a. Num a => a -> a -> a
    + Key
    c2) Key -> Key -> Key
    forall a. Integral a => a -> a -> a
    `div` Key
    2
                        mid2 :: Key
    mid2 = (Key
    c1 Key -> Key -> Key
    forall a. Num a => a -> a -> a
    + Key
    c2) Key -> Key -> Key
    forall a. Integral a => a -> a -> a
    `divUp` Key
    2
                        mid :: Key
    mid = if Key
    mid1 Key -> Key -> Key
    forall a. Num a => a -> a -> a
    - Key
    prev Key -> Key -> Bool
    forall a. Ord a => a -> a -> Bool
    > Key
    4 then Key
    mid1 else Key
    mid2
                    in (Key
    prev, Key
    mid, Key -> Maybe Key
    forall a. a -> Maybe a
    Just Key
    c1) (Key, Key, Maybe Key)
    -> [(Key, Key, Maybe Key)] -> [(Key, Key, Maybe Key)]
    forall a. a -> [a] -> [a]
    : Key -> Key -> Key -> Key -> [Key] -> [(Key, Key, Maybe Key)]
    f Key
    zsize Key
    z1 Key
    n Key
    mid (Key
    c2 Key -> [Key] -> [Key]
    forall a. a -> [a] -> [a]
    : [Key]
    rest)
               else (Key
    prev, Key
    c1 Key -> Key -> Key
    forall a. Num a => a -> a -> a
    + Key
    len Key -> Key -> Key
    forall a. Integral a => a -> a -> a
    `div` (Key
    2 Key -> Key -> Key
    forall a. Num a => a -> a -> a
    * Key
    cn), Key -> Maybe Key
    forall a. a -> Maybe a
    Just Key
    c1)
                    (Key, Key, Maybe Key)
    -> [(Key, Key, Maybe Key)] -> [(Key, Key, Maybe Key)]
    forall a. a -> [a] -> [a]
    : [ ( Key
    c1 Key -> Key -> Key
    forall a. Num a => a -> a -> a
    + Key
    len Key -> Key -> Key
    forall a. Num a => a -> a -> a
    * (Key
    2 Key -> Key -> Key
    forall a. Num a => a -> a -> a
    * Key
    z Key -> Key -> Key
    forall a. Num a => a -> a -> a
    - Key
    1) Key -> Key -> Key
    forall a. Integral a => a -> a -> a
    `div` (Key
    2 Key -> Key -> Key
    forall a. Num a => a -> a -> a
    * Key
    cn)
                        , Key
    c1 Key -> Key -> Key
    forall a. Num a => a -> a -> a
    + Key
    len Key -> Key -> Key
    forall a. Num a => a -> a -> a
    * (Key
    2 Key -> Key -> Key
    forall a. Num a => a -> a -> a
    * Key
    z Key -> Key -> Key
    forall a. Num a => a -> a -> a
    + Key
    1) Key -> Key -> Key
    forall a. Integral a => a -> a -> a
    `div` (Key
    2 Key -> Key -> Key
    forall a. Num a => a -> a -> a
    * Key
    cn)
                        , Maybe Key
    forall a. Maybe a
    Nothing )
                      | Key
    z <- [Key
    1 .. Key
    cn Key -> Key -> Key
    forall a. Num a => a -> a -> a
    - Key
    1] ]
                    [(Key, Key, Maybe Key)]
    -> [(Key, Key, Maybe Key)] -> [(Key, Key, Maybe Key)]
    forall a. [a] -> [a] -> [a]
    ++ Key -> Key -> Key -> Key -> [Key] -> [(Key, Key, Maybe Key)]
    f Key
    zsize Key
    z1 Key
    n (Key
    c1 Key -> Key -> Key
    forall a. Num a => a -> a -> a
    + Key
    len Key -> Key -> Key
    forall a. Num a => a -> a -> a
    * (Key
    2 Key -> Key -> Key
    forall a. Num a => a -> a -> a
    * Key
    cn Key -> Key -> Key
    forall a. Num a => a -> a -> a
    - Key
    1) Key -> Key -> Key
    forall a. Integral a => a -> a -> a
    `div` (Key
    2 Key -> Key -> Key
    forall a. Num a => a -> a -> a
    * Key
    cn))
                         (Key
    c2 Key -> [Key] -> [Key]
    forall a. a -> [a] -> [a]
    : [Key]
    rest)
          f Key
    _ Key
    z1 Key
    _ Key
    prev [Key
    c1] = [(Key
    prev, Key
    z1, Key -> Maybe Key
    forall a. a -> Maybe a
    Just Key
    c1)]
          f Key
    _ Key
    _ Key
    _ Key
    _ [] = [Char] -> [(Key, Key, Maybe Key)]
    forall a. HasCallStack => [Char] -> a
    error ([Char] -> [(Key, Key, Maybe Key)])
    -> [Char] -> [(Key, Key, Maybe Key)]
    forall a b. (a -> b) -> a -> b
    $ [Char]
    "empty list of centers" [Char] -> EnumMap Point (Freqs PlaceKind) -> [Char]
    forall v. Show v => [Char] -> v -> [Char]
    `showFailure` EnumMap Point (Freqs PlaceKind)
    fixedCenters
          (IntSet
    xCenters, IntSet
    yCenters) = [Key] -> IntSet
    IS.fromList ([Key] -> IntSet)
    -> ([Key] -> IntSet) -> ([Key], [Key]) -> (IntSet, IntSet)
    forall b c b' c'. (b -> c) -> (b' -> c') -> (b, b') -> (c, c')
    forall (a :: * -> * -> *) b c b' c'.
    Arrow a =>
    a b c -> a b' c' -> a (b, b') (c, c')
    *** [Key] -> IntSet
    IS.fromList
                                 (([Key], [Key]) -> (IntSet, IntSet))
    -> ([Key], [Key]) -> (IntSet, IntSet)
    forall a b. (a -> b) -> a -> b
    $ [(Key, Key)] -> ([Key], [Key])
    forall a b. [(a, b)] -> ([a], [b])
    unzip ([(Key, Key)] -> ([Key], [Key])) -> [(Key, Key)] -> ([Key], [Key])
    forall a b. (a -> b) -> a -> b
    $ (Point -> (Key, Key)) -> [Point] -> [(Key, Key)]
    forall a b. (a -> b) -> [a] -> [b]
    map (Point -> Key
    px (Point -> Key) -> (Point -> Key) -> Point -> (Key, Key)
    forall b c c'. (b -> c) -> (b -> c') -> b -> (c, c')
    forall (a :: * -> * -> *) b c c'.
    Arrow a =>
    a b c -> a b c' -> a b (c, c')
    &&& Point -> Key
    py) ([Point] -> [(Key, Key)]) -> [Point] -> [(Key, Key)]
    forall a b. (a -> b) -> a -> b
    $ EnumMap Point (Freqs PlaceKind) -> [Point]
    forall k a. Enum k => EnumMap k a -> [k]
    EM.keys EnumMap Point (Freqs PlaceKind)
    fixedCenters
          distFromIS :: IntSet -> Key -> Key
    distFromIS IntSet
    is Key
    z =
            - [Key] -> Key
    forall a. Ord a => [a] -> a
    forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
    minimum (Key
    forall a. Bounded a => a
    maxBound Key -> [Key] -> [Key]
    forall a. a -> [a] -> [a]
    : (Key -> Key) -> [Key] -> [Key]
    forall a b. (a -> b) -> [a] -> [b]
    map (\Key
    i -> Key -> Key
    forall a. Num a => a -> a
    abs (Key
    i Key -> Key -> Key
    forall a. Num a => a -> a -> a
    - Key
    z)) (IntSet -> [Key]
    IS.toList IntSet
    is))
          xboot :: [Key]
    xboot = [Key] -> [Key]
    forall a. Eq a => [a] -> [a]
    nub ([Key] -> [Key]) -> [Key] -> [Key]
    forall a b. (a -> b) -> a -> b
    $ (Key -> Key) -> [Key] -> [Key]
    forall b a. Ord b => (a -> b) -> [a] -> [a]
    sortOn (IntSet -> Key -> Key
    distFromIS IntSet
    xCenters)
                  ([Key] -> [Key]) -> [Key] -> [Key]
    forall a b. (a -> b) -> a -> b
    $ (Key -> Bool) -> [Key] -> [Key]
    forall a. (a -> Bool) -> [a] -> [a]
    filter (Key -> IntSet -> Bool
    `IS.notMember` IntSet
    xCenters) ([Key] -> [Key]) -> [Key] -> [Key]
    forall a b. (a -> b) -> a -> b
    $ (Point -> Key) -> [Point] -> [Key]
    forall a b. (a -> b) -> [a] -> [b]
    map Point -> Key
    px [Point]
    boot
          yboot :: [Key]
    yboot = [Key] -> [Key]
    forall a. Eq a => [a] -> [a]
    nub ([Key] -> [Key]) -> [Key] -> [Key]
    forall a b. (a -> b) -> a -> b
    $ (Key -> Key) -> [Key] -> [Key]
    forall b a. Ord b => (a -> b) -> [a] -> [a]
    sortOn (IntSet -> Key -> Key
    distFromIS IntSet
    yCenters)
                  ([Key] -> [Key]) -> [Key] -> [Key]
    forall a b. (a -> b) -> a -> b
    $ (Key -> Bool) -> [Key] -> [Key]
    forall a. (a -> Bool) -> [a] -> [a]
    filter (Key -> IntSet -> Bool
    `IS.notMember` IntSet
    yCenters) ([Key] -> [Key]) -> [Key] -> [Key]
    forall a b. (a -> b) -> a -> b
    $ (Point -> Key) -> [Point] -> [Key]
    forall a b. (a -> b) -> [a] -> [b]
    map Point -> Key
    py [Point]
    boot
          -- Don't let boots ignore cell size too much, esp. in small caves.
          xcellsInArea :: Key
    xcellsInArea = (Key
    x1 Key -> Key -> Key
    forall a. Num a => a -> a -> a
    - Key
    x0 Key -> Key -> Key
    forall a. Num a => a -> a -> a
    + Key
    1) Key -> Key -> Key
    forall a. Integral a => a -> a -> a
    `div` (Key, Key) -> Key
    forall a b. (a, b) -> a
    fst (Key, Key)
    cellSize
          ycellsInArea :: Key
    ycellsInArea = (Key
    y1 Key -> Key -> Key
    forall a. Num a => a -> a -> a
    - Key
    y0 Key -> Key -> Key
    forall a. Num a => a -> a -> a
    + Key
    1) Key -> Key -> Key
    forall a. Integral a => a -> a -> a
    `div` (Key, Key) -> Key
    forall a b. (a, b) -> b
    snd (Key, Key)
    cellSize
          xbootN :: Key
    xbootN = Bool -> Key -> Key
    forall a. HasCallStack => Bool -> a -> a
    assert (Key
    xcellsInArea Key -> Key -> Bool
    forall a. Ord a => a -> a -> Bool
    > Key
    0) (Key -> Key) -> Key -> Key
    forall a b. (a -> b) -> a -> b
    $ Key
    xcellsInArea Key -> Key -> Key
    forall a. Num a => a -> a -> a
    - IntSet -> Key
    IS.size IntSet
    xCenters
          ybootN :: Key
    ybootN = Bool -> Key -> Key
    forall a. HasCallStack => Bool -> a -> a
    assert (Key
    ycellsInArea Key -> Key -> Bool
    forall a. Ord a => a -> a -> Bool
    > Key
    0) (Key -> Key) -> Key -> Key
    forall a b. (a -> b) -> a -> b
    $ Key
    ycellsInArea Key -> Key -> Key
    forall a. Num a => a -> a -> a
    - IntSet -> Key
    IS.size IntSet
    yCenters
          xset :: IntSet
    xset = IntSet
    xCenters IntSet -> IntSet -> IntSet
    `IS.union` [Key] -> IntSet
    IS.fromList (Key -> [Key] -> [Key]
    forall a. Key -> [a] -> [a]
    take Key
    xbootN [Key]
    xboot)
          yset :: IntSet
    yset = IntSet
    yCenters IntSet -> IntSet -> IntSet
    `IS.union` [Key] -> IntSet
    IS.fromList (Key -> [Key] -> [Key]
    forall a. Key -> [a] -> [a]
    take Key
    ybootN [Key]
    yboot)
          xsize :: Key
    xsize = IntSet -> Key
    IS.findMax IntSet
    xset Key -> Key -> Key
    forall a. Num a => a -> a -> a
    - IntSet -> Key
    IS.findMin IntSet
    xset
          ysize :: Key
    ysize = IntSet -> Key
    IS.findMax IntSet
    yset Key -> Key -> Key
    forall a. Num a => a -> a -> a
    - IntSet -> Key
    IS.findMin IntSet
    yset
          -- This is precisely how the cave will be divided among places,
          -- if there are no fixed centres except at boot coordinates.
          -- In any case, places, except for at boot points and fixed centres,
          -- are guaranteed at least the rolled minimal size of their
          -- enclosing cell (with one shared fence). Fixed centres are guaranteed
          -- a size between the cave cell size and the one implied by their
          -- placement wrt to cave fence and other fixed centers.
          lgrid :: (Key, Key)
    lgrid = ( Key
    xsize Key -> Key -> Key
    forall a. Integral a => a -> a -> a
    `div` (Key, Key) -> Key
    forall a b. (a, b) -> a
    fst (Key, Key)
    cellSize
                  , Key
    ysize Key -> Key -> Key
    forall a. Integral a => a -> a -> a
    `div` (Key, Key) -> Key
    forall a b. (a, b) -> b
    snd (Key, Key)
    cellSize )
          xallSegments :: [(Key, (Key, Key, Maybe Key))]
    xallSegments = [Key] -> [(Key, Key, Maybe Key)] -> [(Key, (Key, Key, Maybe Key))]
    forall a b. [a] -> [b] -> [(a, b)]
    zip [Key
    0..] ([(Key, Key, Maybe Key)] -> [(Key, (Key, Key, Maybe Key))])
    -> [(Key, Key, Maybe Key)] -> [(Key, (Key, Key, Maybe Key))]
    forall a b. (a -> b) -> a -> b
    $ Key -> Key -> Key -> Key -> [Key] -> [(Key, Key, Maybe Key)]
    f Key
    xsize Key
    x1 ((Key, Key) -> Key
    forall a b. (a, b) -> a
    fst (Key, Key)
    lgrid) Key
    x0 ([Key] -> [(Key, Key, Maybe Key)])
    -> [Key] -> [(Key, Key, Maybe Key)]
    forall a b. (a -> b) -> a -> b
    $ IntSet -> [Key]
    IS.toList IntSet
    xset
          yallSegments :: [(Key, (Key, Key, Maybe Key))]
    yallSegments = [Key] -> [(Key, Key, Maybe Key)] -> [(Key, (Key, Key, Maybe Key))]
    forall a b. [a] -> [b] -> [(a, b)]
    zip [Key
    0..] ([(Key, Key, Maybe Key)] -> [(Key, (Key, Key, Maybe Key))])
    -> [(Key, Key, Maybe Key)] -> [(Key, (Key, Key, Maybe Key))]
    forall a b. (a -> b) -> a -> b
    $ Key -> Key -> Key -> Key -> [Key] -> [(Key, Key, Maybe Key)]
    f Key
    ysize Key
    y1 ((Key, Key) -> Key
    forall a b. (a, b) -> b
    snd (Key, Key)
    lgrid) Key
    y0 ([Key] -> [(Key, Key, Maybe Key)])
    -> [Key] -> [(Key, Key, Maybe Key)]
    forall a b. (a -> b) -> a -> b
    $ IntSet -> [Key]
    IS.toList IntSet
    yset
      in -- traceShow (xallSegments, yallSegments) $
         ( ([(Key, (Key, Key, Maybe Key))] -> Key
    forall a. [a] -> Key
    length [(Key, (Key, Key, Maybe Key))]
    xallSegments, [(Key, (Key, Key, Maybe Key))] -> Key
    forall a. [a] -> Key
    length [(Key, (Key, Key, Maybe Key))]
    yallSegments)
         , [(Point, SpecialArea)] -> EnumMap Point SpecialArea
    forall k a. Enum k => [(k, a)] -> EnumMap k a
    EM.fromDistinctAscList
             [ ( Key -> Key -> Point
    Point Key
    x Key
    y
               , case (Maybe Key
    mcx, Maybe Key
    mcy) of
                   (Just Key
    cx, Just Key
    cy) ->
                     case Point -> EnumMap Point (Freqs PlaceKind) -> Maybe (Freqs PlaceKind)
    forall k a. Enum k => k -> EnumMap k a -> Maybe a
    EM.lookup (Key -> Key -> Point
    Point Key
    cx Key
    cy) EnumMap Point (Freqs PlaceKind)
    fixedCenters of
                       Maybe (Freqs PlaceKind)
    Nothing -> Area -> SpecialArea
    SpecialArea Area
    sarea
                       Just Freqs PlaceKind
    placeFreq -> Point -> Freqs PlaceKind -> Area -> SpecialArea
    SpecialFixed (Key -> Key -> Point
    Point Key
    cx Key
    cy) Freqs PlaceKind
    placeFreq Area
    sarea
                   (Maybe Key, Maybe Key)
    _ -> Area -> SpecialArea
    SpecialArea Area
    sarea )
             | (Key
    y, (Key
    cy0, Key
    cy1, Maybe Key
    mcy)) <- [(Key, (Key, Key, Maybe Key))]
    yallSegments
             , (Key
    x, (Key
    cx0, Key
    cx1, Maybe Key
    mcx)) <- [(Key, (Key, Key, Maybe Key))]
    xallSegments
             , let sarea :: Area
    sarea = Area -> Maybe Area -> Area
    forall a. a -> Maybe a -> a
    fromMaybe ([Char] -> Area
    forall a. HasCallStack => [Char] -> a
    error ([Char] -> Area) -> [Char] -> Area
    forall a b. (a -> b) -> a -> b
    $ [Char]
    "" [Char] -> (Key, Key) -> [Char]
    forall v. Show v => [Char] -> v -> [Char]
    `showFailure` (Key
    x, Key
    y))
                           (Maybe Area -> Area) -> Maybe Area -> Area
    forall a b. (a -> b) -> a -> b
    $ (Key, Key, Key, Key) -> Maybe Area
    toArea (Key
    cx0, Key
    cy0, Key
    cx1, Key
    cy1) ] )