-- 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 of cave kinds. Every level in the game is an instantiated
-- cave kind.
module Content.CaveKind
  ( -- * Group name patterns
    pattern CAVE_ROGUE, pattern CAVE_ARENA, pattern CAVE_LABORATORY, pattern CAVE_NOISE, pattern CAVE_SHALLOW_ROGUE, pattern CAVE_OUTERMOST, pattern CAVE_RAID, pattern CAVE_BRAWL, pattern CAVE_BRAWL_ALT, pattern CAVE_SHOOTOUT, pattern CAVE_HUNT, pattern CAVE_FLIGHT, pattern CAVE_ZOO, pattern CAVE_AMBUSH, pattern CAVE_BATTLE, pattern CAVE_SAFARI_1, pattern CAVE_SAFARI_2, pattern CAVE_SAFARI_3
  , pattern CAVE_BRIDGE, pattern CAVE_VIRUS, pattern CAVE_RESIDENTIAL, pattern CAVE_MUSEUM, pattern CAVE_EGRESS, pattern CAVE_CASINO, pattern CAVE_POWER, pattern CAVE_GAUNTLET
  , groupNamesSingleton, groupNames
  , -- * Content
    content
  ) where

import Prelude ()

import Game.LambdaHack.Core.Prelude

import           Data.Ratio
import qualified Data.Text as T

import           Game.LambdaHack.Content.CaveKind
import qualified Game.LambdaHack.Content.ItemKind as IK
import           Game.LambdaHack.Content.TileKind
import           Game.LambdaHack.Core.Dice
import           Game.LambdaHack.Definition.Defs
import           Game.LambdaHack.Definition.DefsInternal

import Content.ItemKind hiding (content, groupNames, groupNamesSingleton)
import Content.ItemKindActor
import Content.ItemKindEmbed
import Content.PlaceKind hiding (content, groupNames, groupNamesSingleton)
import Content.TileKind hiding (content, groupNames, groupNamesSingleton)

-- * Group name patterns

groupNamesSingleton :: [GroupName CaveKind]
groupNamesSingleton :: [GroupName CaveKind]
groupNamesSingleton = []

groupNames :: [GroupName CaveKind]
groupNames :: [GroupName CaveKind]
groupNames =
       [GroupName CaveKind
CAVE_ROGUE, GroupName CaveKind
CAVE_ARENA, GroupName CaveKind
CAVE_LABORATORY, GroupName CaveKind
CAVE_NOISE, GroupName CaveKind
CAVE_SHALLOW_ROGUE, GroupName CaveKind
CAVE_OUTERMOST, GroupName CaveKind
CAVE_RAID, GroupName CaveKind
CAVE_BRAWL, GroupName CaveKind
CAVE_BRAWL_ALT, GroupName CaveKind
CAVE_SHOOTOUT, GroupName CaveKind
CAVE_HUNT, GroupName CaveKind
CAVE_FLIGHT, GroupName CaveKind
CAVE_ZOO, GroupName CaveKind
CAVE_AMBUSH, GroupName CaveKind
CAVE_BATTLE, GroupName CaveKind
CAVE_SAFARI_1, GroupName CaveKind
CAVE_SAFARI_2, GroupName CaveKind
CAVE_SAFARI_3]
    [GroupName CaveKind]
-> [GroupName CaveKind] -> [GroupName CaveKind]
forall a. [a] -> [a] -> [a]
++ [GroupName CaveKind
CAVE_BRIDGE, GroupName CaveKind
CAVE_VIRUS, GroupName CaveKind
CAVE_RESIDENTIAL, GroupName CaveKind
CAVE_MUSEUM, GroupName CaveKind
CAVE_EGRESS, GroupName CaveKind
CAVE_CASINO, GroupName CaveKind
CAVE_POWER, GroupName CaveKind
CAVE_GAUNTLET]

pattern CAVE_ROGUE, CAVE_ARENA, CAVE_LABORATORY, CAVE_NOISE, CAVE_SHALLOW_ROGUE, CAVE_OUTERMOST, CAVE_RAID, CAVE_BRAWL, CAVE_BRAWL_ALT, CAVE_SHOOTOUT, CAVE_HUNT, CAVE_FLIGHT, CAVE_ZOO, CAVE_AMBUSH, CAVE_BATTLE, CAVE_SAFARI_1, CAVE_SAFARI_2, CAVE_SAFARI_3 :: GroupName CaveKind

pattern CAVE_BRIDGE, CAVE_VIRUS, CAVE_RESIDENTIAL, CAVE_MUSEUM, CAVE_EGRESS, CAVE_CASINO, CAVE_POWER, CAVE_GAUNTLET :: GroupName CaveKind

pattern $bCAVE_ROGUE :: GroupName CaveKind
$mCAVE_ROGUE :: forall r. GroupName CaveKind -> (Void# -> r) -> (Void# -> r) -> r
CAVE_ROGUE = GroupName "caveRogue"
pattern $bCAVE_ARENA :: GroupName CaveKind
$mCAVE_ARENA :: forall r. GroupName CaveKind -> (Void# -> r) -> (Void# -> r) -> r
CAVE_ARENA = GroupName "caveArena"
pattern $bCAVE_LABORATORY :: GroupName CaveKind
$mCAVE_LABORATORY :: forall r. GroupName CaveKind -> (Void# -> r) -> (Void# -> r) -> r
CAVE_LABORATORY = GroupName "caveLaboratory"
pattern $bCAVE_NOISE :: GroupName CaveKind
$mCAVE_NOISE :: forall r. GroupName CaveKind -> (Void# -> r) -> (Void# -> r) -> r
CAVE_NOISE = GroupName "caveNoise"
pattern $bCAVE_SHALLOW_ROGUE :: GroupName CaveKind
$mCAVE_SHALLOW_ROGUE :: forall r. GroupName CaveKind -> (Void# -> r) -> (Void# -> r) -> r
CAVE_SHALLOW_ROGUE = GroupName "caveShallowRogue"
pattern $bCAVE_OUTERMOST :: GroupName CaveKind
$mCAVE_OUTERMOST :: forall r. GroupName CaveKind -> (Void# -> r) -> (Void# -> r) -> r
CAVE_OUTERMOST = GroupName "caveOutermost"
pattern $bCAVE_RAID :: GroupName CaveKind
$mCAVE_RAID :: forall r. GroupName CaveKind -> (Void# -> r) -> (Void# -> r) -> r
CAVE_RAID = GroupName "caveRaid"
pattern $bCAVE_BRAWL :: GroupName CaveKind
$mCAVE_BRAWL :: forall r. GroupName CaveKind -> (Void# -> r) -> (Void# -> r) -> r
CAVE_BRAWL = GroupName "caveBrawl"
pattern $bCAVE_BRAWL_ALT :: GroupName CaveKind
$mCAVE_BRAWL_ALT :: forall r. GroupName CaveKind -> (Void# -> r) -> (Void# -> r) -> r
CAVE_BRAWL_ALT = GroupName "caveBrawlAlt"
pattern $bCAVE_SHOOTOUT :: GroupName CaveKind
$mCAVE_SHOOTOUT :: forall r. GroupName CaveKind -> (Void# -> r) -> (Void# -> r) -> r
CAVE_SHOOTOUT = GroupName "caveShootout"
pattern $bCAVE_HUNT :: GroupName CaveKind
$mCAVE_HUNT :: forall r. GroupName CaveKind -> (Void# -> r) -> (Void# -> r) -> r
CAVE_HUNT = GroupName "caveHunt"
pattern $bCAVE_FLIGHT :: GroupName CaveKind
$mCAVE_FLIGHT :: forall r. GroupName CaveKind -> (Void# -> r) -> (Void# -> r) -> r
CAVE_FLIGHT = GroupName "caveFlight"
pattern $bCAVE_ZOO :: GroupName CaveKind
$mCAVE_ZOO :: forall r. GroupName CaveKind -> (Void# -> r) -> (Void# -> r) -> r
CAVE_ZOO = GroupName "caveZoo"
pattern $bCAVE_AMBUSH :: GroupName CaveKind
$mCAVE_AMBUSH :: forall r. GroupName CaveKind -> (Void# -> r) -> (Void# -> r) -> r
CAVE_AMBUSH = GroupName "caveAmbush"
pattern $bCAVE_BATTLE :: GroupName CaveKind
$mCAVE_BATTLE :: forall r. GroupName CaveKind -> (Void# -> r) -> (Void# -> r) -> r
CAVE_BATTLE = GroupName "caveBattle"
pattern $bCAVE_SAFARI_1 :: GroupName CaveKind
$mCAVE_SAFARI_1 :: forall r. GroupName CaveKind -> (Void# -> r) -> (Void# -> r) -> r
CAVE_SAFARI_1 = GroupName "caveSafari1"
pattern $bCAVE_SAFARI_2 :: GroupName CaveKind
$mCAVE_SAFARI_2 :: forall r. GroupName CaveKind -> (Void# -> r) -> (Void# -> r) -> r
CAVE_SAFARI_2 = GroupName "caveSafari2"
pattern $bCAVE_SAFARI_3 :: GroupName CaveKind
$mCAVE_SAFARI_3 :: forall r. GroupName CaveKind -> (Void# -> r) -> (Void# -> r) -> r
CAVE_SAFARI_3 = GroupName "caveSafari3"

-- ** Allure-specific
pattern $bCAVE_BRIDGE :: GroupName CaveKind
$mCAVE_BRIDGE :: forall r. GroupName CaveKind -> (Void# -> r) -> (Void# -> r) -> r
CAVE_BRIDGE = GroupName "caveBridge"
pattern $bCAVE_VIRUS :: GroupName CaveKind
$mCAVE_VIRUS :: forall r. GroupName CaveKind -> (Void# -> r) -> (Void# -> r) -> r
CAVE_VIRUS = GroupName "caveVirus"
pattern $bCAVE_RESIDENTIAL :: GroupName CaveKind
$mCAVE_RESIDENTIAL :: forall r. GroupName CaveKind -> (Void# -> r) -> (Void# -> r) -> r
CAVE_RESIDENTIAL = GroupName "caveResidential"
pattern $bCAVE_MUSEUM :: GroupName CaveKind
$mCAVE_MUSEUM :: forall r. GroupName CaveKind -> (Void# -> r) -> (Void# -> r) -> r
CAVE_MUSEUM = GroupName "caveMuseum"
pattern $bCAVE_EGRESS :: GroupName CaveKind
$mCAVE_EGRESS :: forall r. GroupName CaveKind -> (Void# -> r) -> (Void# -> r) -> r
CAVE_EGRESS = GroupName "caveEgress"
pattern $bCAVE_CASINO :: GroupName CaveKind
$mCAVE_CASINO :: forall r. GroupName CaveKind -> (Void# -> r) -> (Void# -> r) -> r
CAVE_CASINO = GroupName "caveCasino"
pattern $bCAVE_POWER :: GroupName CaveKind
$mCAVE_POWER :: forall r. GroupName CaveKind -> (Void# -> r) -> (Void# -> r) -> r
CAVE_POWER = GroupName "cavePower"
pattern $bCAVE_GAUNTLET :: GroupName CaveKind
$mCAVE_GAUNTLET :: forall r. GroupName CaveKind -> (Void# -> r) -> (Void# -> r) -> r
CAVE_GAUNTLET = GroupName "caveGauntlet"

-- * Content

content :: [CaveKind]
content :: [CaveKind]
content =
  [CaveKind
rogue, CaveKind
residential, CaveKind
arena, CaveKind
casino, CaveKind
museum, CaveKind
laboratory, CaveKind
noise, CaveKind
power, CaveKind
empty, CaveKind
egress, CaveKind
outermost, CaveKind
bridge, CaveKind
shallowRogue, CaveKind
virus, CaveKind
gauntlet, CaveKind
raid, CaveKind
brawl, CaveKind
brawlAlt, CaveKind
shootout, CaveKind
hunt, CaveKind
flight, CaveKind
zoo, CaveKind
ambush, CaveKind
battle, CaveKind
safari1, CaveKind
safari2, CaveKind
safari3]

rogue,    residential, arena, casino, museum, laboratory, noise, power, empty, egress, outermost, bridge, shallowRogue, virus, gauntlet, raid, brawl, brawlAlt, shootout, hunt, flight, zoo, ambush, battle, safari1, safari2, safari3 :: CaveKind

-- * On-ship "caves", that is, decks, most of mediocre height and size

rogue :: CaveKind
rogue = CaveKind :: Text
-> Freqs CaveKind
-> X
-> X
-> DiceXY
-> DiceXY
-> DiceXY
-> Dice
-> Dice
-> Rational
-> Rational
-> Rational
-> Rational
-> X
-> X
-> Freqs ItemKind
-> Dice
-> Freqs ItemKind
-> Freqs PlaceKind
-> Bool
-> Bool
-> GroupName TileKind
-> GroupName TileKind
-> GroupName TileKind
-> GroupName TileKind
-> GroupName TileKind
-> GroupName TileKind
-> GroupName TileKind
-> GroupName TileKind
-> GroupName TileKind
-> Bool
-> X
-> Dice
-> Freqs PlaceKind
-> Freqs PlaceKind
-> Freqs PlaceKind
-> [X]
-> InitSleep
-> Text
-> CaveKind
CaveKind
  { cname :: Text
cname         = Text
"Maintenance and storage"
  , cfreq :: Freqs CaveKind
cfreq         = [(GroupName CaveKind
DEFAULT_RANDOM, X
100), (GroupName CaveKind
CAVE_ROGUE, X
1)]
  , cXminSize :: X
cXminSize     = X
80
  , cYminSize :: X
cYminSize     = X
42
  , ccellSize :: DiceXY
ccellSize     = Dice -> Dice -> DiceXY
DiceXY (X
2 X -> X -> Dice
`d` X
4 Dice -> Dice -> Dice
forall a. Num a => a -> a -> a
+ Dice
10) (X
1 X -> X -> Dice
`d` X
3 Dice -> Dice -> Dice
forall a. Num a => a -> a -> a
+ Dice
6)
  , cminPlaceSize :: DiceXY
cminPlaceSize = Dice -> Dice -> DiceXY
DiceXY (X
2 X -> X -> Dice
`d` X
2 Dice -> Dice -> Dice
forall a. Num a => a -> a -> a
+ Dice
4) (X
1 X -> X -> Dice
`d` X
2 Dice -> Dice -> Dice
forall a. Num a => a -> a -> a
+ Dice
5)  -- sometimes merge vert.
  , cmaxPlaceSize :: DiceXY
cmaxPlaceSize = Dice -> Dice -> DiceXY
DiceXY Dice
16 Dice
40  -- often maximize vertically
  , cdarkOdds :: Dice
cdarkOdds     = X
1 X -> X -> Dice
`d` X
50 Dice -> Dice -> Dice
forall a. Num a => a -> a -> a
+ X
1 X -> X -> Dice
`dL` X
50
      -- most rooms lit, to compensate for dark corridors; at the bottom
      -- of the dungeon, half of the rooms lit
  , cnightOdds :: Dice
cnightOdds    = Dice
51  -- always night
  , cauxConnects :: Rational
cauxConnects  = Integer
1Integer -> Integer -> Rational
forall a. Integral a => a -> a -> Ratio a
%Integer
2
  , cmaxVoid :: Rational
cmaxVoid      = Integer
1Integer -> Integer -> Rational
forall a. Integral a => a -> a -> Ratio a
%Integer
8
  , cdoorChance :: Rational
cdoorChance   = Integer
3Integer -> Integer -> Rational
forall a. Integral a => a -> a -> Ratio a
%Integer
4
  , copenChance :: Rational
copenChance   = Integer
1Integer -> Integer -> Rational
forall a. Integral a => a -> a -> Ratio a
%Integer
5
  , chidden :: X
chidden       = X
7
  , cactorCoeff :: X
cactorCoeff   = X
70  -- the maze requires time to explore
  , cactorFreq :: Freqs ItemKind
cactorFreq    = [(GroupName ItemKind
MONSTER, X
50), (GroupName ItemKind
ANIMAL, X
20), (GroupName ItemKind
ROBOT, X
30)]
  , citemNum :: Dice
citemNum      = X
17 X -> X -> Dice
`d` X
2 Dice -> Dice -> Dice
forall a. Num a => a -> a -> a
+ Dice
25 Dice -> Dice -> Dice
forall a. Num a => a -> a -> a
- X
25 X -> X -> Dice
`dL` X
1
      -- deep down quality over quantity; generally not too random,
      -- sacrificing replayability for consistent balance
  , citemFreq :: Freqs ItemKind
citemFreq     = [ (GroupName ItemKind
IK.COMMON_ITEM, X
40), (GroupName ItemKind
IK.CRAWL_ITEM, X
20)
    -- CRAWL_ITEM items are used only in long scenarios, such as multi-level
    -- dungeon crawl; these may be powerful or a mundate item,
    -- unlike @TREASURE@ items
                    , (GroupName ItemKind
IK.TREASURE, X
40) ]
  , cplaceFreq :: Freqs PlaceKind
cplaceFreq    = [(GroupName PlaceKind
ROGUE, X
1)]
  , cpassable :: Bool
cpassable     = Bool
False
  , clabyrinth :: Bool
clabyrinth    = Bool
False
  , cdefTile :: GroupName TileKind
cdefTile      = GroupName TileKind
ROGUE_SET
  , cdarkCorTile :: GroupName TileKind
cdarkCorTile  = GroupName TileKind
FLOOR_CORRIDOR_DARK
  , clitCorTile :: GroupName TileKind
clitCorTile   = GroupName TileKind
FLOOR_CORRIDOR_LIT
  , cwallTile :: GroupName TileKind
cwallTile     = GroupName TileKind
TRAPPABLE_WALL
  , ccornerTile :: GroupName TileKind
ccornerTile   = GroupName TileKind
FILLER_WALL
  , cfenceTileN :: GroupName TileKind
cfenceTileN   = GroupName TileKind
S_BASIC_OUTER_FENCE
  , cfenceTileE :: GroupName TileKind
cfenceTileE   = GroupName TileKind
HABITAT_CONTAINMENT_WALL
  , cfenceTileS :: GroupName TileKind
cfenceTileS   = GroupName TileKind
S_BASIC_OUTER_FENCE
  , cfenceTileW :: GroupName TileKind
cfenceTileW   = GroupName TileKind
HABITAT_CONTAINMENT_WALL
  , cfenceApart :: Bool
cfenceApart   = Bool
False
  , cminStairDist :: X
cminStairDist = X
15  -- to help Casino stay small
  , cmaxStairsNum :: Dice
cmaxStairsNum = Dice
2 Dice -> Dice -> Dice
forall a. Num a => a -> a -> a
+ X
1 X -> X -> Dice
`d` X
2
  , cescapeFreq :: Freqs PlaceKind
cescapeFreq   = []
  , cstairFreq :: Freqs PlaceKind
cstairFreq    = [ (GroupName PlaceKind
WALLED_LIFT, X
50), (GroupName PlaceKind
OPEN_LIFT, X
50)
                    , (GroupName PlaceKind
TINY_LIFT, X
1) ]
  , cstairAllowed :: Freqs PlaceKind
cstairAllowed = [ (GroupName PlaceKind
WALLED_STAIRCASE, X
50), (GroupName PlaceKind
OPEN_STAIRCASE, X
50)
                    , (GroupName PlaceKind
TINY_STAIRCASE, X
1) ]
  , cskip :: [X]
cskip         = []
  , cinitSleep :: InitSleep
cinitSleep    = InitSleep
InitSleepPermitted
  , cdesc :: Text
cdesc         = Text
"Winding tunnels stretch into the dark. A few areas are passable but the remainder is packed with tanks and cells of raw materials and machinery."
  }
residential :: CaveKind
residential = CaveKind
rogue  -- an alternative with lit corridors but dark rooms
  { cfreq :: Freqs CaveKind
cfreq         = [(GroupName CaveKind
DEFAULT_RANDOM, X
70), (GroupName CaveKind
CAVE_RESIDENTIAL, X
1)]
  , cname :: Text
cname         = Text
"Residential area"
  , cminPlaceSize :: DiceXY
cminPlaceSize = Dice -> Dice -> DiceXY
DiceXY (X
2 X -> X -> Dice
`d` X
2 Dice -> Dice -> Dice
forall a. Num a => a -> a -> a
+ Dice
4) (X
1 X -> X -> Dice
`d` X
2 Dice -> Dice -> Dice
forall a. Num a => a -> a -> a
+ Dice
9)  -- merge vert.
  , cmaxPlaceSize :: DiceXY
cmaxPlaceSize = Dice -> Dice -> DiceXY
DiceXY Dice
20 Dice
20  -- fewer vertically long rooms
  , cdarkOdds :: Dice
cdarkOdds     = Dice
51  -- all rooms dark
  , cnightOdds :: Dice
cnightOdds    = Dice
0  -- always day
  , cauxConnects :: Rational
cauxConnects  = Integer
1Integer -> Integer -> Rational
forall a. Integral a => a -> a -> Ratio a
%Integer
5  -- differentiate; bare skeleton feel; long span paths,
                         -- but don't overdo or a lot of backtracing needed
  , cplaceFreq :: Freqs PlaceKind
cplaceFreq    = [(GroupName PlaceKind
ROGUE, X
1), (GroupName PlaceKind
RESIDENTIAL, X
49)]
  , cdefTile :: GroupName TileKind
cdefTile      = GroupName TileKind
FILLER_WALL
  , cmaxStairsNum :: Dice
cmaxStairsNum = Dice
3 Dice -> Dice -> Dice
forall a. Num a => a -> a -> a
+ X
1 X -> X -> Dice
`d` X
2
  , cstairFreq :: Freqs PlaceKind
cstairFreq    = [ (GroupName PlaceKind
WALLED_STAIRCASE, X
50), (GroupName PlaceKind
OPEN_STAIRCASE, X
50)
                    , (GroupName PlaceKind
TINY_STAIRCASE, X
1) ]
  , cstairAllowed :: Freqs PlaceKind
cstairAllowed = [ (GroupName PlaceKind
WALLED_LIFT, X
50), (GroupName PlaceKind
OPEN_LIFT, X
50)
                    , (GroupName PlaceKind
TINY_LIFT, X
1) ]
  , cdesc :: Text
cdesc         = Text
"The area has been powered down, except for emergency corridors. Many suites are depressurized and sealed."
  }
arena :: CaveKind
arena = CaveKind
rogue
  { cname :: Text
cname         = Text
"Recreational deck"
  , cfreq :: Freqs CaveKind
cfreq         = [(GroupName CaveKind
CAVE_ARENA, X
1)]
  , cXminSize :: X
cXminSize     = X
80
  , cYminSize :: X
cYminSize     = X
25
  , ccellSize :: DiceXY
ccellSize     = Dice -> Dice -> DiceXY
DiceXY (X
3 X -> X -> Dice
`d` X
3 Dice -> Dice -> Dice
forall a. Num a => a -> a -> a
+ Dice
17) (X
1 X -> X -> Dice
`d` X
3 Dice -> Dice -> Dice
forall a. Num a => a -> a -> a
+ Dice
5)
  , cminPlaceSize :: DiceXY
cminPlaceSize = Dice -> Dice -> DiceXY
DiceXY Dice
10 Dice
15  -- merge vertically
  , cmaxPlaceSize :: DiceXY
cmaxPlaceSize = Dice -> Dice -> DiceXY
DiceXY Dice
25 Dice
40  -- often maximize vertically
  , cdarkOdds :: Dice
cdarkOdds     = Dice
49 Dice -> Dice -> Dice
forall a. Num a => a -> a -> a
+ X
1 X -> X -> Dice
`d` X
10  -- almost all rooms dark (1 in 10 lit)
  -- Light is not too deadly, because not many obstructions and so
  -- foes visible from far away and few foes have ranged combat
  -- at shallow depth.
  , cnightOdds :: Dice
cnightOdds    = Dice
0  -- always day
  , cauxConnects :: Rational
cauxConnects  = Rational
1
  , cmaxVoid :: Rational
cmaxVoid      = Integer
1Integer -> Integer -> Rational
forall a. Integral a => a -> a -> Ratio a
%Integer
20
  , chidden :: X
chidden       = X
0
  , cactorCoeff :: X
cactorCoeff   = X
50  -- smallish level, but easy to view and plan
  , cactorFreq :: Freqs ItemKind
cactorFreq    = [ (GroupName ItemKind
EXPLOSIVE_MONSTER, X
50), (GroupName ItemKind
ANIMAL, X
50), (GroupName ItemKind
ROBOT, X
5)
                    , (GroupName ItemKind
IK.AQUATIC, X
10) ]
  , citemNum :: Dice
citemNum      = X
16 X -> X -> Dice
`d` X
2
  , citemFreq :: Freqs ItemKind
citemFreq     = [ (GroupName ItemKind
IK.COMMON_ITEM, X
20), (GroupName ItemKind
IK.CRAWL_ITEM, X
20)
                    , (GroupName ItemKind
IK.TREASURE, X
40)
                    , (GroupName ItemKind
GARDENING_TOOL, X
100)  -- useless and boring by this point
                    , (GroupName ItemKind
IK.ANY_POTION, X
200) ]  -- nature
  , cplaceFreq :: Freqs PlaceKind
cplaceFreq    = [(GroupName PlaceKind
ARENA, X
1)]
  , cpassable :: Bool
cpassable     = Bool
True
  , cdefTile :: GroupName TileKind
cdefTile      = GroupName TileKind
ARENA_SET_LIT
  , cdarkCorTile :: GroupName TileKind
cdarkCorTile  = GroupName TileKind
TRAIL_LIT  -- let trails give off light
  , clitCorTile :: GroupName TileKind
clitCorTile   = GroupName TileKind
TRAIL_LIT  -- may be rolled different than the above
  , cwallTile :: GroupName TileKind
cwallTile     = GroupName TileKind
OPENABLE_WALL
  , cminStairDist :: X
cminStairDist = X
20
  , cmaxStairsNum :: Dice
cmaxStairsNum = X
1 X -> X -> Dice
`d` X
3
  , cstairFreq :: Freqs PlaceKind
cstairFreq    = [ (GroupName PlaceKind
WALLED_LIFT, X
20), (GroupName PlaceKind
CLOSED_LIFT, X
80)
                    , (GroupName PlaceKind
TINY_LIFT, X
1) ]
  , cstairAllowed :: Freqs PlaceKind
cstairAllowed = [ (GroupName PlaceKind
WALLED_STAIRCASE, X
20), (GroupName PlaceKind
CLOSED_STAIRCASE, X
80)
                    , (GroupName PlaceKind
TINY_STAIRCASE, X
1) ]
  , cdesc :: Text
cdesc         = Text
"Debris litters the wide streets and all the stalls are either broken or have their shutters down. Nature is taking over, healing the wounds."  -- potions of healing
  }
casino :: CaveKind
casino = CaveKind
arena
  { cname :: Text
cname         = Text
"Casino"
  , cfreq :: Freqs CaveKind
cfreq         = [(GroupName CaveKind
CAVE_CASINO, X
1)]
  , cXminSize :: X
cXminSize     = X
21
  , cYminSize :: X
cYminSize     = X
21
  , ccellSize :: DiceXY
ccellSize     = Dice -> Dice -> DiceXY
DiceXY Dice
19 (X
1 X -> X -> Dice
`d` X
3 Dice -> Dice -> Dice
forall a. Num a => a -> a -> a
+ Dice
5)
  , cdarkOdds :: Dice
cdarkOdds     = Dice
41 Dice -> Dice -> Dice
forall a. Num a => a -> a -> a
+ X
1 X -> X -> Dice
`d` X
10  -- almost all rooms lit (1 in 10 dark)
  -- Trails provide enough light for fun stealth, though level too small.
  , cnightOdds :: Dice
cnightOdds    = Dice
51  -- always night
  , cactorCoeff :: X
cactorCoeff   = X
100  -- cramped, don't overcrowd
  , cactorFreq :: Freqs ItemKind
cactorFreq    = [(GroupName ItemKind
MONSTER, X
50), (GroupName ItemKind
ANIMAL, X
25), (GroupName ItemKind
ROBOT, X
50)]
  , citemNum :: Dice
citemNum      = X
14 X -> X -> Dice
`d` X
2  -- rare, so make it exciting by keeping many items
  , citemFreq :: Freqs ItemKind
citemFreq     = [ (GroupName ItemKind
IK.COMMON_ITEM, X
20)
                    , (GroupName ItemKind
IK.CRAWL_ITEM, X
20)
                    , (GroupName ItemKind
IK.TREASURE, X
100) ]  -- lives up to its name
  , cdefTile :: GroupName TileKind
cdefTile      = GroupName TileKind
ARENA_SET_DARK
  , cfenceTileN :: GroupName TileKind
cfenceTileN   = GroupName TileKind
HABITAT_CONTAINMENT_WALL  -- small cave
  , cfenceTileE :: GroupName TileKind
cfenceTileE   = GroupName TileKind
HABITAT_CONTAINMENT_WALL
  , cfenceTileS :: GroupName TileKind
cfenceTileS   = GroupName TileKind
HABITAT_CONTAINMENT_WALL
  , cfenceTileW :: GroupName TileKind
cfenceTileW   = GroupName TileKind
HABITAT_CONTAINMENT_WALL
  , cminStairDist :: X
cminStairDist = X
10
  , cmaxStairsNum :: Dice
cmaxStairsNum = Dice
2  -- to make possible 2 stairs in the last cave
  , cinitSleep :: InitSleep
cinitSleep    = InitSleep
InitSleepBanned
  , cdesc :: Text
cdesc         = Text
"The establishment is no longer filled with hollow-eyed gamblers; more dangerous things now lurk in the dark. But the greedy excitement is not gone, even if out of place. Flashing colourful lights and enticing sounds make it a place where one couldn't sleep."
  }
museum :: CaveKind
museum = CaveKind
arena
  { cname :: Text
cname         = Text
"Museum"
  , cfreq :: Freqs CaveKind
cfreq         = [(GroupName CaveKind
CAVE_MUSEUM, X
1)]
  , cXminSize :: X
cXminSize     = X
25
  , cYminSize :: X
cYminSize     = X
25
  , ccellSize :: DiceXY
ccellSize     = Dice -> Dice -> DiceXY
DiceXY Dice
23 (X
1 X -> X -> Dice
`d` X
3 Dice -> Dice -> Dice
forall a. Num a => a -> a -> a
+ Dice
5)
  , cdarkOdds :: Dice
cdarkOdds     = Dice
41 Dice -> Dice -> Dice
forall a. Num a => a -> a -> a
+ X
1 X -> X -> Dice
`d` X
10  -- almost all rooms lit (1 in 10 dark)
  -- Trails provide enough light for fun stealth, though level too small.
  , cnightOdds :: Dice
cnightOdds    = Dice
51  -- always night
  , cactorCoeff :: X
cactorCoeff   = X
100  -- cramped, don't overcrowd
  , cactorFreq :: Freqs ItemKind
cactorFreq    = [(GroupName ItemKind
MONSTER, X
100), (GroupName ItemKind
ANIMAL, X
25), (GroupName ItemKind
ROBOT, X
25)]
  , citemNum :: Dice
citemNum      = X
12 X -> X -> Dice
`d` X
2  -- rare, so make it exciting despite sleeping foes
  , citemFreq :: Freqs ItemKind
citemFreq     = [ (GroupName ItemKind
IK.COMMON_ITEM, X
20)
                    , (GroupName ItemKind
IK.CRAWL_ITEM, X
20)
                    , (GroupName ItemKind
IK.TREASURE, X
20)
                    , (GroupName ItemKind
MUSEAL, X
200) ]  -- lives up to its name
  , cplaceFreq :: Freqs PlaceKind
cplaceFreq    = [(GroupName PlaceKind
MUSEUM, X
1)]
  , cdefTile :: GroupName TileKind
cdefTile      = GroupName TileKind
MUSEUM_SET_DARK
  , cfenceTileN :: GroupName TileKind
cfenceTileN   = GroupName TileKind
HABITAT_CONTAINMENT_WALL  -- small cave
  , cfenceTileE :: GroupName TileKind
cfenceTileE   = GroupName TileKind
HABITAT_CONTAINMENT_WALL
  , cfenceTileS :: GroupName TileKind
cfenceTileS   = GroupName TileKind
HABITAT_CONTAINMENT_WALL
  , cfenceTileW :: GroupName TileKind
cfenceTileW   = GroupName TileKind
HABITAT_CONTAINMENT_WALL
  , cminStairDist :: X
cminStairDist = X
10
  , cinitSleep :: InitSleep
cinitSleep    = InitSleep
InitSleepAlways
  , cdesc :: Text
cdesc         = Text
"History has shown that museal treasures are safer in space than anywhere on Earth. Passengers eagerly attend exhibitions, even if over the weeks of the journey they become increasingly a captive audience and stifle many a yawn. Spaceship crew are not that enthusiastic but even they find reasons to pay visits despite misgivings of museum security. Quite often a museum is the only place within millions of kilometers to house a desperately needed tool, old but sturdy beyond anything a 3D printer can produce."
  }
laboratory :: CaveKind
laboratory = CaveKind
rogue
  { cname :: Text
cname         = Text
"Laboratory"
  , cfreq :: Freqs CaveKind
cfreq         = [(GroupName CaveKind
CAVE_LABORATORY, X
1)]
  , cXminSize :: X
cXminSize     = X
60
  , cYminSize :: X
cYminSize     = X
42
  , ccellSize :: DiceXY
ccellSize     = Dice -> Dice -> DiceXY
DiceXY (X
1 X -> X -> Dice
`d` X
2 Dice -> Dice -> Dice
forall a. Num a => a -> a -> a
+ Dice
5) (X
1 X -> X -> Dice
`d` X
2 Dice -> Dice -> Dice
forall a. Num a => a -> a -> a
+ Dice
7)
  , cminPlaceSize :: DiceXY
cminPlaceSize = Dice -> Dice -> DiceXY
DiceXY Dice
6 Dice
8  -- merge, usually vertically
  , cmaxPlaceSize :: DiceXY
cmaxPlaceSize = Dice -> Dice -> DiceXY
DiceXY Dice
12 Dice
40  -- often maximize vertically
  , cnightOdds :: Dice
cnightOdds    = Dice
0  -- always day so that the corridor smoke is lit
  , cauxConnects :: Rational
cauxConnects  = Integer
1Integer -> Integer -> Rational
forall a. Integral a => a -> a -> Ratio a
%Integer
5
  , cmaxVoid :: Rational
cmaxVoid      = Integer
1Integer -> Integer -> Rational
forall a. Integral a => a -> a -> Ratio a
%Integer
10
  , cdoorChance :: Rational
cdoorChance   = Rational
1
  , copenChance :: Rational
copenChance   = Integer
1Integer -> Integer -> Rational
forall a. Integral a => a -> a -> Ratio a
%Integer
2
  , cactorFreq :: Freqs ItemKind
cactorFreq    = [ (GroupName ItemKind
MONSTER, X
50), (GroupName ItemKind
ANIMAL, X
70), (GroupName ItemKind
ROBOT, X
5)
                    , (GroupName ItemKind
IK.AQUATIC, X
10) ]
  , citemNum :: Dice
citemNum      = X
20 X -> X -> Dice
`d` X
2  -- reward difficulty, despite fewer rooms
  , citemFreq :: Freqs ItemKind
citemFreq     = [ (GroupName ItemKind
IK.COMMON_ITEM, X
20), (GroupName ItemKind
IK.CRAWL_ITEM, X
40)
                    , (GroupName ItemKind
IK.TREASURE, X
40), (GroupName ItemKind
IK.EXPLOSIVE, X
80) ]
  , cplaceFreq :: Freqs PlaceKind
cplaceFreq    = [(GroupName PlaceKind
LABORATORY, X
1)]
  , cdefTile :: GroupName TileKind
cdefTile      = GroupName TileKind
FILLER_WALL
  , cdarkCorTile :: GroupName TileKind
cdarkCorTile  = GroupName TileKind
LAB_TRAIL_LIT  -- let lab smoke give off light always
  , clitCorTile :: GroupName TileKind
clitCorTile   = GroupName TileKind
LAB_TRAIL_LIT
  , cminStairDist :: X
cminStairDist = X
25
  , cmaxStairsNum :: Dice
cmaxStairsNum = X
1 X -> X -> Dice
`d` X
2
  , cstairFreq :: Freqs PlaceKind
cstairFreq    = [ (GroupName PlaceKind
DECON_WALLED_LIFT, X
50)
                    , (GroupName PlaceKind
DECON_OPEN_LIFT, X
50)
                    , (GroupName PlaceKind
DECON_TINY_LIFT, X
1) ]
      -- In lone wolf challenge, the player better summoned or dominated
      -- any helpers by this point. If not, good luck fighting bare-handed.
  , cstairAllowed :: Freqs PlaceKind
cstairAllowed = [ (GroupName PlaceKind
DECON_WALLED_STAIRCASE, X
50)
                    , (GroupName PlaceKind
DECON_OPEN_STAIRCASE, X
50)
                    , (GroupName PlaceKind
DECON_TINY_STAIRCASE, X
1) ]
  , cdesc :: Text
cdesc         = Text
"Shattered glassware and the sharp scent of spilt chemicals show that something terrible happened here. The reinforced bulkheads muffle furious roars."  -- a fair warning to skip the level or regroup
  }
noise :: CaveKind
noise = CaveKind
rogue
  { cname :: Text
cname         = Text
"Computing hardware hub"
  , cfreq :: Freqs CaveKind
cfreq         = [(GroupName CaveKind
CAVE_NOISE, X
1)]
  , cXminSize :: X
cXminSize     = X
25
  , cYminSize :: X
cYminSize     = X
42
  , ccellSize :: DiceXY
ccellSize     = Dice -> Dice -> DiceXY
DiceXY (X
1 X -> X -> Dice
`d` X
3 Dice -> Dice -> Dice
forall a. Num a => a -> a -> a
+ Dice
7) Dice
8
  , cminPlaceSize :: DiceXY
cminPlaceSize = Dice -> Dice -> DiceXY
DiceXY Dice
7 Dice
7  -- often merge vertically
  , cmaxPlaceSize :: DiceXY
cmaxPlaceSize = Dice -> Dice -> DiceXY
DiceXY Dice
8 Dice
20
  , cdarkOdds :: Dice
cdarkOdds     = Dice
51
  -- Light is deadly, because nowhere to hide and pillars enable spawning
  -- very close to heroes.
  , cnightOdds :: Dice
cnightOdds    = Dice
0  -- harder variant, but looks cheerful
  , cauxConnects :: Rational
cauxConnects  = Integer
1Integer -> Integer -> Rational
forall a. Integral a => a -> a -> Ratio a
%Integer
10
  , cmaxVoid :: Rational
cmaxVoid      = Integer
1Integer -> Integer -> Rational
forall a. Integral a => a -> a -> Ratio a
%Integer
100
  , cdoorChance :: Rational
cdoorChance   = Rational
1  -- to prevent openings in solid rooms
  , chidden :: X
chidden       = X
0
  , cactorCoeff :: X
cactorCoeff   = X
100  -- the maze requires time to explore; also, small
  , cactorFreq :: Freqs ItemKind
cactorFreq    = [(GroupName ItemKind
MONSTER, X
100), (GroupName ItemKind
ANIMAL, X
5), (GroupName ItemKind
ROBOT, X
25)]
  , citemNum :: Dice
citemNum      = X
16 X -> X -> Dice
`d` X
2  -- an incentive to explore the labyrinth
  , citemFreq :: Freqs ItemKind
citemFreq     = [ (GroupName ItemKind
IK.COMMON_ITEM, X
40), (GroupName ItemKind
IK.CRAWL_ITEM, X
40)
                    , (GroupName ItemKind
IK.TREASURE, X
40), (GroupName ItemKind
IK.ANY_SCROLL, X
200) ]
  , cplaceFreq :: Freqs PlaceKind
cplaceFreq    = [(GroupName PlaceKind
NOISE, X
1)]
  , cpassable :: Bool
cpassable     = Bool
True
  , clabyrinth :: Bool
clabyrinth    = Bool
True
  , cdefTile :: GroupName TileKind
cdefTile      = GroupName TileKind
NOISE_SET_LIT
  , cwallTile :: GroupName TileKind
cwallTile     = GroupName TileKind
OPENABLE_WALL
  , cfenceApart :: Bool
cfenceApart   = Bool
True  -- ensures no cut-off parts from collapsed
  , cdarkCorTile :: GroupName TileKind
cdarkCorTile  = GroupName TileKind
DAMP_FLOOR_DARK
  , clitCorTile :: GroupName TileKind
clitCorTile   = GroupName TileKind
DAMP_FLOOR_LIT
  , cmaxStairsNum :: Dice
cmaxStairsNum = Dice
1
  , cstairFreq :: Freqs PlaceKind
cstairFreq    = [ (GroupName PlaceKind
CLOSED_LIFT, X
50), (GroupName PlaceKind
OPEN_LIFT, X
50)
                    , (GroupName PlaceKind
TINY_LIFT, X
1) ]
  , cstairAllowed :: Freqs PlaceKind
cstairAllowed = [ (GroupName PlaceKind
CLOSED_STAIRCASE, X
50), (GroupName PlaceKind
OPEN_STAIRCASE, X
50)
                    , (GroupName PlaceKind
TINY_STAIRCASE, X
1) ]
  , cinitSleep :: InitSleep
cinitSleep    = InitSleep
InitSleepBanned
  , cdesc :: Text
cdesc         = Text
"Several machines still function, processors whirring through routines scheduled by dead men. Some scattered chips can still be read."
  }
power :: CaveKind
power = CaveKind
noise
  { cname :: Text
cname         = Text
"Power distribution hub"
  , cfreq :: Freqs CaveKind
cfreq         = [(GroupName CaveKind
CAVE_POWER, X
1)]
  , cXminSize :: X
cXminSize     = X
32
  , cYminSize :: X
cYminSize     = X
42
  , ccellSize :: DiceXY
ccellSize     = Dice -> Dice -> DiceXY
DiceXY (X
1 X -> X -> Dice
`d` X
5 Dice -> Dice -> Dice
forall a. Num a => a -> a -> a
+ Dice
9) Dice
9
  , cminPlaceSize :: DiceXY
cminPlaceSize = Dice -> Dice -> DiceXY
DiceXY Dice
7 Dice
7
  , cmaxPlaceSize :: DiceXY
cmaxPlaceSize = Dice -> Dice -> DiceXY
DiceXY Dice
20 Dice
20
  , cnightOdds :: Dice
cnightOdds    = Dice
51  -- easier variant, but looks sinister
  , citemFreq :: Freqs ItemKind
citemFreq     = [(GroupName ItemKind
IK.COMMON_ITEM, X
20), (GroupName ItemKind
IK.CRAWL_ITEM, X
10), (GroupName ItemKind
GEM, X
80)]
                      -- can't be "valuable" or template items generated
  , clabyrinth :: Bool
clabyrinth    = Bool
True
  , cdefTile :: GroupName TileKind
cdefTile      = GroupName TileKind
POWER_SET_DARK
  , cdarkCorTile :: GroupName TileKind
cdarkCorTile  = GroupName TileKind
OILY_FLOOR_DARK
  , clitCorTile :: GroupName TileKind
clitCorTile   = GroupName TileKind
OILY_FLOOR_LIT
  , cmaxStairsNum :: Dice
cmaxStairsNum = Dice
2
    -- This determines that the continuous staircase uses stairs, not lifts.
  , cstairFreq :: Freqs PlaceKind
cstairFreq    = [ (GroupName PlaceKind
GATED_CLOSED_STAIRCASE, X
50)
                    , (GroupName PlaceKind
GATED_OPEN_STAIRCASE, X
50)
                    , (GroupName PlaceKind
GATED_TINY_STAIRCASE, X
1) ]
  , cstairAllowed :: Freqs PlaceKind
cstairAllowed = [ (GroupName PlaceKind
GATED_CLOSED_LIFT, X
50)
                    , (GroupName PlaceKind
GATED_OPEN_LIFT, X
50)
                    , (GroupName PlaceKind
GATED_TINY_LIFT, X
1) ]
  , cinitSleep :: InitSleep
cinitSleep    = InitSleep
InitSleepBanned
  , cdesc :: Text
cdesc         = Text
"A trickle of energy flows through a hub that could power a city. The air is warm and carries organic stench. Once in a while a young animal scurries across a lit patch of ground, pouncing in low gravity."
  }
empty :: CaveKind
empty = CaveKind
rogue
  { cname :: Text
cname         = Text
"Construction site"
  , cfreq :: Freqs CaveKind
cfreq         = []  -- just a template for some others
  , ccellSize :: DiceXY
ccellSize     = Dice -> Dice -> DiceXY
DiceXY (X
1 X -> X -> Dice
`d` X
5 Dice -> Dice -> Dice
forall a. Num a => a -> a -> a
+ Dice
18) Dice
16
  , cminPlaceSize :: DiceXY
cminPlaceSize = Dice -> Dice -> DiceXY
DiceXY Dice
9 Dice
9  -- normally don't merge
  , cmaxPlaceSize :: DiceXY
cmaxPlaceSize = Dice -> Dice -> DiceXY
DiceXY Dice
50 Dice
20  -- often maximize horizontally
  , cdarkOdds :: Dice
cdarkOdds     = X
1 X -> X -> Dice
`d` X
100 Dice -> Dice -> Dice
forall a. Num a => a -> a -> a
+ X
1 X -> X -> Dice
`dL` X
100
  , cnightOdds :: Dice
cnightOdds    = Dice
0  -- always day
  , cauxConnects :: Rational
cauxConnects  = Integer
3Integer -> Integer -> Rational
forall a. Integral a => a -> a -> Ratio a
%Integer
2
  , cmaxVoid :: Rational
cmaxVoid      = Rational
0  -- too few rooms to have void and fog common anyway
  , cdoorChance :: Rational
cdoorChance   = Rational
1  -- to prevent openings in solid rooms
  , chidden :: X
chidden       = X
0
  , cactorCoeff :: X
cactorCoeff   = X
50  -- easy to view and plan
  , cactorFreq :: Freqs ItemKind
cactorFreq    = [(GroupName ItemKind
MONSTER, X
10), (GroupName ItemKind
ANIMAL, X
5), (GroupName ItemKind
ROBOT, X
85)]
  , citemNum :: Dice
citemNum      = X
16 X -> X -> Dice
`d` X
2  -- lots of free space, but extra loot present
  , cplaceFreq :: Freqs PlaceKind
cplaceFreq    = [(GroupName PlaceKind
EMPTY, X
1)]
  , cpassable :: Bool
cpassable     = Bool
True
  , cdefTile :: GroupName TileKind
cdefTile      = GroupName TileKind
EMPTY_SET_LIT
  , cdarkCorTile :: GroupName TileKind
cdarkCorTile  = GroupName TileKind
FLOOR_ARENA_DARK
  , clitCorTile :: GroupName TileKind
clitCorTile   = GroupName TileKind
FLOOR_ARENA_LIT
  , cwallTile :: GroupName TileKind
cwallTile     = GroupName TileKind
OPENABLE_WALL
  , cfenceApart :: Bool
cfenceApart   = Bool
True  -- ensures no cut-off border airlocks and tanks
  , cminStairDist :: X
cminStairDist = X
30
  , cstairFreq :: Freqs PlaceKind
cstairFreq    = [ (GroupName PlaceKind
WALLED_LIFT, X
20), (GroupName PlaceKind
CLOSED_LIFT, X
80)
                    , (GroupName PlaceKind
TINY_LIFT, X
1) ]
  , cstairAllowed :: Freqs PlaceKind
cstairAllowed = [ (GroupName PlaceKind
WALLED_STAIRCASE, X
20), (GroupName PlaceKind
CLOSED_STAIRCASE, X
80)
                    , (GroupName PlaceKind
TINY_STAIRCASE, X
1) ]
  , cdesc :: Text
cdesc         = Text
"Not much to see here yet."
  }
egress :: CaveKind
egress = CaveKind
empty
  { cname :: Text
cname         = Text
"Shuttle servicing level"
  , cfreq :: Freqs CaveKind
cfreq         = [(GroupName CaveKind
CAVE_EGRESS, X
1)]
  , ccellSize :: DiceXY
ccellSize     = Dice -> Dice -> DiceXY
DiceXY (X
1 X -> X -> Dice
`d` X
2 Dice -> Dice -> Dice
forall a. Num a => a -> a -> a
+ Dice
20) Dice
16
  , cmaxPlaceSize :: DiceXY
cmaxPlaceSize = Dice -> Dice -> DiceXY
DiceXY Dice
25 Dice
20
  , cdarkOdds :: Dice
cdarkOdds     = Dice
51  -- all dark to compensate for the always lit shuttles
  , cplaceFreq :: Freqs PlaceKind
cplaceFreq    = [(GroupName PlaceKind
EGRESS, X
1)]
  , cdefTile :: GroupName TileKind
cdefTile      = GroupName TileKind
EGRESS_SET_LIT
  , cdarkCorTile :: GroupName TileKind
cdarkCorTile  = GroupName TileKind
TRANSPORT_ROUTE
  , clitCorTile :: GroupName TileKind
clitCorTile   = GroupName TileKind
TRANSPORT_ROUTE
  , cfenceTileN :: GroupName TileKind
cfenceTileN   = GroupName TileKind
S_BASIC_OUTER_FENCE
  , cfenceTileE :: GroupName TileKind
cfenceTileE   = GroupName TileKind
HABITAT_CONTAINMENT_WALL
  , cfenceTileS :: GroupName TileKind
cfenceTileS   = GroupName TileKind
AIRLOCK_FENCE
  , cfenceTileW :: GroupName TileKind
cfenceTileW   = GroupName TileKind
HABITAT_CONTAINMENT_WALL
  , cmaxStairsNum :: Dice
cmaxStairsNum = Dice
2  -- too many hinder generation of shuttles
  , cescapeFreq :: Freqs PlaceKind
cescapeFreq   = [(GroupName PlaceKind
SPACESHIP_ESCAPE_DOWN, X
1)]
  , cstairFreq :: Freqs PlaceKind
cstairFreq    = [(GroupName PlaceKind
WALLED_LIFT, X
20), (GroupName PlaceKind
TINY_LIFT, X
1)]
  , cstairAllowed :: Freqs PlaceKind
cstairAllowed = [(GroupName PlaceKind
WALLED_STAIRCASE, X
20), (GroupName PlaceKind
TINY_STAIRCASE, X
1)]
  , cdesc :: Text
cdesc         = Text
"Empty husks and strewn entrails of small craft litter the hangar among cranes and welding machines. The distant main fusion thruster array can be seen to the rear of the spaceship through oriels and airlocks of all sizes."
      -- E and W sides are borders with other level sections, so no oriels.
      -- The meteor shield towards N is not punctured here, because
      -- the cargo bay is too thick here, near the axis of the ship.
  }
outermost :: CaveKind
outermost = CaveKind
empty
  { cname :: Text
cname         = Text
"Outermost deck"
  , cfreq :: Freqs CaveKind
cfreq         = [(GroupName CaveKind
CAVE_OUTERMOST, X
100)]
  , cdarkOdds :: Dice
cdarkOdds     = Dice
0  -- all rooms lit, because can be huge and few lights yet
  , cactorCoeff :: X
cactorCoeff   = X
5  -- shallower than LH, so fewer immediate actors, so boost
  , cactorFreq :: Freqs ItemKind
cactorFreq    = [ (GroupName ItemKind
ANIMAL, X
3), (GroupName ItemKind
ROBOT, X
1)
                    , (GroupName ItemKind
IMMOBILE_ROBOT, X
90), (GroupName ItemKind
IMMOBILE_ANIMAL, X
2)
                    , (GroupName ItemKind
AQUATIC_ANIMAL, X
2) ]  -- (AQUATIC_ROBOT, 2)
      -- The medbot faucets on lvl 1 act like HP resets. Needed to avoid
      -- cascading failure, if the particular starting conditions were
      -- very hard. Items are not reset, even if they are bad, which provides
      -- enough of a continuity. The faucets on lvl 1 are not OP and can't be
      -- abused, because they spawn less and less often and also HP doesn't
      -- effectively accumulate over max.
  , citemFreq :: Freqs ItemKind
citemFreq     = [ (GroupName ItemKind
IK.COMMON_ITEM, X
50), (GroupName ItemKind
IK.CRAWL_ITEM, X
50)
                    , (GroupName ItemKind
GARDENING_TOOL, X
600) ]
  , cfenceTileN :: GroupName TileKind
cfenceTileN   = GroupName TileKind
ORIELS_FENCE
  , cfenceTileE :: GroupName TileKind
cfenceTileE   = GroupName TileKind
HABITAT_CONTAINMENT_WALL
  , cfenceTileS :: GroupName TileKind
cfenceTileS   = GroupName TileKind
EMPTY_AIRLOCK_FENCE
  , cfenceTileW :: GroupName TileKind
cfenceTileW   = GroupName TileKind
HABITAT_CONTAINMENT_WALL
  , cmaxStairsNum :: Dice
cmaxStairsNum = Dice
2
  , cdesc :: Text
cdesc         = Text -> [Text] -> Text
T.intercalate Text
"\n"
      [ Text
"This is as far as one can go \"down\". The void outside sucks light through the oriel and airlock glass in the walls and floor of this outermost level. Each minute, the dusky melancholic light of the distant Sun attempts for a few seconds to squeeze in but is repelled by artificial lighting."
      , Text
"The mucky floor marked by unkempt greenery looks misleadingly straight, its curvature noticeable only across the whole extent of the hull section. Overflowing water basins and series of hanging and stacked tanks double as radiation shields. Hoses writhe on the ground and dangle in thick knots from the ceiling. With proper tools, some of the containers could be opened and working spaces productively employed. There is no junk is space."
      , Text
"This deck is the main pressurized cargo bay and storage, with the only other docking hub for small craft located among the giant spaceship's upper levels. Somewhere here must be the airlock you docked your shuttle to and stacked your supplies against." ]
      -- E and W sides are borders with other level sections, so no oriels.
  }
bridge :: CaveKind
bridge = CaveKind
rogue
  { cname :: Text
cname         = Text
"Captain's bridge"
  , cfreq :: Freqs CaveKind
cfreq         = [(GroupName CaveKind
CAVE_BRIDGE, X
1)]
  , cXminSize :: X
cXminSize     = X
37
  , cYminSize :: X
cYminSize     = X
30
  , ccellSize :: DiceXY
ccellSize     = Dice -> Dice -> DiceXY
DiceXY (X
2 X -> X -> Dice
`d` X
2 Dice -> Dice -> Dice
forall a. Num a => a -> a -> a
+ Dice
7) (X
1 X -> X -> Dice
`d` X
2 Dice -> Dice -> Dice
forall a. Num a => a -> a -> a
+ Dice
5)
  , cminPlaceSize :: DiceXY
cminPlaceSize = Dice -> Dice -> DiceXY
DiceXY (X
2 X -> X -> Dice
`d` X
2 Dice -> Dice -> Dice
forall a. Num a => a -> a -> a
+ Dice
5) (X
1 X -> X -> Dice
`d` X
2 Dice -> Dice -> Dice
forall a. Num a => a -> a -> a
+ Dice
4)  -- sometimes merge all
  , cmaxPlaceSize :: DiceXY
cmaxPlaceSize = Dice -> Dice -> DiceXY
DiceXY Dice
16 Dice
20
  , cdarkOdds :: Dice
cdarkOdds     = Dice
0  -- all rooms lit, for a gentle start
  , cauxConnects :: Rational
cauxConnects  = Rational
1  -- few rooms, so many corridors
  , cmaxVoid :: Rational
cmaxVoid      = Integer
1Integer -> Integer -> Rational
forall a. Integral a => a -> a -> Ratio a
%Integer
4  -- few rooms, so increase the chance of any void
  , cactorCoeff :: X
cactorCoeff   = X
400  -- it's quite deep already, so spawn slowly;
                         -- this is initially the best level for sleeping
  , cactorFreq :: Freqs ItemKind
cactorFreq    = [(GroupName ItemKind
ANIMAL, X
100)]
  , citemNum :: Dice
citemNum      = Dice
16  -- make the initial experience tamer
  , citemFreq :: Freqs ItemKind
citemFreq     = [(GroupName ItemKind
IK.COMMON_ITEM, X
100), (GroupName ItemKind
GARDENING_TOOL, X
800)]
  , cdefTile :: GroupName TileKind
cdefTile      = GroupName TileKind
FILLER_WALL
  , cfenceTileN :: GroupName TileKind
cfenceTileN   = GroupName TileKind
HABITAT_CONTAINMENT_WALL  -- cave isolated for safety
  , cfenceTileE :: GroupName TileKind
cfenceTileE   = GroupName TileKind
HABITAT_CONTAINMENT_WALL
  , cfenceTileS :: GroupName TileKind
cfenceTileS   = GroupName TileKind
HABITAT_CONTAINMENT_WALL
  , cfenceTileW :: GroupName TileKind
cfenceTileW   = GroupName TileKind
HABITAT_CONTAINMENT_WALL
  , cmaxStairsNum :: Dice
cmaxStairsNum = Dice
1
  , cstairFreq :: Freqs PlaceKind
cstairFreq    = [ (GroupName PlaceKind
WELDED_WALLED_LIFT, X
50)
                    , (GroupName PlaceKind
WELDED_OPEN_LIFT, X
50)
                    , (GroupName PlaceKind
WELDED_TINY_LIFT, X
1) ]
  , cstairAllowed :: Freqs PlaceKind
cstairAllowed = [ (GroupName PlaceKind
WELDED_WALLED_STAIRCASE, X
50)
                    , (GroupName PlaceKind
WELDED_OPEN_STAIRCASE, X
50)
                    , (GroupName PlaceKind
WELDED_TINY_STAIRCASE, X
1) ]
  , cdesc :: Text
cdesc         = Text
"The bridge is gutted out and nonoperational. You saved space on the shuttle by only packing demolition equipment (and booze, long gone, all flasks flung to fend off the annoying vermin) and now you can't even attempt repairs. You are also short on rations and vials of medicine to treat your recent wounds. Only water is plentiful on the ship: gaseous, liquid, frozen. There are animal cries down below and ominous silence up above."
  }
shallowRogue :: CaveKind
shallowRogue = CaveKind
rogue
  { cfreq :: Freqs CaveKind
cfreq         = [(GroupName CaveKind
CAVE_SHALLOW_ROGUE, X
100)]
  , cXminSize :: X
cXminSize     = X
60
  , cYminSize :: X
cYminSize     = X
37
  , cactorCoeff :: X
cactorCoeff   = X
150  -- more difficult
  , cactorFreq :: Freqs ItemKind
cactorFreq    = ((GroupName ItemKind, X) -> Bool)
-> Freqs ItemKind -> Freqs ItemKind
forall a. (a -> Bool) -> [a] -> [a]
filter ((GroupName ItemKind -> GroupName ItemKind -> Bool
forall a. Eq a => a -> a -> Bool
/= GroupName ItemKind
MONSTER) (GroupName ItemKind -> Bool)
-> ((GroupName ItemKind, X) -> GroupName ItemKind)
-> (GroupName ItemKind, X)
-> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (GroupName ItemKind, X) -> GroupName ItemKind
forall a b. (a, b) -> a
fst) (Freqs ItemKind -> Freqs ItemKind)
-> Freqs ItemKind -> Freqs ItemKind
forall a b. (a -> b) -> a -> b
$ CaveKind -> Freqs ItemKind
cactorFreq CaveKind
rogue
  , citemNum :: Dice
citemNum      = Dice
20  -- make the initial experience tamer
  , citemFreq :: Freqs ItemKind
citemFreq     = [ (GroupName ItemKind
IK.COMMON_ITEM, X
40), (GroupName ItemKind
IK.CRAWL_ITEM, X
60)
                    , (GroupName ItemKind
GARDENING_TOOL, X
700), (GroupName ItemKind
IK.ANY_FLASK, X
200) ]
  , cmaxStairsNum :: Dice
cmaxStairsNum = Dice
2
  , cskip :: [X]
cskip         = [X
0, X
1]  -- ban foes camping on either stairs
  , cdesc :: Text
cdesc         = Text -> [Text] -> Text
T.intercalate Text
"\n"
      [ Text
"This close to the outermost deck, residence is not permitted and walls and doors are sturdier to contain a theoretically possible micro-meteorite breach. The entry is not closed off, though, because some passengers can't live without a regular pilgrimage to 'look outside' and the only way to the bottom-most level leads through here. Apparently, gazing at the sharp pin-points of stars and planets through the reinforced oriel glass is incomparable to watching the same through the thin polymer of wall displays."
      , Text
"Animals appear to share the fascination of outer decks, perhaps attracted by the increased gravity, nearly Earth-like, unlike elsewhere on the ship. However, they dislike many industrial fluids stored on these floors, so flinging random flasks at them works as an effective deterrent. Moreover, if you throw an unidentified flask, you can be sure you won't waste a badly needed nano medicine, because it's never stored in such large containers. Even tiny vials cost a fortune." ]
  }
virus :: CaveKind
virus = CaveKind
rogue  -- this is a hard level requiring preparation; can be skipped
  { cname :: Text
cname         = Text
"Machinarium"
  , cfreq :: Freqs CaveKind
cfreq         = [(GroupName CaveKind
CAVE_VIRUS, X
1)]
  , cXminSize :: X
cXminSize     = X
17
  , cYminSize :: X
cYminSize     = X
13
  , ccellSize :: DiceXY
ccellSize     = Dice -> Dice -> DiceXY
DiceXY Dice
4 Dice
4
  , cminPlaceSize :: DiceXY
cminPlaceSize = Dice -> Dice -> DiceXY
DiceXY Dice
3 Dice
3
  , cmaxPlaceSize :: DiceXY
cmaxPlaceSize = Dice -> Dice -> DiceXY
DiceXY Dice
5 Dice
4
  , cdarkOdds :: Dice
cdarkOdds     = Dice
51  -- all rooms dark
  , cnightOdds :: Dice
cnightOdds    = Dice
51  -- always night
  , cauxConnects :: Rational
cauxConnects  = Rational
0
  , cmaxVoid :: Rational
cmaxVoid      = Rational
0
  , cdoorChance :: Rational
cdoorChance   = Rational
0  -- openings in solid rooms are fine, because rooms tiny
  , chidden :: X
chidden       = X
0
  , cactorCoeff :: X
cactorCoeff   = X
4  -- fast spawning
  , cactorFreq :: Freqs ItemKind
cactorFreq    = [(GroupName ItemKind
MOBILE_ROBOT, X
100)]  -- only mobile, for fast action
  , citemNum :: Dice
citemNum      = Dice
12  -- avoid random excess given the low area
  , citemFreq :: Freqs ItemKind
citemFreq     = [(GroupName ItemKind
IK.COMMON_ITEM, X
70), (GroupName ItemKind
IK.CRAWL_ITEM, X
30)]
  , cplaceFreq :: Freqs PlaceKind
cplaceFreq    = [(GroupName PlaceKind
VIRUS, X
1)]
  , cpassable :: Bool
cpassable     = Bool
True
  , clabyrinth :: Bool
clabyrinth    = Bool
True  -- don't let aliens explore and farm the robots
  , cdefTile :: GroupName TileKind
cdefTile      = GroupName TileKind
VIRUS_SET_DARK
  , cdarkCorTile :: GroupName TileKind
cdarkCorTile  = GroupName TileKind
OILY_FLOOR_DARK
  , clitCorTile :: GroupName TileKind
clitCorTile   = GroupName TileKind
OILY_FLOOR_LIT
  , cwallTile :: GroupName TileKind
cwallTile     = GroupName TileKind
OPENABLE_WALL
  , cfenceTileN :: GroupName TileKind
cfenceTileN   = GroupName TileKind
HABITAT_CONTAINMENT_WALL  -- small cave
  , cfenceTileE :: GroupName TileKind
cfenceTileE   = GroupName TileKind
HABITAT_CONTAINMENT_WALL
  , cfenceTileS :: GroupName TileKind
cfenceTileS   = GroupName TileKind
HABITAT_CONTAINMENT_WALL
  , cfenceTileW :: GroupName TileKind
cfenceTileW   = GroupName TileKind
HABITAT_CONTAINMENT_WALL
  , cfenceApart :: Bool
cfenceApart   = Bool
True  -- ensures no cut-off parts from collapsed
  , cmaxStairsNum :: Dice
cmaxStairsNum = Dice
1
  , cstairFreq :: Freqs PlaceKind
cstairFreq    = [(GroupName PlaceKind
TINY_LIFT, X
1)]
  , cstairAllowed :: Freqs PlaceKind
cstairAllowed = [(GroupName PlaceKind
TINY_STAIRCASE, X
1)]
  , cdesc :: Text
cdesc         = Text
"The hall surrounded by automated warehouses is where ship's robots are repaired, decommissioned, stored and recycled. This one has been completely cut off from the vessel's network and even lights are out. And yet, the hot darkness smelling of ozone carries echos of arcing and clanking all around."
  }

-- * "Caves" on various celestial bodies (including, but not limited to, moons,
--    with virtually no story-wise limits wrt height and size.
--    Here @citemNum@ is very random, for interesting replays; no risk
--    of bad rolls accumulating and trashing a long game, particularly
--    in symmetric scenarios, where both parties can use extra loot
--    equally well.

gauntlet :: CaveKind
gauntlet = CaveKind
rogue
  { cname :: Text
cname         = Text
"Service tunnel"
  , cfreq :: Freqs CaveKind
cfreq         = [(GroupName CaveKind
CAVE_GAUNTLET, X
1)]
  , cXminSize :: X
cXminSize     = X
52  -- long tunnel
  , cYminSize :: X
cYminSize     = X
8
  , ccellSize :: DiceXY
ccellSize     = Dice -> Dice -> DiceXY
DiceXY Dice
6 Dice
4
  , cminPlaceSize :: DiceXY
cminPlaceSize = Dice -> Dice -> DiceXY
DiceXY Dice
5 Dice
3
  , cmaxPlaceSize :: DiceXY
cmaxPlaceSize = Dice -> Dice -> DiceXY
DiceXY Dice
6 Dice
3
  , cdarkOdds :: Dice
cdarkOdds     = Dice
0  -- all rooms lit, for a gentle start
  , cnightOdds :: Dice
cnightOdds    = Dice
0
  , cauxConnects :: Rational
cauxConnects  = Rational
0
  , cmaxVoid :: Rational
cmaxVoid      = Rational
0
  , cdoorChance :: Rational
cdoorChance   = Integer
1Integer -> Integer -> Rational
forall a. Integral a => a -> a -> Ratio a
%Integer
3  -- openings in solid rooms are fine, because rooms tiny
  , chidden :: X
chidden       = X
0
  , cactorCoeff :: X
cactorCoeff   = X
4  -- fast spawning
  , cactorFreq :: Freqs ItemKind
cactorFreq    = [(GroupName ItemKind
GAUNTLET_ROBOT, X
100)]  -- no drops; tutorial; avoid stash
  , citemNum :: Dice
citemNum      = Dice
0  -- first tutorial mode, no need for a stash
  , citemFreq :: Freqs ItemKind
citemFreq     = []  -- first tutorial level, no need for a stash
  , cplaceFreq :: Freqs PlaceKind
cplaceFreq    = [(GroupName PlaceKind
GAUNTLET, X
1)]  -- first tutorial mode; keep it simple
  , cpassable :: Bool
cpassable     = Bool
True
  , cdefTile :: GroupName TileKind
cdefTile      = GroupName TileKind
VIRUS_SET_LIT  -- first tutorial mode; keep it simple
  , cwallTile :: GroupName TileKind
cwallTile     = GroupName TileKind
OPENABLE_WALL
  , cfenceTileN :: GroupName TileKind
cfenceTileN   = GroupName TileKind
HABITAT_CONTAINMENT_WALL
  , cfenceTileE :: GroupName TileKind
cfenceTileE   = GroupName TileKind
HABITAT_CONTAINMENT_WALL
  , cfenceTileS :: GroupName TileKind
cfenceTileS   = GroupName TileKind
HABITAT_CONTAINMENT_WALL
  , cfenceTileW :: GroupName TileKind
cfenceTileW   = GroupName TileKind
HABITAT_CONTAINMENT_WALL
  , cmaxStairsNum :: Dice
cmaxStairsNum = Dice
0
  , cescapeFreq :: Freqs PlaceKind
cescapeFreq   = [(GroupName PlaceKind
ALARM_ESCAPE_UP, X
1)]
  , cstairFreq :: Freqs PlaceKind
cstairFreq    = []
  , cstairAllowed :: Freqs PlaceKind
cstairAllowed = []
  , cinitSleep :: InitSleep
cinitSleep    = InitSleep
InitSleepBanned  -- to make it harder to escape freely
  , cskip :: [X]
cskip         = [X
0]  -- don't start heroes nor opponents on escape
  , cdesc :: Text
cdesc         = Text -> [Text] -> Text
T.intercalate Text
"\n"
      [ Text
"Triton's cryothermal vents that supply energy and resources to the city are spread far apart. That funnels the unregulated sprawl of the sublunar city wide rather than deep and favours tunnels over domes."
      , Text
"The deepest tunnels, such as this one, serve exclusively as emergency secondary connections between Triton City forges, farms and population centers. They are devoid of amenities and normally unused except by lazy maintenance crews storing and then leaving behind defunct machinery and leftover spare parts. Nobody can be contacted from such a remote corridor, except through a red alarm console, mandatory per every 100m of transport tunnels." ]
  }
raid :: CaveKind
raid = CaveKind
rogue
  { cname :: Text
cname         = Text
"Triton City sewers"
  , cfreq :: Freqs CaveKind
cfreq         = [(GroupName CaveKind
CAVE_RAID, X
1)]
  , cXminSize :: X
cXminSize     = X
60  -- long sewer tunnels
  , cYminSize :: X
cYminSize     = X
21
  , ccellSize :: DiceXY
ccellSize     = Dice -> Dice -> DiceXY
DiceXY (X
2 X -> X -> Dice
`d` X
2 Dice -> Dice -> Dice
forall a. Num a => a -> a -> a
+ Dice
7) Dice
6
  , cminPlaceSize :: DiceXY
cminPlaceSize = Dice -> Dice -> DiceXY
DiceXY (X
2 X -> X -> Dice
`d` X
2 Dice -> Dice -> Dice
forall a. Num a => a -> a -> a
+ Dice
4) Dice
5  -- sometimes merge all
  , cmaxPlaceSize :: DiceXY
cmaxPlaceSize = Dice -> Dice -> DiceXY
DiceXY Dice
16 Dice
20
  , cdarkOdds :: Dice
cdarkOdds     = Dice
0  -- all rooms lit, for a gentle start
  , cmaxVoid :: Rational
cmaxVoid      = Integer
1Integer -> Integer -> Rational
forall a. Integral a => a -> a -> Ratio a
%Integer
5
  , cdoorChance :: Rational
cdoorChance   = Rational
1  -- make sure enemies not seen on turn 1
  , copenChance :: Rational
copenChance   = Rational
0  -- make sure enemies not seen on turn 1
  , cdefTile :: GroupName TileKind
cdefTile      = GroupName TileKind
FILLER_WALL
  , cactorCoeff :: X
cactorCoeff   = X
300  -- deep level with no kit, so slow spawning
  , cactorFreq :: Freqs ItemKind
cactorFreq    = [(GroupName ItemKind
ANIMAL, X
50), (GroupName ItemKind
ROBOT, X
50)]
  , citemNum :: Dice
citemNum      = Dice
20  -- make the initial experience tamer
  , citemFreq :: Freqs ItemKind
citemFreq     = [ (GroupName ItemKind
IK.COMMON_ITEM, X
30)
                    , (GroupName ItemKind
STARTING_ARMOR, X
100), (GroupName ItemKind
STARTING_WEAPON, X
300)
                    , (GroupName ItemKind
WEAK_ARROW, X
100), (GroupName ItemKind
LIGHT_ATTENUATOR, X
50)
                    , (GroupName ItemKind
IK.S_CURRENCY, X
400), (GroupName ItemKind
IK.ANY_SCROLL, X
100) ]
                    -- introducing chips in this scenario
  , cplaceFreq :: Freqs PlaceKind
cplaceFreq    = [(GroupName PlaceKind
RAID, X
1)]
  , cmaxStairsNum :: Dice
cmaxStairsNum = Dice
0
  , cescapeFreq :: Freqs PlaceKind
cescapeFreq   = [(GroupName PlaceKind
INDOOR_ESCAPE_UP, X
1)]
  , cstairFreq :: Freqs PlaceKind
cstairFreq    = []
  , cstairAllowed :: Freqs PlaceKind
cstairAllowed = []
  , cdesc :: Text
cdesc         = Text
"Mold spreads across the walls and scuttling sounds can be heard in the distance."
  }
brawl :: CaveKind
brawl = CaveKind
rogue  -- many random solid tiles, to break LOS, since it's a day
               -- and this scenario is not focused on ranged combat;
               -- also, sanctuaries against missiles in shadow under trees
  { cname :: Text
cname         = Text
"Woodland biosphere"
  , cfreq :: Freqs CaveKind
cfreq         = [(GroupName CaveKind
CAVE_BRAWL, X
1)]
  , cXminSize :: X
cXminSize     = X
60
  , cYminSize :: X
cYminSize     = X
30
  , ccellSize :: DiceXY
ccellSize     = Dice -> Dice -> DiceXY
DiceXY (X
2 X -> X -> Dice
`d` X
5 Dice -> Dice -> Dice
forall a. Num a => a -> a -> a
+ Dice
5) Dice
7
  , cminPlaceSize :: DiceXY
cminPlaceSize = Dice -> Dice -> DiceXY
DiceXY Dice
3 Dice
3  -- rarely merge vertically
  , cmaxPlaceSize :: DiceXY
cmaxPlaceSize = Dice -> Dice -> DiceXY
DiceXY Dice
7 Dice
5
  , cdarkOdds :: Dice
cdarkOdds     = Dice
51
  , cnightOdds :: Dice
cnightOdds    = Dice
0
  , cdoorChance :: Rational
cdoorChance   = Rational
1
  , copenChance :: Rational
copenChance   = Rational
0
  , chidden :: X
chidden       = X
0
  , cactorFreq :: Freqs ItemKind
cactorFreq    = []
  , citemNum :: Dice
citemNum      = X
6 X -> X -> Dice
`d` X
6
  , citemFreq :: Freqs ItemKind
citemFreq     = [ (GroupName ItemKind
IK.COMMON_ITEM, X
50)
                    , (GroupName ItemKind
STARTING_WEAPON, X
200), (GroupName ItemKind
STARTING_ARMOR, X
400)
                    , (GroupName ItemKind
IK.ANY_SCROLL, X
100), (GroupName ItemKind
IK.ANY_POTION, X
600) ]
                      -- introducing vials in this scenario
  , cplaceFreq :: Freqs PlaceKind
cplaceFreq    = [(GroupName PlaceKind
BRAWL, X
1)]
  , cpassable :: Bool
cpassable     = Bool
True
  , cdefTile :: GroupName TileKind
cdefTile      = GroupName TileKind
BRAWL_SET_LIT
  , cdarkCorTile :: GroupName TileKind
cdarkCorTile  = GroupName TileKind
DIRT_LIT
  , clitCorTile :: GroupName TileKind
clitCorTile   = GroupName TileKind
DIRT_LIT
  , cwallTile :: GroupName TileKind
cwallTile     = GroupName TileKind
OPENABLE_WALL
  , cmaxStairsNum :: Dice
cmaxStairsNum = Dice
1
  , cstairFreq :: Freqs PlaceKind
cstairFreq    = [(GroupName PlaceKind
OUTDOOR_TINY_STAIRCASE, X
1)]
  , cstairAllowed :: Freqs PlaceKind
cstairAllowed = []
  , cskip :: [X]
cskip         = []  -- start heroes on stairs, since they are created first
  , cdesc :: Text
cdesc         = Text
"Shadows pool under the trees and leaves crunch underfoot."
  }
brawlAlt :: CaveKind
brawlAlt = CaveKind
brawl
  { cfreq :: Freqs CaveKind
cfreq         = [(GroupName CaveKind
CAVE_BRAWL_ALT, X
1)]
  , cmaxVoid :: Rational
cmaxVoid      = Integer
1Integer -> Integer -> Rational
forall a. Integral a => a -> a -> Ratio a
%Integer
100  -- to ensure enough trees
  , cdefTile :: GroupName TileKind
cdefTile      = GroupName TileKind
HUNT_SET_LIT  -- alt
  , cdarkCorTile :: GroupName TileKind
cdarkCorTile  = GroupName TileKind
S_FROZEN_PATH  -- alt
  , clitCorTile :: GroupName TileKind
clitCorTile   = GroupName TileKind
S_FROZEN_PATH
  , cskip :: [X]
cskip         = [X
0]  -- ban foes camping on stairs
  , cdesc :: Text
cdesc         = Text
"With the Sun so distant, biospheres are stacked vertically rather than horizontally, sharing drainage, not lighting."
  }
shootout :: CaveKind
shootout = CaveKind
rogue  -- a scenario with strong missiles;
                  -- few solid tiles, but only translucent tiles or walkable
                  -- opaque tiles, to make scouting and sniping more interesting
                  -- and to avoid obstructing view too much, since this
                  -- scenario is about ranged combat at long range
  { cname :: Text
cname         = Text
"Hydroponic farm"  -- still a neutral, official wording
  , cfreq :: Freqs CaveKind
cfreq         = [(GroupName CaveKind
CAVE_SHOOTOUT, X
1)]
  , ccellSize :: DiceXY
ccellSize     = Dice -> Dice -> DiceXY
DiceXY (X
1 X -> X -> Dice
`d` X
2 Dice -> Dice -> Dice
forall a. Num a => a -> a -> a
+ Dice
5) Dice
6
  , cminPlaceSize :: DiceXY
cminPlaceSize = Dice -> Dice -> DiceXY
DiceXY Dice
3 Dice
3  -- rarely merge vertically
  , cmaxPlaceSize :: DiceXY
cmaxPlaceSize = Dice -> Dice -> DiceXY
DiceXY Dice
5 Dice
5
  , cdarkOdds :: Dice
cdarkOdds     = Dice
0  -- all lit, not to duplicate the @hunt@ ranged tactics
  , cnightOdds :: Dice
cnightOdds    = Dice
0
  , cauxConnects :: Rational
cauxConnects  = Integer
1Integer -> Integer -> Rational
forall a. Integral a => a -> a -> Ratio a
%Integer
10
  , cdoorChance :: Rational
cdoorChance   = Rational
1
  , copenChance :: Rational
copenChance   = Rational
0
  , chidden :: X
chidden       = X
0
  , cactorFreq :: Freqs ItemKind
cactorFreq    = []
  , citemNum :: Dice
citemNum      = X
6 X -> X -> Dice
`d` X
16
                      -- less items in inventory, more to be picked up,
                      -- to reward explorer and aggressor and punish camper;
                      -- very different experience depending on the roll,
                      -- but it's symmetric, so it's fine
  , citemFreq :: Freqs ItemKind
citemFreq     = [ (GroupName ItemKind
IK.COMMON_ITEM, X
30), (GroupName ItemKind
GARDENING_TOOL, X
500)
                    , (GroupName ItemKind
ANY_ARROW, X
400), (GroupName ItemKind
HARPOON, X
200), (GroupName ItemKind
IK.EXPLOSIVE, X
300) ]
                      -- Many consumable buffs are needed in symmetric maps
                      -- so that aggressor prepares them in advance and camper
                      -- needs to waste initial turns to buff for the defence.
  , cplaceFreq :: Freqs PlaceKind
cplaceFreq    = [(GroupName PlaceKind
SHOOTOUT, X
1)]
  , cpassable :: Bool
cpassable     = Bool
True
  , cdefTile :: GroupName TileKind
cdefTile      = GroupName TileKind
SHOOTOUT_SET_LIT
  , cdarkCorTile :: GroupName TileKind
cdarkCorTile  = GroupName TileKind
DIRT_LIT
  , clitCorTile :: GroupName TileKind
clitCorTile   = GroupName TileKind
DIRT_LIT
  , cwallTile :: GroupName TileKind
cwallTile     = GroupName TileKind
OPENABLE_WALL
  , cmaxStairsNum :: Dice
cmaxStairsNum = Dice
0
  , cstairFreq :: Freqs PlaceKind
cstairFreq    = []
  , cstairAllowed :: Freqs PlaceKind
cstairAllowed = []
  , cdesc :: Text
cdesc         = Text
"Once so carefully curated, the planting beds are now overgrown and choked with weeds. The recently imposed high taxes make the traditional ways of life in space unsustainable."  -- also explains the gangs elsewhere and the motivation of adventurers to take risks (in addition to male hormones)
  }
hunt :: CaveKind
hunt = CaveKind
rogue  -- a scenario with strong missiles for ranged and shade for melee;
              -- the human is likely to focus on melee, not having overwatch
  { cname :: Text
cname         = Text
"Swamp biosphere"
  , cfreq :: Freqs CaveKind
cfreq         = [(GroupName CaveKind
CAVE_HUNT, X
1)]
  , ccellSize :: DiceXY
ccellSize     = Dice -> Dice -> DiceXY
DiceXY (X
1 X -> X -> Dice
`d` X
2 Dice -> Dice -> Dice
forall a. Num a => a -> a -> a
+ Dice
5) Dice
6
  , cminPlaceSize :: DiceXY
cminPlaceSize = Dice -> Dice -> DiceXY
DiceXY Dice
3 Dice
3  -- rarely merge vertically
  , cmaxPlaceSize :: DiceXY
cmaxPlaceSize = Dice -> Dice -> DiceXY
DiceXY Dice
5 Dice
5
  , cdarkOdds :: Dice
cdarkOdds     = Dice
51
  , cnightOdds :: Dice
cnightOdds    = Dice
0
  , cauxConnects :: Rational
cauxConnects  = Integer
1Integer -> Integer -> Rational
forall a. Integral a => a -> a -> Ratio a
%Integer
10
  , cdoorChance :: Rational
cdoorChance   = Rational
1
  , copenChance :: Rational
copenChance   = Rational
0
  , chidden :: X
chidden       = X
0
  , cactorCoeff :: X
cactorCoeff   = X
400  -- spawn slowly
  , cactorFreq :: Freqs ItemKind
cactorFreq    = [(GroupName ItemKind
INSECT, X
100)]
  , citemNum :: Dice
citemNum      = X
6 X -> X -> Dice
`d` X
10
  , citemFreq :: Freqs ItemKind
citemFreq     = [(GroupName ItemKind
IK.COMMON_ITEM, X
30), (GroupName ItemKind
ANY_ARROW, X
60), (GroupName ItemKind
HARPOON, X
30)]
  , cplaceFreq :: Freqs PlaceKind
cplaceFreq    = [(GroupName PlaceKind
BRAWL, X
50), (GroupName PlaceKind
SHOOTOUT, X
100)]
  , cpassable :: Bool
cpassable     = Bool
True
  , cdefTile :: GroupName TileKind
cdefTile      = GroupName TileKind
HUNT_SET_LIT  -- much more water than in shootoutSetLit
  , cdarkCorTile :: GroupName TileKind
cdarkCorTile  = GroupName TileKind
DIRT_LIT
  , clitCorTile :: GroupName TileKind
clitCorTile   = GroupName TileKind
DIRT_LIT
  , cwallTile :: GroupName TileKind
cwallTile     = GroupName TileKind
OPENABLE_WALL
  , cmaxStairsNum :: Dice
cmaxStairsNum = Dice
0
  , cstairFreq :: Freqs PlaceKind
cstairFreq    = []
  , cstairAllowed :: Freqs PlaceKind
cstairAllowed = []
  , cdesc :: Text
cdesc         = Text
"Mangrove trees and murky water, inspired by a habitat now eradicated from Earth. A rather deadly habitat."
  }
flight :: CaveKind
flight = CaveKind
rogue  -- a scenario with weak missiles, because heroes don't depend
                -- on them; dark, so solid obstacles are to hide from missiles,
                -- not view; obstacles are not lit, to frustrate the AI;
                -- lots of small lights to cross, to have some risks
  { cname :: Text
cname         = Text
"Red Collar Bros den"  -- tension rises; non-official name
  , cfreq :: Freqs CaveKind
cfreq         = [(GroupName CaveKind
CAVE_FLIGHT, X
1)]
  , ccellSize :: DiceXY
ccellSize     = Dice -> Dice -> DiceXY
DiceXY (X
1 X -> X -> Dice
`d` X
3 Dice -> Dice -> Dice
forall a. Num a => a -> a -> a
+ Dice
6) Dice
7
  , cminPlaceSize :: DiceXY
cminPlaceSize = Dice -> Dice -> DiceXY
DiceXY Dice
5 Dice
4  -- rarely merge
  , cmaxPlaceSize :: DiceXY
cmaxPlaceSize = Dice -> Dice -> DiceXY
DiceXY Dice
9 Dice
9  -- bias towards larger lamp areas
  , cdarkOdds :: Dice
cdarkOdds     = Dice
0
  , cnightOdds :: Dice
cnightOdds    = Dice
51  -- always night
  , cauxConnects :: Rational
cauxConnects  = Rational
2  -- many lit trails, so easy to aim
  , cmaxVoid :: Rational
cmaxVoid      = Integer
1Integer -> Integer -> Rational
forall a. Integral a => a -> a -> Ratio a
%Integer
100
  , chidden :: X
chidden       = X
0
  , cactorFreq :: Freqs ItemKind
cactorFreq    = []
  , citemNum :: Dice
citemNum      = X
8 X -> X -> Dice
`d` X
8
  , citemFreq :: Freqs ItemKind
citemFreq     = [ (GroupName ItemKind
IK.COMMON_ITEM, X
30), (GroupName ItemKind
STARTING_ARMOR, X
100)
                    , (GroupName ItemKind
LIGHT_ATTENUATOR, X
300), (GroupName ItemKind
GEM, X
400)
                    , (GroupName ItemKind
WEAK_ARROW, X
400), (GroupName ItemKind
HARPOON, X
200), (GroupName ItemKind
IK.EXPLOSIVE, X
200) ]
  , cplaceFreq :: Freqs PlaceKind
cplaceFreq    = [(GroupName PlaceKind
FLIGHT, X
1)]
  , cpassable :: Bool
cpassable     = Bool
True
  , cdefTile :: GroupName TileKind
cdefTile      = GroupName TileKind
FLIGHT_SET_DARK
  , cdarkCorTile :: GroupName TileKind
cdarkCorTile  = GroupName TileKind
SAFE_TRAIL_LIT  -- let trails give off light
  , clitCorTile :: GroupName TileKind
clitCorTile   = GroupName TileKind
SAFE_TRAIL_LIT
  , cwallTile :: GroupName TileKind
cwallTile     = GroupName TileKind
OPENABLE_WALL
  , cescapeFreq :: Freqs PlaceKind
cescapeFreq   = [(GroupName PlaceKind
OUTDOOR_ESCAPE_DOWN, X
1)]
  , cmaxStairsNum :: Dice
cmaxStairsNum = Dice
0
  , cstairFreq :: Freqs PlaceKind
cstairFreq    = []
  , cstairAllowed :: Freqs PlaceKind
cstairAllowed = []
  , cskip :: [X]
cskip         = [X
0]  -- don't start heroes nor opponents on escape
  , cdesc :: Text
cdesc         = Text
"Graffiti scrawls across the walls and the heavy scents of stimulants hang in the air."
  }
zoo :: CaveKind
zoo = CaveKind
rogue  -- few lights and many solids, to help the less numerous heroes
  { cname :: Text
cname         = Text
"Municipal zoo in flames"  -- non-official adjective
  , cfreq :: Freqs CaveKind
cfreq         = [(GroupName CaveKind
CAVE_ZOO, X
1)]
  , ccellSize :: DiceXY
ccellSize     = Dice -> Dice -> DiceXY
DiceXY (X
1 X -> X -> Dice
`d` X
4 Dice -> Dice -> Dice
forall a. Num a => a -> a -> a
+ Dice
7) Dice
8
  , cminPlaceSize :: DiceXY
cminPlaceSize = Dice -> Dice -> DiceXY
DiceXY Dice
4 Dice
4  -- don't merge
  , cmaxPlaceSize :: DiceXY
cmaxPlaceSize = Dice -> Dice -> DiceXY
DiceXY Dice
14 Dice
7
  , cdarkOdds :: Dice
cdarkOdds     = Dice
0
  , cnightOdds :: Dice
cnightOdds    = Dice
51  -- always night
  , cauxConnects :: Rational
cauxConnects  = Integer
1Integer -> Integer -> Rational
forall a. Integral a => a -> a -> Ratio a
%Integer
4
  , cmaxVoid :: Rational
cmaxVoid      = Integer
1Integer -> Integer -> Rational
forall a. Integral a => a -> a -> Ratio a
%Integer
20
  , cdoorChance :: Rational
cdoorChance   = Integer
7Integer -> Integer -> Rational
forall a. Integral a => a -> a -> Ratio a
%Integer
10
  , copenChance :: Rational
copenChance   = Integer
9Integer -> Integer -> Rational
forall a. Integral a => a -> a -> Ratio a
%Integer
10
  , chidden :: X
chidden       = X
0
  , cactorFreq :: Freqs ItemKind
cactorFreq    = []
  , citemNum :: Dice
citemNum      = X
10 X -> X -> Dice
`d` X
8
  , citemFreq :: Freqs ItemKind
citemFreq     = [ (GroupName ItemKind
IK.COMMON_ITEM, X
100), (GroupName ItemKind
LIGHT_ATTENUATOR, X
1000)
                    , (GroupName ItemKind
STARTING_ARMOR, X
500), (GroupName ItemKind
STARTING_WEAPON, X
1000) ]
  , cplaceFreq :: Freqs PlaceKind
cplaceFreq    = [(GroupName PlaceKind
ZOO, X
1)]
  , cpassable :: Bool
cpassable     = Bool
True
  , cdefTile :: GroupName TileKind
cdefTile      = GroupName TileKind
ZOO_SET_DARK
  , cdarkCorTile :: GroupName TileKind
cdarkCorTile  = GroupName TileKind
SAFE_TRAIL_LIT  -- let trails give off light
  , clitCorTile :: GroupName TileKind
clitCorTile   = GroupName TileKind
SAFE_TRAIL_LIT
  , cwallTile :: GroupName TileKind
cwallTile     = GroupName TileKind
OPENABLE_WALL
  , cmaxStairsNum :: Dice
cmaxStairsNum = Dice
0
  , cstairFreq :: Freqs PlaceKind
cstairFreq    = []
  , cstairAllowed :: Freqs PlaceKind
cstairAllowed = []
  , cdesc :: Text
cdesc         = Text
"Leaping flames illuminate the cages; not all are empty."
  }
ambush :: CaveKind
ambush = CaveKind
rogue  -- a scenario with strong missiles;
                -- dark, so solid obstacles are to hide from missiles,
                -- not view, and they are all lit, because stopped missiles
                -- are frustrating, while a few LOS-only obstacles are not lit;
                -- few small lights to cross, giving a chance to snipe;
                -- crucial difference wrt shootout and hunt is that trajectories
                -- of missiles are usually not seen, so enemy can't be guessed;
                -- camping doesn't pay off, because enemies can sneak and only
                -- active scouting, throwing flares and shooting discovers them
                -- and the level is big enough for all that
  { cname :: Text
cname         = Text
"Ravaged spaceport"  -- non-official adjective
  , cfreq :: Freqs CaveKind
cfreq         = [(GroupName CaveKind
CAVE_AMBUSH, X
1)]
  , ccellSize :: DiceXY
ccellSize     = Dice -> Dice -> DiceXY
DiceXY Dice
11 Dice
6
  , cminPlaceSize :: DiceXY
cminPlaceSize = Dice -> Dice -> DiceXY
DiceXY Dice
9 Dice
10  -- merge vertically
  , cmaxPlaceSize :: DiceXY
cmaxPlaceSize = Dice -> Dice -> DiceXY
DiceXY Dice
40 Dice
30  -- allow hangars and shuttles
  , cdarkOdds :: Dice
cdarkOdds     = Dice
51  -- all dark to spread loot evenly
  , cnightOdds :: Dice
cnightOdds    = Dice
51  -- always night
  , cauxConnects :: Rational
cauxConnects  = Integer
1Integer -> Integer -> Rational
forall a. Integral a => a -> a -> Ratio a
%Integer
10  -- few lit trails, so hard to aim
  , chidden :: X
chidden       = X
0
  , cactorFreq :: Freqs ItemKind
cactorFreq    = []
  , citemNum :: Dice
citemNum      = X
10 X -> X -> Dice
`d` X
10
  , citemFreq :: Freqs ItemKind
citemFreq     = [ (GroupName ItemKind
IK.COMMON_ITEM, X
30), (GroupName ItemKind
MERCENARY_AMMO, X
200)
                    , (GroupName ItemKind
HARPOON, X
300), (GroupName ItemKind
IK.EXPLOSIVE, X
50) ]
  , cplaceFreq :: Freqs PlaceKind
cplaceFreq    = [(GroupName PlaceKind
AMBUSH, X
1)]
  , cpassable :: Bool
cpassable     = Bool
True
  , cdefTile :: GroupName TileKind
cdefTile      = GroupName TileKind
AMBUSH_SET_DARK
  , cdarkCorTile :: GroupName TileKind
cdarkCorTile  = GroupName TileKind
TRAIL_LIT  -- let trails give off light
  , clitCorTile :: GroupName TileKind
clitCorTile   = GroupName TileKind
TRAIL_LIT
  , cwallTile :: GroupName TileKind
cwallTile     = GroupName TileKind
OPENABLE_WALL
  , cmaxStairsNum :: Dice
cmaxStairsNum = Dice
0
  , cstairFreq :: Freqs PlaceKind
cstairFreq    = []
  , cstairAllowed :: Freqs PlaceKind
cstairAllowed = []
  , cdesc :: Text
cdesc         = Text
"Scarred walls and ransacked lockers show the total breakdown of order."  -- seems related to the abandoned farm; perhaps distantly to the existence of the gangs; more closely to the mystery of the lost and found space cruiser and various parties interested in it
  }

-- * Other caves; testing, Easter egg, future work

battle :: CaveKind
battle = CaveKind
rogue  -- few lights and many solids, to help the less numerous heroes
  { cname :: Text
cname         = Text
"Old industrial plant"
  , cfreq :: Freqs CaveKind
cfreq         = [(GroupName CaveKind
CAVE_BATTLE, X
1)]
  , ccellSize :: DiceXY
ccellSize     = Dice -> Dice -> DiceXY
DiceXY (X
5 X -> X -> Dice
`d` X
3 Dice -> Dice -> Dice
forall a. Num a => a -> a -> a
+ Dice
11) Dice
7
  , cminPlaceSize :: DiceXY
cminPlaceSize = Dice -> Dice -> DiceXY
DiceXY Dice
4 Dice
4
  , cmaxPlaceSize :: DiceXY
cmaxPlaceSize = Dice -> Dice -> DiceXY
DiceXY Dice
9 Dice
7
  , cdarkOdds :: Dice
cdarkOdds     = Dice
0
  , cnightOdds :: Dice
cnightOdds    = Dice
51  -- always night
  , cauxConnects :: Rational
cauxConnects  = Integer
1Integer -> Integer -> Rational
forall a. Integral a => a -> a -> Ratio a
%Integer
4
  , cmaxVoid :: Rational
cmaxVoid      = Integer
1Integer -> Integer -> Rational
forall a. Integral a => a -> a -> Ratio a
%Integer
20
  , cdoorChance :: Rational
cdoorChance   = Integer
2Integer -> Integer -> Rational
forall a. Integral a => a -> a -> Ratio a
%Integer
10
  , copenChance :: Rational
copenChance   = Integer
9Integer -> Integer -> Rational
forall a. Integral a => a -> a -> Ratio a
%Integer
10
  , chidden :: X
chidden       = X
0
  , cactorFreq :: Freqs ItemKind
cactorFreq    = []
  , citemNum :: Dice
citemNum      = X
6 X -> X -> Dice
`d` X
8
  , citemFreq :: Freqs ItemKind
citemFreq     = [(GroupName ItemKind
IK.COMMON_ITEM, X
100), (GroupName ItemKind
LIGHT_ATTENUATOR, X
200)]
  , cplaceFreq :: Freqs PlaceKind
cplaceFreq    = [(GroupName PlaceKind
BATTLE, X
50), (GroupName PlaceKind
ROGUE, X
50)]
  , cpassable :: Bool
cpassable     = Bool
True
  , cdefTile :: GroupName TileKind
cdefTile      = GroupName TileKind
BATTLE_SET_DARK
  , cdarkCorTile :: GroupName TileKind
cdarkCorTile  = GroupName TileKind
SAFE_TRAIL_LIT  -- let trails give off light
  , clitCorTile :: GroupName TileKind
clitCorTile   = GroupName TileKind
SAFE_TRAIL_LIT
  , cwallTile :: GroupName TileKind
cwallTile     = GroupName TileKind
OPENABLE_WALL
  , cfenceApart :: Bool
cfenceApart   = Bool
True  -- ensures no cut-off parts from collapsed
  , cmaxStairsNum :: Dice
cmaxStairsNum = Dice
0
  , cstairFreq :: Freqs PlaceKind
cstairFreq    = []
  , cstairAllowed :: Freqs PlaceKind
cstairAllowed = []
  , cdesc :: Text
cdesc         = Text
"Huge machines stand silent and powerless in the dark."
  }
safari1 :: CaveKind
safari1 = CaveKind
brawl
  { cname :: Text
cname         = Text
"Hunam habitat"
  , cfreq :: Freqs CaveKind
cfreq         = [(GroupName CaveKind
CAVE_SAFARI_1, X
1)]
  , cminPlaceSize :: DiceXY
cminPlaceSize = Dice -> Dice -> DiceXY
DiceXY Dice
5 Dice
3
  , cstairFreq :: Freqs PlaceKind
cstairFreq    = [ (GroupName PlaceKind
OUTDOOR_WALLED_STAIRCASE, X
20)
                    , (GroupName PlaceKind
OUTDOOR_CLOSED_STAIRCASE, X
80)
                    , (GroupName PlaceKind
OUTDOOR_TINY_STAIRCASE, X
1) ]
  , cskip :: [X]
cskip         = [X
0]
  , cdesc :: Text
cdesc         = Text
"\"DLC 1. Hunams scavenge in a forest in their usual disgusting way.\""
  }
safari2 :: CaveKind
safari2 = CaveKind
flight  -- lamps instead of trees, but ok, it's only a simulation
  { cname :: Text
cname         = Text
"Deep into the jungle"
  , cfreq :: Freqs CaveKind
cfreq         = [(GroupName CaveKind
CAVE_SAFARI_2, X
1)]
  , cmaxStairsNum :: Dice
cmaxStairsNum = Dice
1
  , cescapeFreq :: Freqs PlaceKind
cescapeFreq   = []
  , cstairFreq :: Freqs PlaceKind
cstairFreq    = [ (GroupName PlaceKind
OUTDOOR_WALLED_STAIRCASE, X
20)
                    , (GroupName PlaceKind
OUTDOOR_CLOSED_STAIRCASE, X
80)
                    , (GroupName PlaceKind
OUTDOOR_TINY_STAIRCASE, X
1) ]
  , cskip :: [X]
cskip         = [X
0]
  , cdesc :: Text
cdesc         = Text
"\"DLC 2. In the dark pure heart of the jungle noble animals roam freely.\""
  }
safari3 :: CaveKind
safari3 = CaveKind
zoo  -- glass rooms, but ok, it's only a simulation
  { cname :: Text
cname         = Text
"Jungle in flames"
  , cfreq :: Freqs CaveKind
cfreq         = [(GroupName CaveKind
CAVE_SAFARI_3, X
1)]
  , cminPlaceSize :: DiceXY
cminPlaceSize = Dice -> Dice -> DiceXY
DiceXY Dice
5 Dice
4
  , cescapeFreq :: Freqs PlaceKind
cescapeFreq   = [(GroupName PlaceKind
OUTDOOR_ESCAPE_DOWN, X
1)]
  , cmaxStairsNum :: Dice
cmaxStairsNum = Dice
1
  , cstairFreq :: Freqs PlaceKind
cstairFreq    = [ (GroupName PlaceKind
OUTDOOR_WALLED_STAIRCASE, X
20)
                    , (GroupName PlaceKind
OUTDOOR_CLOSED_STAIRCASE, X
80)
                    , (GroupName PlaceKind
OUTDOOR_TINY_STAIRCASE, X
1) ]
  , cdesc :: Text
cdesc         = Text
"\"DLC 3. Jealous hunams set jungle on fire and flee.\""
  }