-- Copyright (c) 2008--2011 Andres Loeh
-- Copyright (c) 2010--2021 Mikolaj Konarski and others (see git history)
-- This file is a part of the computer game Allure of the Stars
-- and is released under the terms of the GNU Affero General Public License.
-- For license and copyright information, see the file LICENSE.
--
-- | 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 ESCAPE, pattern AMBUSH, pattern BATTLE, pattern NOISE, 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
  , pattern RESIDENTIAL, pattern MUSEUM, pattern EXIT, pattern RAID
  , pattern TINY_LIFT, pattern OPEN_LIFT, pattern WALLED_LIFT, pattern CLOSED_LIFT, pattern ESCAPE_FROM_SPACESHIP_DOWN, pattern DECON_TINY_STAIRCASE, pattern DECON_OPEN_STAIRCASE, pattern DECON_WALLED_STAIRCASE, pattern DECON_TINY_LIFT, pattern DECON_OPEN_LIFT, pattern DECON_WALLED_LIFT, pattern GATED_TINY_LIFT, pattern GATED_OPEN_LIFT, pattern GATED_CLOSED_LIFT, pattern WELDED_TINY_LIFT, pattern WELDED_OPEN_LIFT, pattern WELDED_WALLED_LIFT, pattern WELDED_TINY_STAIRCASE, pattern WELDED_OPEN_STAIRCASE, pattern WELDED_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 Content.TileKind hiding (content, groupNames, groupNamesSingleton)
import Game.LambdaHack.Content.PlaceKind
import Game.LambdaHack.Content.TileKind (TileKind)
import Game.LambdaHack.Definition.Defs
import Game.LambdaHack.Definition.DefsInternal

-- * 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
ESCAPE, GroupName PlaceKind
AMBUSH, GroupName PlaceKind
BATTLE, GroupName PlaceKind
NOISE, 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
RESIDENTIAL, GroupName PlaceKind
MUSEUM, GroupName PlaceKind
EXIT, GroupName PlaceKind
RAID]
    [GroupName PlaceKind]
-> [GroupName PlaceKind] -> [GroupName PlaceKind]
forall a. [a] -> [a] -> [a]
++ [GroupName PlaceKind
TINY_LIFT, GroupName PlaceKind
OPEN_LIFT, GroupName PlaceKind
WALLED_LIFT, GroupName PlaceKind
CLOSED_LIFT, GroupName PlaceKind
ESCAPE_FROM_SPACESHIP_DOWN]
    [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, ESCAPE, AMBUSH, BATTLE, NOISE, 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 RESIDENTIAL, MUSEUM, EXIT, RAID :: GroupName PlaceKind

pattern TINY_LIFT, OPEN_LIFT, WALLED_LIFT, CLOSED_LIFT, ESCAPE_FROM_SPACESHIP_DOWN, DECON_TINY_STAIRCASE, DECON_OPEN_STAIRCASE, DECON_WALLED_STAIRCASE, DECON_TINY_LIFT, DECON_OPEN_LIFT, DECON_WALLED_LIFT, GATED_TINY_LIFT, GATED_OPEN_LIFT, GATED_CLOSED_LIFT, WELDED_TINY_LIFT, WELDED_OPEN_LIFT, WELDED_WALLED_LIFT, WELDED_TINY_STAIRCASE, WELDED_OPEN_STAIRCASE, WELDED_WALLED_STAIRCASE :: GroupName PlaceKind

pattern $bROGUE :: GroupName PlaceKind
$mROGUE :: forall r. GroupName PlaceKind -> (Void# -> r) -> (Void# -> r) -> r
ROGUE = GroupName "rogue"
pattern $bLABORATORY :: GroupName PlaceKind
$mLABORATORY :: forall r. GroupName PlaceKind -> (Void# -> r) -> (Void# -> r) -> r
LABORATORY = GroupName "laboratory"
pattern $bZOO :: GroupName PlaceKind
$mZOO :: forall r. GroupName PlaceKind -> (Void# -> r) -> (Void# -> r) -> r
ZOO = GroupName "zoo"
pattern $bBRAWL :: GroupName PlaceKind
$mBRAWL :: forall r. GroupName PlaceKind -> (Void# -> r) -> (Void# -> r) -> r
BRAWL = GroupName "brawl"
pattern $bSHOOTOUT :: GroupName PlaceKind
$mSHOOTOUT :: forall r. GroupName PlaceKind -> (Void# -> r) -> (Void# -> r) -> r
SHOOTOUT = GroupName "shootout"
pattern $bARENA :: GroupName PlaceKind
$mARENA :: forall r. GroupName PlaceKind -> (Void# -> r) -> (Void# -> r) -> r
ARENA = GroupName "arena"
pattern $bESCAPE :: GroupName PlaceKind
$mESCAPE :: forall r. GroupName PlaceKind -> (Void# -> r) -> (Void# -> r) -> r
ESCAPE = GroupName "escape"
pattern $bAMBUSH :: GroupName PlaceKind
$mAMBUSH :: forall r. GroupName PlaceKind -> (Void# -> r) -> (Void# -> r) -> r
AMBUSH = GroupName "ambush"
pattern $bBATTLE :: GroupName PlaceKind
$mBATTLE :: forall r. GroupName PlaceKind -> (Void# -> r) -> (Void# -> r) -> r
BATTLE = GroupName "battle"
pattern $bNOISE :: GroupName PlaceKind
$mNOISE :: forall r. GroupName PlaceKind -> (Void# -> r) -> (Void# -> r) -> r
NOISE = GroupName "noise"
pattern $bEMPTY :: GroupName PlaceKind
$mEMPTY :: forall r. GroupName PlaceKind -> (Void# -> r) -> (Void# -> r) -> r
EMPTY = GroupName "empty"

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

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

-- ** Allure-specific
pattern $bRESIDENTIAL :: GroupName PlaceKind
$mRESIDENTIAL :: forall r. GroupName PlaceKind -> (Void# -> r) -> (Void# -> r) -> r
RESIDENTIAL = GroupName "residential"
pattern $bMUSEUM :: GroupName PlaceKind
$mMUSEUM :: forall r. GroupName PlaceKind -> (Void# -> r) -> (Void# -> r) -> r
MUSEUM = GroupName "museum"
pattern $bEXIT :: GroupName PlaceKind
$mEXIT :: forall r. GroupName PlaceKind -> (Void# -> r) -> (Void# -> r) -> r
EXIT = GroupName "exit"
pattern $bRAID :: GroupName PlaceKind
$mRAID :: forall r. GroupName PlaceKind -> (Void# -> r) -> (Void# -> r) -> r
RAID = GroupName "raid"

pattern $bTINY_LIFT :: GroupName PlaceKind
$mTINY_LIFT :: forall r. GroupName PlaceKind -> (Void# -> r) -> (Void# -> r) -> r
TINY_LIFT = GroupName "tiny lift"
pattern $bOPEN_LIFT :: GroupName PlaceKind
$mOPEN_LIFT :: forall r. GroupName PlaceKind -> (Void# -> r) -> (Void# -> r) -> r
OPEN_LIFT = GroupName "open lift"
pattern $bWALLED_LIFT :: GroupName PlaceKind
$mWALLED_LIFT :: forall r. GroupName PlaceKind -> (Void# -> r) -> (Void# -> r) -> r
WALLED_LIFT = GroupName "walled lift"
pattern $bCLOSED_LIFT :: GroupName PlaceKind
$mCLOSED_LIFT :: forall r. GroupName PlaceKind -> (Void# -> r) -> (Void# -> r) -> r
CLOSED_LIFT = GroupName "closed lift"
pattern $bESCAPE_FROM_SPACESHIP_DOWN :: GroupName PlaceKind
$mESCAPE_FROM_SPACESHIP_DOWN :: forall r. GroupName PlaceKind -> (Void# -> r) -> (Void# -> r) -> r
ESCAPE_FROM_SPACESHIP_DOWN = GroupName "escape from spaceship"

-- This is a rotten compromise, because these are synthesized below,
-- so typos can happen.
pattern $bDECON_TINY_STAIRCASE :: GroupName PlaceKind
$mDECON_TINY_STAIRCASE :: forall r. GroupName PlaceKind -> (Void# -> r) -> (Void# -> r) -> r
DECON_TINY_STAIRCASE = GroupName "decon tiny staircase"
pattern $bDECON_OPEN_STAIRCASE :: GroupName PlaceKind
$mDECON_OPEN_STAIRCASE :: forall r. GroupName PlaceKind -> (Void# -> r) -> (Void# -> r) -> r
DECON_OPEN_STAIRCASE = GroupName "decon open staircase"
pattern $bDECON_WALLED_STAIRCASE :: GroupName PlaceKind
$mDECON_WALLED_STAIRCASE :: forall r. GroupName PlaceKind -> (Void# -> r) -> (Void# -> r) -> r
DECON_WALLED_STAIRCASE = GroupName "decon walled staircase"
pattern $bDECON_TINY_LIFT :: GroupName PlaceKind
$mDECON_TINY_LIFT :: forall r. GroupName PlaceKind -> (Void# -> r) -> (Void# -> r) -> r
DECON_TINY_LIFT = GroupName "decon tiny lift"
pattern $bDECON_OPEN_LIFT :: GroupName PlaceKind
$mDECON_OPEN_LIFT :: forall r. GroupName PlaceKind -> (Void# -> r) -> (Void# -> r) -> r
DECON_OPEN_LIFT = GroupName "decon open lift"
pattern $bDECON_WALLED_LIFT :: GroupName PlaceKind
$mDECON_WALLED_LIFT :: forall r. GroupName PlaceKind -> (Void# -> r) -> (Void# -> r) -> r
DECON_WALLED_LIFT = GroupName "decon walled lift"
pattern $bGATED_TINY_LIFT :: GroupName PlaceKind
$mGATED_TINY_LIFT :: forall r. GroupName PlaceKind -> (Void# -> r) -> (Void# -> r) -> r
GATED_TINY_LIFT = GroupName "gated tiny lift"
pattern $bGATED_OPEN_LIFT :: GroupName PlaceKind
$mGATED_OPEN_LIFT :: forall r. GroupName PlaceKind -> (Void# -> r) -> (Void# -> r) -> r
GATED_OPEN_LIFT = GroupName "gated open lift"
pattern $bGATED_CLOSED_LIFT :: GroupName PlaceKind
$mGATED_CLOSED_LIFT :: forall r. GroupName PlaceKind -> (Void# -> r) -> (Void# -> r) -> r
GATED_CLOSED_LIFT = GroupName "gated closed lift"
pattern $bWELDED_TINY_LIFT :: GroupName PlaceKind
$mWELDED_TINY_LIFT :: forall r. GroupName PlaceKind -> (Void# -> r) -> (Void# -> r) -> r
WELDED_TINY_LIFT = GroupName "welded tiny lift"
pattern $bWELDED_OPEN_LIFT :: GroupName PlaceKind
$mWELDED_OPEN_LIFT :: forall r. GroupName PlaceKind -> (Void# -> r) -> (Void# -> r) -> r
WELDED_OPEN_LIFT = GroupName "welded open lift"
pattern $bWELDED_WALLED_LIFT :: GroupName PlaceKind
$mWELDED_WALLED_LIFT :: forall r. GroupName PlaceKind -> (Void# -> r) -> (Void# -> r) -> r
WELDED_WALLED_LIFT = GroupName "welded walled lift"
pattern $bWELDED_TINY_STAIRCASE :: GroupName PlaceKind
$mWELDED_TINY_STAIRCASE :: forall r. GroupName PlaceKind -> (Void# -> r) -> (Void# -> r) -> r
WELDED_TINY_STAIRCASE = GroupName "welded tiny staircase"
pattern $bWELDED_OPEN_STAIRCASE :: GroupName PlaceKind
$mWELDED_OPEN_STAIRCASE :: forall r. GroupName PlaceKind -> (Void# -> r) -> (Void# -> r) -> r
WELDED_OPEN_STAIRCASE = GroupName "welded open staircase"
pattern $bWELDED_WALLED_STAIRCASE :: GroupName PlaceKind
$mWELDED_WALLED_STAIRCASE :: forall r. GroupName PlaceKind -> (Void# -> r) -> (Void# -> r) -> r
WELDED_WALLED_STAIRCASE = GroupName "welded walled staircase"

-- * Content

content :: [PlaceKind]
content :: [PlaceKind]
content =
  [PlaceKind
deadEnd, PlaceKind
rect, PlaceKind
rect2, PlaceKind
rectWindows, PlaceKind
glasshouse, PlaceKind
glasshouse2, PlaceKind
glasshouse3, PlaceKind
glasshouse4, 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
pillar6, PlaceKind
colonnade, PlaceKind
colonnade2, PlaceKind
colonnade3, PlaceKind
colonnade4, PlaceKind
colonnade5, PlaceKind
colonnade6, PlaceKind
colonnade7, PlaceKind
colonnade8, PlaceKind
colonnade9, PlaceKind
colonnade10, PlaceKind
lampPost, PlaceKind
lampPost2, PlaceKind
lampPost3, PlaceKind
lampPost4, PlaceKind
treeShade, PlaceKind
fogClump, PlaceKind
fogClump2, PlaceKind
smokeClump, PlaceKind
smokeClump2, PlaceKind
smokeClump3FGround, PlaceKind
bushClump, PlaceKind
escapeDown, PlaceKind
escapeDown2, PlaceKind
escapeDown3, PlaceKind
escapeDown4, PlaceKind
escapeDown5, PlaceKind
escapeDown6, PlaceKind
escapeDown7, PlaceKind
escapeDown8, PlaceKind
escapeDown9, 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]
  -- Allure-specific
  [PlaceKind] -> [PlaceKind] -> [PlaceKind]
forall a. [a] -> [a] -> [a]
++ [PlaceKind
staircaseLift11, PlaceKind
staircaseLift12, PlaceKind
staircaseLift13, PlaceKind
staircaseLift14, PlaceKind
staircaseLift15, PlaceKind
staircaseLift16, PlaceKind
staircaseLift17, PlaceKind
staircaseLift18, PlaceKind
staircaseLift19, PlaceKind
staircaseLift20, PlaceKind
staircaseLift21, PlaceKind
staircaseLift22, PlaceKind
staircaseLift23, PlaceKind
staircaseLift24, PlaceKind
staircaseLift25]
  -- 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
  -- Allure-specific, continued
  [PlaceKind] -> [PlaceKind] -> [PlaceKind]
forall a. [a] -> [a] -> [a]
++ [ PlaceKind
pumps, PlaceKind
oval, PlaceKind
ovalFloor, PlaceKind
ovalSquare, PlaceKind
ovalBasin, PlaceKind
ovalBasin2, PlaceKind
squareBasin, PlaceKind
squareBasin2, PlaceKind
floodedRoom, PlaceKind
floodedRoom2, PlaceKind
maze, PlaceKind
maze2, PlaceKind
maze3, PlaceKind
maze4, PlaceKind
mazeBig, PlaceKind
mazeBig2, PlaceKind
cells, PlaceKind
cells2, PlaceKind
cells3, PlaceKind
cells4, PlaceKind
cells5, PlaceKind
cells6, PlaceKind
cells7, PlaceKind
tank, PlaceKind
tank2, PlaceKind
tank3, PlaceKind
tank4, PlaceKind
tank5, PlaceKind
tank6, PlaceKind
tank7, PlaceKind
tank8, PlaceKind
tank9, PlaceKind
tank10, PlaceKind
tank11, PlaceKind
tank12, PlaceKind
shuttleHusk, PlaceKind
shuttleHusk2, PlaceKind
shuttleHusk3, PlaceKind
shuttleHusk4, PlaceKind
shuttleHusk5, PlaceKind
shuttleHusk6, PlaceKind
dormitory, PlaceKind
dormitory2, PlaceKind
dormitory3, PlaceKind
dormitory4, PlaceKind
dormitory5, PlaceKind
dormitory6]

deadEnd,    rect, rect2, rectWindows, glasshouse, glasshouse2, glasshouse3, glasshouse4, pulpit, ruin, ruin2, collapsed, collapsed2, collapsed3, collapsed4, collapsed5, collapsed6, collapsed7, pillar, pillar2, pillar3, pillar4, pillar5, pillar6, colonnade, colonnade2, colonnade3, colonnade4, colonnade5, colonnade6, colonnade7, colonnade8, colonnade9, colonnade10, lampPost, lampPost2, lampPost3, lampPost4, treeShade, fogClump, fogClump2, smokeClump, smokeClump2, smokeClump3FGround, bushClump, escapeDown, escapeDown2, escapeDown3, escapeDown4, escapeDown5, escapeDown6, escapeDown7, escapeDown8, escapeDown9, 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
-- Allure-specific
staircaseLift11, staircaseLift12, staircaseLift13, staircaseLift14, staircaseLift15, staircaseLift16, staircaseLift17, staircaseLift18, staircaseLift19, staircaseLift20, staircaseLift21, staircaseLift22, staircaseLift23, staircaseLift24, staircaseLift25, pumps, oval, ovalFloor, ovalSquare, ovalBasin, ovalBasin2, squareBasin, squareBasin2, floodedRoom, floodedRoom2, maze, maze2, maze3, maze4, mazeBig, mazeBig2, cells, cells2, cells3, cells4, cells5, cells6, cells7, tank, tank2, tank3, tank4, tank5, tank6, tank7, tank8, tank9, tank10, tank11, tank12, shuttleHusk, shuttleHusk2, shuttleHusk3, shuttleHusk4, shuttleHusk5, shuttleHusk6, dormitory, dormitory2, dormitory3, dormitory4, dormitory5, dormitory6 :: PlaceKind

staircase, staircaseLift :: PlaceKind  -- templates

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]
  -- Allure-specific
  [PlaceKind] -> [PlaceKind] -> [PlaceKind]
forall a. [a] -> [a] -> [a]
++ [PlaceKind
staircaseLift11, PlaceKind
staircaseLift12, PlaceKind
staircaseLift13, PlaceKind
staircaseLift14, PlaceKind
staircaseLift15, PlaceKind
staircaseLift16, PlaceKind
staircaseLift17, PlaceKind
staircaseLift18, PlaceKind
staircaseLift19, PlaceKind
staircaseLift20, PlaceKind
staircaseLift21, PlaceKind
staircaseLift22, PlaceKind
staircaseLift23, PlaceKind
staircaseLift24, PlaceKind
staircaseLift25]

generatedStairs :: ([GroupName PlaceKind], [PlaceKind])
generatedStairs :: ([GroupName PlaceKind], [PlaceKind])
generatedStairs =
  let ([PlaceKind]
stairs, [PlaceKind]
lifts) = (PlaceKind -> Bool) -> [PlaceKind] -> ([PlaceKind], [PlaceKind])
forall a. (a -> Bool) -> [a] -> ([a], [a])
partition ((Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
/= Text
"a lift") (Text -> Bool) -> (PlaceKind -> Text) -> PlaceKind -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PlaceKind -> Text
pname) [PlaceKind]
staircaseBasic
      gatedStairs :: [PlaceKind]
gatedStairs = (PlaceKind -> PlaceKind) -> [PlaceKind] -> [PlaceKind]
forall a b. (a -> b) -> [a] -> [b]
map PlaceKind -> PlaceKind
switchStaircaseToGated [PlaceKind]
stairs
      gatedLifts :: [PlaceKind]
gatedLifts = (PlaceKind -> PlaceKind) -> [PlaceKind] -> [PlaceKind]
forall a b. (a -> b) -> [a] -> [b]
map PlaceKind -> PlaceKind
switchLiftToGated [PlaceKind]
lifts
      deconStairs :: [PlaceKind]
deconStairs = (PlaceKind -> PlaceKind) -> [PlaceKind] -> [PlaceKind]
forall a b. (a -> b) -> [a] -> [b]
map PlaceKind -> PlaceKind
switchStaircaseToDecon [PlaceKind]
stairs
      deconLifts :: [PlaceKind]
deconLifts = (PlaceKind -> PlaceKind) -> [PlaceKind] -> [PlaceKind]
forall a b. (a -> b) -> [a] -> [b]
map PlaceKind -> PlaceKind
switchLiftToDecon [PlaceKind]
lifts
      weldedStairs :: [PlaceKind]
weldedStairs = (PlaceKind -> PlaceKind) -> [PlaceKind] -> [PlaceKind]
forall a b. (a -> b) -> [a] -> [b]
map PlaceKind -> PlaceKind
switchStaircaseToWelded [PlaceKind]
stairs
      weldedLifts :: [PlaceKind]
weldedLifts = (PlaceKind -> PlaceKind) -> [PlaceKind] -> [PlaceKind]
forall a b. (a -> b) -> [a] -> [b]
map PlaceKind -> PlaceKind
switchLiftToWelded [PlaceKind]
lifts
      outdoorStairs :: [PlaceKind]
outdoorStairs = (PlaceKind -> PlaceKind) -> [PlaceKind] -> [PlaceKind]
forall a b. (a -> b) -> [a] -> [b]
map PlaceKind -> PlaceKind
switchStaircaseToOutdoor [PlaceKind]
stairs
      stairsAll :: [PlaceKind]
stairsAll = [PlaceKind]
stairs [PlaceKind] -> [PlaceKind] -> [PlaceKind]
forall a. [a] -> [a] -> [a]
++ [PlaceKind]
gatedStairs [PlaceKind] -> [PlaceKind] -> [PlaceKind]
forall a. [a] -> [a] -> [a]
++ [PlaceKind]
deconStairs [PlaceKind] -> [PlaceKind] -> [PlaceKind]
forall a. [a] -> [a] -> [a]
++ [PlaceKind]
weldedStairs
                  [PlaceKind] -> [PlaceKind] -> [PlaceKind]
forall a. [a] -> [a] -> [a]
++ [PlaceKind]
outdoorStairs
      liftsAll :: [PlaceKind]
liftsAll = [PlaceKind]
lifts [PlaceKind] -> [PlaceKind] -> [PlaceKind]
forall a. [a] -> [a] -> [a]
++ [PlaceKind]
gatedLifts [PlaceKind] -> [PlaceKind] -> [PlaceKind]
forall a. [a] -> [a] -> [a]
++ [PlaceKind]
deconLifts [PlaceKind] -> [PlaceKind] -> [PlaceKind]
forall a. [a] -> [a] -> [a]
++ [PlaceKind]
weldedLifts
      genStairs :: [PlaceKind]
genStairs =
        [PlaceKind]
gatedStairs [PlaceKind] -> [PlaceKind] -> [PlaceKind]
forall a. [a] -> [a] -> [a]
++ [PlaceKind]
gatedLifts
        [PlaceKind] -> [PlaceKind] -> [PlaceKind]
forall a. [a] -> [a] -> [a]
++ [PlaceKind]
deconStairs [PlaceKind] -> [PlaceKind] -> [PlaceKind]
forall a. [a] -> [a] -> [a]
++ [PlaceKind]
deconLifts
        [PlaceKind] -> [PlaceKind] -> [PlaceKind]
forall a. [a] -> [a] -> [a]
++ [PlaceKind]
weldedStairs [PlaceKind] -> [PlaceKind] -> [PlaceKind]
forall a. [a] -> [a] -> [a]
++ [PlaceKind]
weldedLifts
        [PlaceKind] -> [PlaceKind] -> [PlaceKind]
forall a. [a] -> [a] -> [a]
++ [PlaceKind]
outdoorStairs
        [PlaceKind] -> [PlaceKind] -> [PlaceKind]
forall a. [a] -> [a] -> [a]
++ (PlaceKind -> PlaceKind) -> [PlaceKind] -> [PlaceKind]
forall a b. (a -> b) -> [a] -> [b]
map (Text -> PlaceKind -> PlaceKind
switchExitToUp Text
"stair terminal") [PlaceKind]
stairsAll
        [PlaceKind] -> [PlaceKind] -> [PlaceKind]
forall a. [a] -> [a] -> [a]
++ (PlaceKind -> PlaceKind) -> [PlaceKind] -> [PlaceKind]
forall a b. (a -> b) -> [a] -> [b]
map (Text -> PlaceKind -> PlaceKind
switchExitToUp Text
"lift terminal") [PlaceKind]
liftsAll
        [PlaceKind] -> [PlaceKind] -> [PlaceKind]
forall a. [a] -> [a] -> [a]
++ (PlaceKind -> PlaceKind) -> [PlaceKind] -> [PlaceKind]
forall a b. (a -> b) -> [a] -> [b]
map (Text -> PlaceKind -> PlaceKind
switchExitToDown Text
"stair terminal") [PlaceKind]
stairsAll
        [PlaceKind] -> [PlaceKind] -> [PlaceKind]
forall a. [a] -> [a] -> [a]
++ (PlaceKind -> PlaceKind) -> [PlaceKind] -> [PlaceKind]
forall a b. (a -> b) -> [a] -> [b]
map (Text -> PlaceKind -> PlaceKind
switchExitToDown Text
"lift terminal") [PlaceKind]
liftsAll
  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, PlaceKind
escapeDown6
  , PlaceKind
escapeDown7, PlaceKind
escapeDown8, PlaceKind
escapeDown9 ]

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
      spaceshipEscapes :: [PlaceKind]
spaceshipEscapes = (PlaceKind -> PlaceKind) -> [PlaceKind] -> [PlaceKind]
forall a b. (a -> b) -> [a] -> [b]
map PlaceKind -> PlaceKind
switchEscapeToSpaceshipDown [PlaceKind]
escapeDownBasic
  in [PlaceKind]
upEscapes [PlaceKind] -> [PlaceKind] -> [PlaceKind]
forall a. [a] -> [a] -> [a]
++ [PlaceKind]
outdoorEscapes [PlaceKind] -> [PlaceKind] -> [PlaceKind]
forall a. [a] -> [a] -> [a]
++ [PlaceKind]
spaceshipEscapes

-- 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
'0', GroupName TileKind
S_PILLAR)
  , (Char
'&', GroupName TileKind
S_RUBBLE_PILE)
  , (Char
'+', GroupName TileKind
S_CLOSED_DOOR)
  , (Char
'<', GroupName TileKind
ESCAPE_UP)
  , (Char
'>', GroupName TileKind
ESCAPE_DOWN)
  , (Char
'%', GroupName TileKind
TRANSPARENT_WALL)
  , (Char
'^', GroupName TileKind
ICE_BUILDUP)
  , (Char
'\'', GroupName TileKind
S_OPEN_DOOR)
  , (Char
'·', GroupName TileKind
FLOOR_ACTOR_ITEM_LIT)
  , (Char
'~', GroupName TileKind
S_SHALLOW_WATER_LIT)
  , (Char
':', GroupName TileKind
WORKSHOP)
  , (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
'0', GroupName TileKind
S_PILLAR)
  , (Char
'&', GroupName TileKind
S_RUBBLE_PILE)
  , (Char
'+', GroupName TileKind
S_CLOSED_DOOR)
  , (Char
'<', GroupName TileKind
ESCAPE_UP)
  , (Char
'>', GroupName TileKind
ESCAPE_DOWN)
  , (Char
'%', GroupName TileKind
TRANSPARENT_WALL)
  , (Char
'^', GroupName TileKind
ICE_BUILDUP)
  , (Char
'\'', GroupName TileKind
S_OPEN_DOOR)
  , (Char
'·', GroupName TileKind
FLOOR_ACTOR_ITEM_DARK)
  , (Char
'~', GroupName TileKind
S_SHALLOW_WATER_DARK)
  , (Char
':', GroupName TileKind
WORKSHOP)
  , (Char
'I', GroupName TileKind
SIGNBOARD) ]

deadEnd :: PlaceKind
deadEnd = PlaceKind :: Char
-> Text
-> [(GroupName PlaceKind, Int)]
-> Rarity
-> Cover
-> Fence
-> [Text]
-> EnumMap Char (GroupName TileKind)
-> EnumMap Char (GroupName TileKind)
-> PlaceKind
PlaceKind  -- needs to have index 0
  { psymbol :: Char
psymbol  = Char
'd'
  , 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 :: Char
-> Text
-> [(GroupName PlaceKind, Int)]
-> Rarity
-> Cover
-> Fence
-> [Text]
-> EnumMap Char (GroupName TileKind)
-> EnumMap Char (GroupName TileKind)
-> PlaceKind
PlaceKind  -- Valid for any nonempty area, hence low frequency.
  { psymbol :: Char
psymbol  = Char
'r'
  , pname :: Text
pname    = Text
"a room"
  , pfreq :: [(GroupName PlaceKind, Int)]
pfreq    = [(GroupName PlaceKind
ROGUE, Int
100), (GroupName PlaceKind
LABORATORY, Int
10), (GroupName PlaceKind
RAID, Int
100)]
  , prarity :: Rarity
prarity  = [(Double
1, Int
10), (Double
10, Int
6)]
  , pcover :: Cover
pcover   = Cover
CStretch
  , pfence :: Fence
pfence   = Fence
FWall
  , 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
  }
rect2 :: PlaceKind
rect2 = PlaceKind
rect
  { pname :: Text
pname    = Text
"a pen"
  , pfreq :: [(GroupName PlaceKind, Int)]
pfreq    = [(GroupName PlaceKind
SHOOTOUT, Int
1), (GroupName PlaceKind
ZOO, Int
10)]
  }
rectWindows :: PlaceKind
rectWindows = [(Char, GroupName TileKind)] -> PlaceKind -> PlaceKind
overridePlaceKind [(Char
'%', GroupName TileKind
RECT_WINDOWS)] (PlaceKind -> PlaceKind) -> PlaceKind -> PlaceKind
forall a b. (a -> b) -> a -> b
$ PlaceKind :: Char
-> Text
-> [(GroupName PlaceKind, Int)]
-> Rarity
-> Cover
-> Fence
-> [Text]
-> EnumMap Char (GroupName TileKind)
-> EnumMap Char (GroupName TileKind)
-> PlaceKind
PlaceKind
  { psymbol :: Char
psymbol  = Char
'w'
  , pname :: Text
pname    = Text
"a shed"
  , pfreq :: [(GroupName PlaceKind, Int)]
pfreq    = [(GroupName PlaceKind
ESCAPE, Int
20)]
  , 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 = PlaceKind :: Char
-> Text
-> [(GroupName PlaceKind, Int)]
-> Rarity
-> Cover
-> Fence
-> [Text]
-> EnumMap Char (GroupName TileKind)
-> EnumMap Char (GroupName TileKind)
-> PlaceKind
PlaceKind
  { psymbol :: Char
psymbol  = Char
'g'
  , pname :: Text
pname    = Text
"a glasshouse"
  , pfreq :: [(GroupName PlaceKind, Int)]
pfreq    = [(GroupName PlaceKind
SHOOTOUT, Int
10)]
  , 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
DAMP_FLOOR_DARK)]
                                 [(Char
'·', GroupName TileKind
DAMP_FLOOR_LIT)] (PlaceKind -> PlaceKind) -> PlaceKind -> PlaceKind
forall a b. (a -> b) -> a -> b
$ PlaceKind
glasshouse
  { pname :: Text
pname    = Text
"a glass cage"
  , pfreq :: [(GroupName PlaceKind, Int)]
pfreq    = [(GroupName PlaceKind
LABORATORY, Int
2), (GroupName PlaceKind
ZOO, Int
30)]
  }
glasshouse3 :: PlaceKind
glasshouse3 = PlaceKind
glasshouse
  { pname :: Text
pname    = Text
"an entertainment center"
  , pfreq :: [(GroupName PlaceKind, Int)]
pfreq    = [(GroupName PlaceKind
ARENA, Int
1), (GroupName PlaceKind
AMBUSH, Int
10)]
  }
glasshouse4 :: PlaceKind
glasshouse4 = PlaceKind
glasshouse
  { pname :: Text
pname    = Text
"an exhibition area"
  , pfreq :: [(GroupName PlaceKind, Int)]
pfreq    = [(GroupName PlaceKind
ARENA, Int
1), (GroupName PlaceKind
MUSEUM, Int
1)]
  }
pulpit :: PlaceKind
pulpit = [(Char, GroupName TileKind)] -> PlaceKind -> PlaceKind
overridePlaceKind [(Char
'0', GroupName TileKind
S_PULPIT)] (PlaceKind -> PlaceKind) -> PlaceKind -> PlaceKind
forall a b. (a -> b) -> a -> b
$ PlaceKind :: Char
-> Text
-> [(GroupName PlaceKind, Int)]
-> Rarity
-> Cover
-> Fence
-> [Text]
-> EnumMap Char (GroupName TileKind)
-> EnumMap Char (GroupName TileKind)
-> PlaceKind
PlaceKind
           -- except for floor, all will be lit, regardless of night/dark; OK
  { psymbol :: Char
psymbol  = Char
'p'
  , pname :: Text
pname    = Text
"a stand podium"
  , pfreq :: [(GroupName PlaceKind, Int)]
pfreq    = [(GroupName PlaceKind
ARENA, Int
15), (GroupName PlaceKind
MUSEUM, Int
15), (GroupName PlaceKind
ZOO, Int
100)]
  , 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 = [(Char, GroupName TileKind)]
-> [(Char, GroupName TileKind)] -> PlaceKind -> PlaceKind
override2PlaceKind [(Char
'·', GroupName TileKind
DAMP_FLOOR_DARK)]
                          [(Char
'·', GroupName TileKind
DAMP_FLOOR_LIT)] (PlaceKind -> PlaceKind) -> PlaceKind -> PlaceKind
forall a b. (a -> b) -> a -> b
$ PlaceKind :: Char
-> Text
-> [(GroupName PlaceKind, Int)]
-> Rarity
-> Cover
-> Fence
-> [Text]
-> EnumMap Char (GroupName TileKind)
-> EnumMap Char (GroupName TileKind)
-> PlaceKind
PlaceKind
  { psymbol :: Char
psymbol  = Char
'R'
  , pname :: Text
pname    = Text
"ruins"
  , pfreq :: [(GroupName PlaceKind, Int)]
pfreq    = [(GroupName PlaceKind
BATTLE, Int
660), (GroupName PlaceKind
AMBUSH, Int
70)]
  , prarity :: Rarity
prarity  = [(Double
1, Int
1)]
  , pcover :: Cover
pcover   = Cover
CStretch
  , pfence :: Fence
pfence   = Fence
FWall
  , ptopLeft :: [Text]
ptopLeft = [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 = PlaceKind
ruin
  { pname :: Text
pname    = Text
"a scaffolding"
  , pfreq :: [(GroupName PlaceKind, Int)]
pfreq    = [(GroupName PlaceKind
NOISE, Int
2000), (GroupName PlaceKind
EXIT, Int
5), (GroupName PlaceKind
MUSEUM, Int
1)]
  }
collapsed :: PlaceKind
collapsed = [(Char, GroupName TileKind)] -> PlaceKind -> PlaceKind
overridePlaceKind [(Char
'#', GroupName TileKind
DOORLESS_MACHINERY)] (PlaceKind -> PlaceKind) -> PlaceKind -> PlaceKind
forall a b. (a -> b) -> a -> b
$ PlaceKind :: Char
-> Text
-> [(GroupName PlaceKind, Int)]
-> Rarity
-> Cover
-> Fence
-> [Text]
-> EnumMap Char (GroupName TileKind)
-> EnumMap Char (GroupName TileKind)
-> PlaceKind
PlaceKind
  { psymbol :: Char
psymbol  = Char
'c'
  , pname :: Text
pname    = Text
"a hardware stack"
  , 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
"#"
               ]
  , 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 :: [(GroupName PlaceKind, Int)]
pfreq    = [(GroupName PlaceKind
NOISE, Int
1000), (GroupName PlaceKind
BATTLE, Int
200)]
  , ptopLeft :: [Text]
ptopLeft = [ Text
"X#"
               , Text
"##"
               ]
  }
collapsed3 :: PlaceKind
collapsed3 = PlaceKind
collapsed
  { pfreq :: [(GroupName PlaceKind, Int)]
pfreq    = [(GroupName PlaceKind
NOISE, Int
2000), (GroupName PlaceKind
BATTLE, Int
200)]
  , ptopLeft :: [Text]
ptopLeft = [ Text
"XX#"
               , Text
"###"
               ]
  }
collapsed4 :: PlaceKind
collapsed4 = PlaceKind
collapsed
  { pfreq :: [(GroupName PlaceKind, Int)]
pfreq    = [(GroupName PlaceKind
NOISE, Int
2200), (GroupName PlaceKind
BATTLE, Int
200)]
  , ptopLeft :: [Text]
ptopLeft = [ Text
"XXX#"
               , Text
"####"
               ]
  }
collapsed5 :: PlaceKind
collapsed5 = PlaceKind
collapsed
  { pfreq :: [(GroupName PlaceKind, Int)]
pfreq    = [(GroupName PlaceKind
NOISE, Int
3000), (GroupName PlaceKind
BATTLE, Int
500)]
  , ptopLeft :: [Text]
ptopLeft = [ Text
"XX#"
               , Text
"X##"
               , Text
"###"
               ]
  }
collapsed6 :: PlaceKind
collapsed6 = PlaceKind
collapsed
  { pfreq :: [(GroupName PlaceKind, Int)]
pfreq    = [(GroupName PlaceKind
NOISE, Int
4000), (GroupName PlaceKind
BATTLE, Int
1000)]
  , ptopLeft :: [Text]
ptopLeft = [ Text
"XXX#"
               , Text
"X###"
               , Text
"####"
               ]
  }
collapsed7 :: PlaceKind
collapsed7 = PlaceKind
collapsed
  { pfreq :: [(GroupName PlaceKind, Int)]
pfreq    = [(GroupName PlaceKind
NOISE, Int
4000), (GroupName PlaceKind
BATTLE, Int
1000)]
  , ptopLeft :: [Text]
ptopLeft = [ Text
"XXX#"
               , Text
"XX##"
               , Text
"####"
               ]
  }
pillar :: PlaceKind
pillar = PlaceKind :: Char
-> Text
-> [(GroupName PlaceKind, Int)]
-> Rarity
-> Cover
-> Fence
-> [Text]
-> EnumMap Char (GroupName TileKind)
-> EnumMap Char (GroupName TileKind)
-> PlaceKind
PlaceKind
  { psymbol :: Char
psymbol  = Char
'p'
  , pname :: Text
pname    = Text
"a court"
  , pfreq :: [(GroupName PlaceKind, Int)]
pfreq    = [ (GroupName PlaceKind
ROGUE, Int
250), (GroupName PlaceKind
ARENA, Int
15), (GroupName PlaceKind
MUSEUM, Int
10)
               , (GroupName PlaceKind
LABORATORY, Int
200), (GroupName PlaceKind
RAID, Int
50) ]
  , prarity :: Rarity
prarity  = [(Double
1, Int
1)]
  , pcover :: Cover
pcover   = Cover
CStretch
  , pfence :: Fence
pfence   = Fence
FWall
  -- Larger rooms require support pillars.
  , ptopLeft :: [Text]
ptopLeft = [ Text
"#··"
               , Text
"···"
               , 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
  { pname :: Text
pname    = Text
"a plaza"
  , pfreq :: [(GroupName PlaceKind, Int)]
pfreq    = [ (GroupName PlaceKind
ROGUE, Int
1500), (GroupName PlaceKind
ARENA, Int
5000)
               , (GroupName PlaceKind
MUSEUM, Int
4000), (GroupName PlaceKind
LABORATORY, Int
1500) ]
  , ptopLeft :: [Text]
ptopLeft = [ Text
"#·#·"
               , Text
"····"
               , Text
"#···"
               , Text
"····"
               ]
  }
pillar3 :: PlaceKind
pillar3 = [(Char, GroupName TileKind)]
-> [(Char, GroupName TileKind)] -> PlaceKind -> PlaceKind
override2PlaceKind [(Char
'·', GroupName TileKind
OILY_FLOOR_DARK)]
                             [(Char
'·', GroupName TileKind
OILY_FLOOR_LIT)] (PlaceKind -> PlaceKind) -> PlaceKind -> PlaceKind
forall a b. (a -> b) -> a -> b
$ PlaceKind
pillar
  { pname :: Text
pname    = Text
"a market"
  , pfreq :: [(GroupName PlaceKind, Int)]
pfreq    = [(GroupName PlaceKind
ROGUE, Int
300), (GroupName PlaceKind
ARENA, Int
10000), (GroupName PlaceKind
EMPTY, Int
400)]
  , ptopLeft :: [Text]
ptopLeft = [ Text
"····"
               , Text
"·0··"
               , Text
"····"
               , Text
"····"
               ]
  }
pillar4 :: PlaceKind
pillar4 = [(Char, GroupName TileKind)]
-> [(Char, GroupName TileKind)] -> PlaceKind -> PlaceKind
override2PlaceKind [(Char
'~', GroupName TileKind
S_POOL_DARK)]
                             [(Char
'~', GroupName TileKind
S_POOL_LIT)] (PlaceKind -> PlaceKind) -> PlaceKind -> PlaceKind
forall a b. (a -> b) -> a -> b
$ PlaceKind
pillar
  { pname :: Text
pname    = Text
"a mall"
  , pfreq :: [(GroupName PlaceKind, Int)]
pfreq    = [(GroupName PlaceKind
ROGUE, Int
10000), (GroupName PlaceKind
ARENA, Int
100000), (GroupName PlaceKind
EMPTY, Int
4000)]
  , ptopLeft :: [Text]
ptopLeft = [ Text
"0····"
               , Text
"·····"
               , Text
"·····"
               , Text
"···0·"
               , Text
"····~"
               ]
  }
pillar5 :: PlaceKind
pillar5 = [(Char, GroupName TileKind)] -> PlaceKind -> PlaceKind
overridePlaceKind [ (Char
'&', GroupName TileKind
CACHE_DEPOSIT)
                            , (Char
'i', GroupName TileKind
FLOOR_ACTOR_ITEM)  -- lit or not, randomly
                            , (Char
'p', GroupName TileKind
TRAPPED_DOOR) ] (PlaceKind -> PlaceKind) -> PlaceKind -> PlaceKind
forall a b. (a -> b) -> a -> b
$ PlaceKind
pillar
            -- no STUCK_DOOR, because FWall, so would break global pathfinding
  { pname :: Text
pname    = Text
"a bank outlet"
  , pfreq :: [(GroupName PlaceKind, Int)]
pfreq    = [ (GroupName PlaceKind
ROGUE, Int
1200), (GroupName PlaceKind
ARENA, Int
6000)
               , (GroupName PlaceKind
EMPTY, Int
600), (GroupName PlaceKind
EXIT, Int
600) ]
  , ptopLeft :: [Text]
ptopLeft = [ Text
"&i%·"
               , Text
"ii#·"
               , Text
"%#p·"
               , Text
"····"
               ]
  }
pillar6 :: PlaceKind
pillar6 = [(Char, GroupName TileKind)]
-> [(Char, GroupName TileKind)] -> PlaceKind -> PlaceKind
override2PlaceKind [(Char
'f', GroupName TileKind
BUSH_GROVE_DARK)]
                             [(Char
'f', GroupName TileKind
BUSH_GROVE_LIT)] (PlaceKind -> PlaceKind) -> PlaceKind -> PlaceKind
forall a b. (a -> b) -> a -> b
$
          [(Char, GroupName TileKind)] -> PlaceKind -> PlaceKind
overridePlaceKind [ (Char
'&', GroupName TileKind
CACHE_JEWELRY)
                            , (Char
'0', GroupName TileKind
S_LAMP_POST)
                            , (Char
'a', GroupName TileKind
S_FLOOR_ACTOR_LIT) ] (PlaceKind -> PlaceKind) -> PlaceKind -> PlaceKind
forall a b. (a -> b) -> a -> b
$ PlaceKind
pillar
  { pname :: Text
pname    = Text
"a jewelry store"
  , pfreq :: [(GroupName PlaceKind, Int)]
pfreq    = [ (GroupName PlaceKind
ROGUE, Int
1200), (GroupName PlaceKind
ARENA, Int
6000)
               , (GroupName PlaceKind
MUSEUM, Int
7000), (GroupName PlaceKind
EMPTY, Int
600) ]
  , ptopLeft :: [Text]
ptopLeft = [ Text
"0a··"
               , Text
"aaf·"
               , Text
"·f&·"
               , Text
"····"
               ]
  }
colonnade :: PlaceKind
colonnade = PlaceKind :: Char
-> Text
-> [(GroupName PlaceKind, Int)]
-> Rarity
-> Cover
-> Fence
-> [Text]
-> EnumMap Char (GroupName TileKind)
-> EnumMap Char (GroupName TileKind)
-> PlaceKind
PlaceKind
  { psymbol :: Char
psymbol  = Char
'c'
  , pname :: Text
pname    = Text
"a colonnade"
  , pfreq :: [(GroupName PlaceKind, Int)]
pfreq    = [ (GroupName PlaceKind
ROGUE, Int
12), (GroupName PlaceKind
NOISE, Int
1000), (GroupName PlaceKind
ESCAPE, Int
200)
               , (GroupName PlaceKind
EXIT, Int
30), (GroupName PlaceKind
RAID, Int
12) ]
  , prarity :: Rarity
prarity  = [(Double
1, Int
12), (Double
10, Int
12)]
  , pcover :: Cover
pcover   = Cover
CAlternate
  , pfence :: Fence
pfence   = Fence
FFloor
  , 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
  }
colonnade2 :: PlaceKind
colonnade2 = PlaceKind
colonnade
  { pfreq :: [(GroupName PlaceKind, Int)]
pfreq    = [(GroupName PlaceKind
ROGUE, Int
300)]
  , prarity :: Rarity
prarity  = [(Double
1, Int
1)]
  , pfence :: Fence
pfence   = Fence
FWall
  , ptopLeft :: [Text]
ptopLeft = [ Text
"#·"
               , Text
"·#"
               ]
  }
colonnade3 :: PlaceKind
colonnade3 = PlaceKind
colonnade
  { prarity :: Rarity
prarity  = [(Double
1, Int
120), (Double
10, Int
120)]
  , ptopLeft :: [Text]
ptopLeft = [ Text
"··#"
               , Text
"·#·"
               , Text
"#··"
               ]
  }
colonnade4 :: PlaceKind
colonnade4 = PlaceKind
colonnade
  { prarity :: Rarity
prarity  = [(Double
1, Int
1)]
  , pfreq :: [(GroupName PlaceKind, Int)]
pfreq    = [(GroupName PlaceKind
ROGUE, Int
1000), (GroupName PlaceKind
RAID, Int
1000)]
  , pfence :: Fence
pfence   = Fence
FWall
  , ptopLeft :: [Text]
ptopLeft = [ Text
"#··"
               , Text
"·#·"
               , Text
"··#"
               ]
  }
colonnade5 :: PlaceKind
colonnade5 = PlaceKind
colonnade
  { prarity :: Rarity
prarity  = [(Double
1, Int
25), (Double
10, Int
25)]
  , ptopLeft :: [Text]
ptopLeft = [ Text
"#··"
               , Text
"··#"
               ]
  }
colonnade6 :: PlaceKind
colonnade6 = PlaceKind
colonnade
  { prarity :: Rarity
prarity  = [(Double
1, Int
14), (Double
10, Int
14)]
  , ptopLeft :: [Text]
ptopLeft = [ Text
"#·"
               , Text
"··"
               , Text
"·#"
               ]
  }
colonnade7 :: PlaceKind
colonnade7 = PlaceKind
colonnade
  { pfreq :: [(GroupName PlaceKind, Int)]
pfreq    = [(GroupName PlaceKind
ARENA, Int
50), (GroupName PlaceKind
MUSEUM, Int
30), (GroupName PlaceKind
EMPTY, Int
800), (GroupName PlaceKind
RAID, Int
40)]
  , prarity :: Rarity
prarity  = [(Double
1, Int
7), (Double
10, Int
7)]
  , ptopLeft :: [Text]
ptopLeft = [ Text
"0·"
               , Text
"··"
               ]
  }
colonnade8 :: PlaceKind
colonnade8 = PlaceKind
colonnade7
  { prarity :: Rarity
prarity  = [(Double
1, Int
50), (Double
10, Int
50)]
  , ptopLeft :: [Text]
ptopLeft = [ Text
"··0"
               , Text
"·0·"
               , Text
"0··"
               ]
  }
colonnade9 :: PlaceKind
colonnade9 = PlaceKind
colonnade7
  { prarity :: Rarity
prarity  = [(Double
1, Int
20), (Double
10, Int
20)]
  , ptopLeft :: [Text]
ptopLeft = [ Text
"0··"
               , Text
"··0"
               ]
  }
colonnade10 :: PlaceKind
colonnade10 = PlaceKind
colonnade7
  { prarity :: Rarity
prarity  = [(Double
1, Int
10), (Double
10, Int
10)]
  , ptopLeft :: [Text]
ptopLeft = [ Text
"0·"
               , Text
"··"
               , Text
"·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 :: Char
-> Text
-> [(GroupName PlaceKind, Int)]
-> Rarity
-> Cover
-> Fence
-> [Text]
-> EnumMap Char (GroupName TileKind)
-> EnumMap Char (GroupName TileKind)
-> PlaceKind
PlaceKind
  { psymbol :: Char
psymbol  = Char
'l'
  , pname :: Text
pname    = Text
"a lamp-lit area"
  , pfreq :: [(GroupName PlaceKind, Int)]
pfreq    = [ (GroupName PlaceKind
ESCAPE, Int
200), (GroupName PlaceKind
ZOO, Int
100), (GroupName PlaceKind
AMBUSH, Int
1000)
               , (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 :: [Text]
ptopLeft = [ Text
"···"
               , Text
"·0·"
               , Text
"···"
               ]
  }
lampPost3 :: PlaceKind
lampPost3 = PlaceKind
lampPost
  { pfreq :: [(GroupName PlaceKind, Int)]
pfreq    = [(GroupName PlaceKind
ESCAPE, Int
3000), (GroupName PlaceKind
ZOO, Int
500), (GroupName PlaceKind
BATTLE, Int
1100)]
  , ptopLeft :: [Text]
ptopLeft = [ Text
"XX·XX"
               , Text
"X···X"
               , Text
"··0··"
               , Text
"X···X"
               , Text
"XX·XX"
               ]
  }
lampPost4 :: PlaceKind
lampPost4 = PlaceKind
lampPost
  { pfreq :: [(GroupName PlaceKind, Int)]
pfreq    = [(GroupName PlaceKind
ESCAPE, Int
3000), (GroupName PlaceKind
ZOO, Int
500), (GroupName PlaceKind
BATTLE, Int
600)]
  , ptopLeft :: [Text]
ptopLeft = [ Text
"X···X"
               , Text
"·····"
               , Text
"··0··"
               , Text
"·····"
               , Text
"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 :: Char
-> Text
-> [(GroupName PlaceKind, Int)]
-> Rarity
-> Cover
-> Fence
-> [Text]
-> EnumMap Char (GroupName TileKind)
-> EnumMap Char (GroupName TileKind)
-> PlaceKind
PlaceKind
  { psymbol :: Char
psymbol  = Char
't'
  , pname :: Text
pname    = Text
"a tree shade"
  , pfreq :: [(GroupName PlaceKind, Int)]
pfreq    = [(GroupName PlaceKind
BRAWL, Int
500)]
  , 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 :: Char
-> Text
-> [(GroupName PlaceKind, Int)]
-> Rarity
-> Cover
-> Fence
-> [Text]
-> EnumMap Char (GroupName TileKind)
-> EnumMap Char (GroupName TileKind)
-> PlaceKind
PlaceKind
  { psymbol :: Char
psymbol  = Char
'f'
  , pname :: Text
pname    = Text
"a foggy patch"
  , pfreq :: [(GroupName PlaceKind, Int)]
pfreq    = [(GroupName PlaceKind
EMPTY, Int
400), (GroupName PlaceKind
SHOOTOUT, Int
70), (GroupName PlaceKind
ESCAPE, Int
60), (GroupName PlaceKind
RAID, 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
  }
fogClump2 :: PlaceKind
fogClump2 = PlaceKind
fogClump
  { pfreq :: [(GroupName PlaceKind, Int)]
pfreq    = [(GroupName PlaceKind
EMPTY, Int
2200), (GroupName PlaceKind
SHOOTOUT, Int
400), (GroupName PlaceKind
ESCAPE, Int
100), (GroupName PlaceKind
RAID, Int
250)]
  , ptopLeft :: [Text]
ptopLeft = [ Text
"X;f"
               , Text
"f;f"
               , Text
";;f"
               , Text
"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 :: Char
-> Text
-> [(GroupName PlaceKind, Int)]
-> Rarity
-> Cover
-> Fence
-> [Text]
-> EnumMap Char (GroupName TileKind)
-> EnumMap Char (GroupName TileKind)
-> PlaceKind
PlaceKind
  { psymbol :: Char
psymbol  = Char
's'
  , pname :: Text
pname    = Text
"a smoky patch"
  , pfreq :: [(GroupName PlaceKind, Int)]
pfreq    = [(GroupName PlaceKind
EXIT, Int
20), (GroupName PlaceKind
ZOO, Int
40), (GroupName PlaceKind
AMBUSH, 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 :: [(GroupName PlaceKind, Int)]
pfreq    = [(GroupName PlaceKind
EXIT, Int
100), (GroupName PlaceKind
ZOO, Int
200), (GroupName PlaceKind
AMBUSH, Int
150)]
  , ptopLeft :: [Text]
ptopLeft = [ Text
"X;f"
               , Text
"f;f"
               , Text
";;f"
               , Text
"Xff"
               ]
  }
smokeClump3FGround :: PlaceKind
smokeClump3FGround = PlaceKind
smokeClump
  { pname :: Text
pname    = Text
"a burned out area"
  , pfreq :: [(GroupName PlaceKind, Int)]
pfreq    = [(GroupName PlaceKind
LABORATORY, Int
50)]  -- close to guaranteed, but not overcrowded
  , prarity :: Rarity
prarity  = [(Double
1, Int
1)]
  , pcover :: Cover
pcover   = Cover
CMirror
  , pfence :: Fence
pfence   = Fence
FGround
  , ptopLeft :: [Text]
ptopLeft = [ Text
";f:"  -- workshop terrain
               , Text
"f·f"
               , Text
"f·f"
               , Text
";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 :: Char
-> Text
-> [(GroupName PlaceKind, Int)]
-> Rarity
-> Cover
-> Fence
-> [Text]
-> EnumMap Char (GroupName TileKind)
-> EnumMap Char (GroupName TileKind)
-> PlaceKind
PlaceKind
  { psymbol :: Char
psymbol  = Char
'b'
  , pname :: Text
pname    = Text
"a bushy patch"
  , pfreq :: [(GroupName PlaceKind, Int)]
pfreq    = [(GroupName PlaceKind
SHOOTOUT, Int
120), (GroupName PlaceKind
EMPTY, Int
60), (GroupName PlaceKind
BRAWL, Int
30)]
  , prarity :: Rarity
prarity  = [(Double
1, Int
1)]
  , pcover :: Cover
pcover   = Cover
CMirror
  , pfence :: Fence
pfence   = Fence
FNone
  , ptopLeft :: [Text]
ptopLeft = [ Text
"f;X"  -- the third column is needed to prevent blockage
               , Text
";Xf"
               , Text
";fX"
               ]
  , 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
  }
escapeDown :: PlaceKind
escapeDown = [(Char, GroupName TileKind)]
-> [(Char, GroupName TileKind)] -> PlaceKind -> PlaceKind
override2PlaceKind [(Char
'r', GroupName TileKind
RUBBLE_OR_WASTE_DARK)]
                                [(Char
'r', GroupName TileKind
RUBBLE_OR_WASTE_LIT)] (PlaceKind -> PlaceKind) -> PlaceKind -> PlaceKind
forall a b. (a -> b) -> a -> b
$
             [(Char, GroupName TileKind)] -> PlaceKind -> PlaceKind
overridePlaceKind [ (Char
'g', GroupName TileKind
S_FROZEN_PATH)
                               , (Char
'0', GroupName TileKind
S_LAMP_POST)
                               , (Char
'b', GroupName TileKind
BARREL)
                               , (Char
'a', GroupName TileKind
S_FLOOR_ACTOR_LIT) ] (PlaceKind -> PlaceKind) -> PlaceKind -> PlaceKind
forall a b. (a -> b) -> a -> b
$ PlaceKind :: Char
-> Text
-> [(GroupName PlaceKind, Int)]
-> Rarity
-> Cover
-> Fence
-> [Text]
-> EnumMap Char (GroupName TileKind)
-> EnumMap Char (GroupName TileKind)
-> PlaceKind
PlaceKind
  { psymbol :: Char
psymbol  = Char
'>'
  , 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 :: [(GroupName PlaceKind, Int)]
pfreq    = [(GroupName PlaceKind
INDOOR_ESCAPE_DOWN, Int
200)]
  , pfence :: Fence
pfence   = Fence
FGround
  , ptopLeft :: [Text]
ptopLeft = [ Text
"#·#"
               , Text
"·>·"
               , Text
"#·#"
               ]
  }
escapeDown3 :: PlaceKind
escapeDown3 = PlaceKind
escapeDown
  { pfreq :: [(GroupName PlaceKind, Int)]
pfreq    = [(GroupName PlaceKind
INDOOR_ESCAPE_DOWN, Int
200)]
  , pfence :: Fence
pfence   = Fence
FFloor
  , ptopLeft :: [Text]
ptopLeft = [ Text
"·b·"
               , Text
"b>b"
               , Text
"·b·"
               ]
  }
escapeDown4 :: PlaceKind
escapeDown4 = PlaceKind
escapeDown
  { pfreq :: [(GroupName PlaceKind, Int)]
pfreq    = [(GroupName PlaceKind
INDOOR_ESCAPE_DOWN, Int
200)]
  , pfence :: Fence
pfence   = Fence
FWall
  , ptopLeft :: [Text]
ptopLeft = [ Text
"^·^"
               , Text
"·>·"
               , Text
"^·^"
               ]
  }
escapeDown5 :: PlaceKind
escapeDown5 = PlaceKind
escapeDown
  { pfreq :: [(GroupName PlaceKind, Int)]
pfreq    = [(GroupName PlaceKind
INDOOR_ESCAPE_DOWN, Int
200)]
  , pcover :: Cover
pcover   = Cover
CMirror
  , pfence :: Fence
pfence   = Fence
FFloor
  , ptopLeft :: [Text]
ptopLeft = [ Text
"r#·"
               , Text
"r>#"
               , Text
"rrr"
               ]
  }
escapeDown6 :: PlaceKind
escapeDown6 = PlaceKind
escapeDown
  { pfreq :: [(GroupName PlaceKind, Int)]
pfreq    = [(GroupName PlaceKind
INDOOR_ESCAPE_DOWN, Int
1000)]
  , pfence :: Fence
pfence   = Fence
FWall
  , ptopLeft :: [Text]
ptopLeft = [ Text
"··#··"
               , Text
"·#g#·"
               , Text
"#g>g#"
               , Text
"·#g#·"
               , Text
"··#··"
               ]
  }
escapeDown7 :: PlaceKind
escapeDown7 = PlaceKind
escapeDown
  { pfreq :: [(GroupName PlaceKind, Int)]
pfreq    = [(GroupName PlaceKind
INDOOR_ESCAPE_DOWN, Int
1000)]
  , pfence :: Fence
pfence   = Fence
FFloor
  , ptopLeft :: [Text]
ptopLeft = [ Text
"·g#g·"
               , Text
"g#g#g"
               , Text
"#g>g#"
               , Text
"g#g#g"
               , Text
"·g#g·"
               ]
  }
escapeDown8 :: PlaceKind
escapeDown8 = PlaceKind
escapeDown
  { pfreq :: [(GroupName PlaceKind, Int)]
pfreq    = [(GroupName PlaceKind
INDOOR_ESCAPE_DOWN, Int
1000)]
  , pcover :: Cover
pcover   = Cover
CMirror
  , pfence :: Fence
pfence   = Fence
FWall
  , ptopLeft :: [Text]
ptopLeft = [ Text
"··#g·"
               , Text
"·#gg·"
               , Text
"·#>g#"
               , Text
"·gg#·"
               , Text
"g·#··"
               ]
  }
escapeDown9 :: PlaceKind
escapeDown9 = PlaceKind
escapeDown
  { pfreq :: [(GroupName PlaceKind, Int)]
pfreq    = [(GroupName PlaceKind
INDOOR_ESCAPE_DOWN, Int
1000)]
  , pcover :: Cover
pcover   = Cover
CMirror
  , pfence :: Fence
pfence   = Fence
FFloor
  , ptopLeft :: [Text]
ptopLeft = [ Text
"·a·#"
               , Text
"%a>·"
               , Text
"%0a·"
               , Text
"aa%%"
               ]
  }
staircase :: PlaceKind
staircase = [(Char, GroupName TileKind)] -> PlaceKind -> PlaceKind
overridePlaceKind  [ (Char
'<', GroupName TileKind
STAIRCASE_UP)
                               , (Char
'>', GroupName TileKind
STAIRCASE_DOWN)
                               , (Char
'S', GroupName TileKind
FILLER_WALL) ] (PlaceKind -> PlaceKind) -> PlaceKind -> PlaceKind
forall a b. (a -> b) -> a -> b
$ PlaceKind :: Char
-> Text
-> [(GroupName PlaceKind, Int)]
-> Rarity
-> Cover
-> Fence
-> [Text]
-> EnumMap Char (GroupName TileKind)
-> EnumMap Char (GroupName TileKind)
-> PlaceKind
PlaceKind
  { psymbol :: Char
psymbol  = Char
'/'
  , 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
"<S>"
               ]
  , 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 :: Rarity
prarity  = [(Double
1, Int
1)]  -- no cover when arriving; so low rarity
  }
staircase2 :: PlaceKind
staircase2 = PlaceKind
staircase
  { pfreq :: [(GroupName PlaceKind, Int)]
pfreq    = [(GroupName PlaceKind
TINY_STAIRCASE, Int
3)]
  , prarity :: Rarity
prarity  = [(Double
1, Int
1)]
  , pfence :: Fence
pfence   = Fence
FFloor
  , ptopLeft :: [Text]
ptopLeft = [ Text
"·<S>·"
               ]
  }
-- Allure-specific:
overrideLift :: [(Char, GroupName TileKind)]
overrideLift :: [(Char, GroupName TileKind)]
overrideLift =
  [ (Char
'<', GroupName TileKind
STAIRCASE_LIFT_UP), (Char
'>', GroupName TileKind
STAIRCASE_LIFT_DOWN)
  , (Char
'S', GroupName TileKind
S_LIFT_SHAFT) ]
staircaseLift :: PlaceKind
staircaseLift = [(Char, GroupName TileKind)] -> PlaceKind -> PlaceKind
overridePlaceKind [(Char, GroupName TileKind)]
overrideLift (PlaceKind -> PlaceKind) -> PlaceKind -> PlaceKind
forall a b. (a -> b) -> a -> b
$ PlaceKind :: Char
-> Text
-> [(GroupName PlaceKind, Int)]
-> Rarity
-> Cover
-> Fence
-> [Text]
-> EnumMap Char (GroupName TileKind)
-> EnumMap Char (GroupName TileKind)
-> PlaceKind
PlaceKind
  { psymbol :: Char
psymbol  = Char
'|'
  , pname :: Text
pname    = Text
"a lift"
  , pfreq :: [(GroupName PlaceKind, Int)]
pfreq    = [(GroupName PlaceKind
TINY_LIFT, Int
1)]
  , 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
"<S>"
               ]
  , plegendDark :: EnumMap Char (GroupName TileKind)
plegendDark = EnumMap Char (GroupName TileKind)
defaultLegendDark
  , plegendLit :: EnumMap Char (GroupName TileKind)
plegendLit = EnumMap Char (GroupName TileKind)
defaultLegendLit
  }
staircase3 :: PlaceKind
staircase3 = PlaceKind
staircaseLift
  { prarity :: Rarity
prarity  = [(Double
1, Int
1)]
  }
staircase4 :: PlaceKind
staircase4 = PlaceKind
staircaseLift
  { pfreq :: [(GroupName PlaceKind, Int)]
pfreq    = [(GroupName PlaceKind
TINY_LIFT, Int
3)]
  , prarity :: Rarity
prarity  = [(Double
1, Int
1)]
  , ptopLeft :: [Text]
ptopLeft = [ Text
"·<S>·"
               ]
  }
staircase5 :: PlaceKind
staircase5 = PlaceKind
staircase
  { pfreq :: [(GroupName PlaceKind, Int)]
pfreq    = [(GroupName PlaceKind
OPEN_STAIRCASE, Int
200)]  -- no cover, open
  , pfence :: Fence
pfence   = Fence
FGround
  , ptopLeft :: [Text]
ptopLeft = [ Text
"#·#"
               , Text
"···"
               , Text
"<S>"
               , Text
"···"
               , Text
"#·#"
               ]
  }
staircase6 :: PlaceKind
staircase6 = PlaceKind
staircaseLift
  { pfreq :: [(GroupName PlaceKind, Int)]
pfreq    = [(GroupName PlaceKind
OPEN_LIFT, Int
300)]
  , pfence :: Fence
pfence   = Fence
FFloor
  , ptopLeft :: [Text]
ptopLeft = [ Text
"#·#·#"
               , Text
"·····"
               , Text
"·<S>·"
               , Text
"·····"
               , Text
"#·#·#"
               ]
  }
staircase7 :: PlaceKind
staircase7 = PlaceKind
staircase
  { pfreq :: [(GroupName PlaceKind, Int)]
pfreq    = [(GroupName PlaceKind
OPEN_STAIRCASE, Int
500)]
  , pfence :: Fence
pfence   = Fence
FGround
  , ptopLeft :: [Text]
ptopLeft = [ Text
"#·#·#·#"
               , Text
"·······"
               , Text
"#·<S>·#"
               , Text
"·······"
               , Text
"#·#·#·#"
               ]
  }
staircase8 :: PlaceKind
staircase8 = PlaceKind
staircaseLift
  { pfreq :: [(GroupName PlaceKind, Int)]
pfreq    = [(GroupName PlaceKind
OPEN_LIFT, Int
2000)]
  , pfence :: Fence
pfence   = Fence
FFloor
  , ptopLeft :: [Text]
ptopLeft = [ Text
"·#·#·#·"
               , Text
"#·····#"
               , Text
"··<S>··"
               , Text
"#·····#"
               , Text
"·#·#·#·"
               ]
  }
staircase9 :: PlaceKind
staircase9 = PlaceKind
staircase
  { pfreq :: [(GroupName PlaceKind, Int)]
pfreq    = [(GroupName PlaceKind
OPEN_STAIRCASE, Int
500)]
  , pfence :: Fence
pfence   = Fence
FFloor
  , ptopLeft :: [Text]
ptopLeft = [ Text
"#·······#"
               , Text
"···<S>···"
               , Text
"#·······#"
               ]
  }
staircase10 :: PlaceKind
staircase10 = PlaceKind
staircaseLift
  { pfreq :: [(GroupName PlaceKind, Int)]
pfreq    = [(GroupName PlaceKind
OPEN_LIFT, Int
500)]
  , pfence :: Fence
pfence   = Fence
FGround
  , ptopLeft :: [Text]
ptopLeft = [ Text
"0·····0"
               , Text
"··<S>··"
               , Text
"0·····0"
               ]
  }
staircase11 :: PlaceKind
staircase11 = PlaceKind
staircase
  { pfreq :: [(GroupName PlaceKind, Int)]
pfreq    = [(GroupName PlaceKind
CLOSED_STAIRCASE, Int
2000)]  -- weak cover, low freq
  , pfence :: Fence
pfence   = Fence
FFloor
  , ptopLeft :: [Text]
ptopLeft = [ Text
"·#·"
               , Text
"#·#"
               , Text
"···"
               , Text
"<S>"
               , Text
"···"
               , Text
"#·#"
               , Text
"·#·"
               ]
  }
staircase12 :: PlaceKind
staircase12 = PlaceKind
staircase
  { pfreq :: [(GroupName PlaceKind, Int)]
pfreq    = [(GroupName PlaceKind
CLOSED_STAIRCASE, Int
4000)]
  , pfence :: Fence
pfence   = Fence
FFloor
  , ptopLeft :: [Text]
ptopLeft = [ Text
"·#·#·"
               , Text
"#·#·#"
               , Text
"·····"
               , Text
"·<S>·"
               , Text
"·····"
               , Text
"#·#·#"
               , Text
"·#·#·"
               ]
  }
staircase13 :: PlaceKind
staircase13 = PlaceKind
staircase
  { pfreq :: [(GroupName PlaceKind, Int)]
pfreq    = [(GroupName PlaceKind
CLOSED_STAIRCASE, Int
6000)]
  , pfence :: Fence
pfence   = Fence
FFloor
  , ptopLeft :: [Text]
ptopLeft = [ Text
"·#·#·#·"
               , Text
"#·#·#·#"
               , Text
"·······"
               , Text
"0·<S>·0"
               , Text
"·······"
               , Text
"#·#·#·#"
               , Text
"·#·#·#·"
               ]
  }
staircase14 :: PlaceKind
staircase14 = PlaceKind
staircase
  { pfreq :: [(GroupName PlaceKind, Int)]
pfreq    = [(GroupName PlaceKind
CLOSED_STAIRCASE, Int
10000)]
  , pfence :: Fence
pfence   = Fence
FGround
  , ptopLeft :: [Text]
ptopLeft = [ Text
"#·#·#·#"
               , Text
"·#·#·#·"
               , Text
"#·····#"
               , Text
"··<S>··"
               , Text
"#·····#"
               , Text
"·#·#·#·"
               , Text
"#·#·#·#"
               ]
  }
staircase15 :: PlaceKind
staircase15 = PlaceKind
staircase
  { pfreq :: [(GroupName PlaceKind, Int)]
pfreq    = [(GroupName PlaceKind
CLOSED_STAIRCASE, Int
20000)]
  , pfence :: Fence
pfence   = Fence
FFloor
  , ptopLeft :: [Text]
ptopLeft = [ Text
"·#·#·#·#·"
               , Text
"#·#·#·#·#"
               , Text
"·#~~~~~#·"
               , Text
"#~~<S>~~#"
               , Text
"·#~~~~~#·"
               , Text
"#·#·#·#·#"
               , Text
"·#·#·#·#·"
               ]
  }
staircase16 :: PlaceKind
staircase16 = PlaceKind
staircase
  { pfreq :: [(GroupName PlaceKind, Int)]
pfreq    = [(GroupName PlaceKind
CLOSED_STAIRCASE, Int
20000)]
  , pfence :: Fence
pfence   = Fence
FGround
  , ptopLeft :: [Text]
ptopLeft = [ Text
"#·#·#·#·#"
               , Text
"·#·#·#·#·"
               , Text
"#·······#"
               , Text
"·#·<S>·#·"
               , Text
"#·······#"
               , Text
"·#·#·#·#·"
               , Text
"#·#·#·#·#"
               ]
  }
staircase17 :: PlaceKind
staircase17 = PlaceKind
staircase
  { pfreq :: [(GroupName PlaceKind, Int)]
pfreq    = [(GroupName PlaceKind
CLOSED_STAIRCASE, Int
20000)]
  , pfence :: Fence
pfence   = Fence
FFloor
  , ptopLeft :: [Text]
ptopLeft = [ Text
"#·#·#·#·#·#"
               , Text
"·#·#·#·#·#·"
               , Text
"#·#·····#·#"
               , Text
"·#··<S>··#·"
               , Text
"#·#·····#·#"
               , Text
"·#·#·#·#·#·"
               , Text
"#·#·#·#·#·#"
               ]
  }
staircase18 :: PlaceKind
staircase18 = PlaceKind
staircase
  { pfreq :: [(GroupName PlaceKind, Int)]
pfreq    = [(GroupName PlaceKind
CLOSED_STAIRCASE, Int
80000)]
  , pfence :: Fence
pfence   = Fence
FGround
  , ptopLeft :: [Text]
ptopLeft = [ Text
"XX#·#·#·#XX"
               , Text
"X#·#·#·#·#X"
               , Text
"#·#·····#·#"
               , Text
"·#··<S>··#·"
               , Text
"#·#·····#·#"
               , Text
"X#·#·#·#·#X"
               , Text
"XX#·#·#·#XX"
               ]
  }
staircase19 :: PlaceKind
staircase19 = PlaceKind
staircase
  { pfreq :: [(GroupName PlaceKind, Int)]
pfreq    = [(GroupName PlaceKind
CLOSED_STAIRCASE, Int
20000)]
  , pfence :: Fence
pfence   = Fence
FFloor
  , ptopLeft :: [Text]
ptopLeft = [ Text
"·#·#·#·#·#·"
               , Text
"#·#·#·#·#·#"
               , Text
"·#·······#·"
               , Text
"#·#·<S>·#·#"
               , Text
"·#·······#·"
               , Text
"#·#·#·#·#·#"
               , Text
"·#·#·#·#·#·"
               ]
  }
staircase20 :: PlaceKind
staircase20 = PlaceKind
staircase
  { pfreq :: [(GroupName PlaceKind, Int)]
pfreq    = [(GroupName PlaceKind
CLOSED_STAIRCASE, Int
5000)]
  , pfence :: Fence
pfence   = Fence
FFloor
  , ptopLeft :: [Text]
ptopLeft = [ Text
"·#·#·0·#·#·"
               , Text
"#·#·····#·#"
               , Text
"·#··<S>··#·"
               , Text
"#·#·····#·#"
               , Text
"·#·#·I·#·#·"
               ]
  }
staircase21 :: PlaceKind
staircase21 = PlaceKind
staircase
  { pfreq :: [(GroupName PlaceKind, Int)]
pfreq    = [(GroupName PlaceKind
CLOSED_STAIRCASE, Int
5000)]
  , pfence :: Fence
pfence   = Fence
FGround
  , ptopLeft :: [Text]
ptopLeft = [ Text
"#·#·I·#·#"
               , Text
"·#·····#·"
               , Text
"#··<S>··#"
               , Text
"·#·····#·"
               , Text
"#·#·0·#·#"
               ]
  }
staircase22 :: PlaceKind
staircase22 = PlaceKind
staircase
  { pfreq :: [(GroupName PlaceKind, Int)]
pfreq    = [(GroupName PlaceKind
CLOSED_STAIRCASE, Int
2000)]
  , pfence :: Fence
pfence   = Fence
FGround
  , ptopLeft :: [Text]
ptopLeft = [ Text
"#·#·····#·#"
               , Text
"·#··<S>··#·"
               , Text
"#·#·····#·#"
               ]
  }
staircase23 :: PlaceKind
staircase23 = PlaceKind
staircase
  { pfreq :: [(GroupName PlaceKind, Int)]
pfreq    = [(GroupName PlaceKind
CLOSED_STAIRCASE, Int
1000)]
  , pfence :: Fence
pfence   = Fence
FFloor
  , ptopLeft :: [Text]
ptopLeft = [ Text
"·#·······#·"
               , Text
"#·#·<S>·#·#"
               , Text
"·#·······#·"
               ]
  }
staircase24 :: PlaceKind
staircase24 = PlaceKind
staircase
  { pfreq :: [(GroupName PlaceKind, Int)]
pfreq    = [(GroupName PlaceKind
CLOSED_STAIRCASE, Int
1000)]
  , pfence :: Fence
pfence   = Fence
FFloor
  , ptopLeft :: [Text]
ptopLeft = [ Text
"·#·····#·"
               , Text
"#··<S>··#"
               , Text
"·#·····#·"
               ]
  }
staircase25 :: PlaceKind
staircase25 = PlaceKind
staircase
  { pfreq :: [(GroupName PlaceKind, Int)]
pfreq    = [(GroupName PlaceKind
WALLED_STAIRCASE, Int
100)]
  , pfence :: Fence
pfence   = Fence
FWall
  , ptopLeft :: [Text]
ptopLeft = [ Text
"·····"
               , Text
"·<S>·"
               , Text
"·····"
               ]
  }
staircase26 :: PlaceKind
staircase26 = PlaceKind
staircase
  { pfreq :: [(GroupName PlaceKind, Int)]
pfreq    = [(GroupName PlaceKind
WALLED_STAIRCASE, Int
200)]
  , pfence :: Fence
pfence   = Fence
FWall
  , ptopLeft :: [Text]
ptopLeft = [ Text
"·······"
               , Text
"··<S>··"
               , Text
"·······"
               ]
  }
staircase27 :: PlaceKind
staircase27 = PlaceKind
staircaseLift
  { pfreq :: [(GroupName PlaceKind, Int)]
pfreq    = [(GroupName PlaceKind
WALLED_LIFT, Int
500)]
  , pfence :: Fence
pfence   = Fence
FWall
  , ptopLeft :: [Text]
ptopLeft = [ Text
"#·····#"
               , Text
"··<S>··"
               , Text
"#·····#"
               ]
  }
staircase28 :: PlaceKind
staircase28 = PlaceKind
staircaseLift
  { pfreq :: [(GroupName PlaceKind, Int)]
pfreq    = [(GroupName PlaceKind
WALLED_LIFT, Int
1000)]
  , pfence :: Fence
pfence   = Fence
FWall
  , ptopLeft :: [Text]
ptopLeft = [ Text
"·····"
               , Text
"·····"
               , Text
"·<S>·"
               , Text
"·····"
               , Text
"·····"
               ]
  }
staircase29 :: PlaceKind
staircase29 = PlaceKind
staircase
  { pfreq :: [(GroupName PlaceKind, Int)]
pfreq    = [(GroupName PlaceKind
WALLED_STAIRCASE, Int
1000)]
  , pfence :: Fence
pfence   = Fence
FWall
  , ptopLeft :: [Text]
ptopLeft = [ Text
"#···#"
               , Text
"·····"
               , Text
"·<S>·"
               , Text
"·····"
               , Text
"#···#"
               ]
  }
staircase30 :: PlaceKind
staircase30 = PlaceKind
staircaseLift
  { pfreq :: [(GroupName PlaceKind, Int)]
pfreq    = [(GroupName PlaceKind
WALLED_LIFT, Int
1000)]
  , pfence :: Fence
pfence   = Fence
FWall
  , ptopLeft :: [Text]
ptopLeft = [ Text
"#···#"
               , Text
"·····"
               , Text
"·<S>·"
               , Text
"·····"
               , Text
"#···#"
               ]
  }
staircase31 :: PlaceKind
staircase31 = PlaceKind
staircase
  { pfreq :: [(GroupName PlaceKind, Int)]
pfreq    = [(GroupName PlaceKind
WALLED_STAIRCASE, Int
2000)]
  , pfence :: Fence
pfence   = Fence
FWall
  , ptopLeft :: [Text]
ptopLeft = [ Text
"·······"
               , Text
"·~~~~~·"
               , Text
"·~<S>~·"
               , Text
"·~~~~~·"
               , Text
"·······"
               ]
  }
staircase32 :: PlaceKind
staircase32 = PlaceKind
staircaseLift
  { pfreq :: [(GroupName PlaceKind, Int)]
pfreq    = [(GroupName PlaceKind
WALLED_LIFT, Int
5000)]
  , pfence :: Fence
pfence   = Fence
FWall
  , ptopLeft :: [Text]
ptopLeft = [ Text
"#·····#"
               , Text
"·······"
               , Text
"··<S>··"
               , Text
"·······"
               , Text
"#·····#"
               ]
  }
staircase33 :: PlaceKind
staircase33 = PlaceKind
staircase
  { pfreq :: [(GroupName PlaceKind, Int)]
pfreq    = [(GroupName PlaceKind
WALLED_STAIRCASE, Int
5000)]
  , pfence :: Fence
pfence   = Fence
FWall
  , ptopLeft :: [Text]
ptopLeft = [ Text
"#·#·#·#"
               , Text
"·······"
               , Text
"#·<S>·#"
               , Text
"·······"
               , Text
"#·#·#·#"
               ]
  }
staircase34 :: PlaceKind
staircase34 = PlaceKind
staircaseLift
  { pfreq :: [(GroupName PlaceKind, Int)]
pfreq    = [(GroupName PlaceKind
WALLED_LIFT, Int
5000)]
  , pfence :: Fence
pfence   = Fence
FWall
  , ptopLeft :: [Text]
ptopLeft = [ Text
"·#·#·#·"
               , Text
"#·····#"
               , Text
"··<S>··"
               , Text
"#·····#"
               , Text
"·#·#·#·"
               ]
  }
staircase35 :: PlaceKind
staircase35 = PlaceKind
staircase
  { pfreq :: [(GroupName PlaceKind, Int)]
pfreq    = [(GroupName PlaceKind
WALLED_STAIRCASE, Int
1000)]
  , pfence :: Fence
pfence   = Fence
FWall
  , ptopLeft :: [Text]
ptopLeft = [ Text
"·········"
               , Text
"···<S>···"
               , Text
"·········"
               ]
  }
staircase36 :: PlaceKind
staircase36 = PlaceKind
staircaseLift
  { pfreq :: [(GroupName PlaceKind, Int)]
pfreq    = [(GroupName PlaceKind
WALLED_LIFT, Int
1000)]
  , pfence :: Fence
pfence   = Fence
FWall
  , ptopLeft :: [Text]
ptopLeft = [ Text
"·#·····#·"
               , Text
"#··<S>··#"
               , Text
"·#·····#·"
               ]
  }
staircase37 :: PlaceKind
staircase37 = PlaceKind
staircase
  { pfreq :: [(GroupName PlaceKind, Int)]
pfreq    = [(GroupName PlaceKind
WALLED_STAIRCASE, Int
1000)]
  , pfence :: Fence
pfence   = Fence
FWall
  , ptopLeft :: [Text]
ptopLeft = [ Text
"·········"
               , Text
"·0·<S>·0·"
               , Text
"·········"
               ]
  }

-- * Allure-specific

staircaseLift11 :: PlaceKind
staircaseLift11 = [(Char, GroupName TileKind)] -> PlaceKind -> PlaceKind
overridePlaceKind [(Char, GroupName TileKind)]
overrideLift (PlaceKind -> PlaceKind) -> PlaceKind -> PlaceKind
forall a b. (a -> b) -> a -> b
$ PlaceKind
staircase11
  { pname :: Text
pname     = Text
"a lift"
  , pfreq :: [(GroupName PlaceKind, Int)]
pfreq     = [(GroupName PlaceKind
CLOSED_LIFT, Int
2000)]  -- weak cover, low freq
  }
staircaseLift12 :: PlaceKind
staircaseLift12 = [(Char, GroupName TileKind)] -> PlaceKind -> PlaceKind
overridePlaceKind [(Char, GroupName TileKind)]
overrideLift (PlaceKind -> PlaceKind) -> PlaceKind -> PlaceKind
forall a b. (a -> b) -> a -> b
$ PlaceKind
staircase12
  { pname :: Text
pname     = Text
"a lift"
  , pfreq :: [(GroupName PlaceKind, Int)]
pfreq     = [(GroupName PlaceKind
CLOSED_LIFT, Int
4000)]
  }
staircaseLift13 :: PlaceKind
staircaseLift13 = [(Char, GroupName TileKind)] -> PlaceKind -> PlaceKind
overridePlaceKind [(Char, GroupName TileKind)]
overrideLift (PlaceKind -> PlaceKind) -> PlaceKind -> PlaceKind
forall a b. (a -> b) -> a -> b
$ PlaceKind
staircase13
  { pname :: Text
pname     = Text
"a lift"
  , pfreq :: [(GroupName PlaceKind, Int)]
pfreq     = [(GroupName PlaceKind
CLOSED_LIFT, Int
6000)]
  }
staircaseLift14 :: PlaceKind
staircaseLift14 = [(Char, GroupName TileKind)] -> PlaceKind -> PlaceKind
overridePlaceKind [(Char, GroupName TileKind)]
overrideLift (PlaceKind -> PlaceKind) -> PlaceKind -> PlaceKind
forall a b. (a -> b) -> a -> b
$ PlaceKind
staircase14
  { pname :: Text
pname     = Text
"a lift"
  , pfreq :: [(GroupName PlaceKind, Int)]
pfreq     = [(GroupName PlaceKind
CLOSED_LIFT, Int
10000)]
  }
staircaseLift15 :: PlaceKind
staircaseLift15 = [(Char, GroupName TileKind)] -> PlaceKind -> PlaceKind
overridePlaceKind [(Char, GroupName TileKind)]
overrideLift (PlaceKind -> PlaceKind) -> PlaceKind -> PlaceKind
forall a b. (a -> b) -> a -> b
$ PlaceKind
staircase15
  { pname :: Text
pname     = Text
"a lift"
  , pfreq :: [(GroupName PlaceKind, Int)]
pfreq     = [(GroupName PlaceKind
CLOSED_LIFT, Int
20000)]
  }
staircaseLift16 :: PlaceKind
staircaseLift16 = [(Char, GroupName TileKind)] -> PlaceKind -> PlaceKind
overridePlaceKind [(Char, GroupName TileKind)]
overrideLift (PlaceKind -> PlaceKind) -> PlaceKind -> PlaceKind
forall a b. (a -> b) -> a -> b
$ PlaceKind
staircase16
  { pname :: Text
pname     = Text
"a lift"
  , pfreq :: [(GroupName PlaceKind, Int)]
pfreq     = [(GroupName PlaceKind
CLOSED_LIFT, Int
20000)]
  }
staircaseLift17 :: PlaceKind
staircaseLift17 = [(Char, GroupName TileKind)] -> PlaceKind -> PlaceKind
overridePlaceKind [(Char, GroupName TileKind)]
overrideLift (PlaceKind -> PlaceKind) -> PlaceKind -> PlaceKind
forall a b. (a -> b) -> a -> b
$ PlaceKind
staircase17
  { pname :: Text
pname     = Text
"a lift"
  , pfreq :: [(GroupName PlaceKind, Int)]
pfreq     = [(GroupName PlaceKind
CLOSED_LIFT, Int
20000)]
  }
staircaseLift18 :: PlaceKind
staircaseLift18 = [(Char, GroupName TileKind)] -> PlaceKind -> PlaceKind
overridePlaceKind [(Char, GroupName TileKind)]
overrideLift (PlaceKind -> PlaceKind) -> PlaceKind -> PlaceKind
forall a b. (a -> b) -> a -> b
$ PlaceKind
staircase18
  { pname :: Text
pname     = Text
"a lift"
  , pfreq :: [(GroupName PlaceKind, Int)]
pfreq     = [(GroupName PlaceKind
CLOSED_LIFT, Int
80000)]
  }
staircaseLift19 :: PlaceKind
staircaseLift19 = [(Char, GroupName TileKind)] -> PlaceKind -> PlaceKind
overridePlaceKind [(Char, GroupName TileKind)]
overrideLift (PlaceKind -> PlaceKind) -> PlaceKind -> PlaceKind
forall a b. (a -> b) -> a -> b
$ PlaceKind
staircase19
  { pname :: Text
pname     = Text
"a lift"
  , pfreq :: [(GroupName PlaceKind, Int)]
pfreq     = [(GroupName PlaceKind
CLOSED_LIFT, Int
20000)]
  }
staircaseLift20 :: PlaceKind
staircaseLift20 = [(Char, GroupName TileKind)] -> PlaceKind -> PlaceKind
overridePlaceKind [(Char, GroupName TileKind)]
overrideLift (PlaceKind -> PlaceKind) -> PlaceKind -> PlaceKind
forall a b. (a -> b) -> a -> b
$ PlaceKind
staircase20
  { pname :: Text
pname     = Text
"a lift"
  , pfreq :: [(GroupName PlaceKind, Int)]
pfreq     = [(GroupName PlaceKind
CLOSED_LIFT, Int
5000)]
  }
staircaseLift21 :: PlaceKind
staircaseLift21 = [(Char, GroupName TileKind)] -> PlaceKind -> PlaceKind
overridePlaceKind [(Char, GroupName TileKind)]
overrideLift (PlaceKind -> PlaceKind) -> PlaceKind -> PlaceKind
forall a b. (a -> b) -> a -> b
$ PlaceKind
staircase21
  { pname :: Text
pname     = Text
"a lift"
  , pfreq :: [(GroupName PlaceKind, Int)]
pfreq     = [(GroupName PlaceKind
CLOSED_LIFT, Int
5000)]
  }
staircaseLift22 :: PlaceKind
staircaseLift22 = [(Char, GroupName TileKind)] -> PlaceKind -> PlaceKind
overridePlaceKind [(Char, GroupName TileKind)]
overrideLift (PlaceKind -> PlaceKind) -> PlaceKind -> PlaceKind
forall a b. (a -> b) -> a -> b
$ PlaceKind
staircase22
  { pname :: Text
pname     = Text
"a lift"
  , pfreq :: [(GroupName PlaceKind, Int)]
pfreq     = [(GroupName PlaceKind
CLOSED_LIFT, Int
2000)]
  }
staircaseLift23 :: PlaceKind
staircaseLift23 = [(Char, GroupName TileKind)] -> PlaceKind -> PlaceKind
overridePlaceKind [(Char, GroupName TileKind)]
overrideLift (PlaceKind -> PlaceKind) -> PlaceKind -> PlaceKind
forall a b. (a -> b) -> a -> b
$ PlaceKind
staircase23
  { pname :: Text
pname     = Text
"a lift"
  , pfreq :: [(GroupName PlaceKind, Int)]
pfreq     = [(GroupName PlaceKind
CLOSED_LIFT, Int
1000)]
  }
staircaseLift24 :: PlaceKind
staircaseLift24 = [(Char, GroupName TileKind)] -> PlaceKind -> PlaceKind
overridePlaceKind [(Char, GroupName TileKind)]
overrideLift (PlaceKind -> PlaceKind) -> PlaceKind -> PlaceKind
forall a b. (a -> b) -> a -> b
$ PlaceKind
staircase24
  { pname :: Text
pname     = Text
"a lift"
  , pfreq :: [(GroupName PlaceKind, Int)]
pfreq     = [(GroupName PlaceKind
CLOSED_LIFT, Int
1000)]
  }
staircaseLift25 :: PlaceKind
staircaseLift25 = [(Char, GroupName TileKind)] -> PlaceKind -> PlaceKind
overridePlaceKind [(Char, GroupName TileKind)]
overrideLift (PlaceKind -> PlaceKind) -> PlaceKind -> PlaceKind
forall a b. (a -> b) -> a -> b
$ PlaceKind
staircase25
  { pname :: Text
pname     = Text
"a lift"
  , pfreq :: [(GroupName PlaceKind, Int)]
pfreq     = [(GroupName PlaceKind
WALLED_LIFT, Int
100)]
  }
pumps :: PlaceKind
pumps = [(Char, GroupName TileKind)]
-> [(Char, GroupName TileKind)] -> PlaceKind -> PlaceKind
override2PlaceKind [ (Char
'·', GroupName TileKind
DAMP_FLOOR_DARK)
                           , (Char
'f', GroupName TileKind
PUMPS_DARK)
                           , (Char
';', GroupName TileKind
UNDERBRUSH_CLUMP_DARK) ]
                           [ (Char
'·', GroupName TileKind
DAMP_FLOOR_LIT)
                           , (Char
'f', GroupName TileKind
PUMPS_LIT)
                           , (Char
';', GroupName TileKind
UNDERBRUSH_CLUMP_LIT) ] (PlaceKind -> PlaceKind) -> PlaceKind -> PlaceKind
forall a b. (a -> b) -> a -> b
$
        [(Char, GroupName TileKind)] -> PlaceKind -> PlaceKind
overridePlaceKind [(Char
'd', GroupName TileKind
DOORLESS_MACHINERY)] (PlaceKind -> PlaceKind) -> PlaceKind -> PlaceKind
forall a b. (a -> b) -> a -> b
$ PlaceKind :: Char
-> Text
-> [(GroupName PlaceKind, Int)]
-> Rarity
-> Cover
-> Fence
-> [Text]
-> EnumMap Char (GroupName TileKind)
-> EnumMap Char (GroupName TileKind)
-> PlaceKind
PlaceKind
  { psymbol :: Char
psymbol  = Char
'w'
  , pname :: Text
pname    = Text
"water pumps"
  , pfreq :: [(GroupName PlaceKind, Int)]
pfreq    = [ (GroupName PlaceKind
ROGUE, Int
200), (GroupName PlaceKind
LABORATORY, Int
100), (GroupName PlaceKind
EMPTY, Int
2000)
               , (GroupName PlaceKind
SHOOTOUT, Int
50), (GroupName PlaceKind
RAID, Int
300) ]
  , prarity :: Rarity
prarity  = [(Double
1, Int
1)]
  , pcover :: Cover
pcover   = Cover
CAlternate
  , pfence :: Fence
pfence   = Fence
FWall
  , ptopLeft :: [Text]
ptopLeft = [ Text
"·f"
               , Text
"d;"
               ]
  , plegendDark :: EnumMap Char (GroupName TileKind)
plegendDark = EnumMap Char (GroupName TileKind)
defaultLegendDark
  , plegendLit :: EnumMap Char (GroupName TileKind)
plegendLit = EnumMap Char (GroupName TileKind)
defaultLegendLit
  }
oval :: PlaceKind
oval = [(Char, GroupName TileKind)]
-> [(Char, GroupName TileKind)] -> PlaceKind -> PlaceKind
override2PlaceKind [ (Char
'1', GroupName TileKind
STUCK_DOOR)
                          , (Char
'2', GroupName TileKind
TRAPPED_DOOR)
                          , (Char
'~', GroupName TileKind
S_POOL_DARK)
                          , (Char
';', GroupName TileKind
S_UNDERBRUSH_DARK) ]
                          [ (Char
'1', GroupName TileKind
TRAPPED_DOOR)  -- reversed vs dark
                          , (Char
'2', GroupName TileKind
STUCK_DOOR)
                          , (Char
'~', GroupName TileKind
S_POOL_LIT)
                          , (Char
';', GroupName TileKind
S_UNDERBRUSH_LIT) ] (PlaceKind -> PlaceKind) -> PlaceKind -> PlaceKind
forall a b. (a -> b) -> a -> b
$
       [(Char, GroupName TileKind)] -> PlaceKind -> PlaceKind
overridePlaceKind [ (Char
't', GroupName TileKind
TRAIL_LIT)
                         , (Char
'p', GroupName TileKind
TRAPPED_DOOR)
                         , (Char
'b', GroupName TileKind
BARREL)
                         , (Char
'a', GroupName TileKind
SAFE_TRAIL_LIT)
                         , (Char
'T', GroupName TileKind
S_TREE_LIT) ] (PlaceKind -> PlaceKind) -> PlaceKind -> PlaceKind
forall a b. (a -> b) -> a -> b
$ PlaceKind :: Char
-> Text
-> [(GroupName PlaceKind, Int)]
-> Rarity
-> Cover
-> Fence
-> [Text]
-> EnumMap Char (GroupName TileKind)
-> EnumMap Char (GroupName TileKind)
-> PlaceKind
PlaceKind
  { psymbol :: Char
psymbol  = Char
'o'
  , pname :: Text
pname    = Text
"a dome"
  , pfreq :: [(GroupName PlaceKind, Int)]
pfreq    = [ (GroupName PlaceKind
ROGUE, Int
20000), (GroupName PlaceKind
ARENA, Int
30000), (GroupName PlaceKind
MUSEUM, Int
30000)
               , (GroupName PlaceKind
LABORATORY, Int
50000), (GroupName PlaceKind
EMPTY, Int
3000), (GroupName PlaceKind
EXIT, Int
5000)
               , (GroupName PlaceKind
AMBUSH, Int
20000), (GroupName PlaceKind
RAID, Int
20000) ]
  , prarity :: Rarity
prarity  = [(Double
1, Int
1)]
  , pcover :: Cover
pcover   = Cover
CStretch
  , pfence :: Fence
pfence   = Fence
FWall
  , ptopLeft :: [Text]
ptopLeft = [ Text
"####·"
               , Text
"##···"
               , Text
"#··tt"
               , Text
"#·t··"
               , Text
"··t··"
               ]
  , plegendDark :: EnumMap Char (GroupName TileKind)
plegendDark = EnumMap Char (GroupName TileKind)
defaultLegendDark
  , plegendLit :: EnumMap Char (GroupName TileKind)
plegendLit = EnumMap Char (GroupName TileKind)
defaultLegendLit
  }
ovalFloor :: PlaceKind
ovalFloor = PlaceKind
oval
  { pfreq :: [(GroupName PlaceKind, Int)]
pfreq    = [ (GroupName PlaceKind
ROGUE, Int
150000), (GroupName PlaceKind
ARENA, Int
60000), (GroupName PlaceKind
MUSEUM, Int
60000)
               , (GroupName PlaceKind
LABORATORY, Int
100000), (GroupName PlaceKind
EMPTY, Int
20000), (GroupName PlaceKind
EXIT, Int
5000)
               , (GroupName PlaceKind
AMBUSH, Int
100000), (GroupName PlaceKind
RAID, Int
150000) ]
  , pfence :: Fence
pfence   = Fence
FGround
  , ptopLeft :: [Text]
ptopLeft = [ Text
"aXXX##"
               , Text
"Xp###·"
               , Text
"X#a···"
               , Text
"X#·a·a"
               , Text
"##··a;"
               , Text
"#··a;;"
               ]
  }
ovalSquare :: PlaceKind
ovalSquare = PlaceKind
oval
  { pfreq :: [(GroupName PlaceKind, Int)]
pfreq    = [ (GroupName PlaceKind
ROGUE, Int
20000), (GroupName PlaceKind
ARENA, Int
30000), (GroupName PlaceKind
MUSEUM, Int
30000)
               , (GroupName PlaceKind
LABORATORY, Int
50000), (GroupName PlaceKind
EMPTY, Int
8000), (GroupName PlaceKind
EXIT, Int
5000)
               , (GroupName PlaceKind
AMBUSH, Int
20000), (GroupName PlaceKind
RAID, Int
20000) ]
  , pfence :: Fence
pfence   = Fence
FGround
  , ptopLeft :: [Text]
ptopLeft = [ Text
"X###+"
               , Text
"##···"
               , Text
"#··;;"
               , Text
"#·;;;"
               , Text
"+·;;;"
               ]
  }
ovalBasin :: PlaceKind
ovalBasin = PlaceKind
oval
  { pname :: Text
pname    = Text
"a water basin"
  , pfreq :: [(GroupName PlaceKind, Int)]
pfreq    = [ (GroupName PlaceKind
ROGUE, Int
100000), (GroupName PlaceKind
ARENA, Int
100000), (GroupName PlaceKind
LABORATORY, Int
200000)
               , (GroupName PlaceKind
EMPTY, Int
15000), (GroupName PlaceKind
RAID, Int
100000) ]
  , pfence :: Fence
pfence   = Fence
FGround
  , ptopLeft :: [Text]
ptopLeft = [ Text
"XXX1##"
               , Text
"X###··"
               , Text
"X#····"
               , Text
"2#··~~"
               , Text
"#··~~~"
               , Text
"#··~~~"
               ]
  }
ovalBasin2 :: PlaceKind
ovalBasin2 = PlaceKind
oval
  { pname :: Text
pname    = Text
"a water basin"
  , pfreq :: [(GroupName PlaceKind, Int)]
pfreq    = [ (GroupName PlaceKind
ROGUE, Int
600), (GroupName PlaceKind
ARENA, Int
10000), (GroupName PlaceKind
LABORATORY, Int
3000)
               , (GroupName PlaceKind
EMPTY, Int
700), (GroupName PlaceKind
RAID, Int
600) ]
  , pfence :: Fence
pfence   = Fence
FWall
  , ptopLeft :: [Text]
ptopLeft = [ Text
"#···"
               , Text
"··~~"
               , Text
"·~~~"
               , Text
"·~~~"
               ]
  }
squareBasin :: PlaceKind
squareBasin = PlaceKind
oval
  { pname :: Text
pname    = Text
"a water basin"
  , pfreq :: [(GroupName PlaceKind, Int)]
pfreq    = [(GroupName PlaceKind
ARENA, Int
10000), (GroupName PlaceKind
LABORATORY, Int
5000), (GroupName PlaceKind
EMPTY, Int
2000), (GroupName PlaceKind
RAID, Int
1000)]
      -- keep it less common in raid not to overload the newbies
  , pfence :: Fence
pfence   = Fence
FNone
  , ptopLeft :: [Text]
ptopLeft = [ Text
"0bt0t"
               , Text
"b~~~~"
               , Text
"t~0~~"
               , Text
"0~~~~"
               , Text
"t~~~~"
               ]
  }
squareBasin2 :: PlaceKind
squareBasin2 = PlaceKind
oval
  { pname :: Text
pname    = Text
"a water basin"
  , pfreq :: [(GroupName PlaceKind, Int)]
pfreq    = [(GroupName PlaceKind
ARENA, Int
200000), (GroupName PlaceKind
EMPTY, Int
20000), (GroupName PlaceKind
BRAWL, Int
100000)]
      -- can't do LABORATORY, because barrels might block corridors
  , pfence :: Fence
pfence   = Fence
FNone
  , ptopLeft :: [Text]
ptopLeft = [ Text
"T;T;;;"
               , Text
";~~~~~"
               , Text
"T~~~~~"
               , Text
";~~0~~"
               , Text
";~~~~~"
               , Text
"b~~~~~"
               ]
  }
floodedRoom :: PlaceKind
floodedRoom = PlaceKind :: Char
-> Text
-> [(GroupName PlaceKind, Int)]
-> Rarity
-> Cover
-> Fence
-> [Text]
-> EnumMap Char (GroupName TileKind)
-> EnumMap Char (GroupName TileKind)
-> PlaceKind
PlaceKind  -- Valid for any nonempty area, hence low frequency.
  { psymbol :: Char
psymbol  = Char
'f'
  , pname :: Text
pname    = Text
"a flooded room"
  , pfreq :: [(GroupName PlaceKind, Int)]
pfreq    = [(GroupName PlaceKind
ROGUE, Int
10), (GroupName PlaceKind
LABORATORY, Int
12), (GroupName PlaceKind
ZOO, Int
50), (GroupName PlaceKind
RAID, Int
7)]
  , prarity :: Rarity
prarity  = [(Double
1, Int
1)]
  , pcover :: Cover
pcover   = Cover
CStretch
  , pfence :: Fence
pfence   = Fence
FWall
  , 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
  }
floodedRoom2 :: PlaceKind
floodedRoom2 = [(Char, GroupName TileKind)] -> PlaceKind -> PlaceKind
overridePlaceKind [(Char
'f', GroupName TileKind
PUMPS_LIT)] (PlaceKind -> PlaceKind) -> PlaceKind -> PlaceKind
forall a b. (a -> b) -> a -> b
$ PlaceKind :: Char
-> Text
-> [(GroupName PlaceKind, Int)]
-> Rarity
-> Cover
-> Fence
-> [Text]
-> EnumMap Char (GroupName TileKind)
-> EnumMap Char (GroupName TileKind)
-> PlaceKind
PlaceKind
  { psymbol :: Char
psymbol  = Char
'p'
  , pname :: Text
pname    = Text
"a pond"
  , pfreq :: [(GroupName PlaceKind, Int)]
pfreq    = [(GroupName PlaceKind
BRAWL, Int
100)]
  , prarity :: Rarity
prarity  = [(Double
1, Int
1)]
  , pcover :: Cover
pcover   = Cover
CMirror
  , pfence :: Fence
pfence   = Fence
FNone
  , ptopLeft :: [Text]
ptopLeft = [ Text
"XXf"
               , 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
  }
maze :: PlaceKind
maze = [(Char, GroupName TileKind)]
-> [(Char, GroupName TileKind)] -> PlaceKind -> PlaceKind
override2PlaceKind [ (Char
'·', GroupName TileKind
OILY_FLOOR_DARK)
                          , (Char
'f', GroupName TileKind
BUSH_GROVE_DARK)
                          , (Char
';', GroupName TileKind
S_UNDERBRUSH_DARK) ]
                          [ (Char
'·', GroupName TileKind
OILY_FLOOR_LIT)
                          , (Char
'f', GroupName TileKind
BUSH_GROVE_LIT)
                          , (Char
';', GroupName TileKind
S_UNDERBRUSH_LIT) ] (PlaceKind -> PlaceKind) -> PlaceKind -> PlaceKind
forall a b. (a -> b) -> a -> b
$
       [(Char, GroupName TileKind)] -> PlaceKind -> PlaceKind
overridePlaceKind [ (Char
'&', GroupName TileKind
CACHE_MAZE)
                         , (Char
'p', GroupName TileKind
TRAPPED_DOOR)
                         , (Char
'i', GroupName TileKind
FLOOR_ACTOR_ITEM)  -- lit or not, randomly
                         , (Char
'$', GroupName TileKind
TRAPPABLE_WALL) ] (PlaceKind -> PlaceKind) -> PlaceKind -> PlaceKind
forall a b. (a -> b) -> a -> b
$ PlaceKind :: Char
-> Text
-> [(GroupName PlaceKind, Int)]
-> Rarity
-> Cover
-> Fence
-> [Text]
-> EnumMap Char (GroupName TileKind)
-> EnumMap Char (GroupName TileKind)
-> PlaceKind
PlaceKind
  { psymbol :: Char
psymbol  = Char
'm'
  , pname :: Text
pname    = Text
"an intricate maze"
  , pfreq :: [(GroupName PlaceKind, Int)]
pfreq    = [ (GroupName PlaceKind
ROGUE, Int
60), (GroupName PlaceKind
LABORATORY, Int
1500), (GroupName PlaceKind
ARENA, Int
3)
               , (GroupName PlaceKind
MUSEUM, Int
3), (GroupName PlaceKind
EXIT, Int
100), (GroupName PlaceKind
RAID, Int
60) ]
  , prarity :: Rarity
prarity  = [(Double
1, Int
1)]
  , pcover :: Cover
pcover   = Cover
CStretch
  , pfence :: Fence
pfence   = Fence
FWall
  , ptopLeft :: [Text]
ptopLeft = [ Text
"##··"
               , Text
"#··#"
               , Text
"··#·"
               ]
  , plegendDark :: EnumMap Char (GroupName TileKind)
plegendDark = EnumMap Char (GroupName TileKind)
defaultLegendDark
  , plegendLit :: EnumMap Char (GroupName TileKind)
plegendLit = EnumMap Char (GroupName TileKind)
defaultLegendLit
  }
maze2 :: PlaceKind
maze2 = PlaceKind
maze
  { pfreq :: [(GroupName PlaceKind, Int)]
pfreq    = [ (GroupName PlaceKind
ROGUE, Int
120), (GroupName PlaceKind
LABORATORY, Int
12000), (GroupName PlaceKind
ARENA, Int
4)
               , (GroupName PlaceKind
MUSEUM, Int
4), (GroupName PlaceKind
EXIT, Int
100), (GroupName PlaceKind
RAID, Int
120) ]
  , ptopLeft :: [Text]
ptopLeft = [ Text
"#·%%·"
               , Text
"·%··#"
               , Text
"···#·"
               ]
  }
maze3 :: PlaceKind
maze3 = PlaceKind
maze
  { pfreq :: [(GroupName PlaceKind, Int)]
pfreq    = [ (GroupName PlaceKind
ROGUE, Int
120), (GroupName PlaceKind
LABORATORY, Int
1000), (GroupName PlaceKind
ARENA, Int
8)
               , (GroupName PlaceKind
MUSEUM, Int
4), (GroupName PlaceKind
EMPTY, Int
300), (GroupName PlaceKind
EXIT, Int
50), (GroupName PlaceKind
RAID, Int
120) ]
  , ptopLeft :: [Text]
ptopLeft = [ Text
"#·ff·"
               , Text
"·f··#"
               , Text
"···#;"
               ]
  }
maze4 :: PlaceKind
maze4 = PlaceKind
maze
  { pfreq :: [(GroupName PlaceKind, Int)]
pfreq    = [ (GroupName PlaceKind
ROGUE, Int
300), (GroupName PlaceKind
LABORATORY, Int
15000), (GroupName PlaceKind
ARENA, Int
9)
               , (GroupName PlaceKind
EXIT, Int
200), (GroupName PlaceKind
RAID, Int
300) ]
  , ptopLeft :: [Text]
ptopLeft = [ Text
"##·##·"
               , Text
"#·#··#"
               , Text
"~·f···"
               ]
  }
mazeBig :: PlaceKind
mazeBig = PlaceKind
maze
  { pfreq :: [(GroupName PlaceKind, Int)]
pfreq    = [ (GroupName PlaceKind
ROGUE, Int
1500), (GroupName PlaceKind
LABORATORY, Int
8000), (GroupName PlaceKind
ARENA, Int
10000)
               , (GroupName PlaceKind
EXIT, Int
1000), (GroupName PlaceKind
RAID, Int
300) ]
  , pfence :: Fence
pfence   = Fence
FNone
  , ptopLeft :: [Text]
ptopLeft = [ Text
"X$$$$$"
               , Text
"$··##·"
               , Text
"$#····"
               , Text
"$#·p%%"
               , Text
"$··%:i"
               ]
  }
mazeBig2 :: PlaceKind
mazeBig2 = PlaceKind
mazeBig
  { ptopLeft :: [Text]
ptopLeft = [ Text
"XX$$$~"
               , Text
"X#···%"
               , Text
"$·###·"
               , Text
"$·p&%%"
               , Text
"$·#iii"
               ]
  }
cells :: PlaceKind
cells = [(Char, GroupName TileKind)]
-> [(Char, GroupName TileKind)] -> PlaceKind -> PlaceKind
override2PlaceKind [ (Char
'b', GroupName TileKind
RUBBLE_OR_WASTE_DARK)
                           , (Char
'f', GroupName TileKind
BUSH_GROVE_DARK)
                           , (Char
'o', GroupName TileKind
OIL_RESIDUE_DARK)
                           , (Char
';', GroupName TileKind
UNDERBRUSH_CLUMP_DARK) ]
                           [ (Char
'b', GroupName TileKind
RUBBLE_OR_WASTE_LIT)
                           , (Char
'f', GroupName TileKind
BUSH_GROVE_LIT)
                           , (Char
'o', GroupName TileKind
OIL_RESIDUE_LIT)
                           , (Char
';', GroupName TileKind
UNDERBRUSH_CLUMP_LIT) ] (PlaceKind -> PlaceKind) -> PlaceKind -> PlaceKind
forall a b. (a -> b) -> a -> b
$
        [(Char, GroupName TileKind)] -> PlaceKind -> PlaceKind
overridePlaceKind [ (Char
'd', GroupName TileKind
DOORLESS_MACHINERY)
                          , (Char
'w', GroupName TileKind
S_REINFORCED_WALL) ] (PlaceKind -> PlaceKind) -> PlaceKind -> PlaceKind
forall a b. (a -> b) -> a -> b
$ PlaceKind :: Char
-> Text
-> [(GroupName PlaceKind, Int)]
-> Rarity
-> Cover
-> Fence
-> [Text]
-> EnumMap Char (GroupName TileKind)
-> EnumMap Char (GroupName TileKind)
-> PlaceKind
PlaceKind
  { psymbol :: Char
psymbol  = Char
'#'
  , pname :: Text
pname    = Text
"air filters"
  , pfreq :: [(GroupName PlaceKind, Int)]
pfreq    = [ (GroupName PlaceKind
ROGUE, Int
40), (GroupName PlaceKind
LABORATORY, Int
48), (GroupName PlaceKind
MUSEUM, Int
10)
               , (GroupName PlaceKind
EXIT, Int
150), (GroupName PlaceKind
NOISE, Int
480)
               , (GroupName PlaceKind
ZOO, Int
700), (GroupName PlaceKind
AMBUSH, Int
80), (GroupName PlaceKind
RAID, Int
40) ]
  , prarity :: Rarity
prarity  = [(Double
1, Int
1)]
  , pcover :: Cover
pcover   = Cover
CReflect
  , pfence :: Fence
pfence   = Fence
FWall
  , ptopLeft :: [Text]
ptopLeft = [ Text
"#··"
               , Text
"·d·"
               , Text
"··#"
               ]
  , plegendDark :: EnumMap Char (GroupName TileKind)
plegendDark = EnumMap Char (GroupName TileKind)
defaultLegendDark
  , plegendLit :: EnumMap Char (GroupName TileKind)
plegendLit = EnumMap Char (GroupName TileKind)
defaultLegendLit
  }
cells2 :: PlaceKind
cells2 = PlaceKind
cells
  { pname :: Text
pname    = Text
"humidity equalizers"
  , prarity :: Rarity
prarity  = [(Double
1, Int
2), (Double
10, Int
2)]
  , ptopLeft :: [Text]
ptopLeft = [ Text
"f;#·"  -- extra column to avoid blocked exits
               , Text
";d;;"
               , Text
"·db;"
               ]
  }
cells3 :: PlaceKind
cells3 = PlaceKind
cells
  { pname :: Text
pname    = Text
"thermostat units"
  , ptopLeft :: [Text]
ptopLeft = [ Text
"·^#"
               , Text
"·#~"
               , Text
";;#"
               ]
  }
cells4 :: PlaceKind
cells4 = PlaceKind
cells
  { pname :: Text
pname    = Text
"a power node"
  , ptopLeft :: [Text]
ptopLeft = [ Text
"·o#"
               , Text
"oob"
               , Text
"#b·"
               ]
  }
cells5 :: PlaceKind
cells5 = PlaceKind
cells  -- this one is distinct enough from others, so needs a boost
  { pname :: Text
pname    = Text
"broken robot holds"
  , pfreq :: [(GroupName PlaceKind, Int)]
pfreq    = [ (GroupName PlaceKind
ROGUE, Int
20), (GroupName PlaceKind
LABORATORY, Int
15)
               , (GroupName PlaceKind
EMPTY, Int
80), (GroupName PlaceKind
EXIT, Int
70), (GroupName PlaceKind
NOISE, Int
150) ]
  , ptopLeft :: [Text]
ptopLeft = [ Text
"··w"
               , Text
"·:w"
               , Text
"wwo"
               ]
  }
cells6 :: PlaceKind
cells6 = PlaceKind
cells
  { pname :: Text
pname    = Text
"animal holding pens"
  , pfreq :: [(GroupName PlaceKind, Int)]
pfreq    = [ (GroupName PlaceKind
ARENA, Int
3), (GroupName PlaceKind
LABORATORY, Int
20), (GroupName PlaceKind
ZOO, Int
80)]
  , ptopLeft :: [Text]
ptopLeft = [ Text
";;f"
               , Text
"%%'"
               ]
  }
cells7 :: PlaceKind
cells7 = PlaceKind
cells
  { pname :: Text
pname    = Text
"a defunct control room"
  , pfreq :: [(GroupName PlaceKind, Int)]
pfreq    = [ (GroupName PlaceKind
ROGUE, Int
10), (GroupName PlaceKind
LABORATORY, Int
20)
               , (GroupName PlaceKind
EXIT, Int
30), (GroupName PlaceKind
NOISE, Int
200), (GroupName PlaceKind
AMBUSH, Int
50) ]
  , pfence :: Fence
pfence   = Fence
FFloor
  , ptopLeft :: [Text]
ptopLeft = [ Text
"d·o"
               , Text
"·#o"
               ]
  }
tank :: PlaceKind
tank = [(Char, GroupName TileKind)] -> PlaceKind -> PlaceKind
overridePlaceKind [ (Char
'#', GroupName TileKind
DOORLESS_WALL)
                         , (Char
'r', GroupName TileKind
S_REINFORCED_WALL)
                         , (Char
'b', GroupName TileKind
BARREL) ] (PlaceKind -> PlaceKind) -> PlaceKind -> PlaceKind
forall a b. (a -> b) -> a -> b
$ PlaceKind :: Char
-> Text
-> [(GroupName PlaceKind, Int)]
-> Rarity
-> Cover
-> Fence
-> [Text]
-> EnumMap Char (GroupName TileKind)
-> EnumMap Char (GroupName TileKind)
-> PlaceKind
PlaceKind
  { psymbol :: Char
psymbol  = Char
'c'
  , pname :: Text
pname    = Text
"a tank"
  , pfreq :: [(GroupName PlaceKind, Int)]
pfreq    = [(GroupName PlaceKind
EMPTY, 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
"#"
               ]
  , plegendDark :: EnumMap Char (GroupName TileKind)
plegendDark = EnumMap Char (GroupName TileKind)
defaultLegendDark
  , plegendLit :: EnumMap Char (GroupName TileKind)
plegendLit = EnumMap Char (GroupName TileKind)
defaultLegendLit
  }
tank2 :: PlaceKind
tank2 = PlaceKind
tank
  { pname :: Text
pname    = Text
"a barrel stack"
  , pfreq :: [(GroupName PlaceKind, Int)]
pfreq    = [(GroupName PlaceKind
EMPTY, Int
30), (GroupName PlaceKind
EXIT, Int
2), (GroupName PlaceKind
NOISE, Int
1), (GroupName PlaceKind
BATTLE, Int
1)]
  , ptopLeft :: [Text]
ptopLeft = [ Text
"b"
               ]
  }
tank3 :: PlaceKind
tank3 = PlaceKind
tank
  { pfreq :: [(GroupName PlaceKind, Int)]
pfreq    = [(GroupName PlaceKind
EMPTY, Int
150), (GroupName PlaceKind
EXIT, Int
15), (GroupName PlaceKind
NOISE, Int
50), (GroupName PlaceKind
BATTLE, Int
25)]
  , ptopLeft :: [Text]
ptopLeft = [ Text
"0#"
               , Text
"##"
               ]
  }
tank4 :: PlaceKind
tank4 = PlaceKind
tank
  { pname :: Text
pname    = Text
"a barrel stack"
  , pfreq :: [(GroupName PlaceKind, Int)]
pfreq    = [(GroupName PlaceKind
EMPTY, Int
150), (GroupName PlaceKind
EXIT, Int
8), (GroupName PlaceKind
NOISE, Int
50), (GroupName PlaceKind
BATTLE, Int
25)]
  , ptopLeft :: [Text]
ptopLeft = [ Text
"Xb"
               , Text
"bb"
               ]
  }
tank5 :: PlaceKind
tank5 = PlaceKind
tank
  { pname :: Text
pname    = Text
"a barrel yard"
  , pfreq :: [(GroupName PlaceKind, Int)]
pfreq    = [(GroupName PlaceKind
EMPTY, Int
1800), (GroupName PlaceKind
EXIT, Int
700), (GroupName PlaceKind
NOISE, Int
700), (GroupName PlaceKind
BATTLE, Int
300)]
  , pcover :: Cover
pcover   = Cover
CAlternate
  , ptopLeft :: [Text]
ptopLeft = [ Text
"bbX"
               , Text
"bbX"
               , Text
"XXX"
               ]
  }
tank6 :: PlaceKind
tank6 = PlaceKind
tank
  { pname :: Text
pname    = Text
"a barrel yard"
  , pfreq :: [(GroupName PlaceKind, Int)]
pfreq    = [(GroupName PlaceKind
EMPTY, Int
15000), (GroupName PlaceKind
EXIT, Int
5000), (GroupName PlaceKind
NOISE, Int
5000), (GroupName PlaceKind
BATTLE, Int
2500)]
  , pcover :: Cover
pcover   = Cover
CAlternate
  , ptopLeft :: [Text]
ptopLeft = [ Text
"bbbX"
               , Text
"bbbX"
               , Text
"bbbX"
               , Text
"XXXX"
               ]
  }
tank7 :: PlaceKind
tank7 = PlaceKind
tank
  { pfreq :: [(GroupName PlaceKind, Int)]
pfreq    = [(GroupName PlaceKind
EMPTY, Int
300), (GroupName PlaceKind
EXIT, Int
5), (GroupName PlaceKind
NOISE, Int
100), (GroupName PlaceKind
BATTLE, Int
50)]
  , ptopLeft :: [Text]
ptopLeft = [ Text
"rr#"
               , Text
"r##"
               , Text
"###"
               ]
  }
tank8 :: PlaceKind
tank8 = PlaceKind
tank
  { pfreq :: [(GroupName PlaceKind, Int)]
pfreq    = [(GroupName PlaceKind
EMPTY, Int
500), (GroupName PlaceKind
EXIT, Int
15), (GroupName PlaceKind
NOISE, Int
150), (GroupName PlaceKind
BATTLE, Int
70)]
  , ptopLeft :: [Text]
ptopLeft = [ Text
"XX0#"
               , Text
"Xrr#"
               , Text
"0r##"
               , Text
"####"
               ]
  }
tank9 :: PlaceKind
tank9 = PlaceKind
tank
  { pname :: Text
pname    = Text
"a barrel yard"
  , pfreq :: [(GroupName PlaceKind, Int)]
pfreq    = [(GroupName PlaceKind
EMPTY, Int
500), (GroupName PlaceKind
EXIT, Int
150), (GroupName PlaceKind
NOISE, Int
150), (GroupName PlaceKind
BATTLE, Int
70)]
  , pcover :: Cover
pcover   = Cover
CReflect
  , ptopLeft :: [Text]
ptopLeft = [ Text
"XbbX"
               , Text
"bbbX"
               , Text
"bbbX"
               , Text
"XXXX"
               ]
  }
tank10 :: PlaceKind
tank10 = PlaceKind
tank
  { pname :: Text
pname    = Text
"a cistern"
  , pfreq :: [(GroupName PlaceKind, Int)]
pfreq    = [(GroupName PlaceKind
EMPTY, Int
500), (GroupName PlaceKind
EXIT, Int
15), (GroupName PlaceKind
NOISE, Int
150), (GroupName PlaceKind
BATTLE, Int
70)]
  , ptopLeft :: [Text]
ptopLeft = [ Text
"XXr#"
               , Text
"Xr##"
               , Text
"r###"
               , Text
"####"
               ]
  }
tank11 :: PlaceKind
tank11 = PlaceKind
tank
  { pname :: Text
pname    = Text
"a barrel yard"
  , pfreq :: [(GroupName PlaceKind, Int)]
pfreq    = [(GroupName PlaceKind
EMPTY, Int
700), (GroupName PlaceKind
EXIT, Int
250), (GroupName PlaceKind
NOISE, Int
250), (GroupName PlaceKind
BATTLE, Int
125)]
  , pcover :: Cover
pcover   = Cover
CReflect
  , ptopLeft :: [Text]
ptopLeft = [ Text
"bbbXX"
               , Text
"bbbbX"
               , Text
"XbbbX"
               , Text
"XXXXX"
               ]
  }
tank12 :: PlaceKind
tank12 = PlaceKind
tank
  { pname :: Text
pname    = Text
"a barrel yard"
  , pfreq :: [(GroupName PlaceKind, Int)]
pfreq    = [(GroupName PlaceKind
EMPTY, Int
1000), (GroupName PlaceKind
EXIT, Int
500), (GroupName PlaceKind
NOISE, Int
500), (GroupName PlaceKind
BATTLE, Int
250)]
  , pcover :: Cover
pcover   = Cover
CReflect
  , ptopLeft :: [Text]
ptopLeft = [ Text
"XbbXX"
               , Text
"bbbbX"
               , Text
"bbbbX"
               , Text
"Xbbbb"
               , Text
"XXXbb"
               ]
  }
shuttleHusk :: PlaceKind
shuttleHusk = [(Char, GroupName TileKind)]
-> [(Char, GroupName TileKind)] -> PlaceKind -> PlaceKind
override2PlaceKind [ (Char
'·', GroupName TileKind
OILY_FLOOR_DARK)
                                 , (Char
'r', GroupName TileKind
RUBBLE_OR_WASTE_DARK) ]
                                 [ (Char
'·', GroupName TileKind
OILY_FLOOR_LIT)
                                 , (Char
'r', GroupName TileKind
RUBBLE_OR_WASTE_LIT) ] (PlaceKind -> PlaceKind) -> PlaceKind -> PlaceKind
forall a b. (a -> b) -> a -> b
$
              [(Char, GroupName TileKind)] -> PlaceKind -> PlaceKind
overridePlaceKind [ (Char
'#', GroupName TileKind
S_SHUTTLE_HULL)
                                , (Char
'c', GroupName TileKind
CACHE_SHUTTLE)
                                , (Char
'u', GroupName TileKind
STUCK_DOOR)
                                , (Char
'h', GroupName TileKind
S_HARDWARE_RACK)
                                , (Char
'w', GroupName TileKind
S_REINFORCED_WALL) ] (PlaceKind -> PlaceKind) -> PlaceKind -> PlaceKind
forall a b. (a -> b) -> a -> b
$ PlaceKind :: Char
-> Text
-> [(GroupName PlaceKind, Int)]
-> Rarity
-> Cover
-> Fence
-> [Text]
-> EnumMap Char (GroupName TileKind)
-> EnumMap Char (GroupName TileKind)
-> PlaceKind
PlaceKind
  { psymbol :: Char
psymbol  = Char
's'
  , pname :: Text
pname    = Text
"a shuttle husk"
  , pfreq :: [(GroupName PlaceKind, Int)]
pfreq    = [(GroupName PlaceKind
EMPTY, Int
1000), (GroupName PlaceKind
EXIT, Int
15000), (GroupName PlaceKind
AMBUSH, Int
15000)]
  , prarity :: Rarity
prarity  = [(Double
1, Int
1)]
  , pcover :: Cover
pcover   = Cover
CMirror
  , pfence :: Fence
pfence   = Fence
FGround
  , ptopLeft :: [Text]
ptopLeft = [ Text
"X·###·X"  -- 7 x 9
               , Text
"X%#w#%X"
               , Text
"#%···%#"
               , Text
"#··h··#"
               , Text
"#w··rw#"
               , Text
"···rr&c"
               , Text
"###&###"
               , Text
"XhhchhX"
               , Text
"hh#w#hh"
               ]
  , plegendDark :: EnumMap Char (GroupName TileKind)
plegendDark = EnumMap Char (GroupName TileKind)
defaultLegendDark
  , plegendLit :: EnumMap Char (GroupName TileKind)
plegendLit = EnumMap Char (GroupName TileKind)
defaultLegendLit
  }
shuttleHusk2 :: PlaceKind
shuttleHusk2 = PlaceKind
shuttleHusk
  { pfreq :: [(GroupName PlaceKind, Int)]
pfreq    = [(GroupName PlaceKind
EMPTY, Int
1000), (GroupName PlaceKind
EXIT, Int
15000), (GroupName PlaceKind
AMBUSH, Int
15000)]
  , ptopLeft :: [Text]
ptopLeft = (Text -> Text) -> [Text] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map (Char -> Text -> Text
T.cons Char
'X' (Text -> Text) -> (Text -> Text) -> Text -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Text -> Char -> Text) -> Char -> Text -> Text
forall a b c. (a -> b -> c) -> b -> a -> c
flip Text -> Char -> Text
T.snoc Char
'X')
               ([Text] -> [Text]) -> [Text] -> [Text]
forall a b. (a -> b) -> a -> b
$ PlaceKind -> [Text]
ptopLeft PlaceKind
shuttleHusk  -- 9 x 9
  }
shuttleHusk3 :: PlaceKind
shuttleHusk3 = PlaceKind
shuttleHusk
  { pfreq :: [(GroupName PlaceKind, Int)]
pfreq    = [(GroupName PlaceKind
EMPTY, Int
300), (GroupName PlaceKind
EXIT, Int
5000), (GroupName PlaceKind
AMBUSH, Int
5000)]
  , ptopLeft :: [Text]
ptopLeft = [ Text
":··##··X"  -- 8 x 8
               , Text
"X#%ww%#X"
               , Text
"#w····w#"
               , Text
"····h·r#"
               , Text
"#·rrr&r#"
               , Text
"###&&###"
               , Text
"XhhcchhX"
               , Text
"hh#ww#hh"
               ]
  }
shuttleHusk4 :: PlaceKind
shuttleHusk4 = PlaceKind
shuttleHusk3
  { pfreq :: [(GroupName PlaceKind, Int)]
pfreq    = [(GroupName PlaceKind
EMPTY, Int
300), (GroupName PlaceKind
EXIT, Int
5000), (GroupName PlaceKind
AMBUSH, Int
5000)]
  , ptopLeft :: [Text]
ptopLeft = (Text -> Text) -> [Text] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map (Char -> Text -> Text
T.cons Char
'X' (Text -> Text) -> (Text -> Text) -> Text -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Text -> Char -> Text) -> Char -> Text -> Text
forall a b c. (a -> b -> c) -> b -> a -> c
flip Text -> Char -> Text
T.snoc Char
'X')
               ([Text] -> [Text]) -> [Text] -> [Text]
forall a b. (a -> b) -> a -> b
$ PlaceKind -> [Text]
ptopLeft PlaceKind
shuttleHusk3  -- 10 x 8
  }
shuttleHusk5 :: PlaceKind
shuttleHusk5 = PlaceKind
shuttleHusk
  { pfreq :: [(GroupName PlaceKind, Int)]
pfreq    = [(GroupName PlaceKind
EXIT, Int
80000), (GroupName PlaceKind
AMBUSH, Int
80000)]
      -- can't have EMPTY or AI can't reach and kill the boss and get the key
  , ptopLeft :: [Text]
ptopLeft = [ Text
"···##···"  -- 8 x 10
               , Text
"w#%ww%#w"
               , Text
"X#····#X"
               , Text
"Xu··h·#X"
               , Text
"#w····w#"
               , Text
"%rr····%"
               , Text
"##&rrr##"
               , Text
"X##&&##X"
               , Text
"Xhhcc&hX"
               , Text
"hh#w&#hh"
               ]
  }
shuttleHusk6 :: PlaceKind
shuttleHusk6 = PlaceKind
shuttleHusk
  { pfreq :: [(GroupName PlaceKind, Int)]
pfreq    = [(GroupName PlaceKind
EMPTY, Int
2000), (GroupName PlaceKind
EXIT, Int
120000), (GroupName PlaceKind
AMBUSH, Int
120000)]
  , ptopLeft :: [Text]
ptopLeft = [ Text
"X··###··X"  -- 9 x 10
               , Text
"X#%#w#%#X"
               , Text
"##·h·h·##"
               , Text
"········%"
               , Text
"#w·····w#"
               , Text
"%·····rr%"
               , Text
"##·rr&r##"
               , Text
"X###&###X"
               , Text
":XhhchhXX"
               , Text
"Xhh#w#hhX"
               ]
  }
dormitory :: PlaceKind
dormitory = [(Char, GroupName TileKind)] -> PlaceKind -> PlaceKind
overridePlaceKind [ (Char
'd', GroupName TileKind
FLOOR_ACTOR_ITEM_LIT)
                              , (Char
'f', GroupName TileKind
PUMPS_LIT)
                              , (Char
'$', GroupName TileKind
TRAPPABLE_WALL) ] (PlaceKind -> PlaceKind) -> PlaceKind -> PlaceKind
forall a b. (a -> b) -> a -> b
$ PlaceKind :: Char
-> Text
-> [(GroupName PlaceKind, Int)]
-> Rarity
-> Cover
-> Fence
-> [Text]
-> EnumMap Char (GroupName TileKind)
-> EnumMap Char (GroupName TileKind)
-> PlaceKind
PlaceKind
  { psymbol :: Char
psymbol  = Char
'd'
  , pname :: Text
pname    = Text
"dormitory"
  , pfreq :: [(GroupName PlaceKind, Int)]
pfreq    = [(GroupName PlaceKind
RESIDENTIAL, Int
10000)]
  , prarity :: Rarity
prarity  = [(Double
1, Int
1)]
  , pcover :: Cover
pcover   = Cover
CAlternate
  , pfence :: Fence
pfence   = Fence
FWall
  , ptopLeft :: [Text]
ptopLeft = [ Text
"··#"
               , Text
"··#"
               , Text
"+##"
               , Text
"ddd"
               ]
  , plegendDark :: EnumMap Char (GroupName TileKind)
plegendDark = EnumMap Char (GroupName TileKind)
defaultLegendDark
  , plegendLit :: EnumMap Char (GroupName TileKind)
plegendLit = EnumMap Char (GroupName TileKind)
defaultLegendLit
  }
dormitory2 :: PlaceKind
dormitory2 = PlaceKind
dormitory
  { pfreq :: [(GroupName PlaceKind, Int)]
pfreq    = [(GroupName PlaceKind
RESIDENTIAL, Int
10000)]
  , ptopLeft :: [Text]
ptopLeft = [ Text
"··+d"
               , Text
"··#d"
               , Text
"###d"
               ]
  }
dormitory3 :: PlaceKind
dormitory3 = PlaceKind
dormitory
  { pfreq :: [(GroupName PlaceKind, Int)]
pfreq    = [(GroupName PlaceKind
RESIDENTIAL, Int
2000)]
  , pcover :: Cover
pcover   = Cover
CStretch
  , ptopLeft :: [Text]
ptopLeft = [ Text
"··#··"
               , Text
"··+··"
               , Text
"#+###"
               , Text
"ddddd"
               ]
  }
dormitory4 :: PlaceKind
dormitory4 = PlaceKind
dormitory2
  { pfreq :: [(GroupName PlaceKind, Int)]
pfreq    = [(GroupName PlaceKind
RESIDENTIAL, Int
10000)]
  , pcover :: Cover
pcover   = Cover
CStretch
  , ptopLeft :: [Text]
ptopLeft = [ Text
"···#d"  -- avoid huge corridor and tiny room
               , Text
"···+d"
               , Text
"##+#d"
               , Text
"···#d"
               , Text
"···#d"
               ]
  }
dormitory5 :: PlaceKind
dormitory5 = PlaceKind
dormitory
  { pfreq :: [(GroupName PlaceKind, Int)]
pfreq    = [(GroupName PlaceKind
RESIDENTIAL, Int
100)]
  , pcover :: Cover
pcover   = Cover
CMirror
  , pfence :: Fence
pfence   = Fence
FNone
  , ptopLeft :: [Text]
ptopLeft = [ Text
"##$$$$$$$$$##"
               , Text
"f#··#···+··#f"
               , Text
"d#··+···#··+d"
               , Text
"d#####+#####d"
               , Text
"ddddddddddddd"
               ]
  }
dormitory6 :: PlaceKind
dormitory6 = PlaceKind
dormitory
  { pfreq :: [(GroupName PlaceKind, Int)]
pfreq    = [(GroupName PlaceKind
RESIDENTIAL, Int
100)]
  , pcover :: Cover
pcover   = Cover
CMirror
  , pfence :: Fence
pfence   = Fence
FNone
  , ptopLeft :: [Text]
ptopLeft = [ Text
"#fddd"
               , Text
"##+#d"
               , Text
"$··#d"
               , Text
"$··#d"
               , Text
"$+##d"
               , Text
"$··#d"
               , Text
"$··#d"
               , Text
"$··#d"
               , Text
"##+#d"
               , Text
"#fddd"
               ]
  }

-- * Helper functions

switchExitToUp :: Text -> PlaceKind -> PlaceKind
switchExitToUp :: Text -> PlaceKind -> PlaceKind
switchExitToUp Text
terminal PlaceKind
s = [(Char, GroupName TileKind)]
-> [(Char, GroupName TileKind)] -> PlaceKind -> PlaceKind
override2PlaceKind
                              [(Char
'>', Text -> GroupName TileKind
forall c. Text -> GroupName c
GroupName (Text -> GroupName TileKind) -> Text -> GroupName TileKind
forall a b. (a -> b) -> a -> b
$ Text
terminal Text -> Text -> Text
<+> Text
"Dark")]
                              [(Char
'>', Text -> GroupName TileKind
forall c. Text -> GroupName c
GroupName (Text -> GroupName TileKind) -> Text -> GroupName TileKind
forall a b. (a -> b) -> a -> b
$ Text
terminal Text -> Text -> Text
<+> Text
"Lit")] (PlaceKind -> PlaceKind) -> PlaceKind -> PlaceKind
forall a b. (a -> b) -> a -> b
$ PlaceKind
s
  { psymbol :: Char
psymbol   = Char
'<'
  , pname :: Text
pname     = PlaceKind -> Text
pname PlaceKind
s Text -> Text -> Text
<+> Text
"up"
  , pfreq :: [(GroupName PlaceKind, Int)]
pfreq     = (Text -> Text)
-> [(GroupName PlaceKind, Int)] -> [(GroupName PlaceKind, Int)]
forall c. (Text -> Text) -> Freqs c -> Freqs c
renameFreqs (Text -> Text -> Text
<+> Text
"up") ([(GroupName PlaceKind, Int)] -> [(GroupName PlaceKind, Int)])
-> [(GroupName PlaceKind, Int)] -> [(GroupName PlaceKind, Int)]
forall a b. (a -> b) -> a -> b
$ PlaceKind -> [(GroupName PlaceKind, Int)]
pfreq PlaceKind
s
  }

switchExitToDown :: Text -> PlaceKind -> PlaceKind
switchExitToDown :: Text -> PlaceKind -> PlaceKind
switchExitToDown Text
terminal PlaceKind
s = [(Char, GroupName TileKind)]
-> [(Char, GroupName TileKind)] -> PlaceKind -> PlaceKind
override2PlaceKind
                                [(Char
'<', Text -> GroupName TileKind
forall c. Text -> GroupName c
GroupName (Text -> GroupName TileKind) -> Text -> GroupName TileKind
forall a b. (a -> b) -> a -> b
$ Text
terminal Text -> Text -> Text
<+> Text
"Dark")]
                                [(Char
'<', Text -> GroupName TileKind
forall c. Text -> GroupName c
GroupName (Text -> GroupName TileKind) -> Text -> GroupName TileKind
forall a b. (a -> b) -> a -> b
$ Text
terminal Text -> Text -> Text
<+> Text
"Lit")] (PlaceKind -> PlaceKind) -> PlaceKind -> PlaceKind
forall a b. (a -> b) -> a -> b
$ PlaceKind
s
  { psymbol :: Char
psymbol   = Char
'>'
  , pname :: Text
pname     = PlaceKind -> Text
pname PlaceKind
s Text -> Text -> Text
<+> Text
"down"
  , pfreq :: [(GroupName PlaceKind, Int)]
pfreq     = (Text -> Text)
-> [(GroupName PlaceKind, Int)] -> [(GroupName PlaceKind, Int)]
forall c. (Text -> Text) -> Freqs c -> Freqs c
renameFreqs (Text -> Text -> Text
<+> Text
"down") ([(GroupName PlaceKind, Int)] -> [(GroupName PlaceKind, Int)])
-> [(GroupName PlaceKind, Int)] -> [(GroupName PlaceKind, Int)]
forall a b. (a -> b) -> a -> b
$ PlaceKind -> [(GroupName PlaceKind, Int)]
pfreq PlaceKind
s
  }


overrideGatedStaircase :: [(Char, GroupName TileKind)]
overrideGatedStaircase :: [(Char, GroupName TileKind)]
overrideGatedStaircase =
  [ (Char
'<', GroupName TileKind
GATED_STAIRCASE_UP), (Char
'>', GroupName TileKind
GATED_STAIRCASE_DOWN)
  , (Char
'S', GroupName TileKind
FILLER_WALL) ]

switchStaircaseToGated :: PlaceKind -> PlaceKind
switchStaircaseToGated :: PlaceKind -> PlaceKind
switchStaircaseToGated PlaceKind
s = [(Char, GroupName TileKind)] -> PlaceKind -> PlaceKind
overridePlaceKind [(Char, GroupName TileKind)]
overrideGatedStaircase (PlaceKind -> PlaceKind) -> PlaceKind -> PlaceKind
forall a b. (a -> b) -> a -> b
$ PlaceKind
s
  { psymbol :: Char
psymbol   = Char
'g'
  , pname :: Text
pname     = [Text] -> Text
T.unwords ([Text] -> Text) -> [Text] -> Text
forall a b. (a -> b) -> a -> b
$ Text
"a gated" Text -> [Text] -> [Text]
forall a. a -> [a] -> [a]
: [Text] -> [Text]
forall a. [a] -> [a]
tail (Text -> [Text]
T.words (PlaceKind -> Text
pname PlaceKind
s))
  , pfreq :: [(GroupName PlaceKind, Int)]
pfreq     = (Text -> Text)
-> [(GroupName PlaceKind, Int)] -> [(GroupName PlaceKind, Int)]
forall c. (Text -> Text) -> Freqs c -> Freqs c
renameFreqs (Text
"gated" Text -> Text -> Text
<+>) ([(GroupName PlaceKind, Int)] -> [(GroupName PlaceKind, Int)])
-> [(GroupName PlaceKind, Int)] -> [(GroupName PlaceKind, Int)]
forall a b. (a -> b) -> a -> b
$ PlaceKind -> [(GroupName PlaceKind, Int)]
pfreq PlaceKind
s
  }

overrideGatedLift :: [(Char, GroupName TileKind)]
overrideGatedLift :: [(Char, GroupName TileKind)]
overrideGatedLift =
  [ (Char
'<', GroupName TileKind
GATED_LIFT_UP), (Char
'>', GroupName TileKind
GATED_LIFT_DOWN)
  , (Char
'S', GroupName TileKind
S_LIFT_SHAFT) ]

switchLiftToGated :: PlaceKind -> PlaceKind
switchLiftToGated :: PlaceKind -> PlaceKind
switchLiftToGated PlaceKind
s = [(Char, GroupName TileKind)] -> PlaceKind -> PlaceKind
overridePlaceKind [(Char, GroupName TileKind)]
overrideGatedLift (PlaceKind -> PlaceKind) -> PlaceKind -> PlaceKind
forall a b. (a -> b) -> a -> b
$ PlaceKind
s
  { psymbol :: Char
psymbol   = Char
'g'
  , pname :: Text
pname     = [Text] -> Text
T.unwords ([Text] -> Text) -> [Text] -> Text
forall a b. (a -> b) -> a -> b
$ Text
"a gated" Text -> [Text] -> [Text]
forall a. a -> [a] -> [a]
: [Text] -> [Text]
forall a. [a] -> [a]
tail (Text -> [Text]
T.words (PlaceKind -> Text
pname PlaceKind
s))
  , pfreq :: [(GroupName PlaceKind, Int)]
pfreq     = (Text -> Text)
-> [(GroupName PlaceKind, Int)] -> [(GroupName PlaceKind, Int)]
forall c. (Text -> Text) -> Freqs c -> Freqs c
renameFreqs (Text
"gated" Text -> Text -> Text
<+>) ([(GroupName PlaceKind, Int)] -> [(GroupName PlaceKind, Int)])
-> [(GroupName PlaceKind, Int)] -> [(GroupName PlaceKind, Int)]
forall a b. (a -> b) -> a -> b
$ PlaceKind -> [(GroupName PlaceKind, Int)]
pfreq PlaceKind
s
  }


overrideDeconStaircase :: [(Char, GroupName TileKind)]
overrideDeconStaircase :: [(Char, GroupName TileKind)]
overrideDeconStaircase =
  [ (Char
'<', GroupName TileKind
DECON_STAIRCASE_UP)
  , (Char
'>', GroupName TileKind
S_STAIRCASE_TRAP_DOWN_OIL)  -- talter high enough
  , (Char
'S', GroupName TileKind
FILLER_WALL) ]

switchStaircaseToDecon :: PlaceKind -> PlaceKind
switchStaircaseToDecon :: PlaceKind -> PlaceKind
switchStaircaseToDecon PlaceKind
s = [(Char, GroupName TileKind)] -> PlaceKind -> PlaceKind
overridePlaceKind [(Char, GroupName TileKind)]
overrideDeconStaircase (PlaceKind -> PlaceKind) -> PlaceKind -> PlaceKind
forall a b. (a -> b) -> a -> b
$ PlaceKind
s
  { psymbol :: Char
psymbol   = Char
'd'
  , pfreq :: [(GroupName PlaceKind, Int)]
pfreq     = (Text -> Text)
-> [(GroupName PlaceKind, Int)] -> [(GroupName PlaceKind, Int)]
forall c. (Text -> Text) -> Freqs c -> Freqs c
renameFreqs (Text
"decon" Text -> Text -> Text
<+>) ([(GroupName PlaceKind, Int)] -> [(GroupName PlaceKind, Int)])
-> [(GroupName PlaceKind, Int)] -> [(GroupName PlaceKind, Int)]
forall a b. (a -> b) -> a -> b
$ PlaceKind -> [(GroupName PlaceKind, Int)]
pfreq PlaceKind
s
  }

overrideDeconLift :: [(Char, GroupName TileKind)]
overrideDeconLift :: [(Char, GroupName TileKind)]
overrideDeconLift =
  [ (Char
'<', GroupName TileKind
DECON_LIFT_UP)
  , (Char
'>', GroupName TileKind
STAIRCASE_LIFT_DOWN)
  , (Char
'S', GroupName TileKind
S_LIFT_SHAFT) ]

switchLiftToDecon :: PlaceKind -> PlaceKind
switchLiftToDecon :: PlaceKind -> PlaceKind
switchLiftToDecon PlaceKind
s = [(Char, GroupName TileKind)] -> PlaceKind -> PlaceKind
overridePlaceKind [(Char, GroupName TileKind)]
overrideDeconLift (PlaceKind -> PlaceKind) -> PlaceKind -> PlaceKind
forall a b. (a -> b) -> a -> b
$ PlaceKind
s
  { psymbol :: Char
psymbol   = Char
'd'
  , pfreq :: [(GroupName PlaceKind, Int)]
pfreq     = (Text -> Text)
-> [(GroupName PlaceKind, Int)] -> [(GroupName PlaceKind, Int)]
forall c. (Text -> Text) -> Freqs c -> Freqs c
renameFreqs (Text
"decon" Text -> Text -> Text
<+>) ([(GroupName PlaceKind, Int)] -> [(GroupName PlaceKind, Int)])
-> [(GroupName PlaceKind, Int)] -> [(GroupName PlaceKind, Int)]
forall a b. (a -> b) -> a -> b
$ PlaceKind -> [(GroupName PlaceKind, Int)]
pfreq PlaceKind
s
  }


overrideWeldedStaircase :: [(Char, GroupName TileKind)]
overrideWeldedStaircase :: [(Char, GroupName TileKind)]
overrideWeldedStaircase =
  [ (Char
'<', GroupName TileKind
WELDED_STAIRCASE_UP), (Char
'>', GroupName TileKind
ORDINARY_STAIRCASE_DOWN)
  , (Char
'S', GroupName TileKind
FILLER_WALL) ]

switchStaircaseToWelded :: PlaceKind -> PlaceKind
switchStaircaseToWelded :: PlaceKind -> PlaceKind
switchStaircaseToWelded PlaceKind
s = [(Char, GroupName TileKind)] -> PlaceKind -> PlaceKind
overridePlaceKind [(Char, GroupName TileKind)]
overrideWeldedStaircase (PlaceKind -> PlaceKind) -> PlaceKind -> PlaceKind
forall a b. (a -> b) -> a -> b
$ PlaceKind
s
  { psymbol :: Char
psymbol   = Char
'w'
  , pfreq :: [(GroupName PlaceKind, Int)]
pfreq     = (Text -> Text)
-> [(GroupName PlaceKind, Int)] -> [(GroupName PlaceKind, Int)]
forall c. (Text -> Text) -> Freqs c -> Freqs c
renameFreqs (Text
"welded" Text -> Text -> Text
<+>) ([(GroupName PlaceKind, Int)] -> [(GroupName PlaceKind, Int)])
-> [(GroupName PlaceKind, Int)] -> [(GroupName PlaceKind, Int)]
forall a b. (a -> b) -> a -> b
$ PlaceKind -> [(GroupName PlaceKind, Int)]
pfreq PlaceKind
s
  }

overrideWeldedLift :: [(Char, GroupName TileKind)]
overrideWeldedLift :: [(Char, GroupName TileKind)]
overrideWeldedLift =
  [ (Char
'<', GroupName TileKind
WELDED_LIFT_UP), (Char
'>', GroupName TileKind
ORDINARY_LIFT_DOWN)
  , (Char
'S', GroupName TileKind
S_LIFT_SHAFT) ]

switchLiftToWelded :: PlaceKind -> PlaceKind
switchLiftToWelded :: PlaceKind -> PlaceKind
switchLiftToWelded PlaceKind
s = [(Char, GroupName TileKind)] -> PlaceKind -> PlaceKind
overridePlaceKind [(Char, GroupName TileKind)]
overrideWeldedLift (PlaceKind -> PlaceKind) -> PlaceKind -> PlaceKind
forall a b. (a -> b) -> a -> b
$ PlaceKind
s
  { psymbol :: Char
psymbol   = Char
'w'
  , pfreq :: [(GroupName PlaceKind, Int)]
pfreq     = (Text -> Text)
-> [(GroupName PlaceKind, Int)] -> [(GroupName PlaceKind, Int)]
forall c. (Text -> Text) -> Freqs c -> Freqs c
renameFreqs (Text
"welded" Text -> Text -> Text
<+>) ([(GroupName PlaceKind, Int)] -> [(GroupName PlaceKind, Int)])
-> [(GroupName PlaceKind, Int)] -> [(GroupName PlaceKind, Int)]
forall a b. (a -> b) -> a -> b
$ PlaceKind -> [(GroupName PlaceKind, Int)]
pfreq PlaceKind
s
  }


overrideOutdoor :: [(Char, GroupName TileKind)]
overrideOutdoor :: [(Char, GroupName TileKind)]
overrideOutdoor =
  [ (Char
'<', GroupName TileKind
STAIRCASE_OUTDOOR_UP), (Char
'>', GroupName TileKind
STAIRCASE_OUTDOOR_DOWN)
  , (Char
'S', GroupName TileKind
FILLER_WALL) ]

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
  { psymbol :: Char
psymbol   = Char
'o'
  , pname :: Text
pname     = Text
"an outdoor area exit"
  , pfreq :: [(GroupName PlaceKind, Int)]
pfreq     = (Text -> Text)
-> [(GroupName PlaceKind, Int)] -> [(GroupName PlaceKind, Int)]
forall c. (Text -> Text) -> Freqs c -> Freqs c
renameFreqs (Text
"outdoor" Text -> Text -> Text
<+>) ([(GroupName PlaceKind, Int)] -> [(GroupName PlaceKind, Int)])
-> [(GroupName PlaceKind, Int)] -> [(GroupName PlaceKind, Int)]
forall a b. (a -> b) -> a -> b
$ PlaceKind -> [(GroupName PlaceKind, Int)]
pfreq PlaceKind
s
  }

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

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

switchEscapeToSpaceshipDown :: PlaceKind -> PlaceKind
switchEscapeToSpaceshipDown :: PlaceKind -> PlaceKind
switchEscapeToSpaceshipDown PlaceKind
s = [(Char, GroupName TileKind)] -> PlaceKind -> PlaceKind
overridePlaceKind
                                  [(Char
'>', GroupName TileKind
ESCAPE_SPACESHIP_DOWN)] (PlaceKind -> PlaceKind) -> PlaceKind -> PlaceKind
forall a b. (a -> b) -> a -> b
$ PlaceKind
s
  { pname :: Text
pname     = Text
"escape from spaceship"
  , pfreq :: [(GroupName PlaceKind, Int)]
pfreq     = ((GroupName PlaceKind, Int) -> (GroupName PlaceKind, Int))
-> [(GroupName PlaceKind, Int)] -> [(GroupName PlaceKind, Int)]
forall a b. (a -> b) -> [a] -> [b]
map (\(GroupName PlaceKind
_, Int
n) -> (GroupName PlaceKind
ESCAPE_FROM_SPACESHIP_DOWN, Int
n)) ([(GroupName PlaceKind, Int)] -> [(GroupName PlaceKind, Int)])
-> [(GroupName PlaceKind, Int)] -> [(GroupName PlaceKind, Int)]
forall a b. (a -> b) -> a -> b
$ PlaceKind -> [(GroupName PlaceKind, Int)]
pfreq PlaceKind
s
  }