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

import Prelude ()

import Game.LambdaHack.Core.Prelude

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

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

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

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

* The available area is divided into a grid, e.g, 3 by 3,
  where each of the 9 grid cells has approximately the same size.

* In some of the 9 grid cells a room is placed at a random position
  and with a random size, but larger than the minimum size,
  e.g, 2 by 2 floor tiles.

* Rooms that are on horizontally or vertically adjacent grid cells
  may be connected by a corridor. Corridors consist of 3 segments of straight
  lines (either "horizontal, vertical, horizontal" or "vertical, horizontal,
  vertical"). They end in openings in the walls of the room they connect.
  It is possible that one or two of the 3 segments have length 0, such that
  the resulting corridor is L-shaped or even a single straight line.

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

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