    {-# LANGUAGE RankNTypes #-}
    -- | Generation of places from place kinds.
    module Game.LambdaHack.Server.DungeonGen.Place
      ( Place(..), TileMapEM, buildPlace, isChancePos, buildFenceRnd
    #ifdef EXPOSE_INTERNAL
        -- * Internal operations
      , placeCheck, interiorArea, pover, buildFence, buildFenceMap
      , tilePlace
    #endif
      ) where

    import Prelude ()

    import Game.LambdaHack.Core.Prelude

    import qualified Data.Bits as Bits
    import qualified Data.EnumMap.Strict as EM
    import qualified Data.Text as T
    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.Content.CaveKind
    import           Game.LambdaHack.Content.PlaceKind
    import           Game.LambdaHack.Content.TileKind (TileKind)
    import qualified Game.LambdaHack.Content.TileKind as TK
    import qualified Game.LambdaHack.Core.Dice as Dice
    import           Game.LambdaHack.Core.Frequency
    import           Game.LambdaHack.Core.Random
    import           Game.LambdaHack.Definition.Defs
    import           Game.LambdaHack.Server.DungeonGen.AreaRnd

    -- | The map of tile kinds in a place (and generally anywhere in a cave).
    -- The map is sparse. The default tile that eventually fills the empty spaces
    -- is specified in the cave kind specification with @cdefTile@.
    type TileMapEM = EM.EnumMap Point (ContentId TileKind)

    -- | The parameters of a place. All are immutable and rolled and fixed
    -- at the time when a place is generated.
    data Place = Place
      { Place -> ContentId PlaceKind
    qkind  :: ContentId PlaceKind
      , Place -> Area
    qarea  :: Area
      , Place -> TileMapEM
    qmap   :: TileMapEM
      , Place -> TileMapEM
    qfence :: TileMapEM
      }
      deriving X -> Place -> ShowS
    [Place] -> ShowS
    Place -> String
    (X -> Place -> ShowS)
    -> (Place -> String) -> ([Place] -> ShowS) -> Show Place
    forall a.
    (X -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
    $cshowsPrec :: X -> Place -> ShowS
    showsPrec :: X -> Place -> ShowS
    $cshow :: Place -> String
    show :: Place -> String
    $cshowList :: [Place] -> ShowS
    showList :: [Place] -> ShowS
    Show

    -- | For @CAlternate@ tiling, require the place be comprised
    -- of an even number of whole corners, with exactly one square
    -- overlap between consecutive coners and no trimming.
    -- For other tiling methods, check that the area is large enough for tiling
    -- the corner twice in each direction, with a possible one row/column overlap.
    placeCheck :: Area       -- ^ the area to fill
               -> PlaceKind  -- ^ the kind of place to construct
               -> Bool
    placeCheck :: Area -> PlaceKind -> Bool
    placeCheck Area
    r pk :: PlaceKind
    pk@PlaceKind{Rarity
    Freqs PlaceKind
    [Text]
    EnumMap Char (GroupName TileKind)
    Text
    Fence
    Cover
    pname :: Text
    pfreq :: Freqs PlaceKind
    prarity :: Rarity
    pcover :: Cover
    pfence :: Fence
    ptopLeft :: [Text]
    plegendDark :: EnumMap Char (GroupName TileKind)
    plegendLit :: EnumMap Char (GroupName TileKind)
    plegendLit :: PlaceKind -> EnumMap Char (GroupName TileKind)
    plegendDark :: PlaceKind -> EnumMap Char (GroupName TileKind)
    ptopLeft :: PlaceKind -> [Text]
    pfence :: PlaceKind -> Fence
    pcover :: PlaceKind -> Cover
    prarity :: PlaceKind -> Rarity
    pfreq :: PlaceKind -> Freqs PlaceKind
    pname :: PlaceKind -> Text
    ..} =
      case PlaceKind -> Area -> Maybe Area
    interiorArea PlaceKind
    pk Area
    r of
        Maybe Area
    Nothing -> Bool
    False
        Just Area
    area ->
          let (Point
    _, X
    xspan, X
    yspan) = Area -> (Point, X, X)
    spanArea Area
    area
              dxcorner :: X
    dxcorner = case [Text]
    ptopLeft of [] -> X
    0 ; Text
    l : [Text]
    _ -> Text -> X
    T.length Text
    l
              dycorner :: X
    dycorner = [Text] -> X
    forall a. [a] -> X
    length [Text]
    ptopLeft
              wholeOverlapped :: a -> a -> Bool
    wholeOverlapped a
    d a
    dcorner = a
    d a -> a -> Bool
    forall a. Ord a => a -> a -> Bool
    > a
    1 Bool -> Bool -> Bool
    && a
    dcorner a -> a -> Bool
    forall a. Ord a => a -> a -> Bool
    > a
    1 Bool -> Bool -> Bool
    &&
                                          (a
    d a -> a -> a
    forall a. Num a => a -> a -> a
    - a
    1) a -> a -> a
    forall a. Integral a => a -> a -> a
    `mod` (a
    2 a -> a -> a
    forall a. Num a => a -> a -> a
    * (a
    dcorner a -> a -> a
    forall a. Num a => a -> a -> a
    - a
    1)) a -> a -> Bool
    forall a. Eq a => a -> a -> Bool
    == a
    0
              largeEnough :: Bool
    largeEnough = X
    xspan X -> X -> Bool
    forall a. Ord a => a -> a -> Bool
    >= X
    2 X -> X -> X
    forall a. Num a => a -> a -> a
    * X
    dxcorner X -> X -> X
    forall a. Num a => a -> a -> a
    - X
    1 Bool -> Bool -> Bool
    && X
    yspan X -> X -> Bool
    forall a. Ord a => a -> a -> Bool
    >= X
    2 X -> X -> X
    forall a. Num a => a -> a -> a
    * X
    dycorner X -> X -> X
    forall a. Num a => a -> a -> a
    - X
    1
          in case Cover
    pcover of
            Cover
    CAlternate -> X -> X -> Bool
    forall {a}. Integral a => a -> a -> Bool
    wholeOverlapped X
    xspan X
    dxcorner Bool -> Bool -> Bool
    &&
                          X -> X -> Bool
    forall {a}. Integral a => a -> a -> Bool
    wholeOverlapped X
    yspan X
    dycorner
            Cover
    CStretch   -> Bool
    largeEnough
            Cover
    CReflect   -> Bool
    largeEnough
            Cover
    CVerbatim  -> Bool
    True
            Cover
    CMirror    -> Bool
    True

    -- | Calculate interior room area according to fence type, based on the
    -- total area for the room and it's fence. This is used for checking
    -- if the room fits in the area, for digging up the place and the fence
    -- and for deciding if the room is dark or lit later in the dungeon
    -- generation process.
    interiorArea :: PlaceKind -> Area -> Maybe Area
    interiorArea :: PlaceKind -> Area -> Maybe Area
    interiorArea PlaceKind
    kr Area
    r =
      let requiredForFence :: X
    requiredForFence = case PlaceKind -> Fence
    pfence PlaceKind
    kr of
            Fence
    FWall   -> X
    1
            Fence
    FFloor  -> X
    1
            Fence
    FGround -> X
    1
            Fence
    FNone   -> X
    0
      in if PlaceKind -> Cover
    pcover PlaceKind
    kr Cover -> [Cover] -> Bool
    forall a. Eq a => a -> [a] -> Bool
    forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
    `elem` [Cover
    CVerbatim, Cover
    CMirror]
         then let (Point X
    x0 X
    y0, X
    xspan, X
    yspan) = Area -> (Point, X, X)
    spanArea Area
    r
                  dx :: X
    dx = case PlaceKind -> [Text]
    ptopLeft PlaceKind
    kr of
                    [] -> String -> X
    forall a. HasCallStack => String -> a
    error (String -> X) -> String -> X
    forall a b. (a -> b) -> a -> b
    $ String
    "" String -> PlaceKind -> String
    forall v. Show v => String -> v -> String
    `showFailure` PlaceKind
    kr
                    Text
    l : [Text]
    _ -> Text -> X
    T.length Text
    l
                  dy :: X
    dy = [Text] -> X
    forall a. [a] -> X
    length ([Text] -> X) -> [Text] -> X
    forall a b. (a -> b) -> a -> b
    $ PlaceKind -> [Text]
    ptopLeft PlaceKind
    kr
                  mx :: X
    mx = (X
    xspan X -> X -> X
    forall a. Num a => a -> a -> a
    - X
    dx) X -> X -> X
    forall a. Integral a => a -> a -> a
    `div` X
    2
                  my :: X
    my = (X
    yspan X -> X -> X
    forall a. Num a => a -> a -> a
    - X
    dy) X -> X -> X
    forall a. Integral a => a -> a -> a
    `div` X
    2
              in if X
    mx X -> X -> Bool
    forall a. Ord a => a -> a -> Bool
    < X
    requiredForFence Bool -> Bool -> Bool
    || X
    my X -> X -> Bool
    forall a. Ord a => a -> a -> Bool
    < X
    requiredForFence
                 then Maybe Area
    forall a. Maybe a
    Nothing
                 else (X, X, X, X) -> Maybe Area
    toArea (X
    x0 X -> X -> X
    forall a. Num a => a -> a -> a
    + X
    mx, X
    y0 X -> X -> X
    forall a. Num a => a -> a -> a
    + X
    my, X
    x0 X -> X -> X
    forall a. Num a => a -> a -> a
    + X
    mx X -> X -> X
    forall a. Num a => a -> a -> a
    + X
    dx X -> X -> X
    forall a. Num a => a -> a -> a
    - X
    1, X
    y0 X -> X -> X
    forall a. Num a => a -> a -> a
    + X
    my X -> X -> X
    forall a. Num a => a -> a -> a
    + X
    dy X -> X -> X
    forall a. Num a => a -> a -> a
    - X
    1)
         else case X
    requiredForFence of
           X
    0 -> Area -> Maybe Area
    forall a. a -> Maybe a
    Just Area
    r
           X
    1 -> Area -> Maybe Area
    shrink Area
    r
           X
    _ -> String -> Maybe Area
    forall a. HasCallStack => String -> a
    error (String -> Maybe Area) -> String -> Maybe Area
    forall a b. (a -> b) -> a -> b
    $ String
    "" String -> PlaceKind -> String
    forall v. Show v => String -> v -> String
    `showFailure` PlaceKind
    kr

    -- | Given a few parameters, roll and construct a 'Place' datastructure
    -- and fill a cave section acccording to it.
    buildPlace :: COps                -- ^ the game content
               -> CaveKind            -- ^ current cave kind
               -> Bool                -- ^ whether the cave is dark
               -> ContentId TileKind  -- ^ dark fence tile, if fence hollow
               -> ContentId TileKind  -- ^ lit fence tile, if fence hollow
               -> Dice.AbsDepth       -- ^ current level depth
               -> Dice.AbsDepth       -- ^ absolute depth
               -> Word32              -- ^ secret tile seed
               -> Area                -- ^ whole area of the place, fence included
               -> Maybe Area          -- ^ whole inner area of the grid cell
               -> Freqs PlaceKind     -- ^ optional fixed place freq
               -> Rnd Place
    buildPlace :: COps
    -> CaveKind
    -> Bool
    -> ContentId TileKind
    -> ContentId TileKind
    -> AbsDepth
    -> AbsDepth
    -> Word32
    -> Area
    -> Maybe Area
    -> Freqs PlaceKind
    -> Rnd Place
    buildPlace cops :: COps
    cops@COps{ContentData PlaceKind
    coplace :: ContentData PlaceKind
    coplace :: COps -> ContentData PlaceKind
    coplace, TileSpeedup
    coTileSpeedup :: TileSpeedup
    coTileSpeedup :: COps -> TileSpeedup
    coTileSpeedup}
               kc :: CaveKind
    kc@CaveKind{Bool
    X
    [X]
    Freqs ItemKind
    Freqs PlaceKind
    Freqs CaveKind
    Chance
    Text
    DiceXY
    Dice
    GroupName TileKind
    InitSleep
    cname :: Text
    cfreq :: Freqs CaveKind
    cXminSize :: X
    cYminSize :: X
    ccellSize :: DiceXY
    cminPlaceSize :: DiceXY
    cmaxPlaceSize :: DiceXY
    cdarkOdds :: Dice
    cnightOdds :: Dice
    cauxConnects :: Chance
    cmaxVoid :: Chance
    cdoorChance :: Chance
    copenChance :: Chance
    chidden :: X
    cactorCoeff :: X
    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 :: X
    cmaxStairsNum :: Dice
    cescapeFreq :: Freqs PlaceKind
    cstairFreq :: Freqs PlaceKind
    cstairAllowed :: Freqs PlaceKind
    cskip :: [X]
    cinitSleep :: InitSleep
    cdesc :: Text
    cdesc :: CaveKind -> Text
    cinitSleep :: CaveKind -> InitSleep
    cskip :: CaveKind -> [X]
    cstairAllowed :: CaveKind -> Freqs PlaceKind
    cstairFreq :: CaveKind -> Freqs PlaceKind
    cescapeFreq :: CaveKind -> Freqs PlaceKind
    cmaxStairsNum :: CaveKind -> Dice
    cminStairDist :: CaveKind -> X
    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 -> X
    chidden :: CaveKind -> X
    copenChance :: CaveKind -> Chance
    cdoorChance :: CaveKind -> Chance
    cmaxVoid :: CaveKind -> Chance
    cauxConnects :: CaveKind -> Chance
    cnightOdds :: CaveKind -> Dice
    cdarkOdds :: CaveKind -> Dice
    cmaxPlaceSize :: CaveKind -> DiceXY
    cminPlaceSize :: CaveKind -> DiceXY
    ccellSize :: CaveKind -> DiceXY
    cYminSize :: CaveKind -> X
    cXminSize :: CaveKind -> X
    cfreq :: CaveKind -> Freqs CaveKind
    cname :: CaveKind -> Text
    ..} Bool
    dnight ContentId TileKind
    darkCorTile ContentId TileKind
    litCorTile
               levelDepth :: AbsDepth
    levelDepth@(Dice.AbsDepth X
    ldepth)
               totalDepth :: AbsDepth
    totalDepth@(Dice.AbsDepth X
    tdepth)
               Word32
    dsecret Area
    r Maybe Area
    minnerArea Freqs PlaceKind
    mplaceGroup = do
      let f :: X
    -> [(X, (ContentId PlaceKind, PlaceKind))]
    -> X
    -> ContentId PlaceKind
    -> PlaceKind
    -> [(X, (ContentId PlaceKind, PlaceKind))]
    f !X
    q ![(X, (ContentId PlaceKind, PlaceKind))]
    acc !X
    p !ContentId PlaceKind
    pk !PlaceKind
    kind =
            let rarity :: X
    rarity = X -> X -> Rarity -> X
    linearInterpolation X
    ldepth X
    tdepth (PlaceKind -> Rarity
    prarity PlaceKind
    kind)
                !fr :: X
    fr = X
    q X -> X -> X
    forall a. Num a => a -> a -> a
    * X
    p X -> X -> X
    forall a. Num a => a -> a -> a
    * X
    rarity
            in (X
    fr, (ContentId PlaceKind
    pk, PlaceKind
    kind)) (X, (ContentId PlaceKind, PlaceKind))
    -> [(X, (ContentId PlaceKind, PlaceKind))]
    -> [(X, (ContentId PlaceKind, PlaceKind))]
    forall a. a -> [a] -> [a]
    : [(X, (ContentId PlaceKind, PlaceKind))]
    acc
          g :: (GroupName PlaceKind, X) -> [(X, (ContentId PlaceKind, PlaceKind))]
    g (GroupName PlaceKind
    placeGroup, X
    q) = ContentData PlaceKind
    -> GroupName PlaceKind
    -> ([(X, (ContentId PlaceKind, PlaceKind))]
        -> X
        -> ContentId PlaceKind
        -> PlaceKind
        -> [(X, (ContentId PlaceKind, PlaceKind))])
    -> [(X, (ContentId PlaceKind, PlaceKind))]
    -> [(X, (ContentId PlaceKind, PlaceKind))]
    forall a b.
    ContentData a
    -> GroupName a -> (b -> X -> ContentId a -> a -> b) -> b -> b
    ofoldlGroup' ContentData PlaceKind
    coplace GroupName PlaceKind
    placeGroup (X
    -> [(X, (ContentId PlaceKind, PlaceKind))]
    -> X
    -> ContentId PlaceKind
    -> PlaceKind
    -> [(X, (ContentId PlaceKind, PlaceKind))]
    f X
    q) []
          pfreq :: Freqs PlaceKind
    pfreq = case Freqs PlaceKind
    mplaceGroup of
            [] -> Freqs PlaceKind
    cplaceFreq
            Freqs PlaceKind
    _ -> Freqs PlaceKind
    mplaceGroup
          placeFreq :: [(X, (ContentId PlaceKind, PlaceKind))]
    placeFreq = ((GroupName PlaceKind, X)
     -> [(X, (ContentId PlaceKind, PlaceKind))])
    -> Freqs PlaceKind -> [(X, (ContentId PlaceKind, PlaceKind))]
    forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
    concatMap (GroupName PlaceKind, X) -> [(X, (ContentId PlaceKind, PlaceKind))]
    g Freqs PlaceKind
    pfreq
          checkedFreq :: [(X, (ContentId PlaceKind, PlaceKind))]
    checkedFreq = ((X, (ContentId PlaceKind, PlaceKind)) -> Bool)
    -> [(X, (ContentId PlaceKind, PlaceKind))]
    -> [(X, (ContentId PlaceKind, PlaceKind))]
    forall a. (a -> Bool) -> [a] -> [a]
    filter (\(X
    _, (ContentId PlaceKind
    _, PlaceKind
    kind)) -> Area -> PlaceKind -> Bool
    placeCheck Area
    r PlaceKind
    kind) [(X, (ContentId PlaceKind, PlaceKind))]
    placeFreq
          freq :: Frequency (ContentId PlaceKind, PlaceKind)
    freq = Text
    -> [(X, (ContentId PlaceKind, PlaceKind))]
    -> Frequency (ContentId PlaceKind, PlaceKind)
    forall a. Text -> [(X, a)] -> Frequency a
    toFreq Text
    "buildPlace" [(X, (ContentId PlaceKind, PlaceKind))]
    checkedFreq
      let !_A :: ()
    _A = Bool -> () -> ()
    forall a. HasCallStack => Bool -> a -> a
    assert (Bool -> Bool
    not (Frequency (ContentId PlaceKind, PlaceKind) -> Bool
    forall a. Frequency a -> Bool
    nullFreq Frequency (ContentId PlaceKind, PlaceKind)
    freq) Bool
    -> ([(X, (ContentId PlaceKind, PlaceKind))],
        [(X, (ContentId PlaceKind, PlaceKind))], Area)
    -> Bool
    forall v. Show v => Bool -> v -> Bool
    `blame` ([(X, (ContentId PlaceKind, PlaceKind))]
    placeFreq, [(X, (ContentId PlaceKind, PlaceKind))]
    checkedFreq, Area
    r)) ()
      (qkind, kr) <- Frequency (ContentId PlaceKind, PlaceKind)
    -> Rnd (ContentId PlaceKind, PlaceKind)
    forall a. Show a => Frequency a -> Rnd a
    frequency Frequency (ContentId PlaceKind, PlaceKind)
    freq
      let smallPattern = PlaceKind -> Cover
    pcover PlaceKind
    kr Cover -> [Cover] -> Bool
    forall a. Eq a => a -> [a] -> Bool
    forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
    `elem` [Cover
    CVerbatim, Cover
    CMirror]
                         Bool -> Bool -> Bool
    && ([Text] -> X
    forall a. [a] -> X
    length (PlaceKind -> [Text]
    ptopLeft PlaceKind
    kr) X -> X -> Bool
    forall a. Ord a => a -> a -> Bool
    < X
    10
                             Bool -> Bool -> Bool
    || Text -> X
    T.length ([Text] -> Text
    forall a. HasCallStack => [a] -> a
    head (PlaceKind -> [Text]
    ptopLeft PlaceKind
    kr)) X -> X -> Bool
    forall a. Ord a => a -> a -> Bool
    < X
    10)
      -- Below we apply a heuristics to estimate if there are floor tiles
      -- in the place that are adjacent to floor tiles of the cave and so both
      -- should have the same lit condition.
      -- A false positive is walled staircases in LambdaHack, but it's OK.
      dark <- if cpassable
                 && not (dnight && Tile.isLit coTileSpeedup darkCorTile)
                      -- the colonnade can be illuminated just as the trail is
                 && (pfence kr `elem` [FFloor, FGround]
                     || pfence kr == FNone && smallPattern)
              then return dnight
              else oddsDice levelDepth totalDepth cdarkOdds
      rBetter <- case minnerArea of
        Just Area
    innerArea | PlaceKind -> Cover
    pcover PlaceKind
    kr Cover -> [Cover] -> Bool
    forall a. Eq a => a -> [a] -> Bool
    forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
    `elem` [Cover
    CVerbatim, Cover
    CMirror] -> do
          -- A hack: if a verbatim place was rolled, redo computing the area
          -- taking into account that often much smaller portion is taken by place.
          let requiredForFence :: X
    requiredForFence = case PlaceKind -> Fence
    pfence PlaceKind
    kr of
                Fence
    FWall   -> X
    1
                Fence
    FFloor  -> X
    1
                Fence
    FGround -> X
    1
                Fence
    FNone   -> X
    0
              sizeBetter :: (X, X)
    sizeBetter = ( X
    2 X -> X -> X
    forall a. Num a => a -> a -> a
    * X
    requiredForFence
                             X -> X -> X
    forall a. Num a => a -> a -> a
    + Text -> X
    T.length ([Text] -> Text
    forall a. HasCallStack => [a] -> a
    head (PlaceKind -> [Text]
    ptopLeft PlaceKind
    kr))
                           , X
    2 X -> X -> X
    forall a. Num a => a -> a -> a
    * X
    requiredForFence
                             X -> X -> X
    forall a. Num a => a -> a -> a
    + [Text] -> X
    forall a. [a] -> X
    length (PlaceKind -> [Text]
    ptopLeft PlaceKind
    kr) )
          (X, X) -> (X, X) -> Area -> StateT SMGen Identity Area
    mkRoom (X, X)
    sizeBetter (X, X)
    sizeBetter Area
    innerArea
        Maybe Area
    _ -> Area -> StateT SMGen Identity Area
    forall a. a -> StateT SMGen Identity a
    forall (m :: * -> *) a. Monad m => a -> m a
    return Area
    r
      let qarea = Area -> Maybe Area -> Area
    forall a. a -> Maybe a -> a
    fromMaybe (String -> Area
    forall a. HasCallStack => String -> a
    error (String -> Area) -> String -> Area
    forall a b. (a -> b) -> a -> b
    $ String
    "" String -> (PlaceKind, Area) -> String
    forall v. Show v => String -> v -> String
    `showFailure` (PlaceKind
    kr, Area
    r))
                  (Maybe Area -> Area) -> Maybe Area -> Area
    forall a b. (a -> b) -> a -> b
    $ PlaceKind -> Area -> Maybe Area
    interiorArea PlaceKind
    kr Area
    rBetter
          plegend = if Bool
    dark then PlaceKind -> EnumMap Char (GroupName TileKind)
    plegendDark PlaceKind
    kr else PlaceKind -> EnumMap Char (GroupName TileKind)
    plegendLit PlaceKind
    kr
      mOneIn <- pover cops plegend
      cmap <- tilePlace qarea kr
      let lookupOneIn :: Point -> Char -> ContentId TileKind
          lookupOneIn Point
    xy Char
    c =
            let tktk :: (Maybe (X, X, ContentId TileKind), ContentId TileKind)
    tktk = (Maybe (X, X, ContentId TileKind), ContentId TileKind)
    -> Char
    -> EnumMap
         Char (Maybe (X, X, ContentId TileKind), ContentId TileKind)
    -> (Maybe (X, X, ContentId TileKind), ContentId TileKind)
    forall k a. Enum k => a -> k -> EnumMap k a -> a
    EM.findWithDefault
                         (String -> (Maybe (X, X, ContentId TileKind), ContentId TileKind)
    forall a. HasCallStack => String -> a
    error (String -> (Maybe (X, X, ContentId TileKind), ContentId TileKind))
    -> String -> (Maybe (X, X, ContentId TileKind), ContentId TileKind)
    forall a b. (a -> b) -> a -> b
    $ String
    "" String
    -> (Char,
        EnumMap
          Char (Maybe (X, X, ContentId TileKind), ContentId TileKind))
    -> String
    forall v. Show v => String -> v -> String
    `showFailure` (Char
    c, EnumMap Char (Maybe (X, X, ContentId TileKind), ContentId TileKind)
    mOneIn)) Char
    c EnumMap Char (Maybe (X, X, ContentId TileKind), ContentId TileKind)
    mOneIn
            in case (Maybe (X, X, ContentId TileKind), ContentId TileKind)
    tktk of
              (Just (X
    k, X
    n, ContentId TileKind
    tkSpice), ContentId TileKind
    _) | X -> X -> Word32 -> Point -> Bool
    isChancePos X
    k X
    n Word32
    dsecret Point
    xy -> ContentId TileKind
    tkSpice
              (Maybe (X, X, ContentId TileKind)
    _, ContentId TileKind
    tk) -> ContentId TileKind
    tk
          qmap = (Point -> Char -> ContentId TileKind)
    -> EnumMap Point Char -> TileMapEM
    forall k a b. Enum k => (k -> a -> b) -> EnumMap k a -> EnumMap k b
    EM.mapWithKey Point -> Char -> ContentId TileKind
    lookupOneIn EnumMap Point Char
    cmap
      qfence <- buildFence cops kc dnight darkCorTile litCorTile
                           dark (pfence kr) qarea
      return $! Place {..}

    isChancePos :: Int -> Int -> Word32 -> Point -> Bool
    isChancePos :: X -> X -> Word32 -> Point -> Bool
    isChancePos X
    k' X
    n' Word32
    dsecret (Point X
    x' X
    y') = X
    k' X -> X -> Bool
    forall a. Ord a => a -> a -> Bool
    > X
    0 Bool -> Bool -> Bool
    && X
    n' X -> X -> Bool
    forall a. Ord a => a -> a -> Bool
    > X
    0 Bool -> Bool -> Bool
    &&
      let k :: Word32
    k = X -> Word32
    forall a. Enum a => X -> a
    toEnum X
    k'
          n :: Word32
    n = X -> Word32
    forall a. Enum a => X -> a
    toEnum X
    n'
          x :: Word32
    x = X -> Word32
    forall a. Enum a => X -> a
    toEnum X
    x'
          y :: Word32
    y = X -> Word32
    forall a. Enum a => X -> a
    toEnum X
    y'
          z :: Word32
    z = Word32
    dsecret Word32 -> X -> Word32
    forall a. Bits a => a -> X -> a
    `Bits.rotateR` X
    x' Word32 -> Word32 -> Word32
    forall a. Bits a => a -> a -> a
    `Bits.xor` Word32
    y Word32 -> Word32 -> Word32
    forall a. Num a => a -> a -> a
    + Word32
    x
      in if Word32
    k Word32 -> Word32 -> Bool
    forall a. Ord a => a -> a -> Bool
    < Word32
    n
         then Word32
    z Word32 -> Word32 -> Word32
    forall a. Integral a => a -> a -> a
    `mod` ((Word32
    n Word32 -> Word32 -> Word32
    forall a. Num a => a -> a -> a
    + Word32
    k) Word32 -> Word32 -> Word32
    forall a. Integral a => a -> a -> a
    `divUp` Word32
    k) Word32 -> Word32 -> Bool
    forall a. Eq a => a -> a -> Bool
    == Word32
    0
         else Word32
    z Word32 -> Word32 -> Word32
    forall a. Integral a => a -> a -> a
    `mod` ((Word32
    n Word32 -> Word32 -> Word32
    forall a. Num a => a -> a -> a
    + Word32
    k) Word32 -> Word32 -> Word32
    forall a. Integral a => a -> a -> a
    `divUp` Word32
    n) Word32 -> Word32 -> Bool
    forall a. Eq a => a -> a -> Bool
    /= Word32
    0

    -- This can't be optimized by memoization (storing these results per place),
    -- because it would fix random assignment of tiles to groups
    -- for all instances of a place throughout dungeon. Right now the assignment
    -- is fixed for any single place instance and it's consistent and interesting.
    -- Even fixing this per level would make levels less interesting.
    --
    -- This could be precomputed for groups that contain only one tile,
    -- but for these, no random rolls are performed, so little would be saved.
    pover :: COps -> EM.EnumMap Char (GroupName TileKind)
          -> Rnd ( EM.EnumMap Char ( Maybe (Int, Int, ContentId TileKind)
                                   , ContentId TileKind ) )
    pover :: COps
    -> EnumMap Char (GroupName TileKind)
    -> Rnd
         (EnumMap
            Char (Maybe (X, X, ContentId TileKind), ContentId TileKind))
    pover COps{ContentData TileKind
    cotile :: ContentData TileKind
    cotile :: COps -> ContentData TileKind
    cotile} EnumMap Char (GroupName TileKind)
    plegend =
      let assignKN :: GroupName TileKind -> ContentId TileKind -> ContentId TileKind
                   -> (Int, Int, ContentId TileKind)
          assignKN :: GroupName TileKind
    -> ContentId TileKind
    -> ContentId TileKind
    -> (X, X, ContentId TileKind)
    assignKN GroupName TileKind
    cgroup ContentId TileKind
    tk ContentId TileKind
    tkSpice =
            -- Very likely that legends have spice.
            let n :: X
    n = X -> Maybe X -> X
    forall a. a -> Maybe a -> a
    fromMaybe (String -> X
    forall a. HasCallStack => String -> a
    error (String -> X) -> String -> X
    forall a b. (a -> b) -> a -> b
    $ GroupName TileKind -> String
    forall a. Show a => a -> String
    show GroupName TileKind
    cgroup)
                              (GroupName TileKind -> [(GroupName TileKind, X)] -> Maybe X
    forall a b. Eq a => a -> [(a, b)] -> Maybe b
    lookup GroupName TileKind
    cgroup (TileKind -> [(GroupName TileKind, X)]
    TK.tfreq (ContentData TileKind -> ContentId TileKind -> TileKind
    forall a. ContentData a -> ContentId a -> a
    okind ContentData TileKind
    cotile ContentId TileKind
    tk)))
                k :: X
    k = X -> Maybe X -> X
    forall a. a -> Maybe a -> a
    fromMaybe (String -> X
    forall a. HasCallStack => String -> a
    error (String -> X) -> String -> X
    forall a b. (a -> b) -> a -> b
    $ GroupName TileKind -> String
    forall a. Show a => a -> String
    show GroupName TileKind
    cgroup)
                              (GroupName TileKind -> [(GroupName TileKind, X)] -> Maybe X
    forall a b. Eq a => a -> [(a, b)] -> Maybe b
    lookup GroupName TileKind
    cgroup (TileKind -> [(GroupName TileKind, X)]
    TK.tfreq (ContentData TileKind -> ContentId TileKind -> TileKind
    forall a. ContentData a -> ContentId a -> a
    okind ContentData TileKind
    cotile ContentId TileKind
    tkSpice)))
            in (X
    k, X
    n, ContentId TileKind
    tkSpice)
          getLegend :: GroupName TileKind
                    -> Rnd ( Maybe (Int, Int, ContentId TileKind)
                           , ContentId TileKind )
          getLegend :: GroupName TileKind
    -> Rnd (Maybe (X, X, ContentId TileKind), ContentId TileKind)
    getLegend GroupName TileKind
    cgroup = do
            mtkSpice <- ContentData TileKind
    -> GroupName TileKind
    -> (TileKind -> Bool)
    -> Rnd (Maybe (ContentId TileKind))
    forall a.
    Show a =>
    ContentData a
    -> GroupName a -> (a -> Bool) -> Rnd (Maybe (ContentId a))
    opick ContentData TileKind
    cotile GroupName TileKind
    cgroup (Feature -> TileKind -> Bool
    Tile.kindHasFeature Feature
    TK.Spice)
            tk <- fromMaybe (error $ "" `showFailure` (cgroup, plegend))
                  <$> opick cotile cgroup (not . Tile.kindHasFeature TK.Spice)
            return (assignKN cgroup tk <$> mtkSpice, tk)
      in (GroupName TileKind
     -> Rnd (Maybe (X, X, ContentId TileKind), ContentId TileKind))
    -> EnumMap Char (GroupName TileKind)
    -> Rnd
         (EnumMap
            Char (Maybe (X, X, ContentId TileKind), ContentId TileKind))
    forall (t :: * -> *) (m :: * -> *) a b.
    (Traversable t, Monad m) =>
    (a -> m b) -> t a -> m (t b)
    forall (m :: * -> *) a b.
    Monad m =>
    (a -> m b) -> EnumMap Char a -> m (EnumMap Char b)
    mapM GroupName TileKind
    -> Rnd (Maybe (X, X, ContentId TileKind), ContentId TileKind)
    getLegend EnumMap Char (GroupName TileKind)
    plegend

    -- | Construct a fence around a place.
    buildFence :: COps -> CaveKind -> Bool
               -> ContentId TileKind -> ContentId TileKind
               -> Bool -> Fence -> Area
               -> Rnd TileMapEM
    buildFence :: COps
    -> CaveKind
    -> Bool
    -> ContentId TileKind
    -> ContentId TileKind
    -> Bool
    -> Fence
    -> Area
    -> Rnd TileMapEM
    buildFence COps{ContentData TileKind
    cotile :: COps -> ContentData TileKind
    cotile :: ContentData TileKind
    cotile} CaveKind{GroupName TileKind
    ccornerTile :: CaveKind -> GroupName TileKind
    ccornerTile :: GroupName TileKind
    ccornerTile, GroupName TileKind
    cwallTile :: CaveKind -> GroupName TileKind
    cwallTile :: GroupName TileKind
    cwallTile}
               Bool
    dnight ContentId TileKind
    darkCorTile ContentId TileKind
    litCorTile Bool
    dark Fence
    fence Area
    qarea = do
      qFWall <- ContentId TileKind
    -> Maybe (ContentId TileKind) -> ContentId TileKind
    forall a. a -> Maybe a -> a
    fromMaybe (String -> ContentId TileKind
    forall a. HasCallStack => 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
    cwallTile)
                (Maybe (ContentId TileKind) -> ContentId TileKind)
    -> Rnd (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)
    -> Rnd (Maybe (ContentId TileKind))
    forall a.
    Show a =>
    ContentData a
    -> GroupName a -> (a -> Bool) -> Rnd (Maybe (ContentId a))
    opick ContentData TileKind
    cotile GroupName TileKind
    cwallTile (Bool -> TileKind -> Bool
    forall a b. a -> b -> a
    const Bool
    True)
      qFCorner <- fromMaybe (error $ "" `showFailure` ccornerTile)
                  <$> opick cotile ccornerTile (const True)
      let qFFloor = if Bool
    dark then ContentId TileKind
    darkCorTile else ContentId TileKind
    litCorTile
          qFGround = if Bool
    dnight then ContentId TileKind
    darkCorTile else ContentId TileKind
    litCorTile
      return $! case fence of
        Fence
    FWall -> ContentId TileKind -> ContentId TileKind -> Area -> TileMapEM
    buildFenceMap ContentId TileKind
    qFWall ContentId TileKind
    qFCorner Area
    qarea
        Fence
    FFloor -> ContentId TileKind -> ContentId TileKind -> Area -> TileMapEM
    buildFenceMap ContentId TileKind
    qFFloor ContentId TileKind
    qFFloor Area
    qarea
        Fence
    FGround -> ContentId TileKind -> ContentId TileKind -> Area -> TileMapEM
    buildFenceMap ContentId TileKind
    qFGround ContentId TileKind
    qFGround Area
    qarea
        Fence
    FNone -> TileMapEM
    forall k a. EnumMap k a
    EM.empty

    -- | Construct a fence around an area, with the given tile kind.
    -- Corners have a different kind, e.g., to avoid putting doors there.
    buildFenceMap :: ContentId TileKind -> ContentId TileKind -> Area -> TileMapEM
    buildFenceMap :: ContentId TileKind -> ContentId TileKind -> Area -> TileMapEM
    buildFenceMap ContentId TileKind
    wallId ContentId TileKind
    cornerId Area
    area =
      let (X
    x0, X
    y0, X
    x1, X
    y1) = Area -> (X, X, X, X)
    fromArea Area
    area
      in [(Point, ContentId TileKind)] -> TileMapEM
    forall k a. Enum k => [(k, a)] -> EnumMap k a
    EM.fromList ([(Point, ContentId TileKind)] -> TileMapEM)
    -> [(Point, ContentId TileKind)] -> TileMapEM
    forall a b. (a -> b) -> a -> b
    $ [ (X -> X -> Point
    Point X
    x X
    y, ContentId TileKind
    wallId)
                       | X
    x <- [X
    x0X -> X -> X
    forall a. Num a => a -> a -> a
    -X
    1, X
    x1X -> X -> X
    forall a. Num a => a -> a -> a
    +X
    1], X
    y <- [X
    y0..X
    y1] ] [(Point, ContentId TileKind)]
    -> [(Point, ContentId TileKind)] -> [(Point, ContentId TileKind)]
    forall a. [a] -> [a] -> [a]
    ++
                       [ (X -> X -> Point
    Point X
    x X
    y, ContentId TileKind
    wallId)
                       | X
    x <- [X
    x0..X
    x1], X
    y <- [X
    y0X -> X -> X
    forall a. Num a => a -> a -> a
    -X
    1, X
    y1X -> X -> X
    forall a. Num a => a -> a -> a
    +X
    1] ] [(Point, ContentId TileKind)]
    -> [(Point, ContentId TileKind)] -> [(Point, ContentId TileKind)]
    forall a. [a] -> [a] -> [a]
    ++
                       [ (X -> X -> Point
    Point X
    x X
    y, ContentId TileKind
    cornerId)
                       | X
    x <- [X
    x0X -> X -> X
    forall a. Num a => a -> a -> a
    -X
    1, X
    x1X -> X -> X
    forall a. Num a => a -> a -> a
    +X
    1], X
    y <- [X
    y0X -> X -> X
    forall a. Num a => a -> a -> a
    -X
    1, X
    y1X -> X -> X
    forall a. Num a => a -> a -> a
    +X
    1] ]

    -- | Construct a fence around an area, with the given tile group.
    buildFenceRnd :: COps
                  -> GroupName TileKind -> GroupName TileKind
                  -> GroupName TileKind -> GroupName TileKind
                  -> Area
                  -> Rnd TileMapEM
    buildFenceRnd :: COps
    -> GroupName TileKind
    -> GroupName TileKind
    -> GroupName TileKind
    -> GroupName TileKind
    -> Area
    -> Rnd TileMapEM
    buildFenceRnd COps{ContentData TileKind
    cotile :: COps -> ContentData TileKind
    cotile :: ContentData TileKind
    cotile}
                  GroupName TileKind
    cfenceTileN GroupName TileKind
    cfenceTileE GroupName TileKind
    cfenceTileS GroupName TileKind
    cfenceTileW Area
    area = do
      let (X
    x0, X
    y0, X
    x1, X
    y1) = Area -> (X, X, X, X)
    fromArea Area
    area
          allTheSame :: Bool
    allTheSame = (GroupName TileKind -> Bool) -> [GroupName TileKind] -> Bool
    forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
    all (GroupName TileKind -> GroupName TileKind -> Bool
    forall a. Eq a => a -> a -> Bool
    == GroupName TileKind
    cfenceTileN) [GroupName TileKind
    cfenceTileE, GroupName TileKind
    cfenceTileS, GroupName TileKind
    cfenceTileW]
          fenceIdRnd :: GroupName TileKind
    -> (X, X) -> StateT SMGen Identity (Point, ContentId TileKind)
    fenceIdRnd GroupName TileKind
    couterFenceTile (X
    xf, X
    yf) = do
            let isCorner :: X -> X -> Bool
    isCorner X
    x X
    y = X
    x X -> [X] -> Bool
    forall a. Eq a => a -> [a] -> Bool
    forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
    `elem` [X
    x0X -> X -> X
    forall a. Num a => a -> a -> a
    -X
    1, X
    x1X -> X -> X
    forall a. Num a => a -> a -> a
    +X
    1] Bool -> Bool -> Bool
    && X
    y X -> [X] -> Bool
    forall a. Eq a => a -> [a] -> Bool
    forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
    `elem` [X
    y0X -> X -> X
    forall a. Num a => a -> a -> a
    -X
    1, X
    y1X -> X -> X
    forall a. Num a => a -> a -> a
    +X
    1]
                tileGroup :: GroupName TileKind
    tileGroup | X -> X -> Bool
    isCorner X
    xf X
    yf Bool -> Bool -> Bool
    && Bool -> Bool
    not Bool
    allTheSame = GroupName TileKind
    TK.S_BASIC_OUTER_FENCE
                          | Bool
    otherwise = GroupName TileKind
    couterFenceTile
            fenceId <- ContentId TileKind
    -> Maybe (ContentId TileKind) -> ContentId TileKind
    forall a. a -> Maybe a -> a
    fromMaybe (String -> ContentId TileKind
    forall a. HasCallStack => 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
    tileGroup)
                       (Maybe (ContentId TileKind) -> ContentId TileKind)
    -> Rnd (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)
    -> Rnd (Maybe (ContentId TileKind))
    forall a.
    Show a =>
    ContentData a
    -> GroupName a -> (a -> Bool) -> Rnd (Maybe (ContentId a))
    opick ContentData TileKind
    cotile GroupName TileKind
    tileGroup (Bool -> TileKind -> Bool
    forall a b. a -> b -> a
    const Bool
    True)
            return (Point xf yf, fenceId)
          pointListN :: [(X, X)]
    pointListN = [(X
    x, X
    y0X -> X -> X
    forall a. Num a => a -> a -> a
    -X
    1) | X
    x <- [X
    x0X -> X -> X
    forall a. Num a => a -> a -> a
    -X
    1..X
    x1X -> X -> X
    forall a. Num a => a -> a -> a
    +X
    1]]
          pointListE :: [(X, X)]
    pointListE = [(X
    x1X -> X -> X
    forall a. Num a => a -> a -> a
    +X
    1, X
    y) | X
    y <- [X
    y0..X
    y1]]
          pointListS :: [(X, X)]
    pointListS = [(X
    x, X
    y1X -> X -> X
    forall a. Num a => a -> a -> a
    +X
    1) | X
    x <- [X
    x0X -> X -> X
    forall a. Num a => a -> a -> a
    -X
    1..X
    x1X -> X -> X
    forall a. Num a => a -> a -> a
    +X
    1]]
          pointListW :: [(X, X)]
    pointListW = [(X
    x0X -> X -> X
    forall a. Num a => a -> a -> a
    -X
    1, X
    y) | X
    y <- [X
    y0..X
    y1]]
      fenceListN <- ((X, X) -> StateT SMGen Identity (Point, ContentId TileKind))
    -> [(X, X)] -> StateT SMGen Identity [(Point, ContentId TileKind)]
    forall (t :: * -> *) (m :: * -> *) a b.
    (Traversable t, Monad m) =>
    (a -> m b) -> t a -> m (t b)
    forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
    mapM (GroupName TileKind
    -> (X, X) -> StateT SMGen Identity (Point, ContentId TileKind)
    fenceIdRnd GroupName TileKind
    cfenceTileN) [(X, X)]
    pointListN
      fenceListE <- mapM (fenceIdRnd cfenceTileE) pointListE
      fenceListS <- mapM (fenceIdRnd cfenceTileS) pointListS
      fenceListW <- mapM (fenceIdRnd cfenceTileW) pointListW
      return $! EM.fromList $ fenceListN ++ fenceListE ++ fenceListS ++ fenceListW

    -- | Create a place by tiling patterns.
    tilePlace :: Area                           -- ^ the area to fill
              -> PlaceKind                      -- ^ the place kind to construct
              -> Rnd (EM.EnumMap Point Char)
    tilePlace :: Area -> PlaceKind -> Rnd (EnumMap Point Char)
    tilePlace Area
    area pl :: PlaceKind
    pl@PlaceKind{Rarity
    Freqs PlaceKind
    [Text]
    EnumMap Char (GroupName TileKind)
    Text
    Fence
    Cover
    plegendLit :: PlaceKind -> EnumMap Char (GroupName TileKind)
    plegendDark :: PlaceKind -> EnumMap Char (GroupName TileKind)
    ptopLeft :: PlaceKind -> [Text]
    pfence :: PlaceKind -> Fence
    pcover :: PlaceKind -> Cover
    prarity :: PlaceKind -> Rarity
    pfreq :: PlaceKind -> Freqs PlaceKind
    pname :: PlaceKind -> Text
    pname :: Text
    pfreq :: Freqs PlaceKind
    prarity :: Rarity
    pcover :: Cover
    pfence :: Fence
    ptopLeft :: [Text]
    plegendDark :: EnumMap Char (GroupName TileKind)
    plegendLit :: EnumMap Char (GroupName TileKind)
    ..} = do
      let (Point X
    x0 X
    y0, X
    xspan, X
    yspan) = Area -> (Point, X, X)
    spanArea Area
    area
          dxcorner :: X
    dxcorner = case [Text]
    ptopLeft of
            [] -> String -> X
    forall a. HasCallStack => String -> a
    error (String -> X) -> String -> X
    forall a b. (a -> b) -> a -> b
    $ String
    "" String -> (Area, PlaceKind) -> String
    forall v. Show v => String -> v -> String
    `showFailure` (Area
    area, PlaceKind
    pl)
            Text
    l : [Text]
    _ -> Text -> X
    T.length Text
    l
          (X
    dx, X
    dy) = Bool -> (X, X) -> (X, X)
    forall a. HasCallStack => Bool -> a -> a
    assert (X
    xspan X -> X -> Bool
    forall a. Ord a => a -> a -> Bool
    >= X
    dxcorner Bool -> Bool -> Bool
    && X
    yspan X -> X -> Bool
    forall a. Ord a => a -> a -> Bool
    >= [Text] -> X
    forall a. [a] -> X
    length [Text]
    ptopLeft
                             Bool -> (Area, PlaceKind) -> Bool
    forall v. Show v => Bool -> v -> Bool
    `blame` (Area
    area, PlaceKind
    pl))
                            (X
    xspan, X
    yspan)
          fromX :: (X, X) -> [Point]
    fromX (X
    x2, X
    y2) = (X -> Point) -> [X] -> [Point]
    forall a b. (a -> b) -> [a] -> [b]
    map (X -> X -> Point
    `Point` X
    y2) [X
    x2..]
          fillInterior :: (Int -> String -> String)
                       -> (Int -> [String] -> [String])
                       -> [(Point, Char)]
          fillInterior :: (X -> ShowS) -> (X -> [String] -> [String]) -> [(Point, Char)]
    fillInterior X -> ShowS
    f X -> [String] -> [String]
    g =
            let tileInterior :: (X, String) -> [(Point, Char)]
    tileInterior (X
    y, String
    row) =
                  let fx :: String
    fx = X -> ShowS
    f X
    dx String
    row
                      xStart :: X
    xStart = X
    x0 X -> X -> X
    forall a. Num a => a -> a -> a
    + ((X
    xspan X -> X -> X
    forall a. Num a => a -> a -> a
    - String -> X
    forall a. [a] -> X
    length String
    fx) X -> X -> X
    forall a. Integral a => a -> a -> a
    `div` X
    2)
                  in ((Point, Char) -> Bool) -> [(Point, Char)] -> [(Point, Char)]
    forall a. (a -> Bool) -> [a] -> [a]
    filter ((Char -> Char -> Bool
    forall a. Eq a => a -> a -> Bool
    /= Char
    'X') (Char -> Bool) -> ((Point, Char) -> Char) -> (Point, Char) -> Bool
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (Point, Char) -> Char
    forall a b. (a, b) -> b
    snd) ([(Point, Char)] -> [(Point, Char)])
    -> [(Point, Char)] -> [(Point, Char)]
    forall a b. (a -> b) -> a -> b
    $ [Point] -> String -> [(Point, Char)]
    forall a b. [a] -> [b] -> [(a, b)]
    zip ((X, X) -> [Point]
    fromX (X
    xStart, X
    y)) String
    fx
                reflected :: [(X, String)]
    reflected =
                  let gy :: [String]
    gy = X -> [String] -> [String]
    g X
    dy ([String] -> [String]) -> [String] -> [String]
    forall a b. (a -> b) -> a -> b
    $ (Text -> String) -> [Text] -> [String]
    forall a b. (a -> b) -> [a] -> [b]
    map Text -> String
    T.unpack [Text]
    ptopLeft
                      yStart :: X
    yStart = X
    y0 X -> X -> X
    forall a. Num a => a -> a -> a
    + ((X
    yspan X -> X -> X
    forall a. Num a => a -> a -> a
    - [String] -> X
    forall a. [a] -> X
    length [String]
    gy) X -> X -> X
    forall a. Integral a => a -> a -> a
    `div` X
    2)
                  in [X] -> [String] -> [(X, String)]
    forall a b. [a] -> [b] -> [(a, b)]
    zip [X
    yStart..] [String]
    gy
            in ((X, String) -> [(Point, Char)])
    -> [(X, String)] -> [(Point, Char)]
    forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
    concatMap (X, String) -> [(Point, Char)]
    tileInterior [(X, String)]
    reflected
          tileReflect :: Int -> [a] -> [a]
          tileReflect :: forall a. X -> [a] -> [a]
    tileReflect X
    d [a]
    pat =
            let lstart :: [a]
    lstart = X -> [a] -> [a]
    forall a. X -> [a] -> [a]
    take (X
    d X -> X -> X
    forall a. Integral a => a -> a -> a
    `divUp` X
    2) [a]
    pat
                lend :: [a]
    lend   = X -> [a] -> [a]
    forall a. X -> [a] -> [a]
    take (X
    d X -> X -> X
    forall a. Integral a => a -> a -> a
    `div`   X
    2) [a]
    pat
            in [a]
    lstart [a] -> [a] -> [a]
    forall a. [a] -> [a] -> [a]
    ++ [a] -> [a]
    forall a. [a] -> [a]
    reverse [a]
    lend
      interior <- case Cover
    pcover of
        Cover
    CAlternate -> do
          let tile :: Int -> [a] -> [a]
              tile :: forall a. X -> [a] -> [a]
    tile X
    _ []  = String -> [a]
    forall a. HasCallStack => String -> a
    error (String -> [a]) -> String -> [a]
    forall a b. (a -> b) -> a -> b
    $ String
    "nothing to tile" String -> PlaceKind -> String
    forall v. Show v => String -> v -> String
    `showFailure` PlaceKind
    pl
              tile X
    d [a]
    pat = X -> [a] -> [a]
    forall a. X -> [a] -> [a]
    take X
    d ([a] -> [a]
    forall a. HasCallStack => [a] -> [a]
    cycle ([a] -> [a]) -> [a] -> [a]
    forall a b. (a -> b) -> a -> b
    $ [a] -> [a]
    forall a. HasCallStack => [a] -> [a]
    init [a]
    pat [a] -> [a] -> [a]
    forall a. [a] -> [a] -> [a]
    ++ [a] -> [a]
    forall a. HasCallStack => [a] -> [a]
    init ([a] -> [a]
    forall a. [a] -> [a]
    reverse [a]
    pat))
          [(Point, Char)] -> StateT SMGen Identity [(Point, Char)]
    forall a. a -> StateT SMGen Identity a
    forall (m :: * -> *) a. Monad m => a -> m a
    return ([(Point, Char)] -> StateT SMGen Identity [(Point, Char)])
    -> [(Point, Char)] -> StateT SMGen Identity [(Point, Char)]
    forall a b. (a -> b) -> a -> b
    $! (X -> ShowS) -> (X -> [String] -> [String]) -> [(Point, Char)]
    fillInterior X -> ShowS
    forall a. X -> [a] -> [a]
    tile X -> [String] -> [String]
    forall a. X -> [a] -> [a]
    tile
        Cover
    CStretch -> do
          let stretch :: Int -> [a] -> [a]
              stretch :: forall a. X -> [a] -> [a]
    stretch X
    _ []  = String -> [a]
    forall a. HasCallStack => String -> a
    error (String -> [a]) -> String -> [a]
    forall a b. (a -> b) -> a -> b
    $ String
    "nothing to stretch" String -> PlaceKind -> String
    forall v. Show v => String -> v -> String
    `showFailure` PlaceKind
    pl
              stretch X
    d [a]
    pat = X -> [a] -> [a]
    forall a. X -> [a] -> [a]
    tileReflect X
    d ([a]
    pat [a] -> [a] -> [a]
    forall a. [a] -> [a] -> [a]
    ++ a -> [a]
    forall a. a -> [a]
    repeat ([a] -> a
    forall a. HasCallStack => [a] -> a
    last [a]
    pat))
          [(Point, Char)] -> StateT SMGen Identity [(Point, Char)]
    forall a. a -> StateT SMGen Identity a
    forall (m :: * -> *) a. Monad m => a -> m a
    return ([(Point, Char)] -> StateT SMGen Identity [(Point, Char)])
    -> [(Point, Char)] -> StateT SMGen Identity [(Point, Char)]
    forall a b. (a -> b) -> a -> b
    $! (X -> ShowS) -> (X -> [String] -> [String]) -> [(Point, Char)]
    fillInterior X -> ShowS
    forall a. X -> [a] -> [a]
    stretch X -> [String] -> [String]
    forall a. X -> [a] -> [a]
    stretch
        Cover
    CReflect -> do
          let reflect :: Int -> [a] -> [a]
              reflect :: forall a. X -> [a] -> [a]
    reflect X
    d [a]
    pat = X -> [a] -> [a]
    forall a. X -> [a] -> [a]
    tileReflect X
    d ([a] -> [a]
    forall a. HasCallStack => [a] -> [a]
    cycle [a]
    pat)
          [(Point, Char)] -> StateT SMGen Identity [(Point, Char)]
    forall a. a -> StateT SMGen Identity a
    forall (m :: * -> *) a. Monad m => a -> m a
    return ([(Point, Char)] -> StateT SMGen Identity [(Point, Char)])
    -> [(Point, Char)] -> StateT SMGen Identity [(Point, Char)]
    forall a b. (a -> b) -> a -> b
    $! (X -> ShowS) -> (X -> [String] -> [String]) -> [(Point, Char)]
    fillInterior X -> ShowS
    forall a. X -> [a] -> [a]
    reflect X -> [String] -> [String]
    forall a. X -> [a] -> [a]
    reflect
        Cover
    CVerbatim -> [(Point, Char)] -> StateT SMGen Identity [(Point, Char)]
    forall a. a -> StateT SMGen Identity a
    forall (m :: * -> *) a. Monad m => a -> m a
    return ([(Point, Char)] -> StateT SMGen Identity [(Point, Char)])
    -> [(Point, Char)] -> StateT SMGen Identity [(Point, Char)]
    forall a b. (a -> b) -> a -> b
    $! (X -> ShowS) -> (X -> [String] -> [String]) -> [(Point, Char)]
    fillInterior (\ X
    _ String
    x -> String
    x) (\ X
    _ [String]
    x -> [String]
    x)
        Cover
    CMirror -> do
          mirror1 <- [ShowS] -> Rnd ShowS
    forall a. [a] -> Rnd a
    oneOf [ShowS
    forall a. a -> a
    id, ShowS
    forall a. [a] -> [a]
    reverse]
          mirror2 <- oneOf [id, reverse]
          return $! fillInterior (\X
    _ String
    l -> ShowS
    mirror1 String
    l) (\X
    _ [String]
    l -> [String] -> [String]
    mirror2 [String]
    l)
      return $! EM.fromList interior