-- 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 tile kinds. Every terrain tile in the game is
-- an instantiated tile kind.
module Content.TileKind
  ( -- * Group name patterns
    -- ** Used in CaveKind and perhaps elsewhere.
    pattern FILLER_WALL, pattern FLOOR_CORRIDOR_LIT, pattern FLOOR_CORRIDOR_DARK, pattern TRAIL_LIT, pattern SAFE_TRAIL_LIT, pattern LAB_TRAIL_LIT, pattern DAMP_FLOOR_LIT, pattern DAMP_FLOOR_DARK, pattern DIRT_LIT, pattern DIRT_DARK, pattern FLOOR_ARENA_LIT, pattern FLOOR_ARENA_DARK
  , pattern HABITAT_CONTAINMENT_WALL, pattern TRANSPORT_ROUTE, pattern ORIELS_FENCE, pattern AIRLOCK_FENCE, pattern EMPTY_AIRLOCK_FENCE, pattern OPENABLE_WALL, pattern TRAPPABLE_WALL, pattern OILY_FLOOR_LIT, pattern OILY_FLOOR_DARK
  , pattern EMPTY_SET_LIT, pattern EMPTY_SET_DARK, pattern NOISE_SET_LIT, pattern POWER_SET_LIT, pattern POWER_SET_DARK, pattern BATTLE_SET_LIT, pattern BATTLE_SET_DARK, pattern BRAWL_SET_LIT, pattern SHOOTOUT_SET_LIT, pattern ZOO_SET_LIT, pattern ZOO_SET_DARK, pattern FLIGHT_SET_LIT, pattern FLIGHT_SET_DARK, pattern AMBUSH_SET_LIT, pattern AMBUSH_SET_DARK, pattern ARENA_SET_LIT, pattern ARENA_SET_DARK
  , pattern ROGUE_SET, pattern MUSEUM_SET_LIT, pattern MUSEUM_SET_DARK, pattern HUNT_SET_LIT, pattern EGRESS_SET_LIT, pattern VIRUS_SET_LIT, pattern VIRUS_SET_DARK
    -- ** Used in PlaceKind, but not in CaveKind.
  , pattern TREE_SHADE_WALKABLE_LIT, pattern TREE_SHADE_WALKABLE_DARK, pattern SMOKE_CLUMP_LIT, pattern SMOKE_CLUMP_DARK, pattern BUSH_CLUMP_LIT, pattern BUSH_CLUMP_DARK, pattern FOG_CLUMP_LIT, pattern FOG_CLUMP_DARK, pattern STAIR_TERMINAL_LIT, pattern STAIR_TERMINAL_DARK, pattern SIGNBOARD, pattern STAIRCASE_UP, pattern ORDINARY_STAIRCASE_UP, pattern STAIRCASE_OUTDOOR_UP, pattern GATED_STAIRCASE_UP, pattern STAIRCASE_DOWN, pattern ORDINARY_STAIRCASE_DOWN, pattern STAIRCASE_OUTDOOR_DOWN, pattern GATED_STAIRCASE_DOWN, pattern TILE_INDOOR_ESCAPE_UP, pattern TILE_INDOOR_ESCAPE_DOWN, pattern TILE_OUTDOOR_ESCAPE_DOWN, pattern TRANSPARENT_WALL, pattern ICE_BUILDUP, pattern WORKSHOP, pattern FLOOR_ACTOR_ITEM, pattern FLOOR_ACTOR_ITEM_LIT, pattern FLOOR_ACTOR_ITEM_DARK
  , pattern S_PILLAR, pattern S_RUBBLE_PILE, pattern S_LAMP_POST, pattern S_TREE_LIT, pattern S_TREE_DARK, pattern S_PULPIT, pattern S_BUSH_LIT, pattern S_FOG_LIT, pattern S_SMOKE_LIT, pattern S_FLOOR_ACTOR_LIT, pattern S_FLOOR_ACTOR_DARK, pattern S_FLOOR_ASHES_LIT, pattern S_FLOOR_ASHES_DARK, pattern S_SHADED_GROUND, pattern S_SHALLOW_WATER_LIT, pattern S_SHALLOW_WATER_DARK
  , pattern BUSH_GROVE_LIT, pattern BUSH_GROVE_DARK, pattern UNDERBRUSH_CLUMP_LIT, pattern UNDERBRUSH_CLUMP_DARK, pattern ASHES_SMOKE_LIT, pattern ASHES_SMOKE_DARK, pattern RECT_WINDOWS, pattern DOORLESS_MACHINERY, pattern PUMPS_LIT, pattern PUMPS_DARK, pattern DOORLESS_WALL, pattern OIL_RESIDUE_LIT, pattern OIL_RESIDUE_DARK, pattern LIFT_TERMINAL_LIT, pattern LIFT_TERMINAL_DARK, pattern STAIRCASE_LIFT_UP, pattern STAIRCASE_LIFT_DOWN, pattern GATED_LIFT_UP, pattern GATED_LIFT_DOWN, pattern DECON_STAIRCASE_UP, pattern DECON_STAIRCASE_DOWN, pattern DECON_LIFT_UP, pattern DECON_LIFT_DOWN, pattern WELDED_STAIRCASE_UP, pattern WELDED_LIFT_UP, pattern TILE_ALARM_ESCAPE_UP, pattern TILE_SPACESHIP_ESCAPE_DOWN, pattern ORDINARY_LIFT_UP, pattern ORDINARY_LIFT_DOWN, pattern RUBBLE_OR_WASTE_LIT, pattern RUBBLE_OR_WASTE_DARK, pattern CACHE_DEPOSIT, pattern CACHE_JEWELRY, pattern CACHE_MAZE, pattern CACHE_SHUTTLE, pattern TRAPPED_DOOR, pattern STUCK_DOOR, pattern BARREL
  , pattern S_POOL_LIT, pattern S_POOL_DARK, pattern S_CLOSED_DOOR, pattern S_OPEN_DOOR, pattern S_OIL_SPILL, pattern S_FROZEN_PATH, pattern S_LIFT_SHAFT, pattern S_REINFORCED_WALL, pattern S_SHUTTLE_HULL, pattern S_HARDWARE_RACK, pattern S_STAIRCASE_TRAP_DOWN_OIL, pattern S_UNDERBRUSH_LIT, pattern S_UNDERBRUSH_DARK
  , groupNamesSingleton, groupNames
    -- * Content
  , content
  ) where

import Prelude ()

import Game.LambdaHack.Core.Prelude

import qualified Data.Text as T

import Game.LambdaHack.Content.TileKind
import Game.LambdaHack.Definition.Color
import Game.LambdaHack.Definition.Defs
import Game.LambdaHack.Definition.DefsInternal

import Content.ItemKindActor
import Content.ItemKindBlast
import Content.ItemKindEmbed
import Content.ItemKindOrgan

-- * Group name patterns

-- Warning, many of these are also sythesized, so typos can happen.

groupNamesSingleton :: [GroupName TileKind]
groupNamesSingleton :: [GroupName TileKind]
groupNamesSingleton =
       [GroupName TileKind
S_PILLAR, GroupName TileKind
S_RUBBLE_PILE, GroupName TileKind
S_LAMP_POST, GroupName TileKind
S_TREE_LIT, GroupName TileKind
S_TREE_DARK, GroupName TileKind
S_PULPIT, GroupName TileKind
S_BUSH_LIT, GroupName TileKind
S_FOG_LIT, GroupName TileKind
S_SMOKE_LIT, GroupName TileKind
S_FLOOR_ACTOR_LIT, GroupName TileKind
S_FLOOR_ACTOR_DARK, GroupName TileKind
S_FLOOR_ASHES_LIT, GroupName TileKind
S_FLOOR_ASHES_DARK, GroupName TileKind
S_SHADED_GROUND, GroupName TileKind
S_SHALLOW_WATER_LIT, GroupName TileKind
S_SHALLOW_WATER_DARK]
    [GroupName TileKind]
-> [GroupName TileKind] -> [GroupName TileKind]
forall a. [a] -> [a] -> [a]
++ [GroupName TileKind
S_POOL_LIT, GroupName TileKind
S_POOL_DARK, GroupName TileKind
S_CLOSED_DOOR, GroupName TileKind
S_OPEN_DOOR, GroupName TileKind
S_OIL_SPILL, GroupName TileKind
S_FROZEN_PATH, GroupName TileKind
S_LIFT_SHAFT, GroupName TileKind
S_REINFORCED_WALL, GroupName TileKind
S_SHUTTLE_HULL, GroupName TileKind
S_HARDWARE_RACK]
    [GroupName TileKind]
-> [GroupName TileKind] -> [GroupName TileKind]
forall a. [a] -> [a] -> [a]
++ [ GroupName TileKind
S_SIGNBOARD_UNREAD]
    [GroupName TileKind]
-> [GroupName TileKind] -> [GroupName TileKind]
forall a. [a] -> [a] -> [a]
++ [GroupName TileKind
S_SUSPECT_WALL, GroupName TileKind
S_STAIRCASE_TRAP_DOWN_OIL, GroupName TileKind
S_BURNING_INSTALLATION, GroupName TileKind
S_BURNING_TREE, GroupName TileKind
S_BURNING_BUSH, GroupName TileKind
S_BURNING_UNDERBRUSH, GroupName TileKind
S_BURNING_OIL, GroupName TileKind
S_UNDERBRUSH_LIT, GroupName TileKind
S_UNDERBRUSH_DARK]
    [GroupName TileKind]
-> [GroupName TileKind] -> [GroupName TileKind]
forall a. [a] -> [a] -> [a]
++ [GroupName TileKind
S_BUSH_DARK]

-- ** Used in PlaceKind, but not in CaveKind.
pattern S_PILLAR, S_RUBBLE_PILE, S_LAMP_POST, S_TREE_LIT, S_TREE_DARK, S_PULPIT, S_BUSH_LIT, S_FOG_LIT, S_SMOKE_LIT, S_FLOOR_ACTOR_LIT, S_FLOOR_ACTOR_DARK, S_FLOOR_ASHES_LIT, S_FLOOR_ASHES_DARK, S_SHADED_GROUND, S_SHALLOW_WATER_LIT, S_SHALLOW_WATER_DARK :: GroupName TileKind

-- ** Allure-specific
pattern S_POOL_LIT, S_POOL_DARK, S_CLOSED_DOOR, S_OPEN_DOOR, S_OIL_SPILL, S_FROZEN_PATH, S_LIFT_SHAFT, S_REINFORCED_WALL, S_SHUTTLE_HULL, S_HARDWARE_RACK :: GroupName TileKind

-- ** Used only internally in other TileKind definitions or never used.
pattern S_SIGNBOARD_UNREAD :: GroupName TileKind

-- ** Allure-specific
pattern S_SUSPECT_WALL, S_STAIRCASE_TRAP_DOWN_OIL, S_BURNING_INSTALLATION, S_BURNING_TREE, S_BURNING_BUSH, S_BURNING_UNDERBRUSH, S_BURNING_OIL, S_UNDERBRUSH_LIT, S_UNDERBRUSH_DARK :: GroupName TileKind

-- * Not used, but needed, because auto-generated. Singletons.
pattern S_BUSH_DARK :: GroupName TileKind

-- 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 TileKind]
groupNames :: [GroupName TileKind]
groupNames =
       [GroupName TileKind
AQUATIC]
    [GroupName TileKind]
-> [GroupName TileKind] -> [GroupName TileKind]
forall a. [a] -> [a] -> [a]
++ [GroupName TileKind
FILLER_WALL, GroupName TileKind
FLOOR_CORRIDOR_LIT, GroupName TileKind
FLOOR_CORRIDOR_DARK, GroupName TileKind
TRAIL_LIT, GroupName TileKind
SAFE_TRAIL_LIT, GroupName TileKind
LAB_TRAIL_LIT, GroupName TileKind
DAMP_FLOOR_LIT, GroupName TileKind
DAMP_FLOOR_DARK, GroupName TileKind
DIRT_LIT, GroupName TileKind
DIRT_DARK, GroupName TileKind
FLOOR_ARENA_LIT, GroupName TileKind
FLOOR_ARENA_DARK]
    [GroupName TileKind]
-> [GroupName TileKind] -> [GroupName TileKind]
forall a. [a] -> [a] -> [a]
++ [GroupName TileKind
HABITAT_CONTAINMENT_WALL, GroupName TileKind
TRANSPORT_ROUTE, GroupName TileKind
ORIELS_FENCE, GroupName TileKind
AIRLOCK_FENCE, GroupName TileKind
EMPTY_AIRLOCK_FENCE, GroupName TileKind
OPENABLE_WALL, GroupName TileKind
TRAPPABLE_WALL, GroupName TileKind
OILY_FLOOR_LIT, GroupName TileKind
OILY_FLOOR_DARK]
    [GroupName TileKind]
-> [GroupName TileKind] -> [GroupName TileKind]
forall a. [a] -> [a] -> [a]
++ [GroupName TileKind
EMPTY_SET_LIT, GroupName TileKind
EMPTY_SET_DARK, GroupName TileKind
NOISE_SET_LIT, GroupName TileKind
POWER_SET_LIT, GroupName TileKind
POWER_SET_DARK, GroupName TileKind
BATTLE_SET_LIT, GroupName TileKind
BATTLE_SET_DARK, GroupName TileKind
BRAWL_SET_LIT, GroupName TileKind
SHOOTOUT_SET_LIT, GroupName TileKind
ZOO_SET_LIT, GroupName TileKind
ZOO_SET_DARK, GroupName TileKind
FLIGHT_SET_LIT, GroupName TileKind
FLIGHT_SET_DARK, GroupName TileKind
AMBUSH_SET_LIT, GroupName TileKind
AMBUSH_SET_DARK, GroupName TileKind
ARENA_SET_LIT, GroupName TileKind
ARENA_SET_DARK]
    [GroupName TileKind]
-> [GroupName TileKind] -> [GroupName TileKind]
forall a. [a] -> [a] -> [a]
++ [GroupName TileKind
ROGUE_SET, GroupName TileKind
MUSEUM_SET_LIT, GroupName TileKind
MUSEUM_SET_DARK, GroupName TileKind
HUNT_SET_LIT, GroupName TileKind
EGRESS_SET_LIT, GroupName TileKind
VIRUS_SET_LIT, GroupName TileKind
VIRUS_SET_DARK]
    [GroupName TileKind]
-> [GroupName TileKind] -> [GroupName TileKind]
forall a. [a] -> [a] -> [a]
++ [GroupName TileKind
TREE_SHADE_WALKABLE_LIT, GroupName TileKind
TREE_SHADE_WALKABLE_DARK, GroupName TileKind
SMOKE_CLUMP_LIT, GroupName TileKind
SMOKE_CLUMP_DARK, GroupName TileKind
BUSH_CLUMP_LIT, GroupName TileKind
BUSH_CLUMP_DARK, GroupName TileKind
FOG_CLUMP_LIT, GroupName TileKind
FOG_CLUMP_DARK, GroupName TileKind
STAIR_TERMINAL_LIT, GroupName TileKind
STAIR_TERMINAL_DARK, GroupName TileKind
SIGNBOARD, GroupName TileKind
STAIRCASE_UP, GroupName TileKind
ORDINARY_STAIRCASE_UP, GroupName TileKind
STAIRCASE_OUTDOOR_UP, GroupName TileKind
GATED_STAIRCASE_UP, GroupName TileKind
STAIRCASE_DOWN, GroupName TileKind
ORDINARY_STAIRCASE_DOWN, GroupName TileKind
STAIRCASE_OUTDOOR_DOWN, GroupName TileKind
GATED_STAIRCASE_DOWN, GroupName TileKind
TILE_INDOOR_ESCAPE_UP, GroupName TileKind
TILE_INDOOR_ESCAPE_DOWN, GroupName TileKind
TILE_OUTDOOR_ESCAPE_DOWN, GroupName TileKind
TRANSPARENT_WALL, GroupName TileKind
ICE_BUILDUP, GroupName TileKind
WORKSHOP, GroupName TileKind
FLOOR_ACTOR_ITEM, GroupName TileKind
FLOOR_ACTOR_ITEM_LIT, GroupName TileKind
FLOOR_ACTOR_ITEM_DARK]
    [GroupName TileKind]
-> [GroupName TileKind] -> [GroupName TileKind]
forall a. [a] -> [a] -> [a]
++ [GroupName TileKind
BUSH_GROVE_LIT, GroupName TileKind
BUSH_GROVE_DARK, GroupName TileKind
UNDERBRUSH_CLUMP_LIT, GroupName TileKind
UNDERBRUSH_CLUMP_DARK, GroupName TileKind
ASHES_SMOKE_LIT, GroupName TileKind
ASHES_SMOKE_DARK, GroupName TileKind
RECT_WINDOWS, GroupName TileKind
DOORLESS_MACHINERY, GroupName TileKind
PUMPS_LIT, GroupName TileKind
PUMPS_DARK, GroupName TileKind
DOORLESS_WALL, GroupName TileKind
OIL_RESIDUE_LIT, GroupName TileKind
OIL_RESIDUE_DARK, GroupName TileKind
LIFT_TERMINAL_LIT, GroupName TileKind
LIFT_TERMINAL_DARK, GroupName TileKind
STAIRCASE_LIFT_UP, GroupName TileKind
STAIRCASE_LIFT_DOWN, GroupName TileKind
GATED_LIFT_UP, GroupName TileKind
GATED_LIFT_DOWN, GroupName TileKind
DECON_STAIRCASE_UP, GroupName TileKind
DECON_STAIRCASE_DOWN, GroupName TileKind
DECON_LIFT_UP, GroupName TileKind
DECON_LIFT_DOWN, GroupName TileKind
WELDED_STAIRCASE_UP, GroupName TileKind
WELDED_LIFT_UP, GroupName TileKind
TILE_ALARM_ESCAPE_UP, GroupName TileKind
TILE_SPACESHIP_ESCAPE_DOWN, GroupName TileKind
ORDINARY_LIFT_UP, GroupName TileKind
ORDINARY_LIFT_DOWN, GroupName TileKind
RUBBLE_OR_WASTE_LIT, GroupName TileKind
RUBBLE_OR_WASTE_DARK, GroupName TileKind
CACHE_DEPOSIT, GroupName TileKind
CACHE_JEWELRY, GroupName TileKind
CACHE_MAZE, GroupName TileKind
CACHE_SHUTTLE, GroupName TileKind
TRAPPED_DOOR, GroupName TileKind
STUCK_DOOR, GroupName TileKind
BARREL]
    [GroupName TileKind]
-> [GroupName TileKind] -> [GroupName TileKind]
forall a. [a] -> [a] -> [a]
++ [GroupName TileKind
TREE_BURNING_OR_NOT, GroupName TileKind
BUSH_BURNING_OR_NOT]
    [GroupName TileKind]
-> [GroupName TileKind] -> [GroupName TileKind]
forall a. [a] -> [a] -> [a]
++ [GroupName TileKind
OBSCURED_WALL, GroupName TileKind
CACHE_DEPOSIT_OR_NOT, GroupName TileKind
CACHE_DEPOSIT_BREACHED, GroupName TileKind
CACHE_JEWELRY_OR_NOT, GroupName TileKind
CACHE_JEWELRY_TRAPPED_OR_NOT, GroupName TileKind
CACHE_ABANDONED_OR_NOT, GroupName TileKind
RUBBLE_BURNING_OR_NOT]
    [GroupName TileKind]
-> [GroupName TileKind] -> [GroupName TileKind]
forall a. [a] -> [a] -> [a]
++ [GroupName TileKind
BRAWL_SET_DARK, GroupName TileKind
NOISE_SET_DARK, GroupName TileKind
SHOOTOUT_SET_DARK, GroupName TileKind
EGRESS_SET_DARK, GroupName TileKind
HUNT_SET_DARK]

pattern FILLER_WALL, FLOOR_CORRIDOR_LIT, FLOOR_CORRIDOR_DARK, TRAIL_LIT, SAFE_TRAIL_LIT, LAB_TRAIL_LIT, DAMP_FLOOR_LIT, DAMP_FLOOR_DARK, DIRT_LIT, DIRT_DARK, FLOOR_ARENA_LIT, FLOOR_ARENA_DARK :: GroupName TileKind

-- ** Allure-specific
pattern HABITAT_CONTAINMENT_WALL, TRANSPORT_ROUTE, ORIELS_FENCE, AIRLOCK_FENCE, EMPTY_AIRLOCK_FENCE, OPENABLE_WALL, TRAPPABLE_WALL, OILY_FLOOR_LIT, OILY_FLOOR_DARK :: GroupName TileKind

pattern EMPTY_SET_LIT, EMPTY_SET_DARK, NOISE_SET_LIT, POWER_SET_LIT, POWER_SET_DARK, BATTLE_SET_LIT, BATTLE_SET_DARK, BRAWL_SET_LIT, SHOOTOUT_SET_LIT, ZOO_SET_LIT, ZOO_SET_DARK, FLIGHT_SET_LIT, FLIGHT_SET_DARK, AMBUSH_SET_LIT, AMBUSH_SET_DARK, ARENA_SET_LIT, ARENA_SET_DARK :: GroupName TileKind

-- ** Allure-specific
pattern ROGUE_SET, MUSEUM_SET_LIT, MUSEUM_SET_DARK, HUNT_SET_LIT, EGRESS_SET_LIT, VIRUS_SET_LIT, VIRUS_SET_DARK :: GroupName TileKind

-- ** Used in PlaceKind, but not in CaveKind.
pattern TREE_SHADE_WALKABLE_LIT, TREE_SHADE_WALKABLE_DARK, SMOKE_CLUMP_LIT, SMOKE_CLUMP_DARK, BUSH_CLUMP_LIT, BUSH_CLUMP_DARK, FOG_CLUMP_LIT, FOG_CLUMP_DARK, STAIR_TERMINAL_LIT, STAIR_TERMINAL_DARK, SIGNBOARD, STAIRCASE_UP, ORDINARY_STAIRCASE_UP, STAIRCASE_OUTDOOR_UP, GATED_STAIRCASE_UP, STAIRCASE_DOWN, ORDINARY_STAIRCASE_DOWN, STAIRCASE_OUTDOOR_DOWN, GATED_STAIRCASE_DOWN, TILE_INDOOR_ESCAPE_UP, TILE_INDOOR_ESCAPE_DOWN, TILE_OUTDOOR_ESCAPE_DOWN, TRANSPARENT_WALL, ICE_BUILDUP, WORKSHOP, FLOOR_ACTOR_ITEM, FLOOR_ACTOR_ITEM_LIT, FLOOR_ACTOR_ITEM_DARK :: GroupName TileKind

-- ** Allure-specific
pattern BUSH_GROVE_LIT, BUSH_GROVE_DARK, UNDERBRUSH_CLUMP_LIT, UNDERBRUSH_CLUMP_DARK, ASHES_SMOKE_LIT, ASHES_SMOKE_DARK, RECT_WINDOWS, DOORLESS_MACHINERY, PUMPS_LIT, PUMPS_DARK, DOORLESS_WALL, OIL_RESIDUE_LIT, OIL_RESIDUE_DARK, LIFT_TERMINAL_LIT, LIFT_TERMINAL_DARK, STAIRCASE_LIFT_UP, STAIRCASE_LIFT_DOWN, GATED_LIFT_UP, GATED_LIFT_DOWN, DECON_STAIRCASE_UP, DECON_STAIRCASE_DOWN, DECON_LIFT_UP, DECON_LIFT_DOWN, WELDED_STAIRCASE_UP, WELDED_LIFT_UP, TILE_ALARM_ESCAPE_UP, TILE_SPACESHIP_ESCAPE_DOWN, ORDINARY_LIFT_UP, ORDINARY_LIFT_DOWN, RUBBLE_OR_WASTE_LIT, RUBBLE_OR_WASTE_DARK, CACHE_DEPOSIT, CACHE_JEWELRY, CACHE_MAZE, CACHE_SHUTTLE, TRAPPED_DOOR, STUCK_DOOR, BARREL :: GroupName TileKind

-- ** Used only internally in other TileKind definitions or never used.
pattern TREE_BURNING_OR_NOT, BUSH_BURNING_OR_NOT :: GroupName TileKind

-- ** Allure-specific
pattern OBSCURED_WALL, CACHE_DEPOSIT_OR_NOT, CACHE_DEPOSIT_BREACHED, CACHE_JEWELRY_OR_NOT, CACHE_JEWELRY_TRAPPED_OR_NOT, CACHE_ABANDONED_OR_NOT, RUBBLE_BURNING_OR_NOT :: GroupName TileKind

-- * Not used, but needed, because auto-generated. Not singletons.
pattern BRAWL_SET_DARK, NOISE_SET_DARK, SHOOTOUT_SET_DARK, EGRESS_SET_DARK, HUNT_SET_DARK :: GroupName TileKind

-- ** Used in CaveKind and perhaps elsewhere (or a dark/lit version thereof).
pattern $bFILLER_WALL :: GroupName TileKind
$mFILLER_WALL :: forall r. GroupName TileKind -> (Void# -> r) -> (Void# -> r) -> r
FILLER_WALL = GroupName "fillerWall"
pattern $bFLOOR_CORRIDOR_LIT :: GroupName TileKind
$mFLOOR_CORRIDOR_LIT :: forall r. GroupName TileKind -> (Void# -> r) -> (Void# -> r) -> r
FLOOR_CORRIDOR_LIT = GroupName "floorCorridorLit"
pattern $bFLOOR_CORRIDOR_DARK :: GroupName TileKind
$mFLOOR_CORRIDOR_DARK :: forall r. GroupName TileKind -> (Void# -> r) -> (Void# -> r) -> r
FLOOR_CORRIDOR_DARK = GroupName "floorCorridorDark"
pattern $bTRAIL_LIT :: GroupName TileKind
$mTRAIL_LIT :: forall r. GroupName TileKind -> (Void# -> r) -> (Void# -> r) -> r
TRAIL_LIT = GroupName "trailLit"
pattern $bSAFE_TRAIL_LIT :: GroupName TileKind
$mSAFE_TRAIL_LIT :: forall r. GroupName TileKind -> (Void# -> r) -> (Void# -> r) -> r
SAFE_TRAIL_LIT = GroupName "safeTrailLit"
pattern $bLAB_TRAIL_LIT :: GroupName TileKind
$mLAB_TRAIL_LIT :: forall r. GroupName TileKind -> (Void# -> r) -> (Void# -> r) -> r
LAB_TRAIL_LIT = GroupName "labTrailLit"
  -- these three would work without @_LIT@, but it will be needed when
  -- in the future a lit trail is made from terrain that has an autogenerated
  -- dark variant
pattern $bDAMP_FLOOR_LIT :: GroupName TileKind
$mDAMP_FLOOR_LIT :: forall r. GroupName TileKind -> (Void# -> r) -> (Void# -> r) -> r
DAMP_FLOOR_LIT = GroupName "damp floor Lit"
pattern $bDAMP_FLOOR_DARK :: GroupName TileKind
$mDAMP_FLOOR_DARK :: forall r. GroupName TileKind -> (Void# -> r) -> (Void# -> r) -> r
DAMP_FLOOR_DARK = GroupName "damp floor Dark"
pattern $bDIRT_LIT :: GroupName TileKind
$mDIRT_LIT :: forall r. GroupName TileKind -> (Void# -> r) -> (Void# -> r) -> r
DIRT_LIT = GroupName "dirt Lit"
pattern $bDIRT_DARK :: GroupName TileKind
$mDIRT_DARK :: forall r. GroupName TileKind -> (Void# -> r) -> (Void# -> r) -> r
DIRT_DARK = GroupName "dirt Dark"
pattern $bFLOOR_ARENA_LIT :: GroupName TileKind
$mFLOOR_ARENA_LIT :: forall r. GroupName TileKind -> (Void# -> r) -> (Void# -> r) -> r
FLOOR_ARENA_LIT = GroupName "floorArenaLit"
pattern $bFLOOR_ARENA_DARK :: GroupName TileKind
$mFLOOR_ARENA_DARK :: forall r. GroupName TileKind -> (Void# -> r) -> (Void# -> r) -> r
FLOOR_ARENA_DARK = GroupName "floorArenaDark"

-- ** Allure-specific
pattern $bHABITAT_CONTAINMENT_WALL :: GroupName TileKind
$mHABITAT_CONTAINMENT_WALL :: forall r. GroupName TileKind -> (Void# -> r) -> (Void# -> r) -> r
HABITAT_CONTAINMENT_WALL = GroupName "habitat containment wall"
pattern $bTRANSPORT_ROUTE :: GroupName TileKind
$mTRANSPORT_ROUTE :: forall r. GroupName TileKind -> (Void# -> r) -> (Void# -> r) -> r
TRANSPORT_ROUTE = GroupName "transport route"
pattern $bORIELS_FENCE :: GroupName TileKind
$mORIELS_FENCE :: forall r. GroupName TileKind -> (Void# -> r) -> (Void# -> r) -> r
ORIELS_FENCE = GroupName "oriels fence"
pattern $bAIRLOCK_FENCE :: GroupName TileKind
$mAIRLOCK_FENCE :: forall r. GroupName TileKind -> (Void# -> r) -> (Void# -> r) -> r
AIRLOCK_FENCE = GroupName "airlock fence"
pattern $bEMPTY_AIRLOCK_FENCE :: GroupName TileKind
$mEMPTY_AIRLOCK_FENCE :: forall r. GroupName TileKind -> (Void# -> r) -> (Void# -> r) -> r
EMPTY_AIRLOCK_FENCE = GroupName "empty airlock fence"
pattern $bOPENABLE_WALL :: GroupName TileKind
$mOPENABLE_WALL :: forall r. GroupName TileKind -> (Void# -> r) -> (Void# -> r) -> r
OPENABLE_WALL = GroupName "openableWall"
pattern $bTRAPPABLE_WALL :: GroupName TileKind
$mTRAPPABLE_WALL :: forall r. GroupName TileKind -> (Void# -> r) -> (Void# -> r) -> r
TRAPPABLE_WALL = GroupName "trappableWall"
pattern $bOILY_FLOOR_LIT :: GroupName TileKind
$mOILY_FLOOR_LIT :: forall r. GroupName TileKind -> (Void# -> r) -> (Void# -> r) -> r
OILY_FLOOR_LIT = GroupName "oily floor Lit"
pattern $bOILY_FLOOR_DARK :: GroupName TileKind
$mOILY_FLOOR_DARK :: forall r. GroupName TileKind -> (Void# -> r) -> (Void# -> r) -> r
OILY_FLOOR_DARK = GroupName "oily floor Dark"

-- ** Used in CaveKind and perhaps elsewhere; sets of tiles for filling cave.
pattern $bEMPTY_SET_LIT :: GroupName TileKind
$mEMPTY_SET_LIT :: forall r. GroupName TileKind -> (Void# -> r) -> (Void# -> r) -> r
EMPTY_SET_LIT = GroupName "emptySetLit"
pattern $bEMPTY_SET_DARK :: GroupName TileKind
$mEMPTY_SET_DARK :: forall r. GroupName TileKind -> (Void# -> r) -> (Void# -> r) -> r
EMPTY_SET_DARK = GroupName "emptySetDark"
pattern $bNOISE_SET_LIT :: GroupName TileKind
$mNOISE_SET_LIT :: forall r. GroupName TileKind -> (Void# -> r) -> (Void# -> r) -> r
NOISE_SET_LIT = GroupName "noiseSetLit"
pattern $bPOWER_SET_LIT :: GroupName TileKind
$mPOWER_SET_LIT :: forall r. GroupName TileKind -> (Void# -> r) -> (Void# -> r) -> r
POWER_SET_LIT = GroupName "powerSetLit"
pattern $bPOWER_SET_DARK :: GroupName TileKind
$mPOWER_SET_DARK :: forall r. GroupName TileKind -> (Void# -> r) -> (Void# -> r) -> r
POWER_SET_DARK = GroupName "powerSetDark"
pattern $bBATTLE_SET_LIT :: GroupName TileKind
$mBATTLE_SET_LIT :: forall r. GroupName TileKind -> (Void# -> r) -> (Void# -> r) -> r
BATTLE_SET_LIT = GroupName "battleSetLit"
pattern $bBATTLE_SET_DARK :: GroupName TileKind
$mBATTLE_SET_DARK :: forall r. GroupName TileKind -> (Void# -> r) -> (Void# -> r) -> r
BATTLE_SET_DARK = GroupName "battleSetDark"
pattern $bBRAWL_SET_LIT :: GroupName TileKind
$mBRAWL_SET_LIT :: forall r. GroupName TileKind -> (Void# -> r) -> (Void# -> r) -> r
BRAWL_SET_LIT = GroupName "brawlSetLit"
pattern $bSHOOTOUT_SET_LIT :: GroupName TileKind
$mSHOOTOUT_SET_LIT :: forall r. GroupName TileKind -> (Void# -> r) -> (Void# -> r) -> r
SHOOTOUT_SET_LIT = GroupName "shootoutSetLit"
pattern $bZOO_SET_LIT :: GroupName TileKind
$mZOO_SET_LIT :: forall r. GroupName TileKind -> (Void# -> r) -> (Void# -> r) -> r
ZOO_SET_LIT = GroupName "zooSetLit"
pattern $bZOO_SET_DARK :: GroupName TileKind
$mZOO_SET_DARK :: forall r. GroupName TileKind -> (Void# -> r) -> (Void# -> r) -> r
ZOO_SET_DARK = GroupName "zooSetDark"
pattern $bFLIGHT_SET_LIT :: GroupName TileKind
$mFLIGHT_SET_LIT :: forall r. GroupName TileKind -> (Void# -> r) -> (Void# -> r) -> r
FLIGHT_SET_LIT = GroupName "flightSetLit"
pattern $bFLIGHT_SET_DARK :: GroupName TileKind
$mFLIGHT_SET_DARK :: forall r. GroupName TileKind -> (Void# -> r) -> (Void# -> r) -> r
FLIGHT_SET_DARK = GroupName "flightSetDark"
pattern $bAMBUSH_SET_LIT :: GroupName TileKind
$mAMBUSH_SET_LIT :: forall r. GroupName TileKind -> (Void# -> r) -> (Void# -> r) -> r
AMBUSH_SET_LIT = GroupName "ambushSetLit"
pattern $bAMBUSH_SET_DARK :: GroupName TileKind
$mAMBUSH_SET_DARK :: forall r. GroupName TileKind -> (Void# -> r) -> (Void# -> r) -> r
AMBUSH_SET_DARK = GroupName "ambushSetDark"
pattern $bARENA_SET_LIT :: GroupName TileKind
$mARENA_SET_LIT :: forall r. GroupName TileKind -> (Void# -> r) -> (Void# -> r) -> r
ARENA_SET_LIT = GroupName "arenaSetLit"
pattern $bARENA_SET_DARK :: GroupName TileKind
$mARENA_SET_DARK :: forall r. GroupName TileKind -> (Void# -> r) -> (Void# -> r) -> r
ARENA_SET_DARK = GroupName "arenaSetDark"

-- ** Allure-specific
pattern $bROGUE_SET :: GroupName TileKind
$mROGUE_SET :: forall r. GroupName TileKind -> (Void# -> r) -> (Void# -> r) -> r
ROGUE_SET = GroupName "rogueSet"
pattern $bMUSEUM_SET_LIT :: GroupName TileKind
$mMUSEUM_SET_LIT :: forall r. GroupName TileKind -> (Void# -> r) -> (Void# -> r) -> r
MUSEUM_SET_LIT = GroupName "museumSetLit"
pattern $bMUSEUM_SET_DARK :: GroupName TileKind
$mMUSEUM_SET_DARK :: forall r. GroupName TileKind -> (Void# -> r) -> (Void# -> r) -> r
MUSEUM_SET_DARK = GroupName "museumSetDark"
pattern $bHUNT_SET_LIT :: GroupName TileKind
$mHUNT_SET_LIT :: forall r. GroupName TileKind -> (Void# -> r) -> (Void# -> r) -> r
HUNT_SET_LIT = GroupName "huntSetLit"
pattern $bEGRESS_SET_LIT :: GroupName TileKind
$mEGRESS_SET_LIT :: forall r. GroupName TileKind -> (Void# -> r) -> (Void# -> r) -> r
EGRESS_SET_LIT = GroupName "egressSetLit"
pattern $bVIRUS_SET_LIT :: GroupName TileKind
$mVIRUS_SET_LIT :: forall r. GroupName TileKind -> (Void# -> r) -> (Void# -> r) -> r
VIRUS_SET_LIT = GroupName "virusSetLit"
pattern $bVIRUS_SET_DARK :: GroupName TileKind
$mVIRUS_SET_DARK :: forall r. GroupName TileKind -> (Void# -> r) -> (Void# -> r) -> r
VIRUS_SET_DARK = GroupName "virusSetDark"

-- ** Used in PlaceKind, but not in CaveKind. Not singletons.
pattern $bTREE_SHADE_WALKABLE_LIT :: GroupName TileKind
$mTREE_SHADE_WALKABLE_LIT :: forall r. GroupName TileKind -> (Void# -> r) -> (Void# -> r) -> r
TREE_SHADE_WALKABLE_LIT = GroupName "treeShadeWalkableLit"
pattern $bTREE_SHADE_WALKABLE_DARK :: GroupName TileKind
$mTREE_SHADE_WALKABLE_DARK :: forall r. GroupName TileKind -> (Void# -> r) -> (Void# -> r) -> r
TREE_SHADE_WALKABLE_DARK = GroupName "treeShadeWalkableDark"
pattern $bSMOKE_CLUMP_LIT :: GroupName TileKind
$mSMOKE_CLUMP_LIT :: forall r. GroupName TileKind -> (Void# -> r) -> (Void# -> r) -> r
SMOKE_CLUMP_LIT = GroupName "smokeClumpLit"
pattern $bSMOKE_CLUMP_DARK :: GroupName TileKind
$mSMOKE_CLUMP_DARK :: forall r. GroupName TileKind -> (Void# -> r) -> (Void# -> r) -> r
SMOKE_CLUMP_DARK = GroupName "smokeClumpDark"
pattern $bBUSH_CLUMP_LIT :: GroupName TileKind
$mBUSH_CLUMP_LIT :: forall r. GroupName TileKind -> (Void# -> r) -> (Void# -> r) -> r
BUSH_CLUMP_LIT = GroupName "bushClumpLit"
pattern $bBUSH_CLUMP_DARK :: GroupName TileKind
$mBUSH_CLUMP_DARK :: forall r. GroupName TileKind -> (Void# -> r) -> (Void# -> r) -> r
BUSH_CLUMP_DARK = GroupName "bushClumpDark"
pattern $bFOG_CLUMP_LIT :: GroupName TileKind
$mFOG_CLUMP_LIT :: forall r. GroupName TileKind -> (Void# -> r) -> (Void# -> r) -> r
FOG_CLUMP_LIT = GroupName "fogClumpLit"
pattern $bFOG_CLUMP_DARK :: GroupName TileKind
$mFOG_CLUMP_DARK :: forall r. GroupName TileKind -> (Void# -> r) -> (Void# -> r) -> r
FOG_CLUMP_DARK = GroupName "fogClumpDark"
pattern $bSTAIR_TERMINAL_LIT :: GroupName TileKind
$mSTAIR_TERMINAL_LIT :: forall r. GroupName TileKind -> (Void# -> r) -> (Void# -> r) -> r
STAIR_TERMINAL_LIT = GroupName "stair terminal Lit"
pattern $bSTAIR_TERMINAL_DARK :: GroupName TileKind
$mSTAIR_TERMINAL_DARK :: forall r. GroupName TileKind -> (Void# -> r) -> (Void# -> r) -> r
STAIR_TERMINAL_DARK = GroupName "stair terminal Dark"
pattern $bSIGNBOARD :: GroupName TileKind
$mSIGNBOARD :: forall r. GroupName TileKind -> (Void# -> r) -> (Void# -> r) -> r
SIGNBOARD = GroupName "signboard"
pattern $bSTAIRCASE_UP :: GroupName TileKind
$mSTAIRCASE_UP :: forall r. GroupName TileKind -> (Void# -> r) -> (Void# -> r) -> r
STAIRCASE_UP = GroupName "staircase up"
pattern $bORDINARY_STAIRCASE_UP :: GroupName TileKind
$mORDINARY_STAIRCASE_UP :: forall r. GroupName TileKind -> (Void# -> r) -> (Void# -> r) -> r
ORDINARY_STAIRCASE_UP = GroupName "ordinary staircase up"
pattern $bSTAIRCASE_OUTDOOR_UP :: GroupName TileKind
$mSTAIRCASE_OUTDOOR_UP :: forall r. GroupName TileKind -> (Void# -> r) -> (Void# -> r) -> r
STAIRCASE_OUTDOOR_UP = GroupName "staircase outdoor up"
pattern $bGATED_STAIRCASE_UP :: GroupName TileKind
$mGATED_STAIRCASE_UP :: forall r. GroupName TileKind -> (Void# -> r) -> (Void# -> r) -> r
GATED_STAIRCASE_UP = GroupName "gated staircase up"
pattern $bSTAIRCASE_DOWN :: GroupName TileKind
$mSTAIRCASE_DOWN :: forall r. GroupName TileKind -> (Void# -> r) -> (Void# -> r) -> r
STAIRCASE_DOWN = GroupName "staircase down"
pattern $bORDINARY_STAIRCASE_DOWN :: GroupName TileKind
$mORDINARY_STAIRCASE_DOWN :: forall r. GroupName TileKind -> (Void# -> r) -> (Void# -> r) -> r
ORDINARY_STAIRCASE_DOWN = GroupName "ordinary staircase down"
pattern $bSTAIRCASE_OUTDOOR_DOWN :: GroupName TileKind
$mSTAIRCASE_OUTDOOR_DOWN :: forall r. GroupName TileKind -> (Void# -> r) -> (Void# -> r) -> r
STAIRCASE_OUTDOOR_DOWN = GroupName "staircase outdoor down"
pattern $bGATED_STAIRCASE_DOWN :: GroupName TileKind
$mGATED_STAIRCASE_DOWN :: forall r. GroupName TileKind -> (Void# -> r) -> (Void# -> r) -> r
GATED_STAIRCASE_DOWN = GroupName "gated staircase down"
pattern $bTILE_INDOOR_ESCAPE_UP :: GroupName TileKind
$mTILE_INDOOR_ESCAPE_UP :: forall r. GroupName TileKind -> (Void# -> r) -> (Void# -> r) -> r
TILE_INDOOR_ESCAPE_UP = GroupName "indoor escape up"
pattern $bTILE_INDOOR_ESCAPE_DOWN :: GroupName TileKind
$mTILE_INDOOR_ESCAPE_DOWN :: forall r. GroupName TileKind -> (Void# -> r) -> (Void# -> r) -> r
TILE_INDOOR_ESCAPE_DOWN = GroupName "indoor escape down"
pattern $bTILE_OUTDOOR_ESCAPE_DOWN :: GroupName TileKind
$mTILE_OUTDOOR_ESCAPE_DOWN :: forall r. GroupName TileKind -> (Void# -> r) -> (Void# -> r) -> r
TILE_OUTDOOR_ESCAPE_DOWN = GroupName "outdoor escape down"
pattern $bTRANSPARENT_WALL :: GroupName TileKind
$mTRANSPARENT_WALL :: forall r. GroupName TileKind -> (Void# -> r) -> (Void# -> r) -> r
TRANSPARENT_WALL  = GroupName "transparent wall"
pattern $bICE_BUILDUP :: GroupName TileKind
$mICE_BUILDUP :: forall r. GroupName TileKind -> (Void# -> r) -> (Void# -> r) -> r
ICE_BUILDUP = GroupName "ice buildup"
pattern $bWORKSHOP :: GroupName TileKind
$mWORKSHOP :: forall r. GroupName TileKind -> (Void# -> r) -> (Void# -> r) -> r
WORKSHOP = GroupName "workshop"
pattern $bFLOOR_ACTOR_ITEM :: GroupName TileKind
$mFLOOR_ACTOR_ITEM :: forall r. GroupName TileKind -> (Void# -> r) -> (Void# -> r) -> r
FLOOR_ACTOR_ITEM = GroupName "floorActorItem"
pattern $bFLOOR_ACTOR_ITEM_LIT :: GroupName TileKind
$mFLOOR_ACTOR_ITEM_LIT :: forall r. GroupName TileKind -> (Void# -> r) -> (Void# -> r) -> r
FLOOR_ACTOR_ITEM_LIT = GroupName "floorActorItemLit"
pattern $bFLOOR_ACTOR_ITEM_DARK :: GroupName TileKind
$mFLOOR_ACTOR_ITEM_DARK :: forall r. GroupName TileKind -> (Void# -> r) -> (Void# -> r) -> r
FLOOR_ACTOR_ITEM_DARK = GroupName "floorActorItemDark"

-- ** Used in PlaceKind, but not in CaveKind. Singletons.
pattern $bS_PILLAR :: GroupName TileKind
$mS_PILLAR :: forall r. GroupName TileKind -> (Void# -> r) -> (Void# -> r) -> r
S_PILLAR = GroupName "pillar"
pattern $bS_RUBBLE_PILE :: GroupName TileKind
$mS_RUBBLE_PILE :: forall r. GroupName TileKind -> (Void# -> r) -> (Void# -> r) -> r
S_RUBBLE_PILE = GroupName "rubble pile"
pattern $bS_LAMP_POST :: GroupName TileKind
$mS_LAMP_POST :: forall r. GroupName TileKind -> (Void# -> r) -> (Void# -> r) -> r
S_LAMP_POST = GroupName "lamp post"
pattern $bS_TREE_LIT :: GroupName TileKind
$mS_TREE_LIT :: forall r. GroupName TileKind -> (Void# -> r) -> (Void# -> r) -> r
S_TREE_LIT = GroupName "tree Lit"
pattern $bS_TREE_DARK :: GroupName TileKind
$mS_TREE_DARK :: forall r. GroupName TileKind -> (Void# -> r) -> (Void# -> r) -> r
S_TREE_DARK = GroupName "tree Dark"
pattern $bS_PULPIT :: GroupName TileKind
$mS_PULPIT :: forall r. GroupName TileKind -> (Void# -> r) -> (Void# -> r) -> r
S_PULPIT = GroupName "pulpit"
pattern $bS_BUSH_LIT :: GroupName TileKind
$mS_BUSH_LIT :: forall r. GroupName TileKind -> (Void# -> r) -> (Void# -> r) -> r
S_BUSH_LIT = GroupName "bush Lit"
pattern $bS_FOG_LIT :: GroupName TileKind
$mS_FOG_LIT :: forall r. GroupName TileKind -> (Void# -> r) -> (Void# -> r) -> r
S_FOG_LIT = GroupName "fog Lit"
pattern $bS_SMOKE_LIT :: GroupName TileKind
$mS_SMOKE_LIT :: forall r. GroupName TileKind -> (Void# -> r) -> (Void# -> r) -> r
S_SMOKE_LIT = GroupName "smoke Lit"
pattern $bS_FLOOR_ACTOR_LIT :: GroupName TileKind
$mS_FLOOR_ACTOR_LIT :: forall r. GroupName TileKind -> (Void# -> r) -> (Void# -> r) -> r
S_FLOOR_ACTOR_LIT = GroupName "floor with actors Lit"
pattern $bS_FLOOR_ACTOR_DARK :: GroupName TileKind
$mS_FLOOR_ACTOR_DARK :: forall r. GroupName TileKind -> (Void# -> r) -> (Void# -> r) -> r
S_FLOOR_ACTOR_DARK = GroupName "floor with actors Dark"
pattern $bS_FLOOR_ASHES_LIT :: GroupName TileKind
$mS_FLOOR_ASHES_LIT :: forall r. GroupName TileKind -> (Void# -> r) -> (Void# -> r) -> r
S_FLOOR_ASHES_LIT = GroupName "floor with ashes Lit"
pattern $bS_FLOOR_ASHES_DARK :: GroupName TileKind
$mS_FLOOR_ASHES_DARK :: forall r. GroupName TileKind -> (Void# -> r) -> (Void# -> r) -> r
S_FLOOR_ASHES_DARK = GroupName "floor with ashes Dark"
pattern $bS_SHADED_GROUND :: GroupName TileKind
$mS_SHADED_GROUND :: forall r. GroupName TileKind -> (Void# -> r) -> (Void# -> r) -> r
S_SHADED_GROUND = GroupName "shaded ground"
pattern $bS_SHALLOW_WATER_LIT :: GroupName TileKind
$mS_SHALLOW_WATER_LIT :: forall r. GroupName TileKind -> (Void# -> r) -> (Void# -> r) -> r
S_SHALLOW_WATER_LIT = GroupName "shallow water Lit"
pattern $bS_SHALLOW_WATER_DARK :: GroupName TileKind
$mS_SHALLOW_WATER_DARK :: forall r. GroupName TileKind -> (Void# -> r) -> (Void# -> r) -> r
S_SHALLOW_WATER_DARK = GroupName "shallow water Dark"

-- ** Allure-specific
pattern $bBUSH_GROVE_LIT :: GroupName TileKind
$mBUSH_GROVE_LIT :: forall r. GroupName TileKind -> (Void# -> r) -> (Void# -> r) -> r
BUSH_GROVE_LIT = GroupName "bushGroveLit"
pattern $bBUSH_GROVE_DARK :: GroupName TileKind
$mBUSH_GROVE_DARK :: forall r. GroupName TileKind -> (Void# -> r) -> (Void# -> r) -> r
BUSH_GROVE_DARK = GroupName "bushGroveDark"
pattern $bUNDERBRUSH_CLUMP_LIT :: GroupName TileKind
$mUNDERBRUSH_CLUMP_LIT :: forall r. GroupName TileKind -> (Void# -> r) -> (Void# -> r) -> r
UNDERBRUSH_CLUMP_LIT = GroupName "underbrushClumpLit"
pattern $bUNDERBRUSH_CLUMP_DARK :: GroupName TileKind
$mUNDERBRUSH_CLUMP_DARK :: forall r. GroupName TileKind -> (Void# -> r) -> (Void# -> r) -> r
UNDERBRUSH_CLUMP_DARK = GroupName "underbrushClumpDark"
pattern $bASHES_SMOKE_LIT :: GroupName TileKind
$mASHES_SMOKE_LIT :: forall r. GroupName TileKind -> (Void# -> r) -> (Void# -> r) -> r
ASHES_SMOKE_LIT = GroupName "ashesSmokeLit"
pattern $bASHES_SMOKE_DARK :: GroupName TileKind
$mASHES_SMOKE_DARK :: forall r. GroupName TileKind -> (Void# -> r) -> (Void# -> r) -> r
ASHES_SMOKE_DARK = GroupName "ashesSmokeDark"
pattern $bRECT_WINDOWS :: GroupName TileKind
$mRECT_WINDOWS :: forall r. GroupName TileKind -> (Void# -> r) -> (Void# -> r) -> r
RECT_WINDOWS = GroupName "rectWindows"
pattern $bDOORLESS_MACHINERY :: GroupName TileKind
$mDOORLESS_MACHINERY :: forall r. GroupName TileKind -> (Void# -> r) -> (Void# -> r) -> r
DOORLESS_MACHINERY = GroupName "doorlessMachinery"
pattern $bPUMPS_LIT :: GroupName TileKind
$mPUMPS_LIT :: forall r. GroupName TileKind -> (Void# -> r) -> (Void# -> r) -> r
PUMPS_LIT = GroupName "pumpsLit"
pattern $bPUMPS_DARK :: GroupName TileKind
$mPUMPS_DARK :: forall r. GroupName TileKind -> (Void# -> r) -> (Void# -> r) -> r
PUMPS_DARK = GroupName "pumpsDark"
pattern $bDOORLESS_WALL :: GroupName TileKind
$mDOORLESS_WALL :: forall r. GroupName TileKind -> (Void# -> r) -> (Void# -> r) -> r
DOORLESS_WALL = GroupName "doorlessWall"
pattern $bOIL_RESIDUE_LIT :: GroupName TileKind
$mOIL_RESIDUE_LIT :: forall r. GroupName TileKind -> (Void# -> r) -> (Void# -> r) -> r
OIL_RESIDUE_LIT = GroupName "oilResidueLit"
pattern $bOIL_RESIDUE_DARK :: GroupName TileKind
$mOIL_RESIDUE_DARK :: forall r. GroupName TileKind -> (Void# -> r) -> (Void# -> r) -> r
OIL_RESIDUE_DARK = GroupName "oilResidueDark"
pattern $bLIFT_TERMINAL_LIT :: GroupName TileKind
$mLIFT_TERMINAL_LIT :: forall r. GroupName TileKind -> (Void# -> r) -> (Void# -> r) -> r
LIFT_TERMINAL_LIT = GroupName "lift terminal Lit"
pattern $bLIFT_TERMINAL_DARK :: GroupName TileKind
$mLIFT_TERMINAL_DARK :: forall r. GroupName TileKind -> (Void# -> r) -> (Void# -> r) -> r
LIFT_TERMINAL_DARK = GroupName "lift terminal Dark"
pattern $bSTAIRCASE_LIFT_UP :: GroupName TileKind
$mSTAIRCASE_LIFT_UP :: forall r. GroupName TileKind -> (Void# -> r) -> (Void# -> r) -> r
STAIRCASE_LIFT_UP = GroupName "staircase lift up"
pattern $bSTAIRCASE_LIFT_DOWN :: GroupName TileKind
$mSTAIRCASE_LIFT_DOWN :: forall r. GroupName TileKind -> (Void# -> r) -> (Void# -> r) -> r
STAIRCASE_LIFT_DOWN = GroupName "staircase lift down"
pattern $bGATED_LIFT_UP :: GroupName TileKind
$mGATED_LIFT_UP :: forall r. GroupName TileKind -> (Void# -> r) -> (Void# -> r) -> r
GATED_LIFT_UP = GroupName "gated lift up"
pattern $bGATED_LIFT_DOWN :: GroupName TileKind
$mGATED_LIFT_DOWN :: forall r. GroupName TileKind -> (Void# -> r) -> (Void# -> r) -> r
GATED_LIFT_DOWN = GroupName "gated lift down"
pattern $bDECON_STAIRCASE_UP :: GroupName TileKind
$mDECON_STAIRCASE_UP :: forall r. GroupName TileKind -> (Void# -> r) -> (Void# -> r) -> r
DECON_STAIRCASE_UP = GroupName "decon staircase up"
pattern $bDECON_STAIRCASE_DOWN :: GroupName TileKind
$mDECON_STAIRCASE_DOWN :: forall r. GroupName TileKind -> (Void# -> r) -> (Void# -> r) -> r
DECON_STAIRCASE_DOWN = GroupName "decon staircase down"
pattern $bDECON_LIFT_UP :: GroupName TileKind
$mDECON_LIFT_UP :: forall r. GroupName TileKind -> (Void# -> r) -> (Void# -> r) -> r
DECON_LIFT_UP = GroupName "decon lift up"
pattern $bDECON_LIFT_DOWN :: GroupName TileKind
$mDECON_LIFT_DOWN :: forall r. GroupName TileKind -> (Void# -> r) -> (Void# -> r) -> r
DECON_LIFT_DOWN = GroupName "decon lift down"
pattern $bWELDED_STAIRCASE_UP :: GroupName TileKind
$mWELDED_STAIRCASE_UP :: forall r. GroupName TileKind -> (Void# -> r) -> (Void# -> r) -> r
WELDED_STAIRCASE_UP = GroupName "welded staircase up"
pattern $bWELDED_LIFT_UP :: GroupName TileKind
$mWELDED_LIFT_UP :: forall r. GroupName TileKind -> (Void# -> r) -> (Void# -> r) -> r
WELDED_LIFT_UP = GroupName "welded lift up"
pattern $bTILE_ALARM_ESCAPE_UP :: GroupName TileKind
$mTILE_ALARM_ESCAPE_UP :: forall r. GroupName TileKind -> (Void# -> r) -> (Void# -> r) -> r
TILE_ALARM_ESCAPE_UP = GroupName "alarm escape up"
pattern $bTILE_SPACESHIP_ESCAPE_DOWN :: GroupName TileKind
$mTILE_SPACESHIP_ESCAPE_DOWN :: forall r. GroupName TileKind -> (Void# -> r) -> (Void# -> r) -> r
TILE_SPACESHIP_ESCAPE_DOWN = GroupName "spaceship escape down"
pattern $bORDINARY_LIFT_UP :: GroupName TileKind
$mORDINARY_LIFT_UP :: forall r. GroupName TileKind -> (Void# -> r) -> (Void# -> r) -> r
ORDINARY_LIFT_UP = GroupName "ordinary lift up"
pattern $bORDINARY_LIFT_DOWN :: GroupName TileKind
$mORDINARY_LIFT_DOWN :: forall r. GroupName TileKind -> (Void# -> r) -> (Void# -> r) -> r
ORDINARY_LIFT_DOWN = GroupName "ordinary lift down"
pattern $bRUBBLE_OR_WASTE_LIT :: GroupName TileKind
$mRUBBLE_OR_WASTE_LIT :: forall r. GroupName TileKind -> (Void# -> r) -> (Void# -> r) -> r
RUBBLE_OR_WASTE_LIT = GroupName "rubbleOrWaste_Lit"
pattern $bRUBBLE_OR_WASTE_DARK :: GroupName TileKind
$mRUBBLE_OR_WASTE_DARK :: forall r. GroupName TileKind -> (Void# -> r) -> (Void# -> r) -> r
RUBBLE_OR_WASTE_DARK = GroupName "rubbleOrWaste_Dark"
pattern $bCACHE_DEPOSIT :: GroupName TileKind
$mCACHE_DEPOSIT :: forall r. GroupName TileKind -> (Void# -> r) -> (Void# -> r) -> r
CACHE_DEPOSIT = GroupName "cache deposit"
pattern $bCACHE_JEWELRY :: GroupName TileKind
$mCACHE_JEWELRY :: forall r. GroupName TileKind -> (Void# -> r) -> (Void# -> r) -> r
CACHE_JEWELRY = GroupName "cache jewelry"
pattern $bCACHE_MAZE :: GroupName TileKind
$mCACHE_MAZE :: forall r. GroupName TileKind -> (Void# -> r) -> (Void# -> r) -> r
CACHE_MAZE = GroupName "cache maze"
pattern $bCACHE_SHUTTLE :: GroupName TileKind
$mCACHE_SHUTTLE :: forall r. GroupName TileKind -> (Void# -> r) -> (Void# -> r) -> r
CACHE_SHUTTLE = GroupName "cache shuttle"
pattern $bTRAPPED_DOOR :: GroupName TileKind
$mTRAPPED_DOOR :: forall r. GroupName TileKind -> (Void# -> r) -> (Void# -> r) -> r
TRAPPED_DOOR = GroupName "trapped door"
pattern $bSTUCK_DOOR :: GroupName TileKind
$mSTUCK_DOOR :: forall r. GroupName TileKind -> (Void# -> r) -> (Void# -> r) -> r
STUCK_DOOR = GroupName "stuck door"
pattern $bBARREL :: GroupName TileKind
$mBARREL :: forall r. GroupName TileKind -> (Void# -> r) -> (Void# -> r) -> r
BARREL = GroupName "barrel"

pattern $bS_POOL_LIT :: GroupName TileKind
$mS_POOL_LIT :: forall r. GroupName TileKind -> (Void# -> r) -> (Void# -> r) -> r
S_POOL_LIT = GroupName "poolLit"
pattern $bS_POOL_DARK :: GroupName TileKind
$mS_POOL_DARK :: forall r. GroupName TileKind -> (Void# -> r) -> (Void# -> r) -> r
S_POOL_DARK = GroupName "poolDark"
pattern $bS_CLOSED_DOOR :: GroupName TileKind
$mS_CLOSED_DOOR :: forall r. GroupName TileKind -> (Void# -> r) -> (Void# -> r) -> r
S_CLOSED_DOOR = GroupName "closed door"
pattern $bS_OPEN_DOOR :: GroupName TileKind
$mS_OPEN_DOOR :: forall r. GroupName TileKind -> (Void# -> r) -> (Void# -> r) -> r
S_OPEN_DOOR = GroupName "open door"
pattern $bS_OIL_SPILL :: GroupName TileKind
$mS_OIL_SPILL :: forall r. GroupName TileKind -> (Void# -> r) -> (Void# -> r) -> r
S_OIL_SPILL = GroupName "oil spill"
pattern $bS_FROZEN_PATH :: GroupName TileKind
$mS_FROZEN_PATH :: forall r. GroupName TileKind -> (Void# -> r) -> (Void# -> r) -> r
S_FROZEN_PATH = GroupName "frozen path"
pattern $bS_LIFT_SHAFT :: GroupName TileKind
$mS_LIFT_SHAFT :: forall r. GroupName TileKind -> (Void# -> r) -> (Void# -> r) -> r
S_LIFT_SHAFT = GroupName "lift shaft"
pattern $bS_REINFORCED_WALL :: GroupName TileKind
$mS_REINFORCED_WALL :: forall r. GroupName TileKind -> (Void# -> r) -> (Void# -> r) -> r
S_REINFORCED_WALL = GroupName "reinforced wall"
pattern $bS_SHUTTLE_HULL :: GroupName TileKind
$mS_SHUTTLE_HULL :: forall r. GroupName TileKind -> (Void# -> r) -> (Void# -> r) -> r
S_SHUTTLE_HULL = GroupName "shuttle hull"
pattern $bS_HARDWARE_RACK :: GroupName TileKind
$mS_HARDWARE_RACK :: forall r. GroupName TileKind -> (Void# -> r) -> (Void# -> r) -> r
S_HARDWARE_RACK = GroupName "hardware rack"

-- ** Used only internally in other TileKind definitions. Not singletons.
pattern $bTREE_BURNING_OR_NOT :: GroupName TileKind
$mTREE_BURNING_OR_NOT :: forall r. GroupName TileKind -> (Void# -> r) -> (Void# -> r) -> r
TREE_BURNING_OR_NOT = GroupName "tree burning or not"
pattern $bBUSH_BURNING_OR_NOT :: GroupName TileKind
$mBUSH_BURNING_OR_NOT :: forall r. GroupName TileKind -> (Void# -> r) -> (Void# -> r) -> r
BUSH_BURNING_OR_NOT = GroupName "bush burning or not"

-- ** Used only internally in other TileKind definitions. Singletons.

pattern $bS_SIGNBOARD_UNREAD :: GroupName TileKind
$mS_SIGNBOARD_UNREAD :: forall r. GroupName TileKind -> (Void# -> r) -> (Void# -> r) -> r
S_SIGNBOARD_UNREAD = GroupName "signboard unread"

-- ** Allure-specific
pattern $bOBSCURED_WALL :: GroupName TileKind
$mOBSCURED_WALL :: forall r. GroupName TileKind -> (Void# -> r) -> (Void# -> r) -> r
OBSCURED_WALL = GroupName "obscured wall"
pattern $bCACHE_DEPOSIT_OR_NOT :: GroupName TileKind
$mCACHE_DEPOSIT_OR_NOT :: forall r. GroupName TileKind -> (Void# -> r) -> (Void# -> r) -> r
CACHE_DEPOSIT_OR_NOT = GroupName "cache deposit or not"
pattern $bCACHE_DEPOSIT_BREACHED :: GroupName TileKind
$mCACHE_DEPOSIT_BREACHED :: forall r. GroupName TileKind -> (Void# -> r) -> (Void# -> r) -> r
CACHE_DEPOSIT_BREACHED = GroupName "cache deposit breached"
pattern $bCACHE_JEWELRY_OR_NOT :: GroupName TileKind
$mCACHE_JEWELRY_OR_NOT :: forall r. GroupName TileKind -> (Void# -> r) -> (Void# -> r) -> r
CACHE_JEWELRY_OR_NOT = GroupName "cache jewelry or not"
pattern $bCACHE_JEWELRY_TRAPPED_OR_NOT :: GroupName TileKind
$mCACHE_JEWELRY_TRAPPED_OR_NOT :: forall r. GroupName TileKind -> (Void# -> r) -> (Void# -> r) -> r
CACHE_JEWELRY_TRAPPED_OR_NOT = GroupName "cache jewelry trapped or not"
pattern $bCACHE_ABANDONED_OR_NOT :: GroupName TileKind
$mCACHE_ABANDONED_OR_NOT :: forall r. GroupName TileKind -> (Void# -> r) -> (Void# -> r) -> r
CACHE_ABANDONED_OR_NOT = GroupName "cache abandoned or not"
pattern $bRUBBLE_BURNING_OR_NOT :: GroupName TileKind
$mRUBBLE_BURNING_OR_NOT :: forall r. GroupName TileKind -> (Void# -> r) -> (Void# -> r) -> r
RUBBLE_BURNING_OR_NOT = GroupName "rubble burning or not"

pattern $bS_SUSPECT_WALL :: GroupName TileKind
$mS_SUSPECT_WALL :: forall r. GroupName TileKind -> (Void# -> r) -> (Void# -> r) -> r
S_SUSPECT_WALL = GroupName "suspect wall"
pattern $bS_STAIRCASE_TRAP_DOWN_OIL :: GroupName TileKind
$mS_STAIRCASE_TRAP_DOWN_OIL :: forall r. GroupName TileKind -> (Void# -> r) -> (Void# -> r) -> r
S_STAIRCASE_TRAP_DOWN_OIL = GroupName "slippery staircase down"
pattern $bS_BURNING_INSTALLATION :: GroupName TileKind
$mS_BURNING_INSTALLATION :: forall r. GroupName TileKind -> (Void# -> r) -> (Void# -> r) -> r
S_BURNING_INSTALLATION = GroupName "burning installation"
pattern $bS_BURNING_TREE :: GroupName TileKind
$mS_BURNING_TREE :: forall r. GroupName TileKind -> (Void# -> r) -> (Void# -> r) -> r
S_BURNING_TREE = GroupName "burning tree"
pattern $bS_BURNING_BUSH :: GroupName TileKind
$mS_BURNING_BUSH :: forall r. GroupName TileKind -> (Void# -> r) -> (Void# -> r) -> r
S_BURNING_BUSH = GroupName "burning bush"
pattern $bS_BURNING_UNDERBRUSH :: GroupName TileKind
$mS_BURNING_UNDERBRUSH :: forall r. GroupName TileKind -> (Void# -> r) -> (Void# -> r) -> r
S_BURNING_UNDERBRUSH = GroupName "burning underbrush"
pattern $bS_BURNING_OIL :: GroupName TileKind
$mS_BURNING_OIL :: forall r. GroupName TileKind -> (Void# -> r) -> (Void# -> r) -> r
S_BURNING_OIL = GroupName "burning oil"
pattern $bS_UNDERBRUSH_LIT :: GroupName TileKind
$mS_UNDERBRUSH_LIT :: forall r. GroupName TileKind -> (Void# -> r) -> (Void# -> r) -> r
S_UNDERBRUSH_LIT = GroupName "underbrush Lit"
pattern $bS_UNDERBRUSH_DARK :: GroupName TileKind
$mS_UNDERBRUSH_DARK :: forall r. GroupName TileKind -> (Void# -> r) -> (Void# -> r) -> r
S_UNDERBRUSH_DARK = GroupName "underbrush Dark"

-- * Not used, but needed, because auto-generated. Not singletons.
-- This is a rotten compromise, because these are synthesized below,
-- so typos can happen. Similarly below
pattern $bBRAWL_SET_DARK :: GroupName TileKind
$mBRAWL_SET_DARK :: forall r. GroupName TileKind -> (Void# -> r) -> (Void# -> r) -> r
BRAWL_SET_DARK = GroupName "brawlSetDark"
pattern $bNOISE_SET_DARK :: GroupName TileKind
$mNOISE_SET_DARK :: forall r. GroupName TileKind -> (Void# -> r) -> (Void# -> r) -> r
NOISE_SET_DARK = GroupName "noiseSetDark"
pattern $bSHOOTOUT_SET_DARK :: GroupName TileKind
$mSHOOTOUT_SET_DARK :: forall r. GroupName TileKind -> (Void# -> r) -> (Void# -> r) -> r
SHOOTOUT_SET_DARK = GroupName "shootoutSetDark"
pattern $bEGRESS_SET_DARK :: GroupName TileKind
$mEGRESS_SET_DARK :: forall r. GroupName TileKind -> (Void# -> r) -> (Void# -> r) -> r
EGRESS_SET_DARK = GroupName "egressSetDark"
pattern $bHUNT_SET_DARK :: GroupName TileKind
$mHUNT_SET_DARK :: forall r. GroupName TileKind -> (Void# -> r) -> (Void# -> r) -> r
HUNT_SET_DARK = GroupName "huntSetDark"

-- * Not used, but needed, because auto-generated. Singletons.
pattern $bS_BUSH_DARK :: GroupName TileKind
$mS_BUSH_DARK :: forall r. GroupName TileKind -> (Void# -> r) -> (Void# -> r) -> r
S_BUSH_DARK = GroupName "bush Dark"

-- * Content

content :: [TileKind]
content :: [TileKind]
content =
  [TileKind
unknown, TileKind
unknownOuterFence, TileKind
basicOuterFence, TileKind
bedrock, TileKind
wall, TileKind
wallSuspect, TileKind
wallObscured, TileKind
wallObscuredDefaced, TileKind
wallObscuredFrescoed, TileKind
pillar, TileKind
pillarCache, TileKind
lampPost, TileKind
signboardUnread, TileKind
signboardRead, TileKind
treeLit, TileKind
treeBurnt, TileKind
treeBurning, TileKind
rubble, TileKind
rubbleSpice, TileKind
doorTrapped, TileKind
doorClosed, TileKind
stairsUp, TileKind
stairsTrappedUp, TileKind
stairsOutdoorUp, TileKind
stairsGatedUp, TileKind
stairsDown, TileKind
stairsTrappedDown, TileKind
stairsOutdoorDown, TileKind
stairsGatedDown, TileKind
escapeUp, TileKind
escapeDown, TileKind
escapeOutdoorDown, TileKind
wallGlass, TileKind
wallGlassSpice, TileKind
pillarIce, TileKind
pulpit, TileKind
bushLit, TileKind
bushBurnt, TileKind
bushBurning, TileKind
fog, TileKind
fogDark, TileKind
smoke, TileKind
smokeDark, TileKind
doorOpen, TileKind
floorCorridor, TileKind
floorArena, TileKind
floorDamp, TileKind
floorDirt, TileKind
floorDirtSpice, TileKind
floorActor, TileKind
floorActorItem, TileKind
floorAshes, TileKind
shallowWater, TileKind
shallowWaterSpice, TileKind
shallowWater2, TileKind
floorRed, TileKind
floorBlue, TileKind
floorBrown, TileKind
floorArenaShade ]
  [TileKind] -> [TileKind] -> [TileKind]
forall a. [a] -> [a] -> [a]
++ (TileKind -> TileKind) -> [TileKind] -> [TileKind]
forall a b. (a -> b) -> [a] -> [b]
map TileKind -> TileKind
makeDarkColor [TileKind]
ldarkColorable
  -- Allure-specific
  [TileKind] -> [TileKind] -> [TileKind]
forall a. [a] -> [a] -> [a]
++ [TileKind
oriel, TileKind
outerHullWall, TileKind
rubbleBurning, TileKind
rubbleBurningSpice, TileKind
wallOpenable, TileKind
wallObscuredSafety, TileKind
signboardReadExtinguisher, TileKind
wallObscured3dBillboard, TileKind
wallObscuredPipework, TileKind
wallObscuredScary, TileKind
liftShaft, TileKind
rock, TileKind
pillarCache2, TileKind
pillarCache3, TileKind
pillarCache4, TileKind
pillarCache5, TileKind
stairsTrappedDownOil, TileKind
stairsDecontaminatingUp, TileKind
stairsWelded, TileKind
stairsLiftUp, TileKind
stairsLiftTrappedUp, TileKind
stairsLiftGatedUp, TileKind
stairsLiftDecontaminatingUp, TileKind
stairsLiftWelded, TileKind
stairsDecontaminatingDown, TileKind
stairsLiftDown, TileKind
stairsLiftTrappedDown, TileKind
stairsLiftGatedDown, TileKind
stairsLiftDecontaminatingDown, TileKind
escapeAlarmUp, TileKind
escapeSpaceshipDown, TileKind
emptyAirlock, TileKind
reinforcedWall, TileKind
reinforcedWallSpice, TileKind
wallShuttle, TileKind
wallShuttleSpice, TileKind
doorStuck, TileKind
barrel, TileKind
barrelSpice, TileKind
machineWall, TileKind
machineWallSpice, TileKind
bushEdible, TileKind
bushEdibleSpice, TileKind
underbrushBurning, TileKind
floorOily, TileKind
oilSpill, TileKind
oilSpillSpice, TileKind
oilBurning, TileKind
floorWindow, TileKind
underbrush, TileKind
workshop]

unknown,    unknownOuterFence, basicOuterFence, bedrock, wall, wallSuspect, wallObscured, wallObscuredDefaced, wallObscuredFrescoed, pillar, pillarCache, lampPost, signboardUnread, signboardRead, treeLit, treeBurnt, treeBurning, rubble, rubbleSpice, doorTrapped, doorClosed, stairsUp, stairsTrappedUp, stairsOutdoorUp, stairsGatedUp, stairsDown, stairsTrappedDown, stairsOutdoorDown, stairsGatedDown, escapeUp, escapeDown, escapeOutdoorDown, wallGlass, wallGlassSpice, pillarIce, pulpit, bushLit, bushBurnt, bushBurning, fog, fogDark, smoke, smokeDark, doorOpen, floorCorridor, floorArena, floorDamp, floorDirt, floorDirtSpice, floorActor, floorActorItem, floorAshes, shallowWater, shallowWaterSpice, shallowWater2, floorRed, floorBlue, floorBrown, floorArenaShade :: TileKind
-- Allure-specific
oriel,       outerHullWall, rubbleBurning, rubbleBurningSpice, wallOpenable, wallObscuredSafety, signboardReadExtinguisher, wallObscured3dBillboard, wallObscuredPipework, wallObscuredScary, liftShaft, rock, pillarCache2, pillarCache3, pillarCache4, pillarCache5, stairsTrappedDownOil, stairsDecontaminatingUp, stairsWelded, stairsLiftUp, stairsLiftTrappedUp, stairsLiftGatedUp, stairsLiftDecontaminatingUp, stairsLiftWelded, stairsDecontaminatingDown, stairsLiftDown, stairsLiftTrappedDown, stairsLiftGatedDown, stairsLiftDecontaminatingDown, escapeAlarmUp, escapeSpaceshipDown, emptyAirlock, reinforcedWall, reinforcedWallSpice, wallShuttle, wallShuttleSpice, doorStuck, barrel, barrelSpice, machineWall, machineWallSpice, bushEdible, bushEdibleSpice, underbrushBurning, floorOily, oilSpill, oilSpillSpice, oilBurning, floorWindow, underbrush, workshop :: TileKind

ldarkColorable :: [TileKind]
ldarkColorable :: [TileKind]
ldarkColorable = [TileKind
treeLit, TileKind
bushLit, TileKind
floorCorridor, TileKind
floorArena, TileKind
floorDamp, TileKind
floorDirt, TileKind
floorDirtSpice, TileKind
floorActor, TileKind
floorActorItem, TileKind
shallowWater, TileKind
shallowWaterSpice, TileKind
shallowWater2, TileKind
floorOily]

-- Symbols to be used:
--         LOS    noLOS
-- Walk    .'~    :;
-- noWalk  %^     #O&<>+
--
-- can be opened ^&+
-- can be closed '
-- some noWalk can be changed without opening, regardless of symbol
-- not used yet:
-- : (curtain, etc., not flowing, but solid and static)
-- ` (not distinct enough from ' and already used for some blasts)

-- White, cyan and green terrain is usually inert, red is burning or trapped,
-- blue activable or trapped, magenta searchable or activable.

-- Note that for AI hints and UI comfort, most multiple-use @Embed@ tiles
-- should have a variant, which after first use transforms into a different
-- colour tile without @ChangeTo@ and similar (which then AI no longer touches).
-- If a tile is supposed to be repeatedly activated by AI (e.g., cache),
-- it should keep @ChangeTo@ for the whole time.

-- * Main tiles, modified for Allure; some removed

-- ** Not walkable

-- *** Not clear

unknown :: TileKind
unknown = TileKind :: Char
-> Text
-> Freqs TileKind
-> Color
-> Color
-> Word8
-> [Feature]
-> TileKind
TileKind  -- needs to have index 0 and alter 1; no other with 1
  { tsymbol :: Char
tsymbol  = Char
' '
  , tname :: Text
tname    = Text
"unknown space"
  , tfreq :: Freqs TileKind
tfreq    = [(GroupName TileKind
S_UNKNOWN_SPACE, Int
1)]
  , tcolor :: Color
tcolor   = Color
defFG
  , tcolor2 :: Color
tcolor2  = Color
defFG
  , talter :: Word8
talter   = Word8
1
  , tfeature :: [Feature]
tfeature = [Feature
Dark]
  }
unknownOuterFence :: TileKind
unknownOuterFence = TileKind :: Char
-> Text
-> Freqs TileKind
-> Color
-> Color
-> Word8
-> [Feature]
-> TileKind
TileKind
  { tsymbol :: Char
tsymbol  = Char
' '
  , tname :: Text
tname    = Text
"unknown space"
  , tfreq :: Freqs TileKind
tfreq    = [(GroupName TileKind
S_UNKNOWN_OUTER_FENCE, Int
1)]
  , tcolor :: Color
tcolor   = Color
defFG
  , tcolor2 :: Color
tcolor2  = Color
defFG
  , talter :: Word8
talter   = Word8
forall a. Bounded a => a
maxBound  -- impenetrable
  , tfeature :: [Feature]
tfeature = [Feature
Dark]
  }
basicOuterFence :: TileKind
basicOuterFence = TileKind :: Char
-> Text
-> Freqs TileKind
-> Color
-> Color
-> Word8
-> [Feature]
-> TileKind
TileKind
  { tsymbol :: Char
tsymbol  = Char
'#'
  , tname :: Text
tname    = Text
"habitat containment wall"
  , tfreq :: Freqs TileKind
tfreq    = [(GroupName TileKind
HABITAT_CONTAINMENT_WALL, Int
1)]
  , tcolor :: Color
tcolor   = Color
BrBlack
  , tcolor2 :: Color
tcolor2  = Color
BrBlack
  , talter :: Word8
talter   = Word8
forall a. Bounded a => a
maxBound  -- impenetrable
  , tfeature :: [Feature]
tfeature = []
  }
bedrock :: TileKind
bedrock = TileKind :: Char
-> Text
-> Freqs TileKind
-> Color
-> Color
-> Word8
-> [Feature]
-> TileKind
TileKind
  { tsymbol :: Char
tsymbol  = Char
'#'
  , tname :: Text
tname    = Text
"wall"
  , tfreq :: Freqs TileKind
tfreq    = [ (GroupName TileKind
FILLER_WALL, Int
1)
               , (GroupName TileKind
ROGUE_SET, Int
60), (GroupName TileKind
MUSEUM_SET_DARK, Int
4), (GroupName TileKind
NOISE_SET_LIT, Int
450)
               , (GroupName TileKind
POWER_SET_DARK, Int
450), (GroupName TileKind
BATTLE_SET_DARK, Int
250)
               , (GroupName TileKind
FLIGHT_SET_DARK, Int
4)
               , (GroupName TileKind
STAIR_TERMINAL_LIT, Int
100), (GroupName TileKind
STAIR_TERMINAL_DARK, Int
100)
               , (GroupName TileKind
DOORLESS_WALL, Int
80), (GroupName TileKind
DOORLESS_MACHINERY, Int
1) ]
  , tcolor :: Color
tcolor   = Color
BrWhite
  , tcolor2 :: Color
tcolor2  = Color
defFG
  , talter :: Word8
talter   = Word8
100
  , tfeature :: [Feature]
tfeature = []
  }
wall :: TileKind
wall = TileKind
bedrock  -- fireproof
  { tfreq :: Freqs TileKind
tfreq    = [(GroupName TileKind
TRAPPABLE_WALL, Int
1), (GroupName TileKind
RECT_WINDOWS, Int
80)]
  , tfeature :: [Feature]
tfeature = [GroupName TileKind -> Feature
BuildAs GroupName TileKind
S_SUSPECT_WALL]
  }
wallSuspect :: TileKind
wallSuspect = TileKind :: Char
-> Text
-> Freqs TileKind
-> Color
-> Color
-> Word8
-> [Feature]
-> TileKind
TileKind  -- only on client
  { tsymbol :: Char
tsymbol  = Char
'#'
  , tname :: Text
tname    = Text
"suspect wall"
  , tfreq :: Freqs TileKind
tfreq    = [(GroupName TileKind
S_SUSPECT_WALL, Int
1)]
  , tcolor :: Color
tcolor   = Color
BrWhite
  , tcolor2 :: Color
tcolor2  = Color
defFG
  , talter :: Word8
talter   = Word8
2
  , tfeature :: [Feature]
tfeature = [ GroupName TileKind -> Feature
RevealAs GroupName TileKind
TRAPPED_DOOR
               , GroupName TileKind -> Feature
ObscureAs GroupName TileKind
OBSCURED_WALL
               ]
  }
wallObscured :: TileKind
wallObscured = TileKind :: Char
-> Text
-> Freqs TileKind
-> Color
-> Color
-> Word8
-> [Feature]
-> TileKind
TileKind
  { tsymbol :: Char
tsymbol  = Char
'#'
  , tname :: Text
tname    = Text
"scratched wall"
  , tfreq :: Freqs TileKind
tfreq    = [(GroupName TileKind
OBSCURED_WALL, Int
25)]
  , tcolor :: Color
tcolor   = Color
BrWhite
  , tcolor2 :: Color
tcolor2  = Color
defFG
  , talter :: Word8
talter   = Word8
5
  , tfeature :: [Feature]
tfeature = [ GroupName ItemKind -> Feature
Embed GroupName ItemKind
SCRATCH_ON_WALL
               , GroupName TileKind -> Feature
HideAs GroupName TileKind
S_SUSPECT_WALL
               ]
  }
wallObscuredDefaced :: TileKind
wallObscuredDefaced = TileKind :: Char
-> Text
-> Freqs TileKind
-> Color
-> Color
-> Word8
-> [Feature]
-> TileKind
TileKind
  { tsymbol :: Char
tsymbol  = Char
'#'
  , tname :: Text
tname    = Text
"defaced wall"
  , tfreq :: Freqs TileKind
tfreq    = [ (GroupName TileKind
OBSCURED_WALL, Int
25), (GroupName TileKind
FLIGHT_SET_DARK, Int
2)
               , (GroupName TileKind
MUSEUM_SET_DARK, Int
2) ]
  , tcolor :: Color
tcolor   = Color
BrWhite
  , tcolor2 :: Color
tcolor2  = Color
defFG
  , talter :: Word8
talter   = Word8
5
  , tfeature :: [Feature]
tfeature = [ GroupName ItemKind -> Feature
Embed GroupName ItemKind
OBSCENE_PICTOGRAM
               , GroupName TileKind -> Feature
HideAs GroupName TileKind
S_SUSPECT_WALL
               ]
  }
wallObscuredFrescoed :: TileKind
wallObscuredFrescoed = TileKind :: Char
-> Text
-> Freqs TileKind
-> Color
-> Color
-> Word8
-> [Feature]
-> TileKind
TileKind
  { tsymbol :: Char
tsymbol  = Char
'#'
  , tname :: Text
tname    = Text
"subtle mural"
  , tfreq :: Freqs TileKind
tfreq    = [(GroupName TileKind
OBSCURED_WALL, Int
5), (GroupName TileKind
MUSEUM_SET_DARK, Int
2)]
  , tcolor :: Color
tcolor   = Color
BrWhite
  , tcolor2 :: Color
tcolor2  = Color
defFG
  , talter :: Word8
talter   = Word8
5
  , tfeature :: [Feature]
tfeature = [ GroupName ItemKind -> Feature
Embed GroupName ItemKind
SUBTLE_FRESCO
               , GroupName TileKind -> Feature
HideAs GroupName TileKind
S_SUSPECT_WALL
               ]  -- a bit beneficial, but AI would loop if allowed to trigger
                  -- so no @ConsideredByAI@
  }
pillar :: TileKind
pillar = TileKind :: Char
-> Text
-> Freqs TileKind
-> Color
-> Color
-> Word8
-> [Feature]
-> TileKind
TileKind
  { tsymbol :: Char
tsymbol  = Char
'0'
  , tname :: Text
tname    = Text
"construction beam"
  , tfreq :: Freqs TileKind
tfreq    = [(GroupName TileKind
S_PILLAR, Int
1), (GroupName TileKind
MUSEUM_SET_DARK, Int
20), (GroupName TileKind
EMPTY_SET_LIT, Int
60)]
  , tcolor :: Color
tcolor   = Color
BrCyan  -- not BrWhite, to tell from heroes
  , tcolor2 :: Color
tcolor2  = Color
Cyan
  , talter :: Word8
talter   = Word8
100
  , tfeature :: [Feature]
tfeature = []
  }
pillarCache :: TileKind
pillarCache = TileKind :: Char
-> Text
-> Freqs TileKind
-> Color
-> Color
-> Word8
-> [Feature]
-> TileKind
TileKind
  { tsymbol :: Char
tsymbol  = Char
'#'
  , tname :: Text
tname    = Text
"abandoned stash"
  , tfreq :: Freqs TileKind
tfreq    = [ (GroupName TileKind
CACHE_ABANDONED_OR_NOT, Int
40)
               , (GroupName TileKind
CACHE_MAZE, Int
33), (GroupName TileKind
CACHE_SHUTTLE, Int
25) ]
  , tcolor :: Color
tcolor   = Color
BrBlue
  , tcolor2 :: Color
tcolor2  = Color
Blue
  , talter :: Word8
talter   = Word8
5
  , tfeature :: [Feature]
tfeature = [ GroupName ItemKind -> Feature
Embed GroupName ItemKind
ABANDONED_CACHE
               , GroupName TileKind -> Feature
ChangeTo GroupName TileKind
CACHE_ABANDONED_OR_NOT, Feature
ConsideredByAI ]
      -- Not explorable, but prominently placed, so hard to miss.
      -- Very beneficial, so AI eager to trigger.
  }
lampPost :: TileKind
lampPost = TileKind :: Char
-> Text
-> Freqs TileKind
-> Color
-> Color
-> Word8
-> [Feature]
-> TileKind
TileKind
  { tsymbol :: Char
tsymbol  = Char
'0'
  , tname :: Text
tname    = Text
"lamp post"
  , tfreq :: Freqs TileKind
tfreq    = [(GroupName TileKind
S_LAMP_POST, Int
1)]
  , tcolor :: Color
tcolor   = Color
BrYellow
  , tcolor2 :: Color
tcolor2  = Color
Brown
  , talter :: Word8
talter   = Word8
100
  , tfeature :: [Feature]
tfeature = []  -- embed something and explain how there's often
                   -- artificial ambient light in the habitats, but not in all
                   -- of them and in both cases lamps are used to provide fancy
                   -- (extra) lighting; say how low energy drain, such as
                   -- permanent ambient light, is not a problem due to tech
                   -- and also because it's a tiny fraction of what is needed
                   -- for the ecosystem/life support
  }
signboardUnread :: TileKind
signboardUnread = TileKind :: Char
-> Text
-> Freqs TileKind
-> Color
-> Color
-> Word8
-> [Feature]
-> TileKind
TileKind  -- client only, indicates never used by this faction
  { tsymbol :: Char
tsymbol  = Char
'0'
  , tname :: Text
tname    = Text
"signboard"
  , tfreq :: Freqs TileKind
tfreq    = [(GroupName TileKind
S_SIGNBOARD_UNREAD, Int
1)]
  , tcolor :: Color
tcolor   = Color
BrCyan
  , tcolor2 :: Color
tcolor2  = Color
Cyan
  , talter :: Word8
talter   = Word8
5
  , tfeature :: [Feature]
tfeature = [ Feature
ConsideredByAI  -- changes after use, so safe for AI, which
                                 -- in this way uses all kinds of signboards
               , GroupName TileKind -> Feature
RevealAs GroupName TileKind
SIGNBOARD  -- to display as hidden
               ]
  }
signboardRead :: TileKind
signboardRead = TileKind :: Char
-> Text
-> Freqs TileKind
-> Color
-> Color
-> Word8
-> [Feature]
-> TileKind
TileKind
  { tsymbol :: Char
tsymbol  = Char
'0'
  , tname :: Text
tname    = Text
"signboard"
  , tfreq :: Freqs TileKind
tfreq    = [ (GroupName TileKind
SIGNBOARD, Int
80), (GroupName TileKind
EMPTY_SET_LIT, Int
7)
               , (GroupName TileKind
ARENA_SET_LIT, Int
1), (GroupName TileKind
ARENA_SET_DARK, Int
2), (GroupName TileKind
MUSEUM_SET_DARK, Int
1)
               , (GroupName TileKind
FLIGHT_SET_DARK, Int
2) ]
  , tcolor :: Color
tcolor   = Color
BrCyan
  , tcolor2 :: Color
tcolor2  = Color
Cyan
  , talter :: Word8
talter   = Word8
5
  , tfeature :: [Feature]
tfeature = [GroupName ItemKind -> Feature
Embed GroupName ItemKind
SIGNAGE, GroupName TileKind -> Feature
HideAs GroupName TileKind
S_SIGNBOARD_UNREAD]
                 -- can't transform or the hidden version would not trigger
                 -- but only reveal the real version; needed extra keystroke
  }
treeLit :: TileKind
treeLit = TileKind :: Char
-> Text
-> Freqs TileKind
-> Color
-> Color
-> Word8
-> [Feature]
-> TileKind
TileKind
  { tsymbol :: Char
tsymbol  = Char
'0'
  , tname :: Text
tname    = Text
"tree"
  , tfreq :: Freqs TileKind
tfreq    = [ (GroupName TileKind
ARENA_SET_LIT, Int
9), (GroupName TileKind
EMPTY_SET_LIT, Int
4), (GroupName TileKind
BRAWL_SET_LIT, Int
140)
               , (GroupName TileKind
SHOOTOUT_SET_LIT, Int
10), (GroupName TileKind
HUNT_SET_LIT, Int
10)
               , (GroupName TileKind
FLIGHT_SET_LIT, Int
35), (GroupName TileKind
ZOO_SET_DARK, Int
20)
               , (GroupName TileKind
S_TREE_LIT, Int
1) ]
  , tcolor :: Color
tcolor   = Color
BrGreen
  , tcolor2 :: Color
tcolor2  = Color
Green
  , talter :: Word8
talter   = Word8
4
  , tfeature :: [Feature]
tfeature = [ProjectileTriggers
-> [(Int, GroupName ItemKind)] -> GroupName TileKind -> Feature
ChangeWith ProjectileTriggers
ProjYes [(Int
1, GroupName ItemKind
FIRE_SOURCE)] GroupName TileKind
S_BURNING_TREE]
  }
treeBurnt :: TileKind
treeBurnt = TileKind :: Char
-> Text
-> Freqs TileKind
-> Color
-> Color
-> Word8
-> [Feature]
-> TileKind
TileKind
  { tsymbol :: Char
tsymbol  = Char
'0'
  , tname :: Text
tname    = Text
"burnt tree"
  , tfreq :: Freqs TileKind
tfreq    = [(GroupName TileKind
ZOO_SET_DARK, Int
10), (GroupName TileKind
TREE_BURNING_OR_NOT, Int
30)]
  , tcolor :: Color
tcolor   = Color
BrBlack
  , tcolor2 :: Color
tcolor2  = Color
BrBlack
  , talter :: Word8
talter   = Word8
4
  , tfeature :: [Feature]
tfeature = [Feature
Dark]  -- even burned too hard to topple
  }
treeBurning :: TileKind
treeBurning = TileKind :: Char
-> Text
-> Freqs TileKind
-> Color
-> Color
-> Word8
-> [Feature]
-> TileKind
TileKind  -- present in EMPTY_SET_LIT as early light/fire source
  { tsymbol :: Char
tsymbol  = Char
'0'
  , tname :: Text
tname    = Text
"burning tree"
  , tfreq :: Freqs TileKind
tfreq    = [ (GroupName TileKind
EMPTY_SET_LIT, Int
2), (GroupName TileKind
ZOO_SET_DARK, Int
60)
               , (GroupName TileKind
TREE_BURNING_OR_NOT, Int
70), (GroupName TileKind
S_BURNING_TREE, Int
1) ]
  , tcolor :: Color
tcolor   = Color
BrRed
  , tcolor2 :: Color
tcolor2  = Color
Red
  , talter :: Word8
talter   = Word8
5
  , tfeature :: [Feature]
tfeature = [GroupName ItemKind -> Feature
Embed GroupName ItemKind
BIG_FIRE, GroupName TileKind -> Feature
ChangeTo GroupName TileKind
TREE_BURNING_OR_NOT]
      -- too tall to douse with a fireproof cloth or water; have to break off
      -- and isolate smaller branches and let it smolder out
      -- TODO: breaking the burning tree has more use when it periodically
      -- explodes, hitting and lighting up the team and so betraying it
  }
rubble :: TileKind
rubble = TileKind :: Char
-> Text
-> Freqs TileKind
-> Color
-> Color
-> Word8
-> [Feature]
-> TileKind
TileKind
  { tsymbol :: Char
tsymbol  = Char
'&'
  , tname :: Text
tname    = Text
"rubble pile"
  , tfreq :: Freqs TileKind
tfreq    = [ (GroupName TileKind
S_RUBBLE_PILE, Int
1), (GroupName TileKind
RUBBLE_BURNING_OR_NOT, Int
50)
               , (GroupName TileKind
STAIR_TERMINAL_LIT, Int
6), (GroupName TileKind
STAIR_TERMINAL_DARK, Int
6)
               , (GroupName TileKind
LIFT_TERMINAL_LIT, Int
6), (GroupName TileKind
LIFT_TERMINAL_DARK, Int
6)
               , (GroupName TileKind
EMPTY_SET_LIT, Int
12), (GroupName TileKind
EGRESS_SET_LIT, Int
6), (GroupName TileKind
VIRUS_SET_DARK, Int
6)
               , (GroupName TileKind
NOISE_SET_LIT, Int
40), (GroupName TileKind
POWER_SET_DARK, Int
120)
               , (GroupName TileKind
ZOO_SET_DARK, Int
150), (GroupName TileKind
AMBUSH_SET_DARK, Int
3) ]
  , tcolor :: Color
tcolor   = Color
BrYellow
  , tcolor2 :: Color
tcolor2  = Color
Brown
  , talter :: Word8
talter   = Word8
4  -- boss can dig through
  , tfeature :: [Feature]
tfeature = [ ProjectileTriggers
-> [(Int, GroupName ItemKind)] -> GroupName TileKind -> Feature
OpenWith ProjectileTriggers
ProjYes [(Int
1, GroupName ItemKind
BLAST_SOURCE)] GroupName TileKind
S_FLOOR_ASHES_LIT
                   -- can as well be first, because projectiles can't activate
                   -- embeds with non-zero talter; for non-projectiles,
                   -- if a @BLAST_SOURCE@ item could be found,
                   -- this is a safe way to open rubble, with no loot though
               , GroupName ItemKind -> Feature
Embed GroupName ItemKind
RUBBLE
               , GroupName TileKind -> Feature
OpenTo GroupName TileKind
S_FLOOR_ASHES_LIT ]
      -- Getting the item is risky and, e.g., AI doesn't attempt it.
      -- Also, AI doesn't go out of its way to clear the way for heroes.
      -- Rubble can't be ignited, but burning installation, when doused,
      -- becomes rubble. That's different than with trees and bushes.
  }
rubbleSpice :: TileKind
rubbleSpice = TileKind
rubble
  { tfreq :: Freqs TileKind
tfreq    = [ (GroupName TileKind
SMOKE_CLUMP_LIT, Int
1), (GroupName TileKind
SMOKE_CLUMP_DARK, Int
1)
               , (GroupName TileKind
RUBBLE_OR_WASTE_LIT, Int
1), (GroupName TileKind
RUBBLE_OR_WASTE_DARK, Int
1)
               , (GroupName TileKind
CACHE_DEPOSIT, Int
33) ]
  , tfeature :: [Feature]
tfeature = Feature
Spice Feature -> [Feature] -> [Feature]
forall a. a -> [a] -> [a]
: TileKind -> [Feature]
tfeature TileKind
rubble
  }
doorTrapped :: TileKind
doorTrapped = TileKind :: Char
-> Text
-> Freqs TileKind
-> Color
-> Color
-> Word8
-> [Feature]
-> TileKind
TileKind
  { tsymbol :: Char
tsymbol  = Char
'+'
  , tname :: Text
tname    = Text
"trapped door"
  , tfreq :: Freqs TileKind
tfreq    = [(GroupName TileKind
TRAPPED_DOOR, Int
1)]
  , tcolor :: Color
tcolor   = Color
BrRed
  , tcolor2 :: Color
tcolor2  = Color
Red
  , talter :: Word8
talter   = Word8
2
  , tfeature :: [Feature]
tfeature = [ ProjectileTriggers
-> [(Int, GroupName ItemKind)] -> GroupName TileKind -> Feature
ChangeWith ProjectileTriggers
ProjNo [(Int
1, GroupName ItemKind
WIRECUTTING_TOOL)] GroupName TileKind
S_CLOSED_DOOR
               , GroupName ItemKind -> Feature
Embed GroupName ItemKind
DOORWAY_TRAP
               , GroupName TileKind -> Feature
OpenTo GroupName TileKind
S_OPEN_DOOR
               , GroupName TileKind -> Feature
HideAs GroupName TileKind
S_SUSPECT_WALL
               ]
  }
doorClosed :: TileKind
doorClosed = TileKind :: Char
-> Text
-> Freqs TileKind
-> Color
-> Color
-> Word8
-> [Feature]
-> TileKind
TileKind  -- fireproof
  { tsymbol :: Char
tsymbol  = Char
'+'
  , tname :: Text
tname    = Text
"closed door"
  , tfreq :: Freqs TileKind
tfreq    = [(GroupName TileKind
S_CLOSED_DOOR, Int
1)]
  , tcolor :: Color
tcolor   = Color
Brown
  , tcolor2 :: Color
tcolor2  = Color
BrBlack
  , talter :: Word8
talter   = Word8
2
  , tfeature :: [Feature]
tfeature = [ GroupName TileKind -> Feature
OpenTo GroupName TileKind
S_OPEN_DOOR  -- never hidden
               , ProjectileTriggers
-> [(Int, GroupName ItemKind)] -> GroupName TileKind -> Feature
OpenWith ProjectileTriggers
ProjYes [(Int
1, GroupName ItemKind
BLAST_SOURCE)] GroupName TileKind
S_OPEN_DOOR ]
  }
stairsUp :: TileKind
stairsUp = TileKind :: Char
-> Text
-> Freqs TileKind
-> Color
-> Color
-> Word8
-> [Feature]
-> TileKind
TileKind  -- fireproof
  { tsymbol :: Char
tsymbol  = Char
'<'
  , tname :: Text
tname    = Text
"staircase up"
  , tfreq :: Freqs TileKind
tfreq    = [(GroupName TileKind
STAIRCASE_UP, Int
90), (GroupName TileKind
ORDINARY_STAIRCASE_UP, Int
1)]
  , tcolor :: Color
tcolor   = Color
BrWhite
  , tcolor2 :: Color
tcolor2  = Color
defFG
  , talter :: Word8
talter   = Word8
0  -- very easy stairs, unlike all others; projectiles trigger
  , tfeature :: [Feature]
tfeature = [GroupName ItemKind -> Feature
Embed GroupName ItemKind
STAIRS_UP, Feature
ConsideredByAI]
  }
stairsTrappedUp :: TileKind
stairsTrappedUp = TileKind :: Char
-> Text
-> Freqs TileKind
-> Color
-> Color
-> Word8
-> [Feature]
-> TileKind
TileKind
  { tsymbol :: Char
tsymbol  = Char
'<'
  , tname :: Text
tname    = Text
"windy staircase up"
  , tfreq :: Freqs TileKind
tfreq    = [(GroupName TileKind
STAIRCASE_UP, Int
10)]
  , tcolor :: Color
tcolor   = Color
BrRed
  , tcolor2 :: Color
tcolor2  = Color
Red
  , talter :: Word8
talter   = Word8
talterForStairs
  , tfeature :: [Feature]
tfeature = [ GroupName ItemKind -> Feature
Embed GroupName ItemKind
STAIRS_UP
               , GroupName ItemKind -> Feature
Embed GroupName ItemKind
STAIRS_TRAP_UP
               , Feature
ConsideredByAI, GroupName TileKind -> Feature
ChangeTo GroupName TileKind
ORDINARY_STAIRCASE_UP ]
                 -- AI uses despite the trap; exploration more important
  }
stairsOutdoorUp :: TileKind
stairsOutdoorUp = TileKind
stairsUp
  { tfreq :: Freqs TileKind
tfreq    = [(GroupName TileKind
STAIRCASE_OUTDOOR_UP, Int
1)]
  , talter :: Word8
talter   = Word8
talterForStairs
  , tfeature :: [Feature]
tfeature = [GroupName ItemKind -> Feature
Embed GroupName ItemKind
STAIRS_UP_OUTDOOR, Feature
ConsideredByAI]
  }
stairsGatedUp :: TileKind
stairsGatedUp = TileKind
stairsUp
  { tname :: Text
tname    = Text
"gated staircase up"
  , tfreq :: Freqs TileKind
tfreq    = [(GroupName TileKind
GATED_STAIRCASE_UP, Int
1)]
  , talter :: Word8
talter   = Word8
talterForStairs Word8 -> Word8 -> Word8
forall a. Num a => a -> a -> a
+ Word8
2  -- animals and bosses can't use
  }
stairsDown :: TileKind
stairsDown = TileKind :: Char
-> Text
-> Freqs TileKind
-> Color
-> Color
-> Word8
-> [Feature]
-> TileKind
TileKind
  { tsymbol :: Char
tsymbol  = Char
'>'
  , tname :: Text
tname    = Text
"staircase down"
  , tfreq :: Freqs TileKind
tfreq    = [(GroupName TileKind
STAIRCASE_DOWN, Int
90), (GroupName TileKind
ORDINARY_STAIRCASE_DOWN, Int
1)]
  , tcolor :: Color
tcolor   = Color
BrWhite
  , tcolor2 :: Color
tcolor2  = Color
defFG
  , talter :: Word8
talter   = Word8
0  -- very easy stairs, unlike all others; projectiles trigger
  , tfeature :: [Feature]
tfeature = [ ProjectileTriggers
-> [(Int, GroupName ItemKind)] -> GroupName TileKind -> Feature
ChangeWith ProjectileTriggers
ProjYes [(Int
1, GroupName ItemKind
OIL_SOURCE)] GroupName TileKind
S_STAIRCASE_TRAP_DOWN_OIL
                   -- even random oil explosions can create this trap
               , GroupName ItemKind -> Feature
Embed GroupName ItemKind
STAIRS_DOWN
               , Feature
ConsideredByAI ]
  }
stairsTrappedDown :: TileKind
stairsTrappedDown = TileKind :: Char
-> Text
-> Freqs TileKind
-> Color
-> Color
-> Word8
-> [Feature]
-> TileKind
TileKind
  { tsymbol :: Char
tsymbol  = Char
'>'
  , tname :: Text
tname    = Text
"cracked staircase down"
  , tfreq :: Freqs TileKind
tfreq    = [(GroupName TileKind
STAIRCASE_DOWN, Int
5)]
  , tcolor :: Color
tcolor   = Color
BrRed
  , tcolor2 :: Color
tcolor2  = Color
Red
  , talter :: Word8
talter   = Word8
talterForStairs
  , tfeature :: [Feature]
tfeature = [ GroupName ItemKind -> Feature
Embed GroupName ItemKind
STAIRS_DOWN
               , GroupName ItemKind -> Feature
Embed GroupName ItemKind
STAIRS_TRAP_DOWN
               , Feature
ConsideredByAI, GroupName TileKind -> Feature
ChangeTo GroupName TileKind
ORDINARY_STAIRCASE_DOWN ]
  }
stairsOutdoorDown :: TileKind
stairsOutdoorDown = TileKind
stairsDown
  { tfreq :: Freqs TileKind
tfreq    = [(GroupName TileKind
STAIRCASE_OUTDOOR_DOWN, Int
1)]
  , talter :: Word8
talter   = Word8
talterForStairs
  , tfeature :: [Feature]
tfeature = [GroupName ItemKind -> Feature
Embed GroupName ItemKind
STAIRS_DOWN_OUTDOOR, Feature
ConsideredByAI]
  }
stairsGatedDown :: TileKind
stairsGatedDown = TileKind
stairsDown
  { tname :: Text
tname    = Text
"gated staircase down"
  , tfreq :: Freqs TileKind
tfreq    = [(GroupName TileKind
GATED_STAIRCASE_DOWN, Int
1)]
  , talter :: Word8
talter   = Word8
talterForStairs Word8 -> Word8 -> Word8
forall a. Num a => a -> a -> a
+ Word8
2  -- animals and bosses can't use
  }
escapeUp :: TileKind
escapeUp = TileKind :: Char
-> Text
-> Freqs TileKind
-> Color
-> Color
-> Word8
-> [Feature]
-> TileKind
TileKind
  { tsymbol :: Char
tsymbol  = Char
'<'
  , tname :: Text
tname    = Text
"escape hatch up"
  , tfreq :: Freqs TileKind
tfreq    = [(GroupName TileKind
TILE_INDOOR_ESCAPE_UP, Int
1)]
  , tcolor :: Color
tcolor   = Color
BrYellow
  , tcolor2 :: Color
tcolor2  = Color
BrYellow
  , talter :: Word8
talter   = Word8
0  -- anybody can escape (or guard escape)
  , tfeature :: [Feature]
tfeature = [GroupName ItemKind -> Feature
Embed GroupName ItemKind
ESCAPE, Feature
ConsideredByAI]
  }
escapeDown :: TileKind
escapeDown = TileKind :: Char
-> Text
-> Freqs TileKind
-> Color
-> Color
-> Word8
-> [Feature]
-> TileKind
TileKind
  { tsymbol :: Char
tsymbol  = Char
'>'
  , tname :: Text
tname    = Text
"escape trapdoor down"
  , tfreq :: Freqs TileKind
tfreq    = [(GroupName TileKind
TILE_INDOOR_ESCAPE_DOWN, Int
1)]
  , tcolor :: Color
tcolor   = Color
BrYellow
  , tcolor2 :: Color
tcolor2  = Color
BrYellow
  , talter :: Word8
talter   = Word8
0  -- anybody can escape (or guard escape)
  , tfeature :: [Feature]
tfeature = [GroupName ItemKind -> Feature
Embed GroupName ItemKind
ESCAPE, Feature
ConsideredByAI]
  }
escapeOutdoorDown :: TileKind
escapeOutdoorDown = TileKind
escapeDown
  { tname :: Text
tname    = Text
"escape back to town"
  , tfreq :: Freqs TileKind
tfreq    = [(GroupName TileKind
TILE_OUTDOOR_ESCAPE_DOWN, Int
1)]
  }

-- *** Clear

wallGlass :: TileKind
wallGlass = TileKind :: Char
-> Text
-> Freqs TileKind
-> Color
-> Color
-> Word8
-> [Feature]
-> TileKind
TileKind
  { tsymbol :: Char
tsymbol  = Char
'%'
  , tname :: Text
tname    = Text
"transparent polymer wall"
  , tfreq :: Freqs TileKind
tfreq    = [(GroupName TileKind
TRANSPARENT_WALL, Int
1), (GroupName TileKind
MUSEUM_SET_DARK, Int
8)]
  , tcolor :: Color
tcolor   = Color
BrCyan
  , tcolor2 :: Color
tcolor2  = Color
Cyan
  , talter :: Word8
talter   = Word8
10
  , tfeature :: [Feature]
tfeature = [ GroupName TileKind -> Feature
BuildAs GroupName TileKind
S_CLOSED_DOOR  -- when ending a corridor, have doors
               , Feature
Clear ]
  }
wallGlassSpice :: TileKind
wallGlassSpice = TileKind
wallGlass
  { tfreq :: Freqs TileKind
tfreq    = [ (GroupName TileKind
RECT_WINDOWS, Int
20)
               , (GroupName TileKind
CACHE_JEWELRY, Int
40)
               , (GroupName TileKind
CACHE_JEWELRY_OR_NOT, Int
60)
               , (GroupName TileKind
CACHE_JEWELRY_TRAPPED_OR_NOT, Int
60) ]
  , tfeature :: [Feature]
tfeature = Feature
Spice Feature -> [Feature] -> [Feature]
forall a. a -> [a] -> [a]
: TileKind -> [Feature]
tfeature TileKind
wallGlass
  }
pillarIce :: TileKind
pillarIce = TileKind :: Char
-> Text
-> Freqs TileKind
-> Color
-> Color
-> Word8
-> [Feature]
-> TileKind
TileKind
  { tsymbol :: Char
tsymbol  = Char
'^'
  , tname :: Text
tname    = Text
"ice buildup"
  , tfreq :: Freqs TileKind
tfreq    = [ (GroupName TileKind
ICE_BUILDUP, Int
1), (GroupName TileKind
NOISE_SET_LIT, Int
200)
               , (GroupName TileKind
BRAWL_SET_LIT, Int
15), (GroupName TileKind
LIFT_TERMINAL_DARK, Int
4) ]
                 -- ice only in dark staircases
  , tcolor :: Color
tcolor   = Color
BrBlue
  , tcolor2 :: Color
tcolor2  = Color
Blue
  , talter :: Word8
talter   = Word8
4  -- boss can dig through
  , tfeature :: [Feature]
tfeature = [ Feature
Clear
               , GroupName ItemKind -> Feature
Embed GroupName ItemKind
FROST
               , GroupName TileKind -> Feature
OpenTo GroupName TileKind
S_SHALLOW_WATER_LIT
               , ProjectileTriggers
-> [(Int, GroupName ItemKind)] -> GroupName TileKind -> Feature
OpenWith ProjectileTriggers
ProjYes [(Int
1, GroupName ItemKind
BLAST_SOURCE)] GroupName TileKind
DAMP_FLOOR_LIT ]
  }
pulpit :: TileKind
pulpit = TileKind :: Char
-> Text
-> Freqs TileKind
-> Color
-> Color
-> Word8
-> [Feature]
-> TileKind
TileKind
  { tsymbol :: Char
tsymbol  = Char
'%'
  , tname :: Text
tname    = Text
"VR booth"
  , tfreq :: Freqs TileKind
tfreq    = [(GroupName TileKind
S_PULPIT, Int
1)]
  , tcolor :: Color
tcolor   = Color
BrYellow
  , tcolor2 :: Color
tcolor2  = Color
Brown
  , talter :: Word8
talter   = Word8
5
  , tfeature :: [Feature]
tfeature = [ ProjectileTriggers
-> [(Int, GroupName ItemKind)] -> GroupName TileKind -> Feature
ChangeWith ProjectileTriggers
ProjYes [(Int
1, GroupName ItemKind
FIRE_SOURCE)] GroupName TileKind
S_BURNING_INSTALLATION
                   -- wastes the loot; cruel, but rare; usually player's fault
               , GroupName ItemKind -> Feature
Embed GroupName ItemKind
LECTERN
               , Feature
Clear ]
                 -- mixed blessing, so AI ignores, saved for player's fun
  }
bushLit :: TileKind
bushLit = TileKind :: Char
-> Text
-> Freqs TileKind
-> Color
-> Color
-> Word8
-> [Feature]
-> TileKind
TileKind
  { tsymbol :: Char
tsymbol  = Char
'%'
  , tname :: Text
tname    = Text
"bush"
  , tfreq :: Freqs TileKind
tfreq    = [ (GroupName TileKind
S_BUSH_LIT, Int
1), (GroupName TileKind
EMPTY_SET_LIT, Int
8), (GroupName TileKind
ARENA_SET_LIT, Int
13)
               , (GroupName TileKind
BRAWL_SET_LIT, Int
5), (GroupName TileKind
SHOOTOUT_SET_LIT, Int
30), (GroupName TileKind
HUNT_SET_LIT, Int
30)
               , (GroupName TileKind
FLIGHT_SET_LIT, Int
40), (GroupName TileKind
ZOO_SET_DARK, Int
100)
               , (GroupName TileKind
BUSH_CLUMP_LIT, Int
2), (GroupName TileKind
BUSH_CLUMP_DARK, Int
2)  -- always lit
               , (GroupName TileKind
BUSH_GROVE_LIT, Int
5), (GroupName TileKind
BUSH_GROVE_DARK, Int
5)  -- always lit
               , (GroupName TileKind
PUMPS_LIT, Int
300)  -- dark in PUMPS_DARK
               , (GroupName TileKind
LIFT_TERMINAL_LIT, Int
4) ]
  , tcolor :: Color
tcolor   = Color
BrGreen
  , tcolor2 :: Color
tcolor2  = Color
Green
  , talter :: Word8
talter   = Word8
4
  , tfeature :: [Feature]
tfeature = [ ProjectileTriggers
-> [(Int, GroupName ItemKind)] -> GroupName TileKind -> Feature
ChangeWith ProjectileTriggers
ProjYes [(Int
1, GroupName ItemKind
FIRE_SOURCE)] GroupName TileKind
S_BURNING_BUSH
               , Feature
Clear ]
                 -- too tough to topple, has to be burned first
  }
bushBurnt :: TileKind
bushBurnt = TileKind :: Char
-> Text
-> Freqs TileKind
-> Color
-> Color
-> Word8
-> [Feature]
-> TileKind
TileKind
  { tsymbol :: Char
tsymbol  = Char
'%'
  , tname :: Text
tname    = Text
"burnt bush"
  , tfreq :: Freqs TileKind
tfreq    = [ (GroupName TileKind
BATTLE_SET_DARK, Int
30), (GroupName TileKind
AMBUSH_SET_DARK, Int
3)
               , (GroupName TileKind
ZOO_SET_DARK, Int
100), (GroupName TileKind
BUSH_BURNING_OR_NOT, Int
50) ]
  , tcolor :: Color
tcolor   = Color
BrBlack
  , tcolor2 :: Color
tcolor2  = Color
BrBlack
  , talter :: Word8
talter   = Word8
4
  , tfeature :: [Feature]
tfeature = [Feature
Dark, Feature
Clear, GroupName TileKind -> Feature
OpenTo GroupName TileKind
DIRT_DARK]
  }
bushBurning :: TileKind
bushBurning = TileKind :: Char
-> Text
-> Freqs TileKind
-> Color
-> Color
-> Word8
-> [Feature]
-> TileKind
TileKind
  { tsymbol :: Char
tsymbol  = Char
'%'
  , tname :: Text
tname    = Text
"burning bush"
  , tfreq :: Freqs TileKind
tfreq    = [ (GroupName TileKind
EMPTY_SET_LIT, Int
3), (GroupName TileKind
AMBUSH_SET_DARK, Int
10), (GroupName TileKind
ZOO_SET_DARK, Int
300)
               , (GroupName TileKind
BUSH_BURNING_OR_NOT, Int
50), (GroupName TileKind
S_BURNING_BUSH, Int
1) ]
  , tcolor :: Color
tcolor   = Color
BrRed
  , tcolor2 :: Color
tcolor2  = Color
Red
  , talter :: Word8
talter   = Word8
5
  , tfeature :: [Feature]
tfeature = [ Feature
Clear
               , GroupName ItemKind -> Feature
Embed GroupName ItemKind
SMALL_FIRE_5
                   -- crafting via embed first, transformation a fallback
               , ProjectileTriggers
-> [(Int, GroupName ItemKind)] -> GroupName TileKind -> Feature
OpenWith ProjectileTriggers
ProjYes [(Int
3, GroupName ItemKind
WATER_SOURCE)] GroupName TileKind
S_SMOKE_LIT
               , ProjectileTriggers
-> [(Int, GroupName ItemKind)] -> GroupName TileKind -> Feature
ChangeWith ProjectileTriggers
ProjNo [(Int
1, GroupName ItemKind
FIREPROOF_CLOTH)] GroupName TileKind
S_BUSH_LIT
                   -- full effects experienced, but bush saved for repeat
               , GroupName TileKind -> Feature
ChangeTo GroupName TileKind
BUSH_BURNING_OR_NOT ]
  }

-- ** Walkable

-- *** Not clear

fog :: TileKind
fog = TileKind :: Char
-> Text
-> Freqs TileKind
-> Color
-> Color
-> Word8
-> [Feature]
-> TileKind
TileKind  -- always lit
  { tsymbol :: Char
tsymbol  = Char
';'
  , tname :: Text
tname    = Text
"faint fog"
  , tfreq :: Freqs TileKind
tfreq    = [ (GroupName TileKind
S_FOG_LIT, Int
1), (GroupName TileKind
EMPTY_SET_LIT, Int
200), (GroupName TileKind
NOISE_SET_LIT, Int
120)
               , (GroupName TileKind
SHOOTOUT_SET_LIT, Int
30), (GroupName TileKind
HUNT_SET_LIT, Int
30)
               , (GroupName TileKind
FOG_CLUMP_LIT, Int
60), (GroupName TileKind
FOG_CLUMP_DARK, Int
60)
               , (GroupName TileKind
LIFT_TERMINAL_LIT, Int
20) ]
      -- lit fog is OK for shootout, because LOS is mutual, as opposed
      -- to dark fog, and so camper has little advantage, especially
      -- on big maps, where he doesn't know on which side of fog patch to hide
  , tcolor :: Color
tcolor   = Color
BrCyan
  , tcolor2 :: Color
tcolor2  = Color
Cyan
  , talter :: Word8
talter   = Word8
0
  , tfeature :: [Feature]
tfeature = [Feature
Walkable, Feature
NoItem, Feature
OftenActor]
  }
fogDark :: TileKind
fogDark = TileKind
fog  -- always dark
  { tname :: Text
tname    = Text
"thick fog"
  , tfreq :: Freqs TileKind
tfreq    = [(GroupName TileKind
FLIGHT_SET_DARK, Int
50), (GroupName TileKind
LIFT_TERMINAL_DARK, Int
40)]
  , tfeature :: [Feature]
tfeature = Feature
Dark Feature -> [Feature] -> [Feature]
forall a. a -> [a] -> [a]
: TileKind -> [Feature]
tfeature TileKind
fog
  }
smoke :: TileKind
smoke = TileKind :: Char
-> Text
-> Freqs TileKind
-> Color
-> Color
-> Word8
-> [Feature]
-> TileKind
TileKind  -- always lit
  { tsymbol :: Char
tsymbol  = Char
';'
  , tname :: Text
tname    = Text
"billowing smoke"
  , tfreq :: Freqs TileKind
tfreq    = [ (GroupName TileKind
S_SMOKE_LIT, Int
1), (GroupName TileKind
LAB_TRAIL_LIT, Int
1)
               , (GroupName TileKind
STAIR_TERMINAL_LIT, Int
2), (GroupName TileKind
LIFT_TERMINAL_LIT, Int
6)
               , (GroupName TileKind
SMOKE_CLUMP_LIT, Int
3), (GroupName TileKind
SMOKE_CLUMP_DARK, Int
3)
               , (GroupName TileKind
ASHES_SMOKE_LIT, Int
1), (GroupName TileKind
ASHES_SMOKE_DARK, Int
1)
               , (GroupName TileKind
EGRESS_SET_LIT, Int
20), (GroupName TileKind
VIRUS_SET_DARK, Int
30)
               , (GroupName TileKind
AMBUSH_SET_DARK, Int
20) ]
  , tcolor :: Color
tcolor   = Color
Brown
  , tcolor2 :: Color
tcolor2  = Color
BrBlack
  , talter :: Word8
talter   = Word8
0
  , tfeature :: [Feature]
tfeature = [Feature
Walkable, Feature
NoItem]  -- not dark, embers
  }
smokeDark :: TileKind
smokeDark = TileKind
smoke  -- always dark
  { tname :: Text
tname    = Text
"lingering smoke"
  , tfreq :: Freqs TileKind
tfreq    = [ (GroupName TileKind
POWER_SET_DARK, Int
100), (GroupName TileKind
VIRUS_SET_DARK, Int
30)
               , (GroupName TileKind
ZOO_SET_DARK, Int
20), (GroupName TileKind
AMBUSH_SET_DARK, Int
40), (GroupName TileKind
BATTLE_SET_DARK, Int
5)
               , (GroupName TileKind
STAIR_TERMINAL_DARK, Int
2), (GroupName TileKind
LIFT_TERMINAL_DARK, Int
6) ]
  , tfeature :: [Feature]
tfeature = Feature
Dark Feature -> [Feature] -> [Feature]
forall a. a -> [a] -> [a]
: TileKind -> [Feature]
tfeature TileKind
smoke
  }

-- *** Clear

doorOpen :: TileKind
doorOpen = TileKind :: Char
-> Text
-> Freqs TileKind
-> Color
-> Color
-> Word8
-> [Feature]
-> TileKind
TileKind  -- fireproof
  { tsymbol :: Char
tsymbol  = Char
'\''
  , tname :: Text
tname    = Text
"open door"
  , tfreq :: Freqs TileKind
tfreq    = [(GroupName TileKind
S_OPEN_DOOR, Int
1)]
  , tcolor :: Color
tcolor   = Color
Brown
  , tcolor2 :: Color
tcolor2  = Color
BrBlack
  , talter :: Word8
talter   = Word8
4
  , tfeature :: [Feature]
tfeature = [ Feature
Walkable, Feature
Clear, Feature
NoItem, Feature
NoActor
               , GroupName TileKind -> Feature
CloseTo GroupName TileKind
S_CLOSED_DOOR  -- not explorable due to that
               ]
  }
floorCorridor :: TileKind
floorCorridor = TileKind :: Char
-> Text
-> Freqs TileKind
-> Color
-> Color
-> Word8
-> [Feature]
-> TileKind
TileKind
  { tsymbol :: Char
tsymbol  = Char
floorSymbol
  , tname :: Text
tname    = Text
"floor"
  , tfreq :: Freqs TileKind
tfreq    = [(GroupName TileKind
FLOOR_CORRIDOR_LIT, Int
1)]
  , tcolor :: Color
tcolor   = Color
BrWhite
  , tcolor2 :: Color
tcolor2  = Color
defFG
  , talter :: Word8
talter   = Word8
0
  , tfeature :: [Feature]
tfeature = [Feature
Walkable, Feature
Clear]  -- porous, so spilling doesn't transform
  }
floorArena :: TileKind
floorArena = TileKind
floorCorridor
  { tfreq :: Freqs TileKind
tfreq    = [ (GroupName TileKind
FLOOR_ARENA_LIT, Int
1), (GroupName TileKind
ARENA_SET_LIT, Int
400)
               , (GroupName TileKind
MUSEUM_SET_LIT, Int
400), (GroupName TileKind
NOISE_SET_LIT, Int
50), (GroupName TileKind
POWER_SET_LIT, Int
50)
               , (GroupName TileKind
EMPTY_SET_LIT, Int
400), (GroupName TileKind
EGRESS_SET_LIT, Int
100), (GroupName TileKind
VIRUS_SET_LIT, Int
80)
               , (GroupName TileKind
ZOO_SET_LIT, Int
500) ]
  }
floorDamp :: TileKind
floorDamp = TileKind
floorArena
  { tname :: Text
tname    = Text
"damp floor"
  , tfreq :: Freqs TileKind
tfreq    = [ (GroupName TileKind
NOISE_SET_LIT, Int
550), (GroupName TileKind
EMPTY_SET_LIT, Int
3000)
               , (GroupName TileKind
FLIGHT_SET_LIT, Int
300), (GroupName TileKind
DAMP_FLOOR_LIT, Int
1)
               , (GroupName TileKind
STAIR_TERMINAL_LIT, Int
20), (GroupName TileKind
LIFT_TERMINAL_LIT, Int
6) ]
  , tfeature :: [Feature]
tfeature = ProjectileTriggers
-> [(Int, GroupName ItemKind)] -> GroupName TileKind -> Feature
ChangeWith ProjectileTriggers
ProjYes [(Int
1, GroupName ItemKind
OIL_SOURCE)] GroupName TileKind
S_OIL_SPILL  -- oil floats
               Feature -> [Feature] -> [Feature]
forall a. a -> [a] -> [a]
: ProjectileTriggers
-> [(Int, GroupName ItemKind)] -> GroupName TileKind -> Feature
ChangeWith ProjectileTriggers
ProjYes [(Int
1, GroupName ItemKind
COLD_SOURCE)] GroupName TileKind
S_FROZEN_PATH
               Feature -> [Feature] -> [Feature]
forall a. a -> [a] -> [a]
: ProjectileTriggers
-> [(Int, GroupName ItemKind)] -> GroupName TileKind -> Feature
ChangeWith ProjectileTriggers
ProjYes [(Int
5, GroupName ItemKind
WATER_SOURCE)] GroupName TileKind
S_SHALLOW_WATER_LIT
               Feature -> [Feature] -> [Feature]
forall a. a -> [a] -> [a]
: TileKind -> [Feature]
tfeature TileKind
floorArena
  }
floorDirt :: TileKind
floorDirt = TileKind
floorArena
  { tname :: Text
tname    = Text
"dirt floor"
  , tfreq :: Freqs TileKind
tfreq    = [ (GroupName TileKind
BRAWL_SET_LIT, Int
900), (GroupName TileKind
SHOOTOUT_SET_LIT, Int
900)
               , (GroupName TileKind
HUNT_SET_LIT, Int
900), (GroupName TileKind
FLIGHT_SET_LIT, Int
700)
               , (GroupName TileKind
AMBUSH_SET_LIT, Int
1000), (GroupName TileKind
BATTLE_SET_LIT, Int
500)
               , (GroupName TileKind
DIRT_LIT, Int
1) ]
  }
floorDirtSpice :: TileKind
floorDirtSpice = TileKind
floorDirt
  { tfreq :: Freqs TileKind
tfreq    = [ (GroupName TileKind
TREE_SHADE_WALKABLE_LIT, Int
1), (GroupName TileKind
BUSH_CLUMP_LIT, Int
1)
               , (GroupName TileKind
UNDERBRUSH_CLUMP_LIT, Int
1), (GroupName TileKind
PUMPS_LIT, Int
100) ]
  , tfeature :: [Feature]
tfeature = Feature
Spice Feature -> [Feature] -> [Feature]
forall a. a -> [a] -> [a]
: TileKind -> [Feature]
tfeature TileKind
floorDirt
  }
floorActor :: TileKind
floorActor = TileKind
floorArena
  { tfreq :: Freqs TileKind
tfreq    = [(GroupName TileKind
S_FLOOR_ACTOR_LIT, Int
1)]
  , tfeature :: [Feature]
tfeature = Feature
OftenActor Feature -> [Feature] -> [Feature]
forall a. a -> [a] -> [a]
: TileKind -> [Feature]
tfeature TileKind
floorArena
  }
floorActorItem :: TileKind
floorActorItem = TileKind
floorActor
  { tfreq :: Freqs TileKind
tfreq    = [(GroupName TileKind
FLOOR_ACTOR_ITEM, Int
1), (GroupName TileKind
FLOOR_ACTOR_ITEM_LIT, Int
1)]
  , tfeature :: [Feature]
tfeature = Feature
VeryOftenItem Feature -> [Feature] -> [Feature]
forall a. a -> [a] -> [a]
: TileKind -> [Feature]
tfeature TileKind
floorActor
  }
floorAshes :: TileKind
floorAshes = TileKind
floorActor  -- always lit
  { tfreq :: Freqs TileKind
tfreq    = [ (GroupName TileKind
SMOKE_CLUMP_LIT, Int
1)
               , (GroupName TileKind
S_FLOOR_ASHES_LIT, Int
1), (GroupName TileKind
S_FLOOR_ASHES_DARK, Int
1)
               , (GroupName TileKind
ASHES_SMOKE_LIT, Int
2), (GroupName TileKind
ASHES_SMOKE_DARK, Int
5)
               , (GroupName TileKind
RUBBLE_BURNING_OR_NOT, Int
25) ]
  , tname :: Text
tname    = Text
"dirt and ash pile"
  , tcolor :: Color
tcolor   = Color
Brown
  , tcolor2 :: Color
tcolor2  = Color
Brown
  }
shallowWater :: TileKind
shallowWater = TileKind :: Char
-> Text
-> Freqs TileKind
-> Color
-> Color
-> Word8
-> [Feature]
-> TileKind
TileKind
  { tsymbol :: Char
tsymbol  = Char
'~'
  , tname :: Text
tname    = Text
"water puddle"
  , tfreq :: Freqs TileKind
tfreq    = [ (GroupName TileKind
AQUATIC, Int
1), (GroupName TileKind
S_SHALLOW_WATER_LIT, Int
1)
               , (GroupName TileKind
EMPTY_SET_LIT, Int
20), (GroupName TileKind
NOISE_SET_LIT, Int
30), (GroupName TileKind
SHOOTOUT_SET_LIT, Int
5)
               , (GroupName TileKind
HUNT_SET_LIT, Int
250), (GroupName TileKind
LIFT_TERMINAL_LIT, Int
4) ]
  , tcolor :: Color
tcolor   = Color
BrCyan
  , tcolor2 :: Color
tcolor2  = Color
Cyan
  , talter :: Word8
talter   = Word8
2  -- projectiles won't trigger embeds
  , tfeature :: [Feature]
tfeature = GroupName ItemKind -> Feature
Embed GroupName ItemKind
SHALLOW_WATER
                 -- crafting via embed first, transformations a fallback
               Feature -> [Feature] -> [Feature]
forall a. a -> [a] -> [a]
: ProjectileTriggers
-> [(Int, GroupName ItemKind)] -> GroupName TileKind -> Feature
ChangeWith ProjectileTriggers
ProjYes [(Int
1, GroupName ItemKind
OIL_SOURCE)] GroupName TileKind
S_OIL_SPILL  -- oil floats
               Feature -> [Feature] -> [Feature]
forall a. a -> [a] -> [a]
: ProjectileTriggers
-> [(Int, GroupName ItemKind)] -> GroupName TileKind -> Feature
ChangeWith ProjectileTriggers
ProjYes [(Int
1, GroupName ItemKind
COLD_SOURCE)] GroupName TileKind
S_FROZEN_PATH
               Feature -> [Feature] -> [Feature]
forall a. a -> [a] -> [a]
: TileKind -> [Feature]
tfeature TileKind
floorActor
      -- can't make fog from water, because air would need to be cool, too;
      -- if concealment needed, make smoke from fire instead
  }
shallowWaterSpice :: TileKind
shallowWaterSpice = TileKind
shallowWater
  { tfreq :: Freqs TileKind
tfreq    = [ (GroupName TileKind
FOG_CLUMP_LIT, Int
40), (GroupName TileKind
PUMPS_LIT, Int
200)
               , (GroupName TileKind
RUBBLE_OR_WASTE_LIT, Int
1) ]
  , tfeature :: [Feature]
tfeature = Feature
Spice Feature -> [Feature] -> [Feature]
forall a. a -> [a] -> [a]
: TileKind -> [Feature]
tfeature TileKind
shallowWater
  }
shallowWater2 :: TileKind
shallowWater2 = TileKind
shallowWater
  { tname :: Text
tname    = Text
"water pool"
  , tfreq :: Freqs TileKind
tfreq    = [(GroupName TileKind
S_POOL_LIT, Int
1)]
  }
floorRed :: TileKind
floorRed = TileKind
floorCorridor  -- always lit
  { tname :: Text
tname    = Text
"emergency walkway"
  , tfreq :: Freqs TileKind
tfreq    = [(GroupName TileKind
TRAIL_LIT, Int
50), (GroupName TileKind
SAFE_TRAIL_LIT, Int
50)]
  , tcolor :: Color
tcolor   = Color
BrRed
  , tcolor2 :: Color
tcolor2  = Color
Red
  , tfeature :: [Feature]
tfeature = [ ProjectileTriggers
-> [(Int, GroupName ItemKind)] -> GroupName TileKind -> Feature
ChangeWith ProjectileTriggers
ProjYes [(Int
1, GroupName ItemKind
OIL_SOURCE)] GroupName TileKind
S_OIL_SPILL
                   -- non-porous enough
               , GroupName ItemKind -> Feature
Embed GroupName ItemKind
STRAIGHT_PATH
               , Feature
Trail, Feature
Walkable, Feature
Clear ]
  }
floorBlue :: TileKind
floorBlue = TileKind
floorRed  -- always lit
  { tname :: Text
tname    = Text
"frozen path"
  , tfreq :: Freqs TileKind
tfreq    = [(GroupName TileKind
TRAIL_LIT, Int
50), (GroupName TileKind
S_FROZEN_PATH, Int
1)]
  , tcolor :: Color
tcolor   = Color
BrBlue
  , tcolor2 :: Color
tcolor2  = Color
Blue
  , talter :: Word8
talter   = Word8
0
  , tfeature :: [Feature]
tfeature = [ ProjectileTriggers
-> [(Int, GroupName ItemKind)] -> GroupName TileKind -> Feature
ChangeWith ProjectileTriggers
ProjYes [(Int
1, GroupName ItemKind
FIRE_SOURCE)] GroupName TileKind
S_SHALLOW_WATER_LIT
               , ProjectileTriggers
-> [(Int, GroupName ItemKind)] -> GroupName TileKind -> Feature
ChangeWith ProjectileTriggers
ProjYes [(Int
1, GroupName ItemKind
OIL_SOURCE)] GroupName TileKind
S_OIL_SPILL
                   -- non-porous enough
               , GroupName ItemKind -> Feature
Embed GroupName ItemKind
FROZEN_GROUND
               , Feature
Trail, Feature
Walkable, Feature
Clear ]
  }
floorBrown :: TileKind
floorBrown = TileKind
floorRed  -- always lit
  { tname :: Text
tname    = Text
"transport route"
  , tfreq :: Freqs TileKind
tfreq    = [ (GroupName TileKind
TRAIL_LIT, Int
50), (GroupName TileKind
SAFE_TRAIL_LIT, Int
50)
               , (GroupName TileKind
TRANSPORT_ROUTE, Int
1) ]
  , tcolor :: Color
tcolor   = Color
BrMagenta
  , tcolor2 :: Color
tcolor2  = Color
Magenta
  }
floorArenaShade :: TileKind
floorArenaShade = TileKind
floorActor  -- always dark
  { tname :: Text
tname    = Text
"shaded ground"
  , tfreq :: Freqs TileKind
tfreq    = [ (GroupName TileKind
S_SHADED_GROUND, Int
1)
               , (GroupName TileKind
TREE_SHADE_WALKABLE_LIT, Int
2), (GroupName TileKind
TREE_SHADE_WALKABLE_DARK, Int
2)]
  , tcolor :: Color
tcolor   = Color
BrYellow  -- match others, even though no lit counterpart
  , tcolor2 :: Color
tcolor2  = Color
BrBlack
  , tfeature :: [Feature]
tfeature = Feature
Dark Feature -> [Feature] -> [Feature]
forall a. a -> [a] -> [a]
: Feature
NoItem Feature -> [Feature] -> [Feature]
forall a. a -> [a] -> [a]
: TileKind -> [Feature]
tfeature TileKind
floorActor
  }

-- * Allure-specific

-- ** Not walkable

-- *** Not clear

oriel :: TileKind
oriel = TileKind :: Char
-> Text
-> Freqs TileKind
-> Color
-> Color
-> Word8
-> [Feature]
-> TileKind
TileKind  -- no dark variant; it looks dark even when lit
  { tsymbol :: Char
tsymbol  = Char
'%'  -- story-wise it's transparent, hence the symbol
  , tname :: Text
tname    = Text
"oriel"
  , tfreq :: Freqs TileKind
tfreq    = [ (GroupName TileKind
ORIELS_FENCE, Int
15)
               , (GroupName TileKind
AIRLOCK_FENCE, Int
5), (GroupName TileKind
EMPTY_AIRLOCK_FENCE, Int
5) ]
  , tcolor :: Color
tcolor   = Color
BrBlack
  , tcolor2 :: Color
tcolor2  = Color
BrBlack
  , talter :: Word8
talter   = Word8
5
  , tfeature :: [Feature]
tfeature = [GroupName ItemKind -> Feature
Embed GroupName ItemKind
BLACK_STARRY_SKY]
      -- this is morally @Clear@, but technically it would reach outside the map
  }
outerHullWall :: TileKind
outerHullWall = TileKind
basicOuterFence
  { tname :: Text
tname    = Text
"outer hull wall"
  , tfreq :: Freqs TileKind
tfreq    = [ (GroupName TileKind
S_BASIC_OUTER_FENCE, Int
1), (GroupName TileKind
ORIELS_FENCE, Int
85)
               , (GroupName TileKind
AIRLOCK_FENCE, Int
40), (GroupName TileKind
EMPTY_AIRLOCK_FENCE, Int
40) ]
  }
rubbleBurning :: TileKind
rubbleBurning = TileKind :: Char
-> Text
-> Freqs TileKind
-> Color
-> Color
-> Word8
-> [Feature]
-> TileKind
TileKind  -- present in EMPTY_SET_LIT as early light/fire source
  { tsymbol :: Char
tsymbol  = Char
'&'
  , tname :: Text
tname    = Text
"burning installation"
  , tfreq :: Freqs TileKind
tfreq    = [ (GroupName TileKind
EMPTY_SET_LIT, Int
2), (GroupName TileKind
POWER_SET_DARK, Int
20)
               , (GroupName TileKind
AMBUSH_SET_DARK, Int
15), (GroupName TileKind
ZOO_SET_DARK, Int
30)
               , (GroupName TileKind
STAIR_TERMINAL_LIT, Int
4), (GroupName TileKind
STAIR_TERMINAL_DARK, Int
4)
               , (GroupName TileKind
LIFT_TERMINAL_LIT, Int
4), (GroupName TileKind
LIFT_TERMINAL_DARK, Int
4)
               , (GroupName TileKind
S_BURNING_INSTALLATION, Int
1), (GroupName TileKind
RUBBLE_BURNING_OR_NOT, Int
25) ]
  , tcolor :: Color
tcolor   = Color
BrRed
  , tcolor2 :: Color
tcolor2  = Color
Red
  , talter :: Word8
talter   = Word8
4  -- boss can dig through
  , tfeature :: [Feature]
tfeature = [ ProjectileTriggers
-> [(Int, GroupName ItemKind)] -> GroupName TileKind -> Feature
OpenWith ProjectileTriggers
ProjYes [(Int
3, GroupName ItemKind
WATER_SOURCE)] GroupName TileKind
S_SMOKE_LIT
               , ProjectileTriggers
-> [(Int, GroupName ItemKind)] -> GroupName TileKind -> Feature
OpenWith ProjectileTriggers
ProjYes [(Int
1, GroupName ItemKind
BLAST_SOURCE)] GroupName TileKind
ASHES_SMOKE_LIT
               , GroupName ItemKind -> Feature
Embed GroupName ItemKind
BIG_FIRE  -- not as tall as a tree, so quenchable
               , ProjectileTriggers
-> [(Int, GroupName ItemKind)] -> GroupName TileKind -> Feature
ChangeWith ProjectileTriggers
ProjNo [(Int
1, GroupName ItemKind
FIREPROOF_CLOTH)] GroupName TileKind
S_RUBBLE_PILE
                   -- full effects experienced, but rubble saved for repeat
               , ProjectileTriggers
-> [(Int, GroupName ItemKind)] -> GroupName TileKind -> Feature
OpenWith ProjectileTriggers
ProjNo [] GroupName TileKind
RUBBLE_BURNING_OR_NOT ]
                   -- no pathfinding through
  }
rubbleBurningSpice :: TileKind
rubbleBurningSpice = TileKind
rubbleBurning
  { tfreq :: Freqs TileKind
tfreq    = [ (GroupName TileKind
SMOKE_CLUMP_LIT, Int
1), (GroupName TileKind
SMOKE_CLUMP_DARK, Int
1)
               , (GroupName TileKind
CACHE_DEPOSIT, Int
33) ]
  , tfeature :: [Feature]
tfeature = Feature
Spice Feature -> [Feature] -> [Feature]
forall a. a -> [a] -> [a]
: TileKind -> [Feature]
tfeature TileKind
rubbleBurning
  }
wallOpenable :: TileKind
wallOpenable = TileKind
bedrock
  { tfreq :: Freqs TileKind
tfreq    = [(GroupName TileKind
OPENABLE_WALL, Int
1)]
  , tfeature :: [Feature]
tfeature = [GroupName TileKind -> Feature
BuildAs GroupName TileKind
S_CLOSED_DOOR]  -- when ending a corridor, have doors
  }
wallObscuredSafety :: TileKind
wallObscuredSafety = TileKind :: Char
-> Text
-> Freqs TileKind
-> Color
-> Color
-> Word8
-> [Feature]
-> TileKind
TileKind
  { tsymbol :: Char
tsymbol  = Char
'#'
  , tname :: Text
tname    = Text
"safety procedures board"
  , tfreq :: Freqs TileKind
tfreq    = [(GroupName TileKind
OBSCURED_WALL, Int
4), (GroupName TileKind
EGRESS_SET_LIT, Int
1), (GroupName TileKind
VIRUS_SET_DARK, Int
1)]
  , tcolor :: Color
tcolor   = Color
BrWhite
  , tcolor2 :: Color
tcolor2  = Color
defFG
  , talter :: Word8
talter   = Word8
5
  , tfeature :: [Feature]
tfeature = [ GroupName ItemKind -> Feature
Embed GroupName ItemKind
RUINED_FIRST_AID_KIT
               , GroupName TileKind -> Feature
HideAs GroupName TileKind
S_SUSPECT_WALL
               ]
  }
signboardReadExtinguisher :: TileKind
signboardReadExtinguisher = TileKind :: Char
-> Text
-> Freqs TileKind
-> Color
-> Color
-> Word8
-> [Feature]
-> TileKind
TileKind
  { tsymbol :: Char
tsymbol  = Char
'0'
  , tname :: Text
tname    = Text
"fire extinguisher cabinet"
  , tfreq :: Freqs TileKind
tfreq    = [ (GroupName TileKind
SIGNBOARD, Int
20)
               , (GroupName TileKind
LIFT_TERMINAL_LIT, Int
10), (GroupName TileKind
LIFT_TERMINAL_DARK, Int
10)
               , (GroupName TileKind
EMPTY_SET_LIT, Int
7), (GroupName TileKind
ARENA_SET_LIT, Int
1), (GroupName TileKind
ARENA_SET_DARK, Int
2)
               , (GroupName TileKind
MUSEUM_SET_DARK, Int
1), (GroupName TileKind
EGRESS_SET_LIT, Int
1), (GroupName TileKind
VIRUS_SET_DARK, Int
1)
               , (GroupName TileKind
NOISE_SET_LIT, Int
1), (GroupName TileKind
FLIGHT_SET_DARK, Int
1)
               , (GroupName TileKind
AMBUSH_SET_DARK, Int
1) ]
  , tcolor :: Color
tcolor   = Color
BrCyan
  , tcolor2 :: Color
tcolor2  = Color
Cyan
  , talter :: Word8
talter   = Word8
5
  , tfeature :: [Feature]
tfeature = [ GroupName ItemKind -> Feature
Embed GroupName ItemKind
FIRE_FIGHTING_GEAR
               , GroupName TileKind -> Feature
HideAs GroupName TileKind
S_SIGNBOARD_UNREAD
               ]
  }
wallObscured3dBillboard :: TileKind
wallObscured3dBillboard = TileKind :: Char
-> Text
-> Freqs TileKind
-> Color
-> Color
-> Word8
-> [Feature]
-> TileKind
TileKind
  { tsymbol :: Char
tsymbol  = Char
'#'
  , tname :: Text
tname    = Text
"3D billboard"
  , tfreq :: Freqs TileKind
tfreq    = [(GroupName TileKind
OBSCURED_WALL, Int
15)]
  , tcolor :: Color
tcolor   = Color
BrWhite
  , tcolor2 :: Color
tcolor2  = Color
defFG
  , talter :: Word8
talter   = Word8
5
  , tfeature :: [Feature]
tfeature = [ GroupName ItemKind -> Feature
Embed GroupName ItemKind
DISPLAY_3D
               , GroupName TileKind -> Feature
HideAs GroupName TileKind
S_SUSPECT_WALL
               ]
  }
wallObscuredPipework :: TileKind
wallObscuredPipework = TileKind :: Char
-> Text
-> Freqs TileKind
-> Color
-> Color
-> Word8
-> [Feature]
-> TileKind
TileKind
  { tsymbol :: Char
tsymbol  = Char
'#'
  , tname :: Text
tname    = Text
"exposed pipework"
  , tfreq :: Freqs TileKind
tfreq    = [(GroupName TileKind
OBSCURED_WALL, Int
25)]
  , tcolor :: Color
tcolor   = Color
BrWhite
  , tcolor2 :: Color
tcolor2  = Color
defFG
  , talter :: Word8
talter   = Word8
5
  , tfeature :: [Feature]
tfeature = [ GroupName ItemKind -> Feature
Embed GroupName ItemKind
CRACKED_FLUE
               , GroupName TileKind -> Feature
HideAs GroupName TileKind
S_SUSPECT_WALL
               ]
  }
wallObscuredScary :: TileKind
wallObscuredScary = TileKind :: Char
-> Text
-> Freqs TileKind
-> Color
-> Color
-> Word8
-> [Feature]
-> TileKind
TileKind
  { tsymbol :: Char
tsymbol  = Char
'#'
  , tname :: Text
tname    = Text
"stained wall"
  , tfreq :: Freqs TileKind
tfreq    = [(GroupName TileKind
OBSCURED_WALL, Int
35)]
  , tcolor :: Color
tcolor   = Color
BrWhite
  , tcolor2 :: Color
tcolor2  = Color
defFG
  , talter :: Word8
talter   = Word8
5
  , tfeature :: [Feature]
tfeature = [ GroupName ItemKind -> Feature
Embed GroupName ItemKind
BLOOD_ON_WALL
               , GroupName TileKind -> Feature
HideAs GroupName TileKind
S_SUSPECT_WALL
               ]
  }
liftShaft :: TileKind
liftShaft = TileKind
pillar
  { tname :: Text
tname    = Text
"lift shaft"
  , tfreq :: Freqs TileKind
tfreq    = [(GroupName TileKind
S_LIFT_SHAFT, Int
1)]
  }
rock :: TileKind
rock = TileKind
pillar
  { tname :: Text
tname    = Text
"rock outcrop"
  , tfreq :: Freqs TileKind
tfreq    = [(GroupName TileKind
ARENA_SET_LIT, Int
6), (GroupName TileKind
BRAWL_SET_LIT, Int
30)]
  }
pillarCache2 :: TileKind
pillarCache2 = TileKind
pillarCache
  { tname :: Text
tname    = Text
"rack of deposit boxes"
  , tfreq :: Freqs TileKind
tfreq    = [ (GroupName TileKind
CACHE_DEPOSIT_OR_NOT, Int
33)
               , (GroupName TileKind
CACHE_DEPOSIT_BREACHED, Int
1) ]
  , tfeature :: [Feature]
tfeature = [ GroupName ItemKind -> Feature
Embed GroupName ItemKind
DEPOSIT_BOX
               , GroupName TileKind -> Feature
ChangeTo GroupName TileKind
CACHE_DEPOSIT_OR_NOT
               , Feature
ConsideredByAI ]
  }
pillarCache3 :: TileKind
pillarCache3 = TileKind
pillarCache
  { tname :: Text
tname    = Text
"rack of sealed deposit boxes"
  , tfreq :: Freqs TileKind
tfreq    = [ (GroupName TileKind
CACHE_DEPOSIT, Int
33), (GroupName TileKind
ARENA_SET_DARK, Int
4)
               , (GroupName TileKind
STAIR_TERMINAL_LIT, Int
1), (GroupName TileKind
STAIR_TERMINAL_DARK, Int
1) ]
  , tfeature :: [Feature]
tfeature = [ ProjectileTriggers
-> [(Int, GroupName ItemKind)] -> GroupName TileKind -> Feature
ChangeWith ProjectileTriggers
ProjNo [(Int
1, GroupName ItemKind
BREACHING_TOOL)] GroupName TileKind
CACHE_DEPOSIT_BREACHED
                   -- @BLAST_SOURCE@ not enough
               , Feature
ConsideredByAI ]
  }
pillarCache4 :: TileKind
pillarCache4 = TileKind
pillarCache
  { tname :: Text
tname    = Text
"jewelry display"
  , tfreq :: Freqs TileKind
tfreq    = [(GroupName TileKind
CACHE_JEWELRY_OR_NOT, Int
40)]
  , tfeature :: [Feature]
tfeature = [ GroupName ItemKind -> Feature
Embed GroupName ItemKind
JEWELRY_CASE
               , GroupName TileKind -> Feature
ChangeTo GroupName TileKind
CACHE_JEWELRY_OR_NOT
               , Feature
ConsideredByAI ]
  }
pillarCache5 :: TileKind
pillarCache5 = TileKind
pillarCache
  { tname :: Text
tname    = Text
"jewelry display"
  , tfreq :: Freqs TileKind
tfreq    = [ (GroupName TileKind
CACHE_JEWELRY_TRAPPED_OR_NOT, Int
40), (GroupName TileKind
CACHE_JEWELRY, Int
60)
               , (GroupName TileKind
MUSEUM_SET_DARK, Int
2) ]
  , tfeature :: [Feature]
tfeature = [ GroupName ItemKind -> Feature
Embed GroupName ItemKind
JEWELRY_CASE
               , ProjectileTriggers
-> [(Int, GroupName ItemKind)] -> GroupName TileKind -> Feature
ChangeWith ProjectileTriggers
ProjNo [(Int
1, GroupName ItemKind
COLD_SOURCE)]
                            GroupName TileKind
CACHE_JEWELRY_TRAPPED_OR_NOT
                   -- halts watchdog
               , ProjectileTriggers
-> [(Int, GroupName ItemKind)] -> GroupName TileKind -> Feature
ChangeWith ProjectileTriggers
ProjNo [(Int
1, GroupName ItemKind
WIRECUTTING_TOOL)] GroupName TileKind
CACHE_JEWELRY_OR_NOT
                   -- disarms trap altogether
               , GroupName ItemKind -> Feature
Embed GroupName ItemKind
JEWELRY_DISPLAY_TRAP
               , GroupName TileKind -> Feature
ChangeTo GroupName TileKind
CACHE_JEWELRY_TRAPPED_OR_NOT ]
               -- not ConsideredByAI, to leave the risk and reward to the player
  }
stairsTrappedDownOil :: TileKind
stairsTrappedDownOil = TileKind :: Char
-> Text
-> Freqs TileKind
-> Color
-> Color
-> Word8
-> [Feature]
-> TileKind
TileKind
  { tsymbol :: Char
tsymbol  = Char
'>'
  , tname :: Text
tname    = Text
"slippery staircase down"
  , tfreq :: Freqs TileKind
tfreq    = [(GroupName TileKind
STAIRCASE_DOWN, Int
5), (GroupName TileKind
S_STAIRCASE_TRAP_DOWN_OIL, Int
1)]
  , tcolor :: Color
tcolor   = Color
BrRed
  , tcolor2 :: Color
tcolor2  = Color
Red
  , talter :: Word8
talter   = Word8
talterForStairs
  , tfeature :: [Feature]
tfeature = [ ProjectileTriggers
-> [(Int, GroupName ItemKind)] -> GroupName TileKind -> Feature
ChangeWith ProjectileTriggers
ProjNo [(Int
1, GroupName ItemKind
THICK_CLOTH)] GroupName TileKind
ORDINARY_STAIRCASE_DOWN
                   -- safely soaks oil; marginal --- no warning if fails
               , GroupName ItemKind -> Feature
Embed GroupName ItemKind
STAIRS_DOWN
               , GroupName ItemKind -> Feature
Embed GroupName ItemKind
STAIRS_TRAP_DOWN_OIL
               , GroupName TileKind -> Feature
ChangeTo GroupName TileKind
ORDINARY_STAIRCASE_DOWN
               , Feature
ConsideredByAI ]
 }
stairsDecontaminatingUp :: TileKind
stairsDecontaminatingUp = TileKind
stairsUp
  { tname :: Text
tname    = Text
"decontaminating staircase up"
  , tfreq :: Freqs TileKind
tfreq    = [(GroupName TileKind
DECON_STAIRCASE_UP, Int
1)]
  , tcolor :: Color
tcolor   = Color
BrBlue
  , tcolor2 :: Color
tcolor2  = Color
Blue
  , talter :: Word8
talter   = Word8
talterForStairs
  , tfeature :: [Feature]
tfeature = GroupName ItemKind -> Feature
Embed GroupName ItemKind
DECONTAMINATION_CHAMBER Feature -> [Feature] -> [Feature]
forall a. a -> [a] -> [a]
: TileKind -> [Feature]
tfeature TileKind
stairsUp
  }
stairsWelded :: TileKind
stairsWelded = TileKind
stairsUp
  { tname :: Text
tname    = Text
"staircase up welded shut"
  , tfreq :: Freqs TileKind
tfreq    = [(GroupName TileKind
WELDED_STAIRCASE_UP, Int
1)]
  , tcolor :: Color
tcolor   = Color
BrMagenta
  , tcolor2 :: Color
tcolor2  = Color
Magenta
  , talter :: Word8
talter   = Word8
talterForStairs Word8 -> Word8 -> Word8
forall a. Num a => a -> a -> a
+ Word8
3  -- gear or level up needed
  , tfeature :: [Feature]
tfeature = [ GroupName ItemKind -> Feature
Embed GroupName ItemKind
S_CRUDE_WELD
                   -- the embed goes first, because the embed is marginal here
               , ProjectileTriggers
-> [(Int, GroupName ItemKind)] -> GroupName TileKind -> Feature
ChangeWith ProjectileTriggers
ProjNo [(Int
1, GroupName ItemKind
COLD_SOURCE)] GroupName TileKind
ORDINARY_STAIRCASE_UP
               , ProjectileTriggers
-> [(Int, GroupName ItemKind)] -> GroupName TileKind -> Feature
ChangeWith ProjectileTriggers
ProjNo [(Int
1, GroupName ItemKind
BLOWTORCH)] GroupName TileKind
ORDINARY_STAIRCASE_UP
               , Feature
ConsideredByAI ]
  }
stairsLiftUp :: TileKind
stairsLiftUp = TileKind
stairsUp  -- fireproof
  { tname :: Text
tname    = Text
"lift up"
  , tfreq :: Freqs TileKind
tfreq    = [(GroupName TileKind
STAIRCASE_LIFT_UP, Int
9), (GroupName TileKind
ORDINARY_LIFT_UP, Int
1)]
  , talter :: Word8
talter   = Word8
talterForStairs
  , tcolor :: Color
tcolor   = Color
BrCyan
  , tcolor2 :: Color
tcolor2  = Color
Cyan
  , tfeature :: [Feature]
tfeature = [GroupName ItemKind -> Feature
Embed GroupName ItemKind
LIFT_UP, Feature
ConsideredByAI]
  }
stairsLiftTrappedUp :: TileKind
stairsLiftTrappedUp = TileKind
stairsTrappedUp
  { tname :: Text
tname    = Text
"corroded lift up"
  , tfreq :: Freqs TileKind
tfreq    = [(GroupName TileKind
STAIRCASE_LIFT_UP, Int
1)]
  , tcolor :: Color
tcolor   = Color
BrBlue
  , tcolor2 :: Color
tcolor2  = Color
Blue
  , tfeature :: [Feature]
tfeature = [ GroupName ItemKind -> Feature
Embed GroupName ItemKind
LIFT_UP
               , GroupName ItemKind -> Feature
Embed GroupName ItemKind
LIFT_TRAP
               , Feature
ConsideredByAI, GroupName TileKind -> Feature
ChangeTo GroupName TileKind
ORDINARY_LIFT_UP ]
                 -- AI uses despite the trap; exploration more important
  }
stairsLiftGatedUp :: TileKind
stairsLiftGatedUp = TileKind
stairsLiftUp
  { tname :: Text
tname    = Text
"manually opened lift up"
  , tfreq :: Freqs TileKind
tfreq    = [(GroupName TileKind
GATED_LIFT_UP, Int
1)]
  , talter :: Word8
talter   = Word8
talterForStairs Word8 -> Word8 -> Word8
forall a. Num a => a -> a -> a
+ Word8
2  -- animals and bosses can't use
  }
stairsLiftDecontaminatingUp :: TileKind
stairsLiftDecontaminatingUp = TileKind
stairsLiftUp
  { tname :: Text
tname    = Text
"decontaminating lift up"
  , tfreq :: Freqs TileKind
tfreq    = [(GroupName TileKind
DECON_LIFT_UP, Int
1)]
  , tcolor :: Color
tcolor   = Color
BrBlue
  , tcolor2 :: Color
tcolor2  = Color
Blue
  , tfeature :: [Feature]
tfeature = GroupName ItemKind -> Feature
Embed GroupName ItemKind
DECONTAMINATION_CHAMBER Feature -> [Feature] -> [Feature]
forall a. a -> [a] -> [a]
: TileKind -> [Feature]
tfeature TileKind
stairsLiftUp
  }
stairsLiftWelded :: TileKind
stairsLiftWelded = TileKind
stairsLiftUp
  { tname :: Text
tname    = Text
"lift up welded shut"
  , tfreq :: Freqs TileKind
tfreq    = [(GroupName TileKind
WELDED_LIFT_UP, Int
1)]
  , tcolor :: Color
tcolor   = Color
BrMagenta
  , tcolor2 :: Color
tcolor2  = Color
Magenta
  , talter :: Word8
talter   = Word8
talterForStairs Word8 -> Word8 -> Word8
forall a. Num a => a -> a -> a
+ Word8
3  -- gear or level up needed
  , tfeature :: [Feature]
tfeature = [ GroupName ItemKind -> Feature
Embed GroupName ItemKind
S_CRUDE_WELD
                   -- the embed goes first, because marginal
               , ProjectileTriggers
-> [(Int, GroupName ItemKind)] -> GroupName TileKind -> Feature
ChangeWith ProjectileTriggers
ProjNo [(Int
1, GroupName ItemKind
COLD_SOURCE)] GroupName TileKind
ORDINARY_LIFT_UP
               , ProjectileTriggers
-> [(Int, GroupName ItemKind)] -> GroupName TileKind -> Feature
ChangeWith ProjectileTriggers
ProjNo [(Int
1, GroupName ItemKind
BLOWTORCH)] GroupName TileKind
ORDINARY_LIFT_UP
               , Feature
ConsideredByAI ]
  }
stairsDecontaminatingDown :: TileKind
stairsDecontaminatingDown = TileKind
stairsDown
  { tname :: Text
tname    = Text
"decontaminating staircase down"
  , tfreq :: Freqs TileKind
tfreq    = [(GroupName TileKind
DECON_STAIRCASE_DOWN, Int
1)]
  , tcolor :: Color
tcolor   = Color
BrBlue
  , tcolor2 :: Color
tcolor2  = Color
Blue
  , talter :: Word8
talter   = Word8
talterForStairs
  , tfeature :: [Feature]
tfeature = GroupName ItemKind -> Feature
Embed GroupName ItemKind
DECONTAMINATION_CHAMBER Feature -> [Feature] -> [Feature]
forall a. a -> [a] -> [a]
: TileKind -> [Feature]
tfeature TileKind
stairsDown
  }
stairsLiftDown :: TileKind
stairsLiftDown = TileKind
stairsDown
  { tname :: Text
tname    = Text
"lift down"
  , tfreq :: Freqs TileKind
tfreq    = [(GroupName TileKind
STAIRCASE_LIFT_DOWN, Int
9), (GroupName TileKind
ORDINARY_LIFT_DOWN, Int
1)]
  , tcolor :: Color
tcolor   = Color
BrCyan
  , tcolor2 :: Color
tcolor2  = Color
Cyan
  , talter :: Word8
talter   = Word8
talterForStairs
  , tfeature :: [Feature]
tfeature = [GroupName ItemKind -> Feature
Embed GroupName ItemKind
LIFT_DOWN, Feature
ConsideredByAI]
  }
stairsLiftTrappedDown :: TileKind
stairsLiftTrappedDown = TileKind
stairsTrappedDown
  { tname :: Text
tname    = Text
"corroded lift down"
  , tfreq :: Freqs TileKind
tfreq    = [(GroupName TileKind
STAIRCASE_LIFT_DOWN, Int
1)]
  , tcolor :: Color
tcolor   = Color
BrBlue
  , tcolor2 :: Color
tcolor2  = Color
Blue
  , tfeature :: [Feature]
tfeature = [ GroupName ItemKind -> Feature
Embed GroupName ItemKind
LIFT_DOWN
               , GroupName ItemKind -> Feature
Embed GroupName ItemKind
LIFT_TRAP
               , Feature
ConsideredByAI, GroupName TileKind -> Feature
ChangeTo GroupName TileKind
ORDINARY_LIFT_DOWN ]
  }
stairsLiftGatedDown :: TileKind
stairsLiftGatedDown = TileKind
stairsLiftDown
  { tname :: Text
tname    = Text
"manually opened lift down"
  , tfreq :: Freqs TileKind
tfreq    = [(GroupName TileKind
GATED_LIFT_DOWN, Int
1)]
  , talter :: Word8
talter   = Word8
talterForStairs Word8 -> Word8 -> Word8
forall a. Num a => a -> a -> a
+ Word8
2  -- animals and bosses can't use
  }
stairsLiftDecontaminatingDown :: TileKind
stairsLiftDecontaminatingDown = TileKind
stairsLiftDown
  { tname :: Text
tname    = Text
"decontaminating lift down"
  , tfreq :: Freqs TileKind
tfreq    = [(GroupName TileKind
DECON_LIFT_DOWN, Int
1)]
  , tcolor :: Color
tcolor   = Color
BrBlue
  , tcolor2 :: Color
tcolor2  = Color
Blue
  , tfeature :: [Feature]
tfeature = GroupName ItemKind -> Feature
Embed GroupName ItemKind
DECONTAMINATION_CHAMBER Feature -> [Feature] -> [Feature]
forall a. a -> [a] -> [a]
: TileKind -> [Feature]
tfeature TileKind
stairsLiftDown
  }
escapeAlarmUp :: TileKind
escapeAlarmUp = TileKind
escapeUp
  { tname :: Text
tname    = Text
"alarm console"
  , tfreq :: Freqs TileKind
tfreq    = [(GroupName TileKind
TILE_ALARM_ESCAPE_UP, Int
1)]
  , tcolor :: Color
tcolor   = Color
BrRed
  , tcolor2 :: Color
tcolor2  = Color
Red
  }
escapeSpaceshipDown :: TileKind
escapeSpaceshipDown = TileKind
escapeDown
  { tname :: Text
tname    = Text
"airlock to a shuttle"
  , tfreq :: Freqs TileKind
tfreq    = [(GroupName TileKind
TILE_SPACESHIP_ESCAPE_DOWN, Int
1), (GroupName TileKind
AIRLOCK_FENCE, Int
3)]
  }
emptyAirlock :: TileKind
emptyAirlock = TileKind
escapeDown
  { tname :: Text
tname    = Text
"empty airlock"
  , tfreq :: Freqs TileKind
tfreq    = [ (GroupName TileKind
AIRLOCK_FENCE, Int
2), (GroupName TileKind
EMPTY_AIRLOCK_FENCE, Int
7)
               , (GroupName TileKind
EMPTY_SET_LIT, Int
8), (GroupName TileKind
AMBUSH_SET_DARK, Int
7) ]
                   -- not in egressSetLit; space can't be seen
  , tcolor :: Color
tcolor   = Color
BrBlack
  , tcolor2 :: Color
tcolor2  = Color
BrBlack
  , tfeature :: [Feature]
tfeature = [GroupName ItemKind -> Feature
Embed GroupName ItemKind
DISENGAGED_DOCKING_GEAR]
  }
reinforcedWall :: TileKind
reinforcedWall = TileKind :: Char
-> Text
-> Freqs TileKind
-> Color
-> Color
-> Word8
-> [Feature]
-> TileKind
TileKind
  { tsymbol :: Char
tsymbol  = Char
'#'
  , tname :: Text
tname    = Text
"reinforced wall"
  , tfreq :: Freqs TileKind
tfreq    = [ (GroupName TileKind
S_REINFORCED_WALL, Int
1), (GroupName TileKind
ROGUE_SET, Int
15), (GroupName TileKind
EGRESS_SET_LIT, Int
20)
               , (GroupName TileKind
VIRUS_SET_LIT, Int
30), (GroupName TileKind
VIRUS_SET_DARK, Int
6)]
  , tcolor :: Color
tcolor   = Color
White
  , tcolor2 :: Color
tcolor2  = Color
BrBlack
  , talter :: Word8
talter   = Word8
100
  , tfeature :: [Feature]
tfeature = []
  }
reinforcedWallSpice :: TileKind
reinforcedWallSpice = TileKind
reinforcedWall
  { tfreq :: Freqs TileKind
tfreq    = [ (GroupName TileKind
DOORLESS_WALL, Int
20), (GroupName TileKind
CACHE_MAZE, Int
33)
               , (GroupName TileKind
CACHE_ABANDONED_OR_NOT, Int
60), (GroupName TileKind
CACHE_DEPOSIT_OR_NOT, Int
66) ]
  , tfeature :: [Feature]
tfeature = Feature
Spice Feature -> [Feature] -> [Feature]
forall a. a -> [a] -> [a]
: TileKind -> [Feature]
tfeature TileKind
reinforcedWall
  }
wallShuttle :: TileKind
wallShuttle = TileKind
bedrock
  { tname :: Text
tname    = Text
"shuttle hull"
  , tfreq :: Freqs TileKind
tfreq    = [(GroupName TileKind
S_SHUTTLE_HULL, Int
1)]
  , tfeature :: [Feature]
tfeature = [GroupName ItemKind -> Feature
Embed GroupName ItemKind
SHUTTLE_HARDWARE]
  }
wallShuttleSpice :: TileKind
wallShuttleSpice = TileKind
wallShuttle
  { tfreq :: Freqs TileKind
tfreq    = [(GroupName TileKind
CACHE_SHUTTLE, Int
75)]
  , tfeature :: [Feature]
tfeature = Feature
Spice Feature -> [Feature] -> [Feature]
forall a. a -> [a] -> [a]
: TileKind -> [Feature]
tfeature TileKind
wallShuttle
  }
doorStuck :: TileKind
doorStuck = TileKind :: Char
-> Text
-> Freqs TileKind
-> Color
-> Color
-> Word8
-> [Feature]
-> TileKind
TileKind
  { tsymbol :: Char
tsymbol  = Char
'+'
  , tname :: Text
tname    = Text
"stuck door"
  , tfreq :: Freqs TileKind
tfreq    = [(GroupName TileKind
STUCK_DOOR, Int
1)]
  , tcolor :: Color
tcolor   = Color
BrBlue
  , tcolor2 :: Color
tcolor2  = Color
Blue
  , talter :: Word8
talter   = Word8
2
  , tfeature :: [Feature]
tfeature = [ ProjectileTriggers
-> [(Int, GroupName ItemKind)] -> GroupName TileKind -> Feature
OpenWith ProjectileTriggers
ProjNo [(Int
1, GroupName ItemKind
BREACHING_TOOL)] GroupName TileKind
S_OPEN_DOOR
               , ProjectileTriggers
-> [(Int, GroupName ItemKind)] -> GroupName TileKind -> Feature
OpenWith ProjectileTriggers
ProjYes [(Int
1, GroupName ItemKind
BLAST_SOURCE)] GroupName TileKind
S_OPEN_DOOR
               , GroupName ItemKind -> Feature
Embed GroupName ItemKind
DOOR_TRAP_PUSH
               , ProjectileTriggers
-> [(Int, GroupName ItemKind)] -> GroupName TileKind -> Feature
OpenWith ProjectileTriggers
ProjNo [] GroupName TileKind
S_OPEN_DOOR ]  -- no pathfinding
  }
barrel :: TileKind
barrel = TileKind :: Char
-> Text
-> Freqs TileKind
-> Color
-> Color
-> Word8
-> [Feature]
-> TileKind
TileKind
  { tsymbol :: Char
tsymbol  = Char
'0'
  , tname :: Text
tname    = Text
"large barrel"
  , tfreq :: Freqs TileKind
tfreq    = [ (GroupName TileKind
BARREL, Int
1)
               , (GroupName TileKind
EGRESS_SET_LIT, Int
3), (GroupName TileKind
VIRUS_SET_DARK, Int
10), (GroupName TileKind
NOISE_SET_LIT, Int
20)
               , (GroupName TileKind
POWER_SET_DARK, Int
50), (GroupName TileKind
ZOO_SET_DARK, Int
30)
               , (GroupName TileKind
AMBUSH_SET_DARK, Int
2) ]
  , tcolor :: Color
tcolor   = Color
BrBlue
  , tcolor2 :: Color
tcolor2  = Color
Blue
  , talter :: Word8
talter   = Word8
0  -- projectiles can trigger the embed
  , tfeature :: [Feature]
tfeature = [ GroupName ItemKind -> Feature
Embed GroupName ItemKind
BARREL_CONTENTS
               , ProjectileTriggers
-> [(Int, GroupName ItemKind)] -> GroupName TileKind -> Feature
OpenWith ProjectileTriggers
ProjYes [] GroupName TileKind
ASHES_SMOKE_LIT ]
                   -- no pathfinding through
  }
barrelSpice :: TileKind
barrelSpice = TileKind
barrel
  { tfreq :: Freqs TileKind
tfreq    = [ (GroupName TileKind
SMOKE_CLUMP_LIT, Int
1), (GroupName TileKind
SMOKE_CLUMP_DARK, Int
1)
               , (GroupName TileKind
RUBBLE_OR_WASTE_LIT, Int
2), (GroupName TileKind
RUBBLE_OR_WASTE_DARK, Int
2)
               , (GroupName TileKind
CACHE_MAZE, Int
33) ]
  , tfeature :: [Feature]
tfeature = Feature
Spice Feature -> [Feature] -> [Feature]
forall a. a -> [a] -> [a]
: TileKind -> [Feature]
tfeature TileKind
barrel
  }

-- *** Clear

machineWall :: TileKind
machineWall = TileKind :: Char
-> Text
-> Freqs TileKind
-> Color
-> Color
-> Word8
-> [Feature]
-> TileKind
TileKind
  { tsymbol :: Char
tsymbol  = Char
'%'
  , tname :: Text
tname    = Text
"hardware rack"
  , tfreq :: Freqs TileKind
tfreq    = [ (GroupName TileKind
S_HARDWARE_RACK, Int
1)
               , (GroupName TileKind
ROGUE_SET, Int
25), (GroupName TileKind
NOISE_SET_LIT, Int
250), (GroupName TileKind
POWER_SET_DARK, Int
250)
               , (GroupName TileKind
EGRESS_SET_LIT, Int
30), (GroupName TileKind
VIRUS_SET_LIT, Int
60), (GroupName TileKind
VIRUS_SET_DARK, Int
30)
               , (GroupName TileKind
LIFT_TERMINAL_LIT, Int
40), (GroupName TileKind
LIFT_TERMINAL_DARK, Int
40) ]
  , tcolor :: Color
tcolor   = Color
White
  , tcolor2 :: Color
tcolor2  = Color
BrBlack
  , talter :: Word8
talter   = Word8
100
  , tfeature :: [Feature]
tfeature = [Feature
Clear]
  }
machineWallSpice :: TileKind
machineWallSpice = TileKind
machineWall
  { tfreq :: Freqs TileKind
tfreq    = [(GroupName TileKind
DOORLESS_MACHINERY, Int
1)]
  , tfeature :: [Feature]
tfeature = Feature
Spice Feature -> [Feature] -> [Feature]
forall a. a -> [a] -> [a]
: TileKind -> [Feature]
tfeature TileKind
machineWall
  }
bushEdible :: TileKind
bushEdible = TileKind :: Char
-> Text
-> Freqs TileKind
-> Color
-> Color
-> Word8
-> [Feature]
-> TileKind
TileKind
  { tsymbol :: Char
tsymbol  = Char
'%'
  , tname :: Text
tname    = Text
"ripe bush"
  , tfreq :: Freqs TileKind
tfreq    = [ (GroupName TileKind
EMPTY_SET_LIT, Int
4), (GroupName TileKind
ARENA_SET_LIT, Int
2), (GroupName TileKind
ARENA_SET_DARK, Int
4)
               , (GroupName TileKind
SHOOTOUT_SET_LIT, Int
1), (GroupName TileKind
HUNT_SET_LIT, Int
1)
               , (GroupName TileKind
FLIGHT_SET_DARK, Int
4), (GroupName TileKind
ZOO_SET_DARK, Int
1)
               , (GroupName TileKind
LIFT_TERMINAL_LIT, Int
1), (GroupName TileKind
LIFT_TERMINAL_DARK, Int
1) ]
  , tcolor :: Color
tcolor   = Color
BrMagenta
  , tcolor2 :: Color
tcolor2  = Color
Magenta
  , talter :: Word8
talter   = Word8
4
  , tfeature :: [Feature]
tfeature = [ Feature
Clear
               , GroupName ItemKind -> Feature
Embed GroupName ItemKind
EDIBLE_PLANT_RIPE
                   -- loot granted even when ignited, but missiles can't reap
               , ProjectileTriggers
-> [(Int, GroupName ItemKind)] -> GroupName TileKind -> Feature
ChangeWith ProjectileTriggers
ProjYes [(Int
1, GroupName ItemKind
FIRE_SOURCE)] GroupName TileKind
S_BURNING_BUSH
               , GroupName TileKind -> Feature
ChangeTo GroupName TileKind
S_BUSH_LIT ]
  }
bushEdibleSpice :: TileKind
bushEdibleSpice = TileKind
bushEdible
  { tfreq :: Freqs TileKind
tfreq    = [ (GroupName TileKind
BUSH_GROVE_LIT, Int
1), (GroupName TileKind
BUSH_GROVE_DARK, Int
1)
               , (GroupName TileKind
PUMPS_LIT, Int
100), (GroupName TileKind
PUMPS_DARK, Int
100) ]
  , tfeature :: [Feature]
tfeature = Feature
Spice Feature -> [Feature] -> [Feature]
forall a. a -> [a] -> [a]
: TileKind -> [Feature]
tfeature TileKind
bushEdible
  }

-- ** Walkable

-- *** Not clear

underbrushBurning :: TileKind
underbrushBurning = TileKind :: Char
-> Text
-> Freqs TileKind
-> Color
-> Color
-> Word8
-> [Feature]
-> TileKind
TileKind  -- always lit
  { tsymbol :: Char
tsymbol  = Char
';'
  , tname :: Text
tname    = Text
"burning underbrush"
  , tfreq :: Freqs TileKind
tfreq    = [ (GroupName TileKind
AMBUSH_SET_DARK, Int
1), (GroupName TileKind
ZOO_SET_DARK, Int
5)
               , (GroupName TileKind
S_BURNING_UNDERBRUSH, Int
1) ]
  , tcolor :: Color
tcolor   = Color
BrRed
  , tcolor2 :: Color
tcolor2  = Color
Red
  , talter :: Word8
talter   = Word8
2  -- due to this, ordinary projectiles can't put out the fire
                  -- and don't get burned
  , tfeature :: [Feature]
tfeature = [ Feature
Walkable, Feature
NoItem, Feature
NoActor  -- not clear, due to smoke
               , GroupName ItemKind -> Feature
Embed GroupName ItemKind
SMALL_FIRE  -- little mass, so one fire only
               , ProjectileTriggers
-> [(Int, GroupName ItemKind)] -> GroupName TileKind -> Feature
ChangeWith ProjectileTriggers
ProjYes [(Int
1, GroupName ItemKind
WATER_SOURCE)] GroupName TileKind
S_SMOKE_LIT
                   -- transformation only a fallback if crafting unintended
               , ProjectileTriggers
-> [(Int, GroupName ItemKind)] -> GroupName TileKind -> Feature
ChangeWith ProjectileTriggers
ProjNo [(Int
1, GroupName ItemKind
FIREPROOF_CLOTH)] GroupName TileKind
S_UNDERBRUSH_LIT
                   -- underbrush saved for repeat
               , GroupName TileKind -> Feature
ChangeTo GroupName TileKind
S_FLOOR_ASHES_LIT ]  -- not enough matter for smoke
  }

-- *** Clear

floorOily :: TileKind
floorOily = TileKind
floorArena
  { tname :: Text
tname    = Text
"oily floor"
  , tfreq :: Freqs TileKind
tfreq    = [ (GroupName TileKind
MUSEUM_SET_LIT, Int
40), (GroupName TileKind
POWER_SET_LIT, Int
550)
               , (GroupName TileKind
EGRESS_SET_LIT, Int
800), (GroupName TileKind
VIRUS_SET_LIT, Int
700)
               , (GroupName TileKind
BATTLE_SET_LIT, Int
1000)
               , (GroupName TileKind
OILY_FLOOR_LIT, Int
1), (GroupName TileKind
RUBBLE_OR_WASTE_LIT, Int
1)
               , (GroupName TileKind
OIL_RESIDUE_LIT, Int
4) ]
  , tfeature :: [Feature]
tfeature = ProjectileTriggers
-> [(Int, GroupName ItemKind)] -> GroupName TileKind -> Feature
ChangeWith ProjectileTriggers
ProjYes [(Int
1, GroupName ItemKind
OIL_SOURCE)] GroupName TileKind
S_OIL_SPILL
                 -- non-porous enough
               Feature -> [Feature] -> [Feature]
forall a. a -> [a] -> [a]
: TileKind -> [Feature]
tfeature TileKind
floorArena
  }
oilSpill :: TileKind
oilSpill = TileKind :: Char
-> Text
-> Freqs TileKind
-> Color
-> Color
-> Word8
-> [Feature]
-> TileKind
TileKind  -- always lit
  { tsymbol :: Char
tsymbol  = Char
'~'
  , tname :: Text
tname    = Text
"oil spill"
  , tfreq :: Freqs TileKind
tfreq    = [ (GroupName TileKind
POWER_SET_DARK, Int
35), (GroupName TileKind
EGRESS_SET_LIT, Int
9), (GroupName TileKind
VIRUS_SET_DARK, Int
15)
               , (GroupName TileKind
AMBUSH_SET_DARK, Int
20), (GroupName TileKind
S_OIL_SPILL, Int
1) ]
  , tcolor :: Color
tcolor   = Color
BrYellow
  , tcolor2 :: Color
tcolor2  = Color
BrGreen
  , talter :: Word8
talter   = Word8
2  -- projectiles won't trigger embeds; doesn't matter
                  -- for others, because walkable;
                  -- TODO: not everything should be able/willing to enter
  , tfeature :: [Feature]
tfeature = [ GroupName ItemKind -> Feature
Embed GroupName ItemKind
OIL_PUDDLE
                   -- embed goes first, because transformation and crafting
                   -- may use the same item and crafting needs priority
               , ProjectileTriggers
-> [(Int, GroupName ItemKind)] -> GroupName TileKind -> Feature
ChangeWith ProjectileTriggers
ProjYes [(Int
1, GroupName ItemKind
FIRE_SOURCE)] GroupName TileKind
S_BURNING_OIL
               , ProjectileTriggers
-> [(Int, GroupName ItemKind)] -> GroupName TileKind -> Feature
ChangeWith ProjectileTriggers
ProjNo [(Int
1, GroupName ItemKind
THICK_CLOTH)] GroupName TileKind
OILY_FLOOR_LIT
               , Feature
Walkable, Feature
Clear ]
  }
oilSpillSpice :: TileKind
oilSpillSpice = TileKind
oilSpill
  { tfreq :: Freqs TileKind
tfreq    = [ (GroupName TileKind
RUBBLE_OR_WASTE_LIT, Int
1), (GroupName TileKind
RUBBLE_OR_WASTE_DARK, Int
1)
               , (GroupName TileKind
OIL_RESIDUE_LIT, Int
1), (GroupName TileKind
OIL_RESIDUE_DARK, Int
1) ]
  , tfeature :: [Feature]
tfeature = Feature
Spice Feature -> [Feature] -> [Feature]
forall a. a -> [a] -> [a]
: TileKind -> [Feature]
tfeature TileKind
oilSpill
  }

oilBurning :: TileKind
oilBurning = TileKind :: Char
-> Text
-> Freqs TileKind
-> Color
-> Color
-> Word8
-> [Feature]
-> TileKind
TileKind  -- always lit
  { tsymbol :: Char
tsymbol  = Char
'~'
  , tname :: Text
tname    = Text
"burning oil"
  , tfreq :: Freqs TileKind
tfreq    = [ (GroupName TileKind
POWER_SET_DARK, Int
1), (GroupName TileKind
VIRUS_SET_DARK, Int
1), (GroupName TileKind
AMBUSH_SET_DARK, Int
1)
               , (GroupName TileKind
S_BURNING_OIL, Int
1) ]
  , tcolor :: Color
tcolor   = Color
BrRed
  , tcolor2 :: Color
tcolor2  = Color
Red
  , talter :: Word8
talter   = Word8
2  -- due to this, projectiles can't put out the fire
                  -- and don't get burned
  , tfeature :: [Feature]
tfeature = [ Feature
Walkable, Feature
Clear  -- clear, no smoke, as in oil lamps
               , Feature
NoItem, Feature
NoActor
               , GroupName ItemKind -> Feature
Embed GroupName ItemKind
OIL_PUDDLE
               , GroupName ItemKind -> Feature
Embed GroupName ItemKind
SMALL_FIRE_5
               , ProjectileTriggers
-> [(Int, GroupName ItemKind)] -> GroupName TileKind -> Feature
ChangeWith ProjectileTriggers
ProjNo [(Int
1, GroupName ItemKind
FIREPROOF_CLOTH)] GroupName TileKind
OILY_FLOOR_LIT
                   -- safely soaks oil, if crafting fails or unintended
               , GroupName TileKind -> Feature
ChangeTo GroupName TileKind
S_OIL_SPILL ]
                   -- TODO: change only after all 5 fires used up
  }
floorWindow :: TileKind
floorWindow = TileKind
floorArena  -- no dark variant; it looks dark even when lit
  { tsymbol :: Char
tsymbol  = Char
floorSymbol  -- story-wise it's transparent, but no good symbol
  , tname :: Text
tname    = Text
"floor window"
  , tfreq :: Freqs TileKind
tfreq    = [(GroupName TileKind
EMPTY_SET_LIT, Int
24)]
  , tcolor :: Color
tcolor   = Color
BrBlack  -- not yellow, because light sucked away
  , tcolor2 :: Color
tcolor2  = Color
BrBlack
  , tfeature :: [Feature]
tfeature = GroupName ItemKind -> Feature
Embed GroupName ItemKind
BLACK_STARRY_SKY Feature -> [Feature] -> [Feature]
forall a. a -> [a] -> [a]
: TileKind -> [Feature]
tfeature TileKind
floorArena
  }
underbrush :: TileKind
underbrush = TileKind :: Char
-> Text
-> Freqs TileKind
-> Color
-> Color
-> Word8
-> [Feature]
-> TileKind
TileKind  -- always lit
  { tsymbol :: Char
tsymbol  = Char
floorSymbol
  , tname :: Text
tname    = Text
"underbrush"
  , tfreq :: Freqs TileKind
tfreq    = [ (GroupName TileKind
S_UNDERBRUSH_LIT, Int
1), (GroupName TileKind
S_UNDERBRUSH_DARK, Int
1)
               , (GroupName TileKind
UNDERBRUSH_CLUMP_LIT, Int
1), (GroupName TileKind
UNDERBRUSH_CLUMP_DARK, Int
1)
               , (GroupName TileKind
EMPTY_SET_LIT, Int
200), (GroupName TileKind
ARENA_SET_LIT, Int
80), (GroupName TileKind
BRAWL_SET_LIT, Int
100)
               , (GroupName TileKind
SHOOTOUT_SET_LIT, Int
100), (GroupName TileKind
HUNT_SET_LIT, Int
100)
               , (GroupName TileKind
FLIGHT_SET_LIT, Int
100), (GroupName TileKind
ZOO_SET_DARK, Int
5)
               , (GroupName TileKind
AMBUSH_SET_DARK, Int
20)
               , (GroupName TileKind
BUSH_CLUMP_LIT, Int
1), (GroupName TileKind
BUSH_CLUMP_DARK, Int
1)
               , (GroupName TileKind
TRAIL_LIT, Int
50), (GroupName TileKind
SAFE_TRAIL_LIT, Int
50) ]
  , tcolor :: Color
tcolor   = Color
BrGreen
  , tcolor2 :: Color
tcolor2  = Color
Green
  , talter :: Word8
talter   = Word8
0
  , tfeature :: [Feature]
tfeature = [ ProjectileTriggers
-> [(Int, GroupName ItemKind)] -> GroupName TileKind -> Feature
ChangeWith ProjectileTriggers
ProjYes [(Int
1, GroupName ItemKind
FIRE_SOURCE)] GroupName TileKind
S_BURNING_UNDERBRUSH
               , Feature
Trail, Feature
Walkable, Feature
Clear, Feature
NoItem ]
  }
workshop :: TileKind
workshop = TileKind :: Char
-> Text
-> Freqs TileKind
-> Color
-> Color
-> Word8
-> [Feature]
-> TileKind
TileKind  -- always lit
  { tsymbol :: Char
tsymbol  = Char
':'
  , tname :: Text
tname    = Text
"workshop"
  , tfreq :: Freqs TileKind
tfreq    = [ (GroupName TileKind
WORKSHOP, Int
100), (GroupName TileKind
EMPTY_SET_LIT, Int
16), (GroupName TileKind
SHOOTOUT_SET_LIT, Int
2)
               , (GroupName TileKind
AMBUSH_SET_DARK, Int
4), (GroupName TileKind
BATTLE_SET_DARK, Int
4) ]
  , tcolor :: Color
tcolor   = Color
BrBlue
  , tcolor2 :: Color
tcolor2  = Color
Blue
  , talter :: Word8
talter   = Word8
2  -- projectiles cannot craft (otherwise durable tools
                  -- would be applicable without harmful side-effects)
  , tfeature :: [Feature]
tfeature = [ Feature
Walkable, Feature
NoItem, Feature
NoActor  -- not clear, due to overhang
               , GroupName ItemKind -> Feature
Embed GroupName ItemKind
WORKSHOP_BENCH ]
  }

-- * Helper functions

makeDark :: TileKind -> TileKind
makeDark :: TileKind -> TileKind
makeDark TileKind
k = let darkenText :: GroupName TileKind -> GroupName TileKind
                 darkenText :: GroupName TileKind -> GroupName TileKind
darkenText GroupName TileKind
t = GroupName TileKind
-> (Text -> GroupName TileKind) -> Maybe Text -> GroupName TileKind
forall b a. b -> (a -> b) -> Maybe a -> b
maybe GroupName TileKind
t (Text -> GroupName TileKind
forall c. Text -> GroupName c
GroupName (Text -> GroupName TileKind)
-> (Text -> Text) -> Text -> GroupName TileKind
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"Dark"))
                                (Maybe Text -> GroupName TileKind)
-> Maybe Text -> GroupName TileKind
forall a b. (a -> b) -> a -> b
$ Text -> Text -> Maybe Text
T.stripSuffix Text
"Lit" (Text -> Maybe Text) -> Text -> Maybe Text
forall a b. (a -> b) -> a -> b
$ GroupName TileKind -> Text
forall c. GroupName c -> Text
fromGroupName GroupName TileKind
t
                 darkenFreq :: (GroupName TileKind, Int)
                            -> [(GroupName TileKind, Int)]
                 darkenFreq :: (GroupName TileKind, Int) -> Freqs TileKind
darkenFreq (GroupName TileKind
t, Int
n) =
                   case Text -> Text -> Maybe Text
T.stripSuffix Text
"Lit" (Text -> Maybe Text) -> Text -> Maybe Text
forall a b. (a -> b) -> a -> b
$ GroupName TileKind -> Text
forall c. GroupName c -> Text
fromGroupName GroupName TileKind
t of
                     Maybe Text
Nothing -> [(GroupName TileKind
t, Int
n)]
                     Just Text
stripped ->
                       let dark :: GroupName TileKind
dark = Text -> GroupName TileKind
forall c. Text -> GroupName c
GroupName (Text -> GroupName TileKind) -> Text -> GroupName TileKind
forall a b. (a -> b) -> a -> b
$ Text
stripped Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"Dark"
                       in -- lit plays the role of dark in a @Dark@ group
                          [(GroupName TileKind
dark, Int
n) | Maybe Int -> Bool
forall a. Maybe a -> Bool
isNothing (Maybe Int -> Bool) -> Maybe Int -> Bool
forall a b. (a -> b) -> a -> b
$ GroupName TileKind
dark GroupName TileKind -> Freqs TileKind -> Maybe Int
forall a b. Eq a => a -> [(a, b)] -> Maybe b
`lookup` Freqs TileKind
darkFreq]
                 (Freqs TileKind
darkFreq, Freqs TileKind
notDarkFreq) =
                   ((GroupName TileKind, Int) -> Bool)
-> Freqs TileKind -> (Freqs TileKind, Freqs TileKind)
forall a. (a -> Bool) -> [a] -> ([a], [a])
partition (Text -> Text -> Bool
T.isSuffixOf Text
"Dark" (Text -> Bool)
-> ((GroupName TileKind, Int) -> Text)
-> (GroupName TileKind, Int)
-> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. GroupName TileKind -> Text
forall c. GroupName c -> Text
fromGroupName (GroupName TileKind -> Text)
-> ((GroupName TileKind, Int) -> GroupName TileKind)
-> (GroupName TileKind, Int)
-> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (GroupName TileKind, Int) -> GroupName TileKind
forall a b. (a, b) -> a
fst)
                             (TileKind -> Freqs TileKind
tfreq TileKind
k)
                 darkFrequency :: Freqs TileKind
                 darkFrequency :: Freqs TileKind
darkFrequency = ((GroupName TileKind, Int) -> Freqs TileKind)
-> Freqs TileKind -> Freqs TileKind
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (GroupName TileKind, Int) -> Freqs TileKind
darkenFreq Freqs TileKind
notDarkFreq
                 darkFeat :: Feature -> Maybe Feature
darkFeat (OpenTo GroupName TileKind
t) = Feature -> Maybe Feature
forall a. a -> Maybe a
Just (Feature -> Maybe Feature) -> Feature -> Maybe Feature
forall a b. (a -> b) -> a -> b
$ GroupName TileKind -> Feature
OpenTo (GroupName TileKind -> Feature) -> GroupName TileKind -> Feature
forall a b. (a -> b) -> a -> b
$ GroupName TileKind -> GroupName TileKind
darkenText GroupName TileKind
t
                 darkFeat (CloseTo GroupName TileKind
t) = Feature -> Maybe Feature
forall a. a -> Maybe a
Just (Feature -> Maybe Feature) -> Feature -> Maybe Feature
forall a b. (a -> b) -> a -> b
$ GroupName TileKind -> Feature
CloseTo (GroupName TileKind -> Feature) -> GroupName TileKind -> Feature
forall a b. (a -> b) -> a -> b
$ GroupName TileKind -> GroupName TileKind
darkenText GroupName TileKind
t
                 darkFeat (ChangeTo GroupName TileKind
t) = Feature -> Maybe Feature
forall a. a -> Maybe a
Just (Feature -> Maybe Feature) -> Feature -> Maybe Feature
forall a b. (a -> b) -> a -> b
$ GroupName TileKind -> Feature
ChangeTo (GroupName TileKind -> Feature) -> GroupName TileKind -> Feature
forall a b. (a -> b) -> a -> b
$ GroupName TileKind -> GroupName TileKind
darkenText GroupName TileKind
t
                 darkFeat (OpenWith ProjectileTriggers
proj [(Int, GroupName ItemKind)]
grps GroupName TileKind
t) =
                   Feature -> Maybe Feature
forall a. a -> Maybe a
Just (Feature -> Maybe Feature) -> Feature -> Maybe Feature
forall a b. (a -> b) -> a -> b
$ ProjectileTriggers
-> [(Int, GroupName ItemKind)] -> GroupName TileKind -> Feature
OpenWith ProjectileTriggers
proj [(Int, GroupName ItemKind)]
grps (GroupName TileKind -> Feature) -> GroupName TileKind -> Feature
forall a b. (a -> b) -> a -> b
$ GroupName TileKind -> GroupName TileKind
darkenText GroupName TileKind
t
                 darkFeat (CloseWith ProjectileTriggers
proj [(Int, GroupName ItemKind)]
grps GroupName TileKind
t) =
                   Feature -> Maybe Feature
forall a. a -> Maybe a
Just (Feature -> Maybe Feature) -> Feature -> Maybe Feature
forall a b. (a -> b) -> a -> b
$ ProjectileTriggers
-> [(Int, GroupName ItemKind)] -> GroupName TileKind -> Feature
CloseWith ProjectileTriggers
proj [(Int, GroupName ItemKind)]
grps (GroupName TileKind -> Feature) -> GroupName TileKind -> Feature
forall a b. (a -> b) -> a -> b
$ GroupName TileKind -> GroupName TileKind
darkenText GroupName TileKind
t
                 darkFeat (ChangeWith ProjectileTriggers
proj [(Int, GroupName ItemKind)]
grps GroupName TileKind
t) =
                   Feature -> Maybe Feature
forall a. a -> Maybe a
Just (Feature -> Maybe Feature) -> Feature -> Maybe Feature
forall a b. (a -> b) -> a -> b
$ ProjectileTriggers
-> [(Int, GroupName ItemKind)] -> GroupName TileKind -> Feature
ChangeWith ProjectileTriggers
proj [(Int, GroupName ItemKind)]
grps (GroupName TileKind -> Feature) -> GroupName TileKind -> Feature
forall a b. (a -> b) -> a -> b
$ GroupName TileKind -> GroupName TileKind
darkenText GroupName TileKind
t
                 darkFeat (HideAs GroupName TileKind
t) = Feature -> Maybe Feature
forall a. a -> Maybe a
Just (Feature -> Maybe Feature) -> Feature -> Maybe Feature
forall a b. (a -> b) -> a -> b
$ GroupName TileKind -> Feature
HideAs (GroupName TileKind -> Feature) -> GroupName TileKind -> Feature
forall a b. (a -> b) -> a -> b
$ GroupName TileKind -> GroupName TileKind
darkenText GroupName TileKind
t
                 darkFeat (BuildAs GroupName TileKind
t) = Feature -> Maybe Feature
forall a. a -> Maybe a
Just (Feature -> Maybe Feature) -> Feature -> Maybe Feature
forall a b. (a -> b) -> a -> b
$ GroupName TileKind -> Feature
BuildAs (GroupName TileKind -> Feature) -> GroupName TileKind -> Feature
forall a b. (a -> b) -> a -> b
$ GroupName TileKind -> GroupName TileKind
darkenText GroupName TileKind
t
                 darkFeat (RevealAs GroupName TileKind
t) = Feature -> Maybe Feature
forall a. a -> Maybe a
Just (Feature -> Maybe Feature) -> Feature -> Maybe Feature
forall a b. (a -> b) -> a -> b
$ GroupName TileKind -> Feature
RevealAs (GroupName TileKind -> Feature) -> GroupName TileKind -> Feature
forall a b. (a -> b) -> a -> b
$ GroupName TileKind -> GroupName TileKind
darkenText GroupName TileKind
t
                 darkFeat (ObscureAs GroupName TileKind
t) = Feature -> Maybe Feature
forall a. a -> Maybe a
Just (Feature -> Maybe Feature) -> Feature -> Maybe Feature
forall a b. (a -> b) -> a -> b
$ GroupName TileKind -> Feature
ObscureAs (GroupName TileKind -> Feature) -> GroupName TileKind -> Feature
forall a b. (a -> b) -> a -> b
$ GroupName TileKind -> GroupName TileKind
darkenText GroupName TileKind
t
                 darkFeat Feature
VeryOftenItem = Feature -> Maybe Feature
forall a. a -> Maybe a
Just Feature
OftenItem
                 darkFeat Feature
OftenItem = Maybe Feature
forall a. Maybe a
Nothing  -- items not common in the dark
                 darkFeat Feature
feat = Feature -> Maybe Feature
forall a. a -> Maybe a
Just Feature
feat
             in TileKind
k { tfreq :: Freqs TileKind
tfreq    = Freqs TileKind
darkFrequency
                  , tfeature :: [Feature]
tfeature = Feature
Dark Feature -> [Feature] -> [Feature]
forall a. a -> [a] -> [a]
: (Feature -> Maybe Feature) -> [Feature] -> [Feature]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe Feature -> Maybe Feature
darkFeat (TileKind -> [Feature]
tfeature TileKind
k)
                  }

-- The yellow colour represents a dark tile lit by artificial light source,
-- or seen (felt, if very close) via noctovision. It is used to distinguish
-- ambiently lit tiles and dark tiles lit by dynamic light.
makeDarkColor :: TileKind -> TileKind
makeDarkColor :: TileKind -> TileKind
makeDarkColor TileKind
k = (TileKind -> TileKind
makeDark TileKind
k) { tcolor :: Color
tcolor  = if TileKind -> Char
tsymbol TileKind
k Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
floorSymbol
                                              Bool -> Bool -> Bool
&& TileKind -> Color
tcolor TileKind
k Color -> Color -> Bool
forall a. Eq a => a -> a -> Bool
== Color
BrWhite
                                           then Color
BrYellow
                                           else TileKind -> Color
tcolor TileKind
k
                               , tcolor2 :: Color
tcolor2 = Color
BrBlack
                               }