-- | Definitions of place kinds. Every room in the game is an instantiated
-- place kind.
module Content.PlaceKind
  ( -- * Group name patterns
    pattern ROGUE, pattern LABORATORY, pattern ZOO, pattern BRAWL, pattern SHOOTOUT, pattern ARENA, pattern FLIGHT, pattern AMBUSH, pattern BATTLE, pattern NOISE, pattern MINE, pattern EMPTY
  , pattern INDOOR_ESCAPE_DOWN, pattern INDOOR_ESCAPE_UP, pattern OUTDOOR_ESCAPE_DOWN, pattern TINY_STAIRCASE, pattern OPEN_STAIRCASE, pattern CLOSED_STAIRCASE, pattern WALLED_STAIRCASE, pattern GATED_TINY_STAIRCASE, pattern GATED_OPEN_STAIRCASE, pattern GATED_CLOSED_STAIRCASE, pattern OUTDOOR_TINY_STAIRCASE, pattern OUTDOOR_CLOSED_STAIRCASE, pattern OUTDOOR_WALLED_STAIRCASE
  , groupNamesSingleton, groupNames
  , -- * Content
    content
  ) where

import Prelude ()

import Game.LambdaHack.Core.Prelude

import qualified Data.EnumMap.Strict as EM
import qualified Data.Text as T

import Game.LambdaHack.Content.PlaceKind
import Game.LambdaHack.Content.TileKind (TileKind)
import Game.LambdaHack.Definition.Defs
import Game.LambdaHack.Definition.DefsInternal

import Content.TileKind hiding (content, groupNames, groupNamesSingleton)

-- * Group name patterns

groupNamesSingleton :: [GroupName PlaceKind]
groupNamesSingleton :: [GroupName PlaceKind]
groupNamesSingleton = []

-- TODO: if we stick to the current system of generating extra kinds and their
-- group names, let's also add the generated group names to @groupNames@.
groupNames :: [GroupName PlaceKind]
groupNames :: [GroupName PlaceKind]
groupNames =
       [GroupName PlaceKind
ROGUE, GroupName PlaceKind
LABORATORY, GroupName PlaceKind
ZOO, GroupName PlaceKind
BRAWL, GroupName PlaceKind
SHOOTOUT, GroupName PlaceKind
ARENA, GroupName PlaceKind
FLIGHT, GroupName PlaceKind
AMBUSH, GroupName PlaceKind
BATTLE, GroupName PlaceKind
NOISE, GroupName PlaceKind
MINE, GroupName PlaceKind
EMPTY]
    [GroupName PlaceKind]
-> [GroupName PlaceKind] -> [GroupName PlaceKind]
forall a. [a] -> [a] -> [a]
++ [GroupName PlaceKind
INDOOR_ESCAPE_DOWN, GroupName PlaceKind
INDOOR_ESCAPE_UP, GroupName PlaceKind
OUTDOOR_ESCAPE_DOWN, GroupName PlaceKind
TINY_STAIRCASE, GroupName PlaceKind
OPEN_STAIRCASE, GroupName PlaceKind
CLOSED_STAIRCASE, GroupName PlaceKind
WALLED_STAIRCASE]
    [GroupName PlaceKind]
-> [GroupName PlaceKind] -> [GroupName PlaceKind]
forall a. [a] -> [a] -> [a]
++ ([GroupName PlaceKind], [PlaceKind]) -> [GroupName PlaceKind]
forall a b. (a, b) -> a
fst ([GroupName PlaceKind], [PlaceKind])
generatedStairs

pattern ROGUE, LABORATORY, ZOO, BRAWL, SHOOTOUT, ARENA, FLIGHT, AMBUSH, BATTLE, NOISE, MINE, EMPTY :: GroupName PlaceKind

pattern INDOOR_ESCAPE_DOWN, INDOOR_ESCAPE_UP, OUTDOOR_ESCAPE_DOWN, TINY_STAIRCASE, OPEN_STAIRCASE, CLOSED_STAIRCASE, WALLED_STAIRCASE, GATED_TINY_STAIRCASE, GATED_OPEN_STAIRCASE, GATED_CLOSED_STAIRCASE, OUTDOOR_TINY_STAIRCASE, OUTDOOR_CLOSED_STAIRCASE, OUTDOOR_WALLED_STAIRCASE :: GroupName PlaceKind

pattern $mROGUE :: forall {r}.
GroupName PlaceKind -> ((# #) -> r) -> ((# #) -> r) -> r
$bROGUE :: GroupName PlaceKind
ROGUE = GroupName "rogue"
pattern $mLABORATORY :: forall {r}.
GroupName PlaceKind -> ((# #) -> r) -> ((# #) -> r) -> r
$bLABORATORY :: GroupName PlaceKind
LABORATORY = GroupName "laboratory"
pattern $mZOO :: forall {r}.
GroupName PlaceKind -> ((# #) -> r) -> ((# #) -> r) -> r
$bZOO :: GroupName PlaceKind
ZOO = GroupName "zoo"
pattern $mBRAWL :: forall {r}.
GroupName PlaceKind -> ((# #) -> r) -> ((# #) -> r) -> r
$bBRAWL :: GroupName PlaceKind
BRAWL = GroupName "brawl"
pattern $mSHOOTOUT :: forall {r}.
GroupName PlaceKind -> ((# #) -> r) -> ((# #) -> r) -> r
$bSHOOTOUT :: GroupName PlaceKind
SHOOTOUT = GroupName "shootout"
pattern $mARENA :: forall {r}.
GroupName PlaceKind -> ((# #) -> r) -> ((# #) -> r) -> r
$bARENA :: GroupName PlaceKind
ARENA = GroupName "arena"
pattern $mFLIGHT :: forall {r}.
GroupName PlaceKind -> ((# #) -> r) -> ((# #) -> r) -> r
$bFLIGHT :: GroupName PlaceKind
FLIGHT = GroupName "flight"
pattern $mAMBUSH :: forall {r}.
GroupName PlaceKind -> ((# #) -> r) -> ((# #) -> r) -> r
$bAMBUSH :: GroupName PlaceKind
AMBUSH = GroupName "ambush"
pattern $mBATTLE :: forall {r}.
GroupName PlaceKind -> ((# #) -> r) -> ((# #) -> r) -> r
$bBATTLE :: GroupName PlaceKind
BATTLE = GroupName "battle"
pattern $mNOISE :: forall {r}.
GroupName PlaceKind -> ((# #) -> r) -> ((# #) -> r) -> r
$bNOISE :: GroupName PlaceKind
NOISE = GroupName "noise"
pattern $mMINE :: forall {r}.
GroupName PlaceKind -> ((# #) -> r) -> ((# #) -> r) -> r
$bMINE :: GroupName PlaceKind
MINE = GroupName "mine"
pattern $mEMPTY :: forall {r}.
GroupName PlaceKind -> ((# #) -> r) -> ((# #) -> r) -> r
$bEMPTY :: GroupName PlaceKind
EMPTY = GroupName "empty"

pattern $mINDOOR_ESCAPE_DOWN :: forall {r}.
GroupName PlaceKind -> ((# #) -> r) -> ((# #) -> r) -> r
$bINDOOR_ESCAPE_DOWN :: GroupName PlaceKind
INDOOR_ESCAPE_DOWN = GroupName "indoor escape down"
pattern $mINDOOR_ESCAPE_UP :: forall {r}.
GroupName PlaceKind -> ((# #) -> r) -> ((# #) -> r) -> r
$bINDOOR_ESCAPE_UP :: GroupName PlaceKind
INDOOR_ESCAPE_UP = GroupName "indoor escape up"
pattern $mOUTDOOR_ESCAPE_DOWN :: forall {r}.
GroupName PlaceKind -> ((# #) -> r) -> ((# #) -> r) -> r
$bOUTDOOR_ESCAPE_DOWN :: GroupName PlaceKind
OUTDOOR_ESCAPE_DOWN = GroupName "outdoor escape down"
pattern $mTINY_STAIRCASE :: forall {r}.
GroupName PlaceKind -> ((# #) -> r) -> ((# #) -> r) -> r
$bTINY_STAIRCASE :: GroupName PlaceKind
TINY_STAIRCASE = GroupName "tiny staircase"
pattern $mOPEN_STAIRCASE :: forall {r}.
GroupName PlaceKind -> ((# #) -> r) -> ((# #) -> r) -> r
$bOPEN_STAIRCASE :: GroupName PlaceKind
OPEN_STAIRCASE = GroupName "open staircase"
pattern $mCLOSED_STAIRCASE :: forall {r}.
GroupName PlaceKind -> ((# #) -> r) -> ((# #) -> r) -> r
$bCLOSED_STAIRCASE :: GroupName PlaceKind
CLOSED_STAIRCASE = GroupName "closed staircase"
pattern $mWALLED_STAIRCASE :: forall {r}.
GroupName PlaceKind -> ((# #) -> r) -> ((# #) -> r) -> r
$bWALLED_STAIRCASE :: GroupName PlaceKind
WALLED_STAIRCASE = GroupName "walled staircase"

-- This is a rotten compromise, because these are synthesized below,
-- so typos can happen.
pattern $mGATED_TINY_STAIRCASE :: forall {r}.
GroupName PlaceKind -> ((# #) -> r) -> ((# #) -> r) -> r
$bGATED_TINY_STAIRCASE :: GroupName PlaceKind
GATED_TINY_STAIRCASE = GroupName "gated tiny staircase"
pattern $mGATED_OPEN_STAIRCASE :: forall {r}.
GroupName PlaceKind -> ((# #) -> r) -> ((# #) -> r) -> r
$bGATED_OPEN_STAIRCASE :: GroupName PlaceKind
GATED_OPEN_STAIRCASE = GroupName "gated open staircase"
pattern $mGATED_CLOSED_STAIRCASE :: forall {r}.
GroupName PlaceKind -> ((# #) -> r) -> ((# #) -> r) -> r
$bGATED_CLOSED_STAIRCASE :: GroupName PlaceKind
GATED_CLOSED_STAIRCASE = GroupName "gated closed staircase"
pattern $mOUTDOOR_TINY_STAIRCASE :: forall {r}.
GroupName PlaceKind -> ((# #) -> r) -> ((# #) -> r) -> r
$bOUTDOOR_TINY_STAIRCASE :: GroupName PlaceKind
OUTDOOR_TINY_STAIRCASE = GroupName "outdoor tiny staircase"
pattern $mOUTDOOR_CLOSED_STAIRCASE :: forall {r}.
GroupName PlaceKind -> ((# #) -> r) -> ((# #) -> r) -> r
$bOUTDOOR_CLOSED_STAIRCASE :: GroupName PlaceKind
OUTDOOR_CLOSED_STAIRCASE = GroupName "outdoor closed staircase"
pattern $mOUTDOOR_WALLED_STAIRCASE :: forall {r}.
GroupName PlaceKind -> ((# #) -> r) -> ((# #) -> r) -> r
$bOUTDOOR_WALLED_STAIRCASE :: GroupName PlaceKind
OUTDOOR_WALLED_STAIRCASE = GroupName "outdoor walled staircase"

-- * Content

content :: [PlaceKind]
content :: [PlaceKind]
content =
  [PlaceKind
deadEnd, PlaceKind
rect, PlaceKind
rect2, PlaceKind
rect3, PlaceKind
rect4, PlaceKind
rectWindows, PlaceKind
glasshouse, PlaceKind
glasshouse2, PlaceKind
glasshouse3, PlaceKind
pulpit, PlaceKind
ruin, PlaceKind
ruin2, PlaceKind
collapsed, PlaceKind
collapsed2, PlaceKind
collapsed3, PlaceKind
collapsed4, PlaceKind
collapsed5, PlaceKind
collapsed6, PlaceKind
collapsed7, PlaceKind
pillar, PlaceKind
pillar2, PlaceKind
pillar3, PlaceKind
pillar4, PlaceKind
pillar5, PlaceKind
colonnade, PlaceKind
colonnade2, PlaceKind
colonnade3, PlaceKind
colonnade4, PlaceKind
colonnade5, PlaceKind
colonnade6, PlaceKind
lampPost, PlaceKind
lampPost2, PlaceKind
lampPost3, PlaceKind
lampPost4, PlaceKind
treeShade, PlaceKind
fogClump, PlaceKind
fogClump2, PlaceKind
smokeClump, PlaceKind
smokeClump2, PlaceKind
smokeClump3FGround, PlaceKind
bushClump, PlaceKind
bushClump2, PlaceKind
escapeDown, PlaceKind
escapeDown2, PlaceKind
escapeDown3, PlaceKind
escapeDown4, PlaceKind
escapeDown5, PlaceKind
staircase1, PlaceKind
staircase2, PlaceKind
staircase3, PlaceKind
staircase4, PlaceKind
staircase5, PlaceKind
staircase6, PlaceKind
staircase7, PlaceKind
staircase8, PlaceKind
staircase9, PlaceKind
staircase10, PlaceKind
staircase11, PlaceKind
staircase12, PlaceKind
staircase13, PlaceKind
staircase14, PlaceKind
staircase15, PlaceKind
staircase16, PlaceKind
staircase17, PlaceKind
staircase18, PlaceKind
staircase19, PlaceKind
staircase20, PlaceKind
staircase21, PlaceKind
staircase22, PlaceKind
staircase23, PlaceKind
staircase24, PlaceKind
staircase25, PlaceKind
staircase26, PlaceKind
staircase27, PlaceKind
staircase28, PlaceKind
staircase29, PlaceKind
staircase30, PlaceKind
staircase31, PlaceKind
staircase32, PlaceKind
staircase33, PlaceKind
staircase34, PlaceKind
staircase35, PlaceKind
staircase36, PlaceKind
staircase37]
  -- automatically generated
  [PlaceKind] -> [PlaceKind] -> [PlaceKind]
forall a. [a] -> [a] -> [a]
++ ([GroupName PlaceKind], [PlaceKind]) -> [PlaceKind]
forall a b. (a, b) -> b
snd ([GroupName PlaceKind], [PlaceKind])
generatedStairs [PlaceKind] -> [PlaceKind] -> [PlaceKind]
forall a. [a] -> [a] -> [a]
++ [PlaceKind]
generatedEscapes

deadEnd,    rect, rect2, rect3, rect4, rectWindows, glasshouse, glasshouse2, glasshouse3, pulpit, ruin, ruin2, collapsed, collapsed2, collapsed3, collapsed4, collapsed5, collapsed6, collapsed7, pillar, pillar2, pillar3, pillar4, pillar5, colonnade, colonnade2, colonnade3, colonnade4, colonnade5, colonnade6, lampPost, lampPost2, lampPost3, lampPost4, treeShade, fogClump, fogClump2, smokeClump, smokeClump2, smokeClump3FGround, bushClump, bushClump2, escapeDown, escapeDown2, escapeDown3, escapeDown4, escapeDown5, staircase1, staircase2, staircase3, staircase4, staircase5, staircase6, staircase7, staircase8, staircase9, staircase10, staircase11, staircase12, staircase13, staircase14, staircase15, staircase16, staircase17, staircase18, staircase19, staircase20, staircase21, staircase22, staircase23, staircase24, staircase25, staircase26, staircase27, staircase28, staircase29, staircase30, staircase31, staircase32, staircase33, staircase34, staircase35, staircase36, staircase37 :: PlaceKind

staircase :: PlaceKind  -- template

staircaseBasic :: [PlaceKind]
staircaseBasic :: [PlaceKind]
staircaseBasic = [PlaceKind
staircase1, PlaceKind
staircase2, PlaceKind
staircase3, PlaceKind
staircase4, PlaceKind
staircase5, PlaceKind
staircase6, PlaceKind
staircase7, PlaceKind
staircase8, PlaceKind
staircase9, PlaceKind
staircase10, PlaceKind
staircase11, PlaceKind
staircase12, PlaceKind
staircase13, PlaceKind
staircase14, PlaceKind
staircase15, PlaceKind
staircase16, PlaceKind
staircase17, PlaceKind
staircase18, PlaceKind
staircase19, PlaceKind
staircase20, PlaceKind
staircase21, PlaceKind
staircase22, PlaceKind
staircase23, PlaceKind
staircase24, PlaceKind
staircase25, PlaceKind
staircase26, PlaceKind
staircase27, PlaceKind
staircase28, PlaceKind
staircase29, PlaceKind
staircase30, PlaceKind
staircase31, PlaceKind
staircase32, PlaceKind
staircase33, PlaceKind
staircase34, PlaceKind
staircase35, PlaceKind
staircase36, PlaceKind
staircase37]

generatedStairs :: ([GroupName PlaceKind], [PlaceKind])
generatedStairs :: ([GroupName PlaceKind], [PlaceKind])
generatedStairs =
  let gatedStairs :: [PlaceKind]
gatedStairs = (PlaceKind -> PlaceKind) -> [PlaceKind] -> [PlaceKind]
forall a b. (a -> b) -> [a] -> [b]
map PlaceKind -> PlaceKind
switchStaircaseToGated [PlaceKind]
staircaseBasic
      outdoorStairs :: [PlaceKind]
outdoorStairs = (PlaceKind -> PlaceKind) -> [PlaceKind] -> [PlaceKind]
forall a b. (a -> b) -> [a] -> [b]
map PlaceKind -> PlaceKind
switchStaircaseToOutdoor [PlaceKind]
staircaseBasic
      stairsAll :: [PlaceKind]
stairsAll = [PlaceKind]
staircaseBasic [PlaceKind] -> [PlaceKind] -> [PlaceKind]
forall a. [a] -> [a] -> [a]
++ [PlaceKind]
gatedStairs [PlaceKind] -> [PlaceKind] -> [PlaceKind]
forall a. [a] -> [a] -> [a]
++ [PlaceKind]
outdoorStairs
      upStairs :: [PlaceKind]
upStairs = (PlaceKind -> PlaceKind) -> [PlaceKind] -> [PlaceKind]
forall a b. (a -> b) -> [a] -> [b]
map PlaceKind -> PlaceKind
switchStaircaseToUp [PlaceKind]
stairsAll
      downStairs :: [PlaceKind]
downStairs = (PlaceKind -> PlaceKind) -> [PlaceKind] -> [PlaceKind]
forall a b. (a -> b) -> [a] -> [b]
map PlaceKind -> PlaceKind
switchStaircaseToDown [PlaceKind]
stairsAll
      genStairs :: [PlaceKind]
genStairs = [PlaceKind]
gatedStairs [PlaceKind] -> [PlaceKind] -> [PlaceKind]
forall a. [a] -> [a] -> [a]
++ [PlaceKind]
outdoorStairs [PlaceKind] -> [PlaceKind] -> [PlaceKind]
forall a. [a] -> [a] -> [a]
++ [PlaceKind]
upStairs [PlaceKind] -> [PlaceKind] -> [PlaceKind]
forall a. [a] -> [a] -> [a]
++ [PlaceKind]
downStairs
  in ( [GroupName PlaceKind] -> [GroupName PlaceKind]
forall a. Eq a => [a] -> [a]
nub ([GroupName PlaceKind] -> [GroupName PlaceKind])
-> [GroupName PlaceKind] -> [GroupName PlaceKind]
forall a b. (a -> b) -> a -> b
$ [GroupName PlaceKind] -> [GroupName PlaceKind]
forall a. Ord a => [a] -> [a]
sort ([GroupName PlaceKind] -> [GroupName PlaceKind])
-> [GroupName PlaceKind] -> [GroupName PlaceKind]
forall a b. (a -> b) -> a -> b
$ (PlaceKind -> [GroupName PlaceKind])
-> [PlaceKind] -> [GroupName PlaceKind]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (((GroupName PlaceKind, Int) -> GroupName PlaceKind)
-> [(GroupName PlaceKind, Int)] -> [GroupName PlaceKind]
forall a b. (a -> b) -> [a] -> [b]
map (GroupName PlaceKind, Int) -> GroupName PlaceKind
forall a b. (a, b) -> a
fst ([(GroupName PlaceKind, Int)] -> [GroupName PlaceKind])
-> (PlaceKind -> [(GroupName PlaceKind, Int)])
-> PlaceKind
-> [GroupName PlaceKind]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PlaceKind -> [(GroupName PlaceKind, Int)]
pfreq) [PlaceKind]
genStairs
     , [PlaceKind]
genStairs )

escapeDownBasic :: [PlaceKind]
escapeDownBasic :: [PlaceKind]
escapeDownBasic =
  [PlaceKind
escapeDown, PlaceKind
escapeDown2, PlaceKind
escapeDown3, PlaceKind
escapeDown4, PlaceKind
escapeDown5]

generatedEscapes :: [PlaceKind]
generatedEscapes :: [PlaceKind]
generatedEscapes =
  let upEscapes :: [PlaceKind]
upEscapes = (PlaceKind -> PlaceKind) -> [PlaceKind] -> [PlaceKind]
forall a b. (a -> b) -> [a] -> [b]
map PlaceKind -> PlaceKind
switchEscapeToUp [PlaceKind]
escapeDownBasic
      outdoorEscapes :: [PlaceKind]
outdoorEscapes = (PlaceKind -> PlaceKind) -> [PlaceKind] -> [PlaceKind]
forall a b. (a -> b) -> [a] -> [b]
map PlaceKind -> PlaceKind
switchEscapeToOutdoorDown [PlaceKind]
escapeDownBasic
  in [PlaceKind]
upEscapes [PlaceKind] -> [PlaceKind] -> [PlaceKind]
forall a. [a] -> [a] -> [a]
++ [PlaceKind]
outdoorEscapes

-- The dots below are @'\x00B7'@, as defined in `TileKind.floorSymbol`.
defaultLegendLit :: EM.EnumMap Char (GroupName TileKind)
defaultLegendLit :: EnumMap Char (GroupName TileKind)
defaultLegendLit = [(Char, GroupName TileKind)] -> EnumMap Char (GroupName TileKind)
forall k a. Enum k => [(k, a)] -> EnumMap k a
EM.fromList
  [ (Char
' ', GroupName TileKind
FILLER_WALL)
  , (Char
'|', GroupName TileKind
S_WALL_LIT)
  , (Char
'-', GroupName TileKind
S_WALL_HORIZONTAL_LIT)
  , (Char
'0', GroupName TileKind
S_PILLAR)
  , (Char
'&', GroupName TileKind
S_RUBBLE_PILE)
  , (Char
'<', GroupName TileKind
TILE_INDOOR_ESCAPE_UP)
  , (Char
'>', GroupName TileKind
TILE_INDOOR_ESCAPE_DOWN)
  , (Char
'·', GroupName TileKind
FLOOR_ACTOR_ITEM_LIT)
  , (Char
'~', GroupName TileKind
S_SHALLOW_WATER_LIT)
  , (Char
'I', GroupName TileKind
SIGNBOARD) ]

defaultLegendDark :: EM.EnumMap Char (GroupName TileKind)
defaultLegendDark :: EnumMap Char (GroupName TileKind)
defaultLegendDark = [(Char, GroupName TileKind)] -> EnumMap Char (GroupName TileKind)
forall k a. Enum k => [(k, a)] -> EnumMap k a
EM.fromList
  [ (Char
' ', GroupName TileKind
FILLER_WALL)
  , (Char
'|', GroupName TileKind
S_WALL_DARK)
  , (Char
'-', GroupName TileKind
S_WALL_HORIZONTAL_DARK)
  , (Char
'0', GroupName TileKind
S_PILLAR)
  , (Char
'&', GroupName TileKind
S_RUBBLE_PILE)
  , (Char
'<', GroupName TileKind
TILE_INDOOR_ESCAPE_UP)
  , (Char
'>', GroupName TileKind
TILE_INDOOR_ESCAPE_DOWN)
  , (Char
'·', GroupName TileKind
FLOOR_ACTOR_ITEM_DARK)
  , (Char
'~', GroupName TileKind
S_SHALLOW_WATER_DARK)
  , (Char
'I', GroupName TileKind
SIGNBOARD) ]

deadEnd :: PlaceKind
deadEnd = PlaceKind  -- needs to have index 0
  { pname :: Text
pname    = Text
"a dead end"
  , pfreq :: [(GroupName PlaceKind, Int)]
pfreq    = []
  , prarity :: Rarity
prarity  = []
  , pcover :: Cover
pcover   = Cover
CStretch
  , pfence :: Fence
pfence   = Fence
FNone
  , ptopLeft :: [Text]
ptopLeft = [Text
"·"]
  , plegendDark :: EnumMap Char (GroupName TileKind)
plegendDark = EnumMap Char (GroupName TileKind)
defaultLegendDark
  , plegendLit :: EnumMap Char (GroupName TileKind)
plegendLit = EnumMap Char (GroupName TileKind)
defaultLegendLit
  }
rect :: PlaceKind
rect = PlaceKind  -- Valid for any nonempty area, hence low frequency.
  { pname :: Text
pname    = Text
"a chamber"
  , pfreq :: [(GroupName PlaceKind, Int)]
pfreq    = [(GroupName PlaceKind
ROGUE, Int
30), (GroupName PlaceKind
LABORATORY, Int
10)]
  , prarity :: Rarity
prarity  = [(Double
1, Int
10), (Double
10, Int
6)]
  , pcover :: Cover
pcover   = Cover
CStretch
  , pfence :: Fence
pfence   = Fence
FNone
  , ptopLeft :: [Text]
ptopLeft = [ Text
"--"
               , Text
"|·"
               ]
  , plegendDark :: EnumMap Char (GroupName TileKind)
plegendDark = EnumMap Char (GroupName TileKind)
defaultLegendDark
  , plegendLit :: EnumMap Char (GroupName TileKind)
plegendLit = EnumMap Char (GroupName TileKind)
defaultLegendLit
  }
rect2 :: PlaceKind
rect2 = PlaceKind
rect
  { pname    = "a pen"
  , pfreq    = [(ZOO, 3)]
  }
rect3 :: PlaceKind
rect3 = [(Char, GroupName TileKind)] -> PlaceKind -> PlaceKind
overridePlaceKind [ (Char
'|', GroupName TileKind
S_WALL_LIT)  -- visible from afar
                          , (Char
'-', GroupName TileKind
S_WALL_HORIZONTAL_LIT) ] (PlaceKind -> PlaceKind) -> PlaceKind -> PlaceKind
forall a b. (a -> b) -> a -> b
$ PlaceKind
rect
  { pname    = "a shed"
  , pfreq    = [(BRAWL, 10), (SHOOTOUT, 1)]
  }
rect4 :: PlaceKind
rect4 = PlaceKind
rect3
  { pname    = "cabinet"
  , pfreq    = [(ARENA, 10)]
  }
rectWindows :: PlaceKind
rectWindows = [(Char, GroupName TileKind)]
-> [(Char, GroupName TileKind)] -> PlaceKind -> PlaceKind
override2PlaceKind
                [ (Char
'=', GroupName TileKind
RECT_WINDOWS_HORIZONTAL_DARK)
                , (Char
'!', GroupName TileKind
RECT_WINDOWS_VERTICAL_DARK) ]
                [ (Char
'=', GroupName TileKind
RECT_WINDOWS_HORIZONTAL_LIT)
                , (Char
'!', GroupName TileKind
RECT_WINDOWS_VERTICAL_LIT) ] (PlaceKind -> PlaceKind) -> PlaceKind -> PlaceKind
forall a b. (a -> b) -> a -> b
$ PlaceKind
  { pname :: Text
pname    = Text
"a hut"
  , pfreq :: [(GroupName PlaceKind, Int)]
pfreq    = [(GroupName PlaceKind
FLIGHT, Int
10), (GroupName PlaceKind
AMBUSH, Int
7)]
  , prarity :: Rarity
prarity  = [(Double
1, Int
10), (Double
10, Int
10)]
  , pcover :: Cover
pcover   = Cover
CStretch
  , pfence :: Fence
pfence   = Fence
FNone
  , ptopLeft :: [Text]
ptopLeft = [ Text
"-="
               , Text
"!·"
               ]
  , plegendDark :: EnumMap Char (GroupName TileKind)
plegendDark = EnumMap Char (GroupName TileKind)
defaultLegendDark
  , plegendLit :: EnumMap Char (GroupName TileKind)
plegendLit = EnumMap Char (GroupName TileKind)
defaultLegendLit
  }
glasshouse :: PlaceKind
glasshouse = [(Char, GroupName TileKind)] -> PlaceKind -> PlaceKind
overridePlaceKind
               [ (Char
'=', GroupName TileKind
GLASSHOUSE_HORIZONTAL_LIT)  -- visible from afar
               , (Char
'!', GroupName TileKind
GLASSHOUSE_VERTICAL_LIT) ] (PlaceKind -> PlaceKind) -> PlaceKind -> PlaceKind
forall a b. (a -> b) -> a -> b
$ PlaceKind
  { pname :: Text
pname    = Text
"a glasshouse"
  , pfreq :: [(GroupName PlaceKind, Int)]
pfreq    = [(GroupName PlaceKind
SHOOTOUT, Int
4)]
  , prarity :: Rarity
prarity  = [(Double
1, Int
10), (Double
10, Int
7)]
  , pcover :: Cover
pcover   = Cover
CStretch
  , pfence :: Fence
pfence   = Fence
FNone
  , ptopLeft :: [Text]
ptopLeft = [ Text
"=="
               , Text
"!·"
               ]
  , plegendDark :: EnumMap Char (GroupName TileKind)
plegendDark = EnumMap Char (GroupName TileKind)
defaultLegendDark
  , plegendLit :: EnumMap Char (GroupName TileKind)
plegendLit = EnumMap Char (GroupName TileKind)
defaultLegendLit
  }
glasshouse2 :: PlaceKind
glasshouse2 = [(Char, GroupName TileKind)]
-> [(Char, GroupName TileKind)] -> PlaceKind -> PlaceKind
override2PlaceKind [ (Char
'=', GroupName TileKind
GLASSHOUSE_HORIZONTAL_DARK)
                                 , (Char
'!', GroupName TileKind
GLASSHOUSE_VERTICAL_DARK) ]
                                 [ (Char
'=', GroupName TileKind
GLASSHOUSE_HORIZONTAL_LIT)
                                 , (Char
'!', GroupName TileKind
GLASSHOUSE_VERTICAL_LIT) ] (PlaceKind -> PlaceKind) -> PlaceKind -> PlaceKind
forall a b. (a -> b) -> a -> b
$ PlaceKind
glasshouse
  { pname    = "a glass cage"
  , pfreq    = [(ZOO, 10)]
  }
glasshouse3 :: PlaceKind
glasshouse3 = PlaceKind
glasshouse
  { pname    = "a reading room"
  , pfreq    = [(ARENA, 40)]
  }
pulpit :: PlaceKind
pulpit = [(Char, GroupName TileKind)] -> PlaceKind -> PlaceKind
overridePlaceKind [ (Char
'=', GroupName TileKind
GLASSHOUSE_HORIZONTAL_LIT)
                           , (Char
'!', GroupName TileKind
GLASSHOUSE_VERTICAL_LIT)
                           , (Char
'0', GroupName TileKind
S_PULPIT) ] (PlaceKind -> PlaceKind) -> PlaceKind -> PlaceKind
forall a b. (a -> b) -> a -> b
$ PlaceKind
           -- except for floor, all will be lit, regardless of night/dark; OK
  { pname :: Text
pname    = Text
"a stand dais"
  , pfreq :: [(GroupName PlaceKind, Int)]
pfreq    = [(GroupName PlaceKind
ARENA, Int
200), (GroupName PlaceKind
ZOO, Int
200)]
  , prarity :: Rarity
prarity  = [(Double
1, Int
1)]
  , pcover :: Cover
pcover   = Cover
CMirror
  , pfence :: Fence
pfence   = Fence
FGround
  , ptopLeft :: [Text]
ptopLeft = [ Text
"==·"
               , Text
"!··"
               , Text
"··0"
               ]
  , plegendDark :: EnumMap Char (GroupName TileKind)
plegendDark = EnumMap Char (GroupName TileKind)
defaultLegendDark
  , plegendLit :: EnumMap Char (GroupName TileKind)
plegendLit = EnumMap Char (GroupName TileKind)
defaultLegendLit
  }
ruin :: PlaceKind
ruin = PlaceKind
  { pname :: Text
pname    = Text
"ruins"
  , pfreq :: [(GroupName PlaceKind, Int)]
pfreq    = [(GroupName PlaceKind
BATTLE, Int
330)]
  , prarity :: Rarity
prarity  = [(Double
1, Int
1)]
  , pcover :: Cover
pcover   = Cover
CStretch
  , pfence :: Fence
pfence   = Fence
FNone
  , ptopLeft :: [Text]
ptopLeft = [ Text
"--"
               , Text
"|X"
               ]
  , plegendDark :: EnumMap Char (GroupName TileKind)
plegendDark = EnumMap Char (GroupName TileKind)
defaultLegendDark
  , plegendLit :: EnumMap Char (GroupName TileKind)
plegendLit = EnumMap Char (GroupName TileKind)
defaultLegendLit
  }
ruin2 :: PlaceKind
ruin2 = [(Char, GroupName TileKind)] -> PlaceKind -> PlaceKind
overridePlaceKind [ (Char
'|', GroupName TileKind
S_WALL_LIT)  -- visible from afar
                          , (Char
'-', GroupName TileKind
S_WALL_HORIZONTAL_LIT) ] (PlaceKind -> PlaceKind) -> PlaceKind -> PlaceKind
forall a b. (a -> b) -> a -> b
$ PlaceKind
ruin
  { pname    = "blasted walls"
  , pfreq    = [(AMBUSH, 50)]
  }
collapsed :: PlaceKind
collapsed = PlaceKind
  { pname :: Text
pname    = Text
"a collapsed cavern"
  , pfreq :: [(GroupName PlaceKind, Int)]
pfreq    = [(GroupName PlaceKind
NOISE, Int
1)]
      -- no point taking up space if very little space taken,
      -- but if no other place can be generated, a failsafe is useful
  , prarity :: Rarity
prarity  = [(Double
1, Int
1)]
  , pcover :: Cover
pcover   = Cover
CStretch
  , pfence :: Fence
pfence   = Fence
FNone
  , ptopLeft :: [Text]
ptopLeft = [ Text
"0"
               ]
  , plegendDark :: EnumMap Char (GroupName TileKind)
plegendDark = EnumMap Char (GroupName TileKind)
defaultLegendDark
  , plegendLit :: EnumMap Char (GroupName TileKind)
plegendLit = EnumMap Char (GroupName TileKind)
defaultLegendLit
  }
collapsed2 :: PlaceKind
collapsed2 = PlaceKind
collapsed
  { pfreq    = [(NOISE, 1000), (BATTLE, 200)]
  , ptopLeft = [ "X0"
               , "00"
               ]
  }
collapsed3 :: PlaceKind
collapsed3 = PlaceKind
collapsed
  { pfreq    = [(NOISE, 2000), (BATTLE, 200)]
  , ptopLeft = [ "XX0"
               , "000"
               ]
  }
collapsed4 :: PlaceKind
collapsed4 = PlaceKind
collapsed
  { pfreq    = [(NOISE, 2000), (BATTLE, 200)]
  , ptopLeft = [ "XXX0"
               , "0000"
               ]
  }
collapsed5 :: PlaceKind
collapsed5 = PlaceKind
collapsed
  { pfreq    = [(NOISE, 3000), (BATTLE, 500)]
  , ptopLeft = [ "XX0"
               , "X00"
               , "000"
               ]
  }
collapsed6 :: PlaceKind
collapsed6 = PlaceKind
collapsed
  { pfreq    = [(NOISE, 4000), (BATTLE, 1000)]
  , ptopLeft = [ "XXX0"
               , "X000"
               , "0000"
               ]
  }
collapsed7 :: PlaceKind
collapsed7 = PlaceKind
collapsed
  { pfreq    = [(NOISE, 4000), (BATTLE, 1000)]
  , ptopLeft = [ "XXX0"
               , "XX00"
               , "0000"
               ]
  }
pillar :: PlaceKind
pillar = PlaceKind
  { pname :: Text
pname    = Text
"a hall"
  , pfreq :: [(GroupName PlaceKind, Int)]
pfreq    = [(GroupName PlaceKind
ROGUE, Int
600), (GroupName PlaceKind
LABORATORY, Int
2000)]
  , prarity :: Rarity
prarity  = [(Double
1, Int
1)]
  , pcover :: Cover
pcover   = Cover
CStretch
  , pfence :: Fence
pfence   = Fence
FNone
  -- Larger rooms require support pillars.
  , ptopLeft :: [Text]
ptopLeft = [ Text
"----"
               , Text
"|···"
               , Text
"|·0·"
               , Text
"|···"
               ]
  , plegendDark :: EnumMap Char (GroupName TileKind)
plegendDark = EnumMap Char (GroupName TileKind)
defaultLegendDark
  , plegendLit :: EnumMap Char (GroupName TileKind)
plegendLit = EnumMap Char (GroupName TileKind)
defaultLegendLit
  }
pillar2 :: PlaceKind
pillar2 = PlaceKind
pillar
  { pfreq    = [(ROGUE, 60), (LABORATORY, 200)]
  , ptopLeft = [ "----"
               , "|0··"
               , "|···"
               , "|···"
               ]
  }
pillar3 :: PlaceKind
pillar3 = PlaceKind
pillar
  { pfreq    = [(ROGUE, 8000), (LABORATORY, 25000)]
  , ptopLeft = [ "-----"
               , "|0···"
               , "|····"
               , "|··0·"
               , "|····"
               ]
  }
pillar4 :: PlaceKind
pillar4 = [(Char, GroupName TileKind)] -> PlaceKind -> PlaceKind
overridePlaceKind [(Char
'&', GroupName TileKind
CACHE)] (PlaceKind -> PlaceKind) -> PlaceKind -> PlaceKind
forall a b. (a -> b) -> a -> b
$ PlaceKind
pillar
  { pname    = "an exquisite hall"
  , pfreq    = [(ROGUE, 30000), (LABORATORY, 100000)]
  , ptopLeft = [ "-----"
               , "|&·0·"
               , "|····"
               , "|0·0·"
               , "|····"
               ]
  }
pillar5 :: PlaceKind
pillar5 = [(Char, GroupName TileKind)] -> PlaceKind -> PlaceKind
overridePlaceKind [(Char
'&', GroupName TileKind
CACHE)] (PlaceKind -> PlaceKind) -> PlaceKind -> PlaceKind
forall a b. (a -> b) -> a -> b
$ PlaceKind
pillar
  { pname    = "a decorated hall"
  , pfreq    = [(ROGUE, 30000), (LABORATORY, 100000)]
  , ptopLeft = [ "-----"
               , "|&·0·"
               , "|····"
               , "|0···"
               , "|····"
               ]
  }
colonnade :: PlaceKind
colonnade = PlaceKind
  { pname :: Text
pname    = Text
"a colonnade"
  , pfreq :: [(GroupName PlaceKind, Int)]
pfreq    = [ (GroupName PlaceKind
ROGUE, Int
3), (GroupName PlaceKind
ARENA, Int
20), (GroupName PlaceKind
LABORATORY, Int
2)
               , (GroupName PlaceKind
EMPTY, Int
10000), (GroupName PlaceKind
MINE, Int
1000), (GroupName PlaceKind
BRAWL, Int
4)
               , (GroupName PlaceKind
FLIGHT, Int
40), (GroupName PlaceKind
AMBUSH, Int
40) ]
  , prarity :: Rarity
prarity  = [(Double
1, Int
10), (Double
10, Int
10)]
  , pcover :: Cover
pcover   = Cover
CAlternate
  , pfence :: Fence
pfence   = Fence
FFloor
  , ptopLeft :: [Text]
ptopLeft = [ Text
"0·"
               , Text
"··"
               ]
  , plegendDark :: EnumMap Char (GroupName TileKind)
plegendDark = EnumMap Char (GroupName TileKind)
defaultLegendDark
  , plegendLit :: EnumMap Char (GroupName TileKind)
plegendLit = EnumMap Char (GroupName TileKind)
defaultLegendLit
  }
colonnade2 :: PlaceKind
colonnade2 = PlaceKind
colonnade
  { prarity  = [(1, 15), (10, 15)]
  , ptopLeft = [ "0·"
               , "·0"
               ]
  }
colonnade3 :: PlaceKind
colonnade3 = PlaceKind
colonnade
  { prarity  = [(1, 800), (10, 800)]
  , ptopLeft = [ "··0"
               , "·0·"
               , "0··"
               ]
  }
colonnade4 :: PlaceKind
colonnade4 = PlaceKind
colonnade
  { prarity  = [(1, 200), (10, 200)]
  , ptopLeft = [ "0··"
               , "·0·"
               , "··0"
               ]
  }
colonnade5 :: PlaceKind
colonnade5 = PlaceKind
colonnade
  { prarity  = [(1, 10), (10, 10)]
  , ptopLeft = [ "0··"
               , "··0"
               ]
  }
colonnade6 :: PlaceKind
colonnade6 = PlaceKind
colonnade
  { prarity  = [(1, 100), (10, 100)]
  , ptopLeft = [ "0·"
               , "··"
               , "·0"
               ]
  }
lampPost :: PlaceKind
lampPost = [(Char, GroupName TileKind)] -> PlaceKind -> PlaceKind
overridePlaceKind [ (Char
'0', GroupName TileKind
S_LAMP_POST)
                             , (Char
'·', GroupName TileKind
S_FLOOR_ACTOR_LIT) ] (PlaceKind -> PlaceKind) -> PlaceKind -> PlaceKind
forall a b. (a -> b) -> a -> b
$ PlaceKind
  { pname :: Text
pname    = Text
"a lamp-lit area"
  , pfreq :: [(GroupName PlaceKind, Int)]
pfreq    = [(GroupName PlaceKind
FLIGHT, Int
200), (GroupName PlaceKind
AMBUSH, Int
200), (GroupName PlaceKind
ZOO, Int
100), (GroupName PlaceKind
BATTLE, Int
100)]
  , prarity :: Rarity
prarity  = [(Double
1, Int
1)]
  , pcover :: Cover
pcover   = Cover
CVerbatim
  , pfence :: Fence
pfence   = Fence
FNone
  , ptopLeft :: [Text]
ptopLeft = [ Text
"X·X"
               , Text
"·0·"
               , Text
"X·X"
               ]
  , plegendDark :: EnumMap Char (GroupName TileKind)
plegendDark = EnumMap Char (GroupName TileKind)
defaultLegendDark
  , plegendLit :: EnumMap Char (GroupName TileKind)
plegendLit = EnumMap Char (GroupName TileKind)
defaultLegendLit
  }
lampPost2 :: PlaceKind
lampPost2 = PlaceKind
lampPost
  { ptopLeft = [ "···"
               , "·0·"
               , "···"
               ]
  }
lampPost3 :: PlaceKind
lampPost3 = PlaceKind
lampPost
  { pfreq    = [ (FLIGHT, 3000), (AMBUSH, 3000), (ZOO, 50)
               , (BATTLE, 110) ]
  , ptopLeft = [ "XX·XX"
               , "X···X"
               , "··0··"
               , "X···X"
               , "XX·XX"
               ]
  }
lampPost4 :: PlaceKind
lampPost4 = PlaceKind
lampPost
  { pfreq    = [(FLIGHT, 3000), (AMBUSH, 3000), (ZOO, 50), (BATTLE, 60)]
  , ptopLeft = [ "X···X"
               , "·····"
               , "··0··"
               , "·····"
               , "X···X"
               ]
  }
treeShade :: PlaceKind
treeShade = [(Char, GroupName TileKind)]
-> [(Char, GroupName TileKind)] -> PlaceKind -> PlaceKind
override2PlaceKind [ (Char
'0', GroupName TileKind
S_TREE_DARK)
                               , (Char
's', GroupName TileKind
TREE_SHADE_WALKABLE_DARK) ]
                               [ (Char
'0', GroupName TileKind
S_TREE_LIT)
                               , (Char
's', GroupName TileKind
TREE_SHADE_WALKABLE_LIT) ] (PlaceKind -> PlaceKind) -> PlaceKind -> PlaceKind
forall a b. (a -> b) -> a -> b
$
            [(Char, GroupName TileKind)] -> PlaceKind -> PlaceKind
overridePlaceKind [(Char
'·', GroupName TileKind
S_SHADED_GROUND)] (PlaceKind -> PlaceKind) -> PlaceKind -> PlaceKind
forall a b. (a -> b) -> a -> b
$ PlaceKind
  { pname :: Text
pname    = Text
"a tree shade"
  , pfreq :: [(GroupName PlaceKind, Int)]
pfreq    = [(GroupName PlaceKind
BRAWL, Int
1000)]
  , prarity :: Rarity
prarity  = [(Double
1, Int
1)]
  , pcover :: Cover
pcover   = Cover
CMirror
  , pfence :: Fence
pfence   = Fence
FNone
  , ptopLeft :: [Text]
ptopLeft = [ Text
"··s"
               , Text
"s0·"
               , Text
"Xs·"
               ]
  , plegendDark :: EnumMap Char (GroupName TileKind)
plegendDark = EnumMap Char (GroupName TileKind)
defaultLegendDark
  , plegendLit :: EnumMap Char (GroupName TileKind)
plegendLit = EnumMap Char (GroupName TileKind)
defaultLegendLit
  }
fogClump :: PlaceKind
fogClump = [(Char, GroupName TileKind)]
-> [(Char, GroupName TileKind)] -> PlaceKind -> PlaceKind
override2PlaceKind [(Char
'f', GroupName TileKind
FOG_CLUMP_DARK)]
                              [(Char
'f', GroupName TileKind
FOG_CLUMP_LIT)] (PlaceKind -> PlaceKind) -> PlaceKind -> PlaceKind
forall a b. (a -> b) -> a -> b
$
           [(Char, GroupName TileKind)] -> PlaceKind -> PlaceKind
overridePlaceKind [(Char
';', GroupName TileKind
S_FOG_LIT)] (PlaceKind -> PlaceKind) -> PlaceKind -> PlaceKind
forall a b. (a -> b) -> a -> b
$ PlaceKind
  { pname :: Text
pname    = Text
"a foggy patch"
  , pfreq :: [(GroupName PlaceKind, Int)]
pfreq    = [(GroupName PlaceKind
SHOOTOUT, Int
150), (GroupName PlaceKind
EMPTY, Int
15)]
  , prarity :: Rarity
prarity  = [(Double
1, Int
1)]
  , pcover :: Cover
pcover   = Cover
CMirror
  , pfence :: Fence
pfence   = Fence
FNone
  , ptopLeft :: [Text]
ptopLeft = [ Text
"f;"
               , Text
";f"
               , Text
";X"
               ]
  , plegendDark :: EnumMap Char (GroupName TileKind)
plegendDark = EnumMap Char (GroupName TileKind)
defaultLegendDark
  , plegendLit :: EnumMap Char (GroupName TileKind)
plegendLit = EnumMap Char (GroupName TileKind)
defaultLegendLit
  }
fogClump2 :: PlaceKind
fogClump2 = PlaceKind
fogClump
  { pfreq    = [(SHOOTOUT, 500), (EMPTY, 50)]
  , ptopLeft = [ "X;f"
               , "f;f"
               , ";;f"
               , "Xff"
               ]
  }
smokeClump :: PlaceKind
smokeClump = [(Char, GroupName TileKind)]
-> [(Char, GroupName TileKind)] -> PlaceKind -> PlaceKind
override2PlaceKind [ (Char
'f', GroupName TileKind
SMOKE_CLUMP_DARK)
                                , (Char
'·', GroupName TileKind
S_FLOOR_ACTOR_DARK) ]
                                [ (Char
'f', GroupName TileKind
SMOKE_CLUMP_LIT)
                                , (Char
'·', GroupName TileKind
S_FLOOR_ACTOR_LIT) ] (PlaceKind -> PlaceKind) -> PlaceKind -> PlaceKind
forall a b. (a -> b) -> a -> b
$
             [(Char, GroupName TileKind)] -> PlaceKind -> PlaceKind
overridePlaceKind [(Char
';', GroupName TileKind
S_SMOKE_LIT)] (PlaceKind -> PlaceKind) -> PlaceKind -> PlaceKind
forall a b. (a -> b) -> a -> b
$ PlaceKind
  { pname :: Text
pname    = Text
"a smoky patch"
  , pfreq :: [(GroupName PlaceKind, Int)]
pfreq    = [(GroupName PlaceKind
ZOO, Int
50)]
  , prarity :: Rarity
prarity  = [(Double
1, Int
1)]
  , pcover :: Cover
pcover   = Cover
CMirror
  , pfence :: Fence
pfence   = Fence
FNone
  , ptopLeft :: [Text]
ptopLeft = [ Text
"f;"
               , Text
";f"
               , Text
";X"
               ]
  , plegendDark :: EnumMap Char (GroupName TileKind)
plegendDark = EnumMap Char (GroupName TileKind)
defaultLegendDark
  , plegendLit :: EnumMap Char (GroupName TileKind)
plegendLit = EnumMap Char (GroupName TileKind)
defaultLegendLit
  }
smokeClump2 :: PlaceKind
smokeClump2 = PlaceKind
smokeClump
  { pfreq    = [(ZOO, 500)]
  , ptopLeft = [ "X;f"
               , "f;f"
               , ";;f"
               , "Xff"
               ]
  }
smokeClump3FGround :: PlaceKind
smokeClump3FGround = PlaceKind
smokeClump
  { pname    = "a burned out area"
  , pfreq    = [(LABORATORY, 150)]
  , prarity  = [(1, 1)]
  , pcover   = CVerbatim
  , pfence   = FGround
  , ptopLeft = [ ";f;"
               , "f·f"
               , "f·f"
               , ";f;"
               ]
      -- should not be used in caves with trails, because bushes should
      -- not grow over such artificial trails
  }
bushClump :: PlaceKind
bushClump = [(Char, GroupName TileKind)]
-> [(Char, GroupName TileKind)] -> PlaceKind -> PlaceKind
override2PlaceKind [(Char
'f', GroupName TileKind
BUSH_CLUMP_DARK)]
                               [(Char
'f', GroupName TileKind
BUSH_CLUMP_LIT)] (PlaceKind -> PlaceKind) -> PlaceKind -> PlaceKind
forall a b. (a -> b) -> a -> b
$
            [(Char, GroupName TileKind)] -> PlaceKind -> PlaceKind
overridePlaceKind [(Char
';', GroupName TileKind
S_BUSH_LIT)] (PlaceKind -> PlaceKind) -> PlaceKind -> PlaceKind
forall a b. (a -> b) -> a -> b
$ PlaceKind
  { pname :: Text
pname    = Text
"a bushy patch"
  , pfreq :: [(GroupName PlaceKind, Int)]
pfreq    = [(GroupName PlaceKind
SHOOTOUT, Int
40)]
  , prarity :: Rarity
prarity  = [(Double
1, Int
1)]
  , pcover :: Cover
pcover   = Cover
CMirror
  , pfence :: Fence
pfence   = Fence
FNone
  , ptopLeft :: [Text]
ptopLeft = [ Text
"Xf"  -- one sure exit needed not to block a corner
               , Text
";X"
               , Text
";;"
               ]
  , plegendDark :: EnumMap Char (GroupName TileKind)
plegendDark = EnumMap Char (GroupName TileKind)
defaultLegendDark
  , plegendLit :: EnumMap Char (GroupName TileKind)
plegendLit = EnumMap Char (GroupName TileKind)
defaultLegendLit
      -- should not be used in caves with trails, because bushes can't
      -- grow over such artificial trails
  }
bushClump2 :: PlaceKind
bushClump2 = PlaceKind
bushClump
  { pfreq    = [(SHOOTOUT, 80)]
  , ptopLeft = [ "Xf"  -- one sure exit needed not to block a corner
               , ";X"
               , ";X"
               , ";;"
               ]
  }
escapeDown :: PlaceKind
escapeDown = [(Char, GroupName TileKind)] -> PlaceKind -> PlaceKind
overridePlaceKind [ (Char
'|', GroupName TileKind
S_WALL_LIT)  -- visible from afar
                               , (Char
'-', GroupName TileKind
S_WALL_HORIZONTAL_LIT) ] (PlaceKind -> PlaceKind) -> PlaceKind -> PlaceKind
forall a b. (a -> b) -> a -> b
$ PlaceKind
  { pname :: Text
pname    = Text
"an escape down"
  , pfreq :: [(GroupName PlaceKind, Int)]
pfreq    = [(GroupName PlaceKind
INDOOR_ESCAPE_DOWN, Int
1)]
  , prarity :: Rarity
prarity  = [(Double
1, Int
1)]
  , pcover :: Cover
pcover   = Cover
CVerbatim
  , pfence :: Fence
pfence   = Fence
FGround
  , ptopLeft :: [Text]
ptopLeft = [ Text
">"
               ]
  , plegendDark :: EnumMap Char (GroupName TileKind)
plegendDark = EnumMap Char (GroupName TileKind)
defaultLegendDark
  , plegendLit :: EnumMap Char (GroupName TileKind)
plegendLit = EnumMap Char (GroupName TileKind)
defaultLegendLit
  }
escapeDown2 :: PlaceKind
escapeDown2 = PlaceKind
escapeDown
  { pfreq    = [(INDOOR_ESCAPE_DOWN, 1000)]
  , pfence   = FFloor
  , ptopLeft = [ "0·0"
               , "·>·"
               , "0·0"
               ]
  }
escapeDown3 :: PlaceKind
escapeDown3 = PlaceKind
escapeDown
  { pfreq    = [(INDOOR_ESCAPE_DOWN, 2000)]
  , pfence   = FNone
  , ptopLeft = [ "-----"
               , "|0·0|"
               , "|·>·|"
               , "|0·0|"
               , "-----"
               ]
  }
escapeDown4 :: PlaceKind
escapeDown4 = PlaceKind
escapeDown
  { pfreq    = [(INDOOR_ESCAPE_DOWN, 1000)]
  , pcover   = CMirror
  , pfence   = FFloor
  , ptopLeft = [ "0··"
               , "·>·"
               , "··0"
               ]
  }
escapeDown5 :: PlaceKind
escapeDown5 = PlaceKind
escapeDown
  { pfreq    = [(INDOOR_ESCAPE_DOWN, 2000)]
  , pcover   = CMirror
  , pfence   = FNone
  , ptopLeft = [ "-----"
               , "|0··|"
               , "|·>·|"
               , "|0·0|"
               , "-----"
               ]
  }
staircase :: PlaceKind
staircase = [(Char, GroupName TileKind)] -> PlaceKind -> PlaceKind
overridePlaceKind [ (Char
'<', GroupName TileKind
STAIRCASE_UP)
                              , (Char
'>', GroupName TileKind
STAIRCASE_DOWN)
                              , (Char
'|', GroupName TileKind
S_WALL_LIT)  -- visible from afar
                              , (Char
'-', GroupName TileKind
S_WALL_HORIZONTAL_LIT) ] (PlaceKind -> PlaceKind) -> PlaceKind -> PlaceKind
forall a b. (a -> b) -> a -> b
$ PlaceKind
  { pname :: Text
pname    = Text
"a staircase"
  , pfreq :: [(GroupName PlaceKind, Int)]
pfreq    = [(GroupName PlaceKind
TINY_STAIRCASE, Int
1)]  -- no cover when arriving; low freq
  , prarity :: Rarity
prarity  = [(Double
1, Int
100), (Double
10, Int
100)]
  , pcover :: Cover
pcover   = Cover
CVerbatim
  , pfence :: Fence
pfence   = Fence
FGround
  , ptopLeft :: [Text]
ptopLeft = [ Text
"<·>"
               ]
  , plegendDark :: EnumMap Char (GroupName TileKind)
plegendDark = EnumMap Char (GroupName TileKind)
defaultLegendDark
  , plegendLit :: EnumMap Char (GroupName TileKind)
plegendLit = EnumMap Char (GroupName TileKind)
defaultLegendLit
  }
staircase1 :: PlaceKind
staircase1 = PlaceKind
staircase
  { prarity  = [(1, 1)]  -- no cover when arriving; so low rarity
  }
staircase2 :: PlaceKind
staircase2 = PlaceKind
staircase
  { pfreq    = [(TINY_STAIRCASE, 3)]
  , prarity  = [(1, 1)]
  , pfence   = FGround
  , ptopLeft = [ "·<·>·"
               ]
  }
staircase3 :: PlaceKind
staircase3 = PlaceKind
staircase
  { prarity  = [(1, 1)]
  , pfence   = FFloor
  }
staircase4 :: PlaceKind
staircase4 = PlaceKind
staircase2
  { pfence   = FFloor
  , prarity  = [(1, 1)]
  }
staircase5 :: PlaceKind
staircase5 = PlaceKind
staircase
  { pfreq    = [(OPEN_STAIRCASE, 200)]  -- no cover, open
  , pfence   = FGround
  , ptopLeft = [ "0·0"
               , "···"
               , "<·>"
               , "···"
               , "0·0"
               ]
  }
staircase6 :: PlaceKind
staircase6 = PlaceKind
staircase
  { pfreq    = [(OPEN_STAIRCASE, 300)]
  , pfence   = FGround
  , ptopLeft = [ "0·0·0"
               , "·····"
               , "·<·>·"
               , "·····"
               , "0·0·0"
               ]
  }
staircase7 :: PlaceKind
staircase7 = PlaceKind
staircase
  { pfreq    = [(OPEN_STAIRCASE, 500)]
  , pfence   = FGround
  , ptopLeft = [ "0·0·0·0"
               , "·······"
               , "0·<·>·0"
               , "·······"
               , "0·0·0·0"
               ]
  }
staircase8 :: PlaceKind
staircase8 = PlaceKind
staircase
  { pfreq    = [(OPEN_STAIRCASE, 2000)]
  , pfence   = FGround
  , ptopLeft = [ "·0·I·0·"
               , "0·····0"
               , "··<·>··"
               , "0·····0"
               , "·0·0·0·"
               ]
  }
staircase9 :: PlaceKind
staircase9 = PlaceKind
staircase
  { pfreq    = [(OPEN_STAIRCASE, 500)]
  , pfence   = FGround
  , ptopLeft = [ "0·······0"
               , "···<·>···"
               , "0·······0"
               ]
  }
staircase10 :: PlaceKind
staircase10 = PlaceKind
staircase
  { pfreq    = [(OPEN_STAIRCASE, 500)]
  , pfence   = FGround
  , ptopLeft = [ "0·····0"
               , "··<·>··"
               , "0·····0"
               ]
  }
staircase11 :: PlaceKind
staircase11 = PlaceKind
staircase
  { pfreq    = [(CLOSED_STAIRCASE, 2000)]  -- weak cover, low freq
  , pfence   = FFloor
  , ptopLeft = [ "·0·"
               , "0·0"
               , "···"
               , "<·>"
               , "···"
               , "0·0"
               , "·0·"
               ]
  }
staircase12 :: PlaceKind
staircase12 = PlaceKind
staircase
  { pfreq    = [(CLOSED_STAIRCASE, 4000)]
  , pfence   = FFloor
  , ptopLeft = [ "·0·0·"
               , "0·0·0"
               , "·····"
               , "·<·>·"
               , "·····"
               , "0·0·0"
               , "·0·0·"
               ]
  }
staircase13 :: PlaceKind
staircase13 = PlaceKind
staircase
  { pfreq    = [(CLOSED_STAIRCASE, 6000)]
  , pfence   = FFloor
  , ptopLeft = [ "·0·0·0·"
               , "0·0·0·0"
               , "·······"
               , "0·<·>·0"
               , "·······"
               , "0·0·0·0"
               , "·0·0·0·"
               ]
  }
staircase14 :: PlaceKind
staircase14 = PlaceKind
staircase
  { pfreq    = [(CLOSED_STAIRCASE, 10000)]
  , pfence   = FFloor
  , ptopLeft = [ "0·0·0·0"
               , "·0·0·0·"
               , "0·····0"
               , "··<·>··"
               , "0·····0"
               , "·0·0·0·"
               , "0·0·0·0"
               ]
  }
staircase15 :: PlaceKind
staircase15 = PlaceKind
staircase
  { pfreq    = [(CLOSED_STAIRCASE, 20000)]
  , pfence   = FFloor
  , ptopLeft = [ "·0·0·0·0·"
               , "0·0·0·0·0"
               , "·0·····0·"
               , "0··<·>··0"
               , "·0·····0·"
               , "0·0·0·0·0"
               , "·0·0·0·0·"
               ]
  }
staircase16 :: PlaceKind
staircase16 = PlaceKind
staircase
  { pfreq    = [(CLOSED_STAIRCASE, 20000)]
  , pfence   = FFloor
  , ptopLeft = [ "0·0·0·0·0"
               , "·0·0·0·0·"
               , "0·······0"
               , "·0·<·>·0·"
               , "0·······0"
               , "·0·0·0·0·"
               , "0·0·0·0·0"
               ]
  }
staircase17 :: PlaceKind
staircase17 = PlaceKind
staircase
  { pfreq    = [(CLOSED_STAIRCASE, 20000)]
  , pfence   = FFloor
  , ptopLeft = [ "0·0·0·0·0·0"
               , "·0·0·0·0·0·"
               , "0·0·····0·0"
               , "·0··<·>··0·"
               , "0·0·····0·0"
               , "·0·0·0·0·0·"
               , "0·0·0·0·0·0"
               ]
  }
staircase18 :: PlaceKind
staircase18 = PlaceKind
staircase
  { pfreq    = [(CLOSED_STAIRCASE, 80000)]
  , pfence   = FFloor
  , ptopLeft = [ "··0·0·0·0··"
               , "·0·0·0·0·0·"
               , "0·0·····0·0"
               , "·0··<·>··0·"
               , "0·0·····0·0"
               , "·0·0·0·0·0·"
               , "··0·0·0·0··"
               ]
  }
staircase19 :: PlaceKind
staircase19 = PlaceKind
staircase
  { pfreq    = [(CLOSED_STAIRCASE, 20000)]
  , pfence   = FFloor
  , ptopLeft = [ "·0·0·0·0·0·"
               , "0·0·0·0·0·0"
               , "·0·······0·"
               , "0·0·<·>·0·0"
               , "·0·······0·"
               , "0·0·0·0·0·0"
               , "·0·0·0·0·0·"
               ]
  }
staircase20 :: PlaceKind
staircase20 = PlaceKind
staircase
  { pfreq    = [(CLOSED_STAIRCASE, 5000)]
  , pfence   = FFloor
  , ptopLeft = [ "·0·0·0·0·0·"
               , "0·0·····0·0"
               , "·0··<·>··0·"
               , "0·0·····0·0"
               , "·0·0·I·0·0·"
               ]
  }
staircase21 :: PlaceKind
staircase21 = PlaceKind
staircase
  { pfreq    = [(CLOSED_STAIRCASE, 5000)]
  , pfence   = FFloor
  , ptopLeft = [ "0·0·I·0·0"
               , "·0·····0·"
               , "0··<·>··0"
               , "·0·····0·"
               , "0·0·0·0·0"
               ]
  }
staircase22 :: PlaceKind
staircase22 = PlaceKind
staircase
  { pfreq    = [(CLOSED_STAIRCASE, 2000)]
  , pfence   = FFloor
  , ptopLeft = [ "0·0·····0·0"
               , "·0··<·>··0·"
               , "0·0·····0·0"
               ]
  }
staircase23 :: PlaceKind
staircase23 = PlaceKind
staircase
  { pfreq    = [(CLOSED_STAIRCASE, 1000)]
  , pfence   = FFloor
  , ptopLeft = [ "·0·······0·"
               , "0·0·<·>·0·0"
               , "·0·······0·"
               ]
  }
staircase24 :: PlaceKind
staircase24 = PlaceKind
staircase
  { pfreq    = [(CLOSED_STAIRCASE, 1000)]
  , pfence   = FFloor
  , ptopLeft = [ "·0·····0·"
               , "0··<·>··0"
               , "·0·····0·"
               ]
  }
staircase25 :: PlaceKind
staircase25 = PlaceKind
staircase
  { pfreq    = [(WALLED_STAIRCASE, 10)]
  , pfence   = FNone
  , ptopLeft = [ "-------"
               , "|·····|"
               , "|·<·>·|"
               , "|·····|"
               , "-------"
               ]
  }
staircase26 :: PlaceKind
staircase26 = PlaceKind
staircase
  { pfreq    = [(WALLED_STAIRCASE, 50)]
  , pfence   = FNone
  , ptopLeft = [ "---------"
               , "|·······|"
               , "|··<·>··|"
               , "|·······|"
               , "---------"
               ]
  }
staircase27 :: PlaceKind
staircase27 = PlaceKind
staircase
  { pfreq    = [(WALLED_STAIRCASE, 100)]
  , pfence   = FNone
  , ptopLeft = [ "---------"
               , "|0·····0|"
               , "|··<·>··|"
               , "|0·····0|"
               , "---------"
               ]
  }
staircase28 :: PlaceKind
staircase28 = PlaceKind
staircase
  { pfreq    = [(WALLED_STAIRCASE, 1000)]
  , pfence   = FNone
  , ptopLeft = [ "-------"
               , "|·····|"
               , "|·····|"
               , "|·<·>·|"
               , "|·····|"
               , "|·····|"
               , "-------"
               ]
  }
staircase29 :: PlaceKind
staircase29 = PlaceKind
staircase
  { pfreq    = [(WALLED_STAIRCASE, 1000)]
  , pfence   = FNone
  , ptopLeft = [ "-------"
               , "|0···0|"
               , "|·····|"
               , "|·<·>·|"
               , "|·····|"
               , "|0···0|"
               , "-------"
               ]
  }
staircase30 :: PlaceKind
staircase30 = PlaceKind
staircase
  { pfreq    = [(WALLED_STAIRCASE, 1000)]
  , pfence   = FNone
  , ptopLeft = [ "-------"
               , "|0·0·0|"
               , "|·····|"
               , "|·<·>·|"
               , "|·····|"
               , "|0·0·0|"
               , "-------"
               ]
  }
staircase31 :: PlaceKind
staircase31 = PlaceKind
staircase
  { pfreq    = [(WALLED_STAIRCASE, 2000)]
  , pfence   = FNone
  , ptopLeft = [ "---------"
               , "|·······|"
               , "|·······|"
               , "|··<·>··|"
               , "|·······|"
               , "|·······|"
               , "---------"
               ]
  }
staircase32 :: PlaceKind
staircase32 = PlaceKind
staircase
  { pfreq    = [(WALLED_STAIRCASE, 5000)]
  , pfence   = FNone
  , ptopLeft = [ "---------"
               , "|0·····0|"
               , "|·······|"
               , "|··<·>··|"
               , "|·······|"
               , "|0·····0|"
               , "---------"
               ]
  }
staircase33 :: PlaceKind
staircase33 = PlaceKind
staircase
  { pfreq    = [(WALLED_STAIRCASE, 5000)]
  , pfence   = FNone
  , ptopLeft = [ "---------"
               , "|0·0·0·0|"
               , "|·······|"
               , "|0·<·>·0|"
               , "|·······|"
               , "|0·0·0·0|"
               , "---------"
               ]
  }
staircase34 :: PlaceKind
staircase34 = PlaceKind
staircase
  { pfreq    = [(WALLED_STAIRCASE, 5000)]
  , pfence   = FNone
  , ptopLeft = [ "---------"
               , "|·0·0·0·|"
               , "|0·····0|"
               , "|··<·>··|"
               , "|0·····0|"
               , "|·0·I·0·|"
               , "---------"
               ]
  }
staircase35 :: PlaceKind
staircase35 = PlaceKind
staircase
  { pfreq    = [(WALLED_STAIRCASE, 200)]
  , pfence   = FNone
  , ptopLeft = [ "-----------"
               , "|·········|"
               , "|···<·>···|"
               , "|·········|"
               , "-----------"
               ]
  }
staircase36 :: PlaceKind
staircase36 = PlaceKind
staircase
  { pfreq    = [(WALLED_STAIRCASE, 500)]
  , pfence   = FNone
  , ptopLeft = [ "-----------"
               , "|·0·····0·|"
               , "|0··<·>··0|"
               , "|·0·····0·|"
               , "-----------"
               ]
  }
staircase37 :: PlaceKind
staircase37 = PlaceKind
staircase
  { pfreq    = [(WALLED_STAIRCASE, 500)]
  , pfence   = FNone
  , ptopLeft = [ "-----------"
               , "|0·······0|"
               , "|·0·<·>·0·|"
               , "|0·······0|"
               , "-----------"
               ]
  }

switchStaircaseToUp :: PlaceKind -> PlaceKind
switchStaircaseToUp :: PlaceKind -> PlaceKind
switchStaircaseToUp PlaceKind
s = [(Char, GroupName TileKind)]
-> [(Char, GroupName TileKind)] -> PlaceKind -> PlaceKind
override2PlaceKind [(Char
'>', GroupName TileKind
STAIR_TERMINAL_DARK)]
                                           [(Char
'>', GroupName TileKind
STAIR_TERMINAL_LIT)] (PlaceKind -> PlaceKind) -> PlaceKind -> PlaceKind
forall a b. (a -> b) -> a -> b
$ PlaceKind
s
  { pname     = pname s <+> "up"
  , pfreq     = renameFreqs (<+> "up") $ pfreq s
  }

switchStaircaseToDown :: PlaceKind -> PlaceKind
switchStaircaseToDown :: PlaceKind -> PlaceKind
switchStaircaseToDown PlaceKind
s = [(Char, GroupName TileKind)]
-> [(Char, GroupName TileKind)] -> PlaceKind -> PlaceKind
override2PlaceKind [(Char
'<', GroupName TileKind
STAIR_TERMINAL_DARK)]
                                             [(Char
'<', GroupName TileKind
STAIR_TERMINAL_LIT)] (PlaceKind -> PlaceKind) -> PlaceKind -> PlaceKind
forall a b. (a -> b) -> a -> b
$ PlaceKind
s
  { pname     = pname s <+> "down"
  , pfreq     = renameFreqs (<+> "down") $ pfreq s
  }

overrideGated :: [(Char, GroupName TileKind)]
overrideGated :: [(Char, GroupName TileKind)]
overrideGated =
  [ (Char
'<', GroupName TileKind
GATED_STAIRCASE_UP), (Char
'>', GroupName TileKind
GATED_STAIRCASE_DOWN)
  , (Char
'|', GroupName TileKind
S_WALL_LIT), (Char
'-', GroupName TileKind
S_WALL_HORIZONTAL_LIT) ]  -- visible from afar

switchStaircaseToGated :: PlaceKind -> PlaceKind
switchStaircaseToGated :: PlaceKind -> PlaceKind
switchStaircaseToGated PlaceKind
s = [(Char, GroupName TileKind)] -> PlaceKind -> PlaceKind
overridePlaceKind [(Char, GroupName TileKind)]
overrideGated (PlaceKind -> PlaceKind) -> PlaceKind -> PlaceKind
forall a b. (a -> b) -> a -> b
$ PlaceKind
s
  { pname     = T.unwords $ "a gated" : tail (T.words (pname s))
  , pfreq     = renameFreqs ("gated" <+>) $ pfreq s
  }

overrideOutdoor :: [(Char, GroupName TileKind)]
overrideOutdoor :: [(Char, GroupName TileKind)]
overrideOutdoor =
  [ (Char
'<', GroupName TileKind
STAIRCASE_OUTDOOR_UP), (Char
'>', GroupName TileKind
STAIRCASE_OUTDOOR_DOWN)
  , (Char
'|', GroupName TileKind
S_WALL_LIT), (Char
'-', GroupName TileKind
S_WALL_HORIZONTAL_LIT) ]  -- visible from afar

switchStaircaseToOutdoor :: PlaceKind -> PlaceKind
switchStaircaseToOutdoor :: PlaceKind -> PlaceKind
switchStaircaseToOutdoor PlaceKind
s = [(Char, GroupName TileKind)] -> PlaceKind -> PlaceKind
overridePlaceKind [(Char, GroupName TileKind)]
overrideOutdoor (PlaceKind -> PlaceKind) -> PlaceKind -> PlaceKind
forall a b. (a -> b) -> a -> b
$ PlaceKind
s
  { pname     = "an outdoor area exit"
  , pfreq     = renameFreqs ("outdoor" <+>) $ pfreq s
  }

switchEscapeToUp :: PlaceKind -> PlaceKind
switchEscapeToUp :: PlaceKind -> PlaceKind
switchEscapeToUp PlaceKind
s = [(Char, GroupName TileKind)] -> PlaceKind -> PlaceKind
overridePlaceKind [(Char
'>', GroupName TileKind
TILE_INDOOR_ESCAPE_UP)] (PlaceKind -> PlaceKind) -> PlaceKind -> PlaceKind
forall a b. (a -> b) -> a -> b
$ PlaceKind
s
  { pname     = "an escape up"
  , pfreq     = map (\(GroupName PlaceKind
_, Int
n) -> (GroupName PlaceKind
INDOOR_ESCAPE_UP, Int
n)) $ pfreq s
  }

switchEscapeToOutdoorDown :: PlaceKind -> PlaceKind
switchEscapeToOutdoorDown :: PlaceKind -> PlaceKind
switchEscapeToOutdoorDown PlaceKind
s = [(Char, GroupName TileKind)] -> PlaceKind -> PlaceKind
overridePlaceKind
                                [(Char
'>', GroupName TileKind
TILE_OUTDOOR_ESCAPE_DOWN)] (PlaceKind -> PlaceKind) -> PlaceKind -> PlaceKind
forall a b. (a -> b) -> a -> b
$ PlaceKind
s
  { pname     = "outdoor escape route"
  , pfreq     = map (\(GroupName PlaceKind
_, Int
n) -> (GroupName PlaceKind
OUTDOOR_ESCAPE_DOWN, Int
n)) $ pfreq s
  }