-- | 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 OUTDOOR_OUTER_FENCE, pattern DIRT_LIT, pattern DIRT_DARK, pattern FLOOR_ARENA_LIT, pattern FLOOR_ARENA_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
    -- ** Used in PlaceKind, but not in CaveKind.
  , pattern RECT_WINDOWS_VERTICAL_LIT, pattern RECT_WINDOWS_VERTICAL_DARK, pattern RECT_WINDOWS_HORIZONTAL_LIT, pattern RECT_WINDOWS_HORIZONTAL_DARK, pattern TREE_SHADE_WALKABLE_LIT, pattern TREE_SHADE_WALKABLE_DARK, pattern SMOKE_CLUMP_LIT, pattern SMOKE_CLUMP_DARK, pattern GLASSHOUSE_VERTICAL_LIT, pattern GLASSHOUSE_VERTICAL_DARK, pattern GLASSHOUSE_HORIZONTAL_LIT, pattern GLASSHOUSE_HORIZONTAL_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 CACHE, 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 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_WALL_LIT, pattern S_WALL_DARK, pattern S_WALL_HORIZONTAL_LIT, pattern S_WALL_HORIZONTAL_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
  , 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.ItemKindEmbed

-- * 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_WALL_LIT, GroupName TileKind
S_WALL_DARK, GroupName TileKind
S_WALL_HORIZONTAL_LIT, GroupName TileKind
S_WALL_HORIZONTAL_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_SUSPECT_VERTICAL_WALL_LIT, GroupName TileKind
S_SUSPECT_HORIZONTAL_WALL_LIT, GroupName TileKind
S_CLOSED_VERTICAL_DOOR_LIT, GroupName TileKind
S_CLOSED_HORIZONTAL_DOOR_LIT, GroupName TileKind
S_OPEN_VERTICAL_DOOR_LIT, GroupName TileKind
S_OPEN_HORIZONTAL_DOOR_LIT, GroupName TileKind
S_SIGNBOARD_UNREAD]
    [GroupName TileKind]
-> [GroupName TileKind] -> [GroupName TileKind]
forall a. [a] -> [a] -> [a]
++ [GroupName TileKind
S_BUSH_DARK, GroupName TileKind
S_CLOSED_HORIZONTAL_DOOR_DARK, GroupName TileKind
S_CLOSED_VERTICAL_DOOR_DARK, GroupName TileKind
S_OPEN_HORIZONTAL_DOOR_DARK, GroupName TileKind
S_OPEN_VERTICAL_DOOR_DARK, GroupName TileKind
S_SUSPECT_HORIZONTAL_WALL_DARK, GroupName TileKind
S_SUSPECT_VERTICAL_WALL_DARK]

-- ** Used in PlaceKind, but not in CaveKind.
pattern S_PILLAR, S_RUBBLE_PILE, S_LAMP_POST, S_TREE_LIT, S_TREE_DARK, S_WALL_LIT, S_WALL_DARK, S_WALL_HORIZONTAL_LIT, S_WALL_HORIZONTAL_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

-- ** Used only internally in other TileKind definitions or never used.
pattern S_SUSPECT_VERTICAL_WALL_LIT, S_SUSPECT_HORIZONTAL_WALL_LIT, S_CLOSED_VERTICAL_DOOR_LIT, S_CLOSED_HORIZONTAL_DOOR_LIT, S_OPEN_VERTICAL_DOOR_LIT, S_OPEN_HORIZONTAL_DOOR_LIT, S_SIGNBOARD_UNREAD :: GroupName TileKind

-- * Not used, but needed, because auto-generated. Singletons.
pattern S_BUSH_DARK, S_CLOSED_HORIZONTAL_DOOR_DARK, S_CLOSED_VERTICAL_DOOR_DARK, S_OPEN_HORIZONTAL_DOOR_DARK, S_OPEN_VERTICAL_DOOR_DARK, S_SUSPECT_HORIZONTAL_WALL_DARK, S_SUSPECT_VERTICAL_WALL_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
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
OUTDOOR_OUTER_FENCE, 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
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
RECT_WINDOWS_VERTICAL_LIT, GroupName TileKind
RECT_WINDOWS_VERTICAL_DARK, GroupName TileKind
RECT_WINDOWS_HORIZONTAL_LIT, GroupName TileKind
RECT_WINDOWS_HORIZONTAL_DARK, GroupName TileKind
TREE_SHADE_WALKABLE_LIT, GroupName TileKind
TREE_SHADE_WALKABLE_DARK, GroupName TileKind
SMOKE_CLUMP_LIT, GroupName TileKind
SMOKE_CLUMP_DARK, GroupName TileKind
GLASSHOUSE_VERTICAL_LIT, GroupName TileKind
GLASSHOUSE_VERTICAL_DARK, GroupName TileKind
GLASSHOUSE_HORIZONTAL_LIT, GroupName TileKind
GLASSHOUSE_HORIZONTAL_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
CACHE, 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
FLOOR_ACTOR_ITEM_LIT, GroupName TileKind
FLOOR_ACTOR_ITEM_DARK]
    [GroupName TileKind]
-> [GroupName TileKind] -> [GroupName TileKind]
forall a. [a] -> [a] -> [a]
++ [GroupName TileKind
OBSCURED_VERTICAL_WALL_LIT, GroupName TileKind
OBSCURED_HORIZONTAL_WALL_LIT, GroupName TileKind
TRAPPED_VERTICAL_DOOR_LIT, GroupName TileKind
TRAPPED_HORIZONAL_DOOR_LIT, GroupName TileKind
TREE_BURNING_OR_NOT, GroupName TileKind
BUSH_BURNING_OR_NOT, GroupName TileKind
CACHE_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
OBSCURED_HORIZONTAL_WALL_DARK, GroupName TileKind
OBSCURED_VERTICAL_WALL_DARK, GroupName TileKind
SHOOTOUT_SET_DARK, GroupName TileKind
TRAPPED_HORIZONAL_DOOR_DARK, GroupName TileKind
TRAPPED_VERTICAL_DOOR_DARK]

pattern FILLER_WALL, FLOOR_CORRIDOR_LIT, FLOOR_CORRIDOR_DARK, TRAIL_LIT, SAFE_TRAIL_LIT, LAB_TRAIL_LIT, DAMP_FLOOR_LIT, DAMP_FLOOR_DARK, OUTDOOR_OUTER_FENCE, DIRT_LIT, DIRT_DARK, FLOOR_ARENA_LIT, FLOOR_ARENA_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

-- ** Used in PlaceKind, but not in CaveKind.
pattern RECT_WINDOWS_VERTICAL_LIT, RECT_WINDOWS_VERTICAL_DARK, RECT_WINDOWS_HORIZONTAL_LIT, RECT_WINDOWS_HORIZONTAL_DARK, TREE_SHADE_WALKABLE_LIT, TREE_SHADE_WALKABLE_DARK, SMOKE_CLUMP_LIT, SMOKE_CLUMP_DARK, GLASSHOUSE_VERTICAL_LIT, GLASSHOUSE_VERTICAL_DARK, GLASSHOUSE_HORIZONTAL_LIT, GLASSHOUSE_HORIZONTAL_DARK, BUSH_CLUMP_LIT, BUSH_CLUMP_DARK, FOG_CLUMP_LIT, FOG_CLUMP_DARK, STAIR_TERMINAL_LIT, STAIR_TERMINAL_DARK, CACHE, 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, FLOOR_ACTOR_ITEM_LIT, FLOOR_ACTOR_ITEM_DARK :: GroupName TileKind

-- ** Used only internally in other TileKind definitions or never used.
pattern OBSCURED_VERTICAL_WALL_LIT, OBSCURED_HORIZONTAL_WALL_LIT, TRAPPED_VERTICAL_DOOR_LIT, TRAPPED_HORIZONAL_DOOR_LIT, TREE_BURNING_OR_NOT, BUSH_BURNING_OR_NOT, CACHE_OR_NOT :: GroupName TileKind

-- * Not used, but needed, because auto-generated. Not singletons.
pattern BRAWL_SET_DARK, NOISE_SET_DARK, OBSCURED_HORIZONTAL_WALL_DARK, OBSCURED_VERTICAL_WALL_DARK, SHOOTOUT_SET_DARK, TRAPPED_HORIZONAL_DOOR_DARK, TRAPPED_VERTICAL_DOOR_DARK :: GroupName TileKind

-- ** Used in CaveKind and perhaps elsewhere (or a dark/lit version thereof).
pattern $mFILLER_WALL :: forall {r}. GroupName TileKind -> ((# #) -> r) -> ((# #) -> r) -> r
$bFILLER_WALL :: GroupName TileKind
FILLER_WALL = GroupName "fillerWall"
pattern $mFLOOR_CORRIDOR_LIT :: forall {r}. GroupName TileKind -> ((# #) -> r) -> ((# #) -> r) -> r
$bFLOOR_CORRIDOR_LIT :: GroupName TileKind
FLOOR_CORRIDOR_LIT = GroupName "floorCorridorLit"
pattern $mFLOOR_CORRIDOR_DARK :: forall {r}. GroupName TileKind -> ((# #) -> r) -> ((# #) -> r) -> r
$bFLOOR_CORRIDOR_DARK :: GroupName TileKind
FLOOR_CORRIDOR_DARK = GroupName "floorCorridorDark"
pattern $mTRAIL_LIT :: forall {r}. GroupName TileKind -> ((# #) -> r) -> ((# #) -> r) -> r
$bTRAIL_LIT :: GroupName TileKind
TRAIL_LIT = GroupName "trailLit"
pattern $mSAFE_TRAIL_LIT :: forall {r}. GroupName TileKind -> ((# #) -> r) -> ((# #) -> r) -> r
$bSAFE_TRAIL_LIT :: GroupName TileKind
SAFE_TRAIL_LIT = GroupName "safeTrailLit"
pattern $mLAB_TRAIL_LIT :: forall {r}. GroupName TileKind -> ((# #) -> r) -> ((# #) -> r) -> r
$bLAB_TRAIL_LIT :: GroupName TileKind
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 $mDAMP_FLOOR_LIT :: forall {r}. GroupName TileKind -> ((# #) -> r) -> ((# #) -> r) -> r
$bDAMP_FLOOR_LIT :: GroupName TileKind
DAMP_FLOOR_LIT = GroupName "damp floor Lit"
pattern $mDAMP_FLOOR_DARK :: forall {r}. GroupName TileKind -> ((# #) -> r) -> ((# #) -> r) -> r
$bDAMP_FLOOR_DARK :: GroupName TileKind
DAMP_FLOOR_DARK = GroupName "damp floor Dark"
pattern $mOUTDOOR_OUTER_FENCE :: forall {r}. GroupName TileKind -> ((# #) -> r) -> ((# #) -> r) -> r
$bOUTDOOR_OUTER_FENCE :: GroupName TileKind
OUTDOOR_OUTER_FENCE = GroupName "outdoor outer fence"
pattern $mDIRT_LIT :: forall {r}. GroupName TileKind -> ((# #) -> r) -> ((# #) -> r) -> r
$bDIRT_LIT :: GroupName TileKind
DIRT_LIT = GroupName "dirt Lit"
pattern $mDIRT_DARK :: forall {r}. GroupName TileKind -> ((# #) -> r) -> ((# #) -> r) -> r
$bDIRT_DARK :: GroupName TileKind
DIRT_DARK = GroupName "dirt Dark"
pattern $mFLOOR_ARENA_LIT :: forall {r}. GroupName TileKind -> ((# #) -> r) -> ((# #) -> r) -> r
$bFLOOR_ARENA_LIT :: GroupName TileKind
FLOOR_ARENA_LIT = GroupName "floorArenaLit"
pattern $mFLOOR_ARENA_DARK :: forall {r}. GroupName TileKind -> ((# #) -> r) -> ((# #) -> r) -> r
$bFLOOR_ARENA_DARK :: GroupName TileKind
FLOOR_ARENA_DARK = GroupName "floorArenaDark"

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

-- ** Used in PlaceKind, but not in CaveKind. Not singletons.
pattern $mRECT_WINDOWS_VERTICAL_LIT :: forall {r}. GroupName TileKind -> ((# #) -> r) -> ((# #) -> r) -> r
$bRECT_WINDOWS_VERTICAL_LIT :: GroupName TileKind
RECT_WINDOWS_VERTICAL_LIT = GroupName "rectWindowsVerticalLit"
pattern $mRECT_WINDOWS_VERTICAL_DARK :: forall {r}. GroupName TileKind -> ((# #) -> r) -> ((# #) -> r) -> r
$bRECT_WINDOWS_VERTICAL_DARK :: GroupName TileKind
RECT_WINDOWS_VERTICAL_DARK = GroupName "rectWindowsVerticalDark"
pattern $mRECT_WINDOWS_HORIZONTAL_LIT :: forall {r}. GroupName TileKind -> ((# #) -> r) -> ((# #) -> r) -> r
$bRECT_WINDOWS_HORIZONTAL_LIT :: GroupName TileKind
RECT_WINDOWS_HORIZONTAL_LIT = GroupName "rectWindowsHorizontalLit"
pattern $mRECT_WINDOWS_HORIZONTAL_DARK :: forall {r}. GroupName TileKind -> ((# #) -> r) -> ((# #) -> r) -> r
$bRECT_WINDOWS_HORIZONTAL_DARK :: GroupName TileKind
RECT_WINDOWS_HORIZONTAL_DARK = GroupName "rectWindowsHorizontalDark"
pattern $mTREE_SHADE_WALKABLE_LIT :: forall {r}. GroupName TileKind -> ((# #) -> r) -> ((# #) -> r) -> r
$bTREE_SHADE_WALKABLE_LIT :: GroupName TileKind
TREE_SHADE_WALKABLE_LIT = GroupName "treeShadeWalkableLit"
pattern $mTREE_SHADE_WALKABLE_DARK :: forall {r}. GroupName TileKind -> ((# #) -> r) -> ((# #) -> r) -> r
$bTREE_SHADE_WALKABLE_DARK :: GroupName TileKind
TREE_SHADE_WALKABLE_DARK = GroupName "treeShadeWalkableDark"
pattern $mSMOKE_CLUMP_LIT :: forall {r}. GroupName TileKind -> ((# #) -> r) -> ((# #) -> r) -> r
$bSMOKE_CLUMP_LIT :: GroupName TileKind
SMOKE_CLUMP_LIT = GroupName "smokeClumpLit"
pattern $mSMOKE_CLUMP_DARK :: forall {r}. GroupName TileKind -> ((# #) -> r) -> ((# #) -> r) -> r
$bSMOKE_CLUMP_DARK :: GroupName TileKind
SMOKE_CLUMP_DARK = GroupName "smokeClumpDark"
pattern $mGLASSHOUSE_VERTICAL_LIT :: forall {r}. GroupName TileKind -> ((# #) -> r) -> ((# #) -> r) -> r
$bGLASSHOUSE_VERTICAL_LIT :: GroupName TileKind
GLASSHOUSE_VERTICAL_LIT = GroupName "glasshouseVerticalLit"
pattern $mGLASSHOUSE_VERTICAL_DARK :: forall {r}. GroupName TileKind -> ((# #) -> r) -> ((# #) -> r) -> r
$bGLASSHOUSE_VERTICAL_DARK :: GroupName TileKind
GLASSHOUSE_VERTICAL_DARK = GroupName "glasshouseVerticalDark"
pattern $mGLASSHOUSE_HORIZONTAL_LIT :: forall {r}. GroupName TileKind -> ((# #) -> r) -> ((# #) -> r) -> r
$bGLASSHOUSE_HORIZONTAL_LIT :: GroupName TileKind
GLASSHOUSE_HORIZONTAL_LIT = GroupName "glasshouseHorizontalLit"
pattern $mGLASSHOUSE_HORIZONTAL_DARK :: forall {r}. GroupName TileKind -> ((# #) -> r) -> ((# #) -> r) -> r
$bGLASSHOUSE_HORIZONTAL_DARK :: GroupName TileKind
GLASSHOUSE_HORIZONTAL_DARK = GroupName "glasshouseHorizontalDark"
pattern $mBUSH_CLUMP_LIT :: forall {r}. GroupName TileKind -> ((# #) -> r) -> ((# #) -> r) -> r
$bBUSH_CLUMP_LIT :: GroupName TileKind
BUSH_CLUMP_LIT = GroupName "bushClumpLit"
pattern $mBUSH_CLUMP_DARK :: forall {r}. GroupName TileKind -> ((# #) -> r) -> ((# #) -> r) -> r
$bBUSH_CLUMP_DARK :: GroupName TileKind
BUSH_CLUMP_DARK = GroupName "bushClumpDark"
pattern $mFOG_CLUMP_LIT :: forall {r}. GroupName TileKind -> ((# #) -> r) -> ((# #) -> r) -> r
$bFOG_CLUMP_LIT :: GroupName TileKind
FOG_CLUMP_LIT = GroupName "fogClumpLit"
pattern $mFOG_CLUMP_DARK :: forall {r}. GroupName TileKind -> ((# #) -> r) -> ((# #) -> r) -> r
$bFOG_CLUMP_DARK :: GroupName TileKind
FOG_CLUMP_DARK = GroupName "fogClumpDark"
pattern $mSTAIR_TERMINAL_LIT :: forall {r}. GroupName TileKind -> ((# #) -> r) -> ((# #) -> r) -> r
$bSTAIR_TERMINAL_LIT :: GroupName TileKind
STAIR_TERMINAL_LIT = GroupName "stair terminal Lit"
pattern $mSTAIR_TERMINAL_DARK :: forall {r}. GroupName TileKind -> ((# #) -> r) -> ((# #) -> r) -> r
$bSTAIR_TERMINAL_DARK :: GroupName TileKind
STAIR_TERMINAL_DARK = GroupName "stair terminal Dark"
pattern $mCACHE :: forall {r}. GroupName TileKind -> ((# #) -> r) -> ((# #) -> r) -> r
$bCACHE :: GroupName TileKind
CACHE = GroupName "cache"
pattern $mSIGNBOARD :: forall {r}. GroupName TileKind -> ((# #) -> r) -> ((# #) -> r) -> r
$bSIGNBOARD :: GroupName TileKind
SIGNBOARD = GroupName "signboard"
pattern $mSTAIRCASE_UP :: forall {r}. GroupName TileKind -> ((# #) -> r) -> ((# #) -> r) -> r
$bSTAIRCASE_UP :: GroupName TileKind
STAIRCASE_UP = GroupName "staircase up"
pattern $mORDINARY_STAIRCASE_UP :: forall {r}. GroupName TileKind -> ((# #) -> r) -> ((# #) -> r) -> r
$bORDINARY_STAIRCASE_UP :: GroupName TileKind
ORDINARY_STAIRCASE_UP = GroupName "ordinary staircase up"
pattern $mSTAIRCASE_OUTDOOR_UP :: forall {r}. GroupName TileKind -> ((# #) -> r) -> ((# #) -> r) -> r
$bSTAIRCASE_OUTDOOR_UP :: GroupName TileKind
STAIRCASE_OUTDOOR_UP = GroupName "staircase outdoor up"
pattern $mGATED_STAIRCASE_UP :: forall {r}. GroupName TileKind -> ((# #) -> r) -> ((# #) -> r) -> r
$bGATED_STAIRCASE_UP :: GroupName TileKind
GATED_STAIRCASE_UP = GroupName "gated staircase up"
pattern $mSTAIRCASE_DOWN :: forall {r}. GroupName TileKind -> ((# #) -> r) -> ((# #) -> r) -> r
$bSTAIRCASE_DOWN :: GroupName TileKind
STAIRCASE_DOWN = GroupName "staircase down"
pattern $mORDINARY_STAIRCASE_DOWN :: forall {r}. GroupName TileKind -> ((# #) -> r) -> ((# #) -> r) -> r
$bORDINARY_STAIRCASE_DOWN :: GroupName TileKind
ORDINARY_STAIRCASE_DOWN = GroupName "ordinary staircase down"
pattern $mSTAIRCASE_OUTDOOR_DOWN :: forall {r}. GroupName TileKind -> ((# #) -> r) -> ((# #) -> r) -> r
$bSTAIRCASE_OUTDOOR_DOWN :: GroupName TileKind
STAIRCASE_OUTDOOR_DOWN = GroupName "staircase outdoor down"
pattern $mGATED_STAIRCASE_DOWN :: forall {r}. GroupName TileKind -> ((# #) -> r) -> ((# #) -> r) -> r
$bGATED_STAIRCASE_DOWN :: GroupName TileKind
GATED_STAIRCASE_DOWN = GroupName "gated staircase down"
pattern $mTILE_INDOOR_ESCAPE_UP :: forall {r}. GroupName TileKind -> ((# #) -> r) -> ((# #) -> r) -> r
$bTILE_INDOOR_ESCAPE_UP :: GroupName TileKind
TILE_INDOOR_ESCAPE_UP = GroupName "indoor escape up"
pattern $mTILE_INDOOR_ESCAPE_DOWN :: forall {r}. GroupName TileKind -> ((# #) -> r) -> ((# #) -> r) -> r
$bTILE_INDOOR_ESCAPE_DOWN :: GroupName TileKind
TILE_INDOOR_ESCAPE_DOWN = GroupName "indoor escape down"
pattern $mTILE_OUTDOOR_ESCAPE_DOWN :: forall {r}. GroupName TileKind -> ((# #) -> r) -> ((# #) -> r) -> r
$bTILE_OUTDOOR_ESCAPE_DOWN :: GroupName TileKind
TILE_OUTDOOR_ESCAPE_DOWN = GroupName "outdoor escape down"
pattern $mFLOOR_ACTOR_ITEM_LIT :: forall {r}. GroupName TileKind -> ((# #) -> r) -> ((# #) -> r) -> r
$bFLOOR_ACTOR_ITEM_LIT :: GroupName TileKind
FLOOR_ACTOR_ITEM_LIT = GroupName "floorActorItemLit"
pattern $mFLOOR_ACTOR_ITEM_DARK :: forall {r}. GroupName TileKind -> ((# #) -> r) -> ((# #) -> r) -> r
$bFLOOR_ACTOR_ITEM_DARK :: GroupName TileKind
FLOOR_ACTOR_ITEM_DARK = GroupName "floorActorItemDark"

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

-- ** Used only internally in other TileKind definitions. Not singletons.
pattern $mOBSCURED_VERTICAL_WALL_LIT :: forall {r}. GroupName TileKind -> ((# #) -> r) -> ((# #) -> r) -> r
$bOBSCURED_VERTICAL_WALL_LIT :: GroupName TileKind
OBSCURED_VERTICAL_WALL_LIT = GroupName "obscured vertical wall Lit"
pattern $mOBSCURED_HORIZONTAL_WALL_LIT :: forall {r}. GroupName TileKind -> ((# #) -> r) -> ((# #) -> r) -> r
$bOBSCURED_HORIZONTAL_WALL_LIT :: GroupName TileKind
OBSCURED_HORIZONTAL_WALL_LIT = GroupName "obscured horizontal wall Lit"
pattern $mTRAPPED_VERTICAL_DOOR_LIT :: forall {r}. GroupName TileKind -> ((# #) -> r) -> ((# #) -> r) -> r
$bTRAPPED_VERTICAL_DOOR_LIT :: GroupName TileKind
TRAPPED_VERTICAL_DOOR_LIT = GroupName "trapped vertical door Lit"
pattern $mTRAPPED_HORIZONAL_DOOR_LIT :: forall {r}. GroupName TileKind -> ((# #) -> r) -> ((# #) -> r) -> r
$bTRAPPED_HORIZONAL_DOOR_LIT :: GroupName TileKind
TRAPPED_HORIZONAL_DOOR_LIT = GroupName "trapped horizontal door Lit"
pattern $mTREE_BURNING_OR_NOT :: forall {r}. GroupName TileKind -> ((# #) -> r) -> ((# #) -> r) -> r
$bTREE_BURNING_OR_NOT :: GroupName TileKind
TREE_BURNING_OR_NOT = GroupName "tree burning or not"
pattern $mBUSH_BURNING_OR_NOT :: forall {r}. GroupName TileKind -> ((# #) -> r) -> ((# #) -> r) -> r
$bBUSH_BURNING_OR_NOT :: GroupName TileKind
BUSH_BURNING_OR_NOT = GroupName "bush burning or not"
pattern $mCACHE_OR_NOT :: forall {r}. GroupName TileKind -> ((# #) -> r) -> ((# #) -> r) -> r
$bCACHE_OR_NOT :: GroupName TileKind
CACHE_OR_NOT = GroupName "cache or not"

-- ** Used only internally in other TileKind definitions. Singletons.
pattern $mS_SUSPECT_VERTICAL_WALL_LIT :: forall {r}. GroupName TileKind -> ((# #) -> r) -> ((# #) -> r) -> r
$bS_SUSPECT_VERTICAL_WALL_LIT :: GroupName TileKind
S_SUSPECT_VERTICAL_WALL_LIT = GroupName "suspect vertical wall Lit"
pattern $mS_SUSPECT_HORIZONTAL_WALL_LIT :: forall {r}. GroupName TileKind -> ((# #) -> r) -> ((# #) -> r) -> r
$bS_SUSPECT_HORIZONTAL_WALL_LIT :: GroupName TileKind
S_SUSPECT_HORIZONTAL_WALL_LIT = GroupName "suspect horizontal wall Lit"
pattern $mS_CLOSED_VERTICAL_DOOR_LIT :: forall {r}. GroupName TileKind -> ((# #) -> r) -> ((# #) -> r) -> r
$bS_CLOSED_VERTICAL_DOOR_LIT :: GroupName TileKind
S_CLOSED_VERTICAL_DOOR_LIT = GroupName "closed vertical door Lit"
pattern $mS_CLOSED_HORIZONTAL_DOOR_LIT :: forall {r}. GroupName TileKind -> ((# #) -> r) -> ((# #) -> r) -> r
$bS_CLOSED_HORIZONTAL_DOOR_LIT :: GroupName TileKind
S_CLOSED_HORIZONTAL_DOOR_LIT = GroupName "closed horizontal door Lit"
pattern $mS_OPEN_VERTICAL_DOOR_LIT :: forall {r}. GroupName TileKind -> ((# #) -> r) -> ((# #) -> r) -> r
$bS_OPEN_VERTICAL_DOOR_LIT :: GroupName TileKind
S_OPEN_VERTICAL_DOOR_LIT = GroupName "open vertical door Lit"
pattern $mS_OPEN_HORIZONTAL_DOOR_LIT :: forall {r}. GroupName TileKind -> ((# #) -> r) -> ((# #) -> r) -> r
$bS_OPEN_HORIZONTAL_DOOR_LIT :: GroupName TileKind
S_OPEN_HORIZONTAL_DOOR_LIT = GroupName "open horizontal door Lit"
pattern $mS_SIGNBOARD_UNREAD :: forall {r}. GroupName TileKind -> ((# #) -> r) -> ((# #) -> r) -> r
$bS_SIGNBOARD_UNREAD :: GroupName TileKind
S_SIGNBOARD_UNREAD = GroupName "signboard unread"

-- * 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 $mBRAWL_SET_DARK :: forall {r}. GroupName TileKind -> ((# #) -> r) -> ((# #) -> r) -> r
$bBRAWL_SET_DARK :: GroupName TileKind
BRAWL_SET_DARK = GroupName "brawlSetDark"
pattern $mNOISE_SET_DARK :: forall {r}. GroupName TileKind -> ((# #) -> r) -> ((# #) -> r) -> r
$bNOISE_SET_DARK :: GroupName TileKind
NOISE_SET_DARK = GroupName "noiseSetDark"
pattern $mOBSCURED_HORIZONTAL_WALL_DARK :: forall {r}. GroupName TileKind -> ((# #) -> r) -> ((# #) -> r) -> r
$bOBSCURED_HORIZONTAL_WALL_DARK :: GroupName TileKind
OBSCURED_HORIZONTAL_WALL_DARK =
  GroupName "obscured horizontal wall Dark"
pattern $mOBSCURED_VERTICAL_WALL_DARK :: forall {r}. GroupName TileKind -> ((# #) -> r) -> ((# #) -> r) -> r
$bOBSCURED_VERTICAL_WALL_DARK :: GroupName TileKind
OBSCURED_VERTICAL_WALL_DARK = GroupName "obscured vertical wall Dark"
pattern $mSHOOTOUT_SET_DARK :: forall {r}. GroupName TileKind -> ((# #) -> r) -> ((# #) -> r) -> r
$bSHOOTOUT_SET_DARK :: GroupName TileKind
SHOOTOUT_SET_DARK = GroupName "shootoutSetDark"
pattern $mTRAPPED_HORIZONAL_DOOR_DARK :: forall {r}. GroupName TileKind -> ((# #) -> r) -> ((# #) -> r) -> r
$bTRAPPED_HORIZONAL_DOOR_DARK :: GroupName TileKind
TRAPPED_HORIZONAL_DOOR_DARK = GroupName "trapped horizontal door Dark"
pattern $mTRAPPED_VERTICAL_DOOR_DARK :: forall {r}. GroupName TileKind -> ((# #) -> r) -> ((# #) -> r) -> r
$bTRAPPED_VERTICAL_DOOR_DARK :: GroupName TileKind
TRAPPED_VERTICAL_DOOR_DARK = GroupName "trapped vertical door Dark"

-- * Not used, but needed, because auto-generated. Singletons.
pattern $mS_BUSH_DARK :: forall {r}. GroupName TileKind -> ((# #) -> r) -> ((# #) -> r) -> r
$bS_BUSH_DARK :: GroupName TileKind
S_BUSH_DARK = GroupName "bush Dark"
pattern $mS_CLOSED_HORIZONTAL_DOOR_DARK :: forall {r}. GroupName TileKind -> ((# #) -> r) -> ((# #) -> r) -> r
$bS_CLOSED_HORIZONTAL_DOOR_DARK :: GroupName TileKind
S_CLOSED_HORIZONTAL_DOOR_DARK = GroupName "closed horizontal door Dark"
pattern $mS_CLOSED_VERTICAL_DOOR_DARK :: forall {r}. GroupName TileKind -> ((# #) -> r) -> ((# #) -> r) -> r
$bS_CLOSED_VERTICAL_DOOR_DARK :: GroupName TileKind
S_CLOSED_VERTICAL_DOOR_DARK = GroupName "closed vertical door Dark"
pattern $mS_OPEN_HORIZONTAL_DOOR_DARK :: forall {r}. GroupName TileKind -> ((# #) -> r) -> ((# #) -> r) -> r
$bS_OPEN_HORIZONTAL_DOOR_DARK :: GroupName TileKind
S_OPEN_HORIZONTAL_DOOR_DARK = GroupName "open horizontal door Dark"
pattern $mS_OPEN_VERTICAL_DOOR_DARK :: forall {r}. GroupName TileKind -> ((# #) -> r) -> ((# #) -> r) -> r
$bS_OPEN_VERTICAL_DOOR_DARK :: GroupName TileKind
S_OPEN_VERTICAL_DOOR_DARK = GroupName "open vertical door Dark"
pattern $mS_SUSPECT_HORIZONTAL_WALL_DARK :: forall {r}. GroupName TileKind -> ((# #) -> r) -> ((# #) -> r) -> r
$bS_SUSPECT_HORIZONTAL_WALL_DARK :: GroupName TileKind
S_SUSPECT_HORIZONTAL_WALL_DARK =
  GroupName "suspect horizontal wall Dark"
pattern $mS_SUSPECT_VERTICAL_WALL_DARK :: forall {r}. GroupName TileKind -> ((# #) -> r) -> ((# #) -> r) -> r
$bS_SUSPECT_VERTICAL_WALL_DARK :: GroupName TileKind
S_SUSPECT_VERTICAL_WALL_DARK = GroupName "suspect vertical wall Dark"

-- * Content

content :: [TileKind]
content :: [TileKind]
content =
  [TileKind
unknown, TileKind
unknownOuterFence, TileKind
basicOuterFence, TileKind
bedrock, TileKind
wall, TileKind
wallSuspect, TileKind
wallObscured, TileKind
wallH, TileKind
wallSuspectH, TileKind
wallObscuredDefacedH, TileKind
wallObscuredFrescoedH, TileKind
pillar, TileKind
pillarCache, TileKind
lampPost, TileKind
signboardUnread, TileKind
signboardRead, TileKind
tree, TileKind
treeBurnt, TileKind
treeBurning, TileKind
rubble, TileKind
rubbleSpice, TileKind
doorTrapped, TileKind
doorClosed, TileKind
doorTrappedH, TileKind
doorClosedH, 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
wallGlassH, TileKind
wallGlassHSpice, TileKind
pillarIce, TileKind
pulpit, TileKind
bush, TileKind
bushBurnt, TileKind
bushBurning, TileKind
fog, TileKind
fogDark, TileKind
smoke, TileKind
smokeDark, TileKind
doorOpen, TileKind
doorOpenH, TileKind
floorCorridor, TileKind
floorArena, TileKind
floorDamp, TileKind
floorDirt, TileKind
floorDirtSpice, TileKind
floorActor, TileKind
floorActorItem, TileKind
floorAshes, TileKind
shallowWater, TileKind
shallowWaterSpice, TileKind
floorRed, TileKind
floorBlue, TileKind
floorGreen, TileKind
floorBrown, TileKind
floorArenaShade, TileKind
outdoorFence ]
  [TileKind] -> [TileKind] -> [TileKind]
forall a. [a] -> [a] -> [a]
++ (TileKind -> TileKind) -> [TileKind] -> [TileKind]
forall a b. (a -> b) -> [a] -> [b]
map TileKind -> TileKind
makeDark [TileKind]
ldarkable
  [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

unknown,    unknownOuterFence, basicOuterFence, bedrock, wall, wallSuspect, wallObscured, wallH, wallSuspectH, wallObscuredDefacedH, wallObscuredFrescoedH, pillar, pillarCache, lampPost, signboardUnread, signboardRead, tree, treeBurnt, treeBurning, rubble, rubbleSpice, doorTrapped, doorClosed, doorTrappedH, doorClosedH, stairsUp, stairsTrappedUp, stairsOutdoorUp, stairsGatedUp, stairsDown, stairsTrappedDown, stairsOutdoorDown, stairsGatedDown, escapeUp, escapeDown, escapeOutdoorDown, wallGlass, wallGlassSpice, wallGlassH, wallGlassHSpice, pillarIce, pulpit, bush, bushBurnt, bushBurning, fog, fogDark, smoke, smokeDark, doorOpen, doorOpenH, floorCorridor, floorArena, floorDamp, floorDirt, floorDirtSpice, floorActor, floorActorItem, floorAshes, shallowWater, shallowWaterSpice, floorRed, floorBlue, floorGreen, floorBrown, floorArenaShade, outdoorFence :: TileKind

ldarkable :: [TileKind]
ldarkable :: [TileKind]
ldarkable = [TileKind
wall, TileKind
wallSuspect, TileKind
wallObscured, TileKind
wallH, TileKind
wallSuspectH, TileKind
wallObscuredDefacedH, TileKind
wallObscuredFrescoedH, TileKind
doorTrapped, TileKind
doorClosed, TileKind
doorTrappedH, TileKind
doorClosedH, TileKind
wallGlass, TileKind
wallGlassSpice, TileKind
wallGlassH, TileKind
wallGlassHSpice, TileKind
doorOpen, TileKind
doorOpenH, TileKind
floorCorridor, TileKind
shallowWater, TileKind
shallowWaterSpice]

ldarkColorable :: [TileKind]
ldarkColorable :: [TileKind]
ldarkColorable = [TileKind
tree, TileKind
bush, TileKind
floorArena, TileKind
floorDamp, TileKind
floorDirt, TileKind
floorDirtSpice, TileKind
floorActor, TileKind
floorActorItem]

-- Symbols to be used (the Nethack visual tradition imposes inconsistency):
--         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 visible enough when immobile)

-- 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, in other games modified and some removed

-- ** Not walkable

-- *** Not clear

unknown :: TileKind
unknown = 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
  { 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
  { tsymbol :: Char
tsymbol  = Char
' '
  , tname :: Text
tname    = Text
"impenetrable bedrock"
  , tfreq :: Freqs TileKind
tfreq    = [(GroupName TileKind
S_BASIC_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]
  }
bedrock :: TileKind
bedrock = TileKind
  { tsymbol :: Char
tsymbol  = Char
' '
  , tname :: Text
tname    = Text
"bedrock"
  , tfreq :: Freqs TileKind
tfreq    = [(GroupName TileKind
FILLER_WALL, Int
1)]
  , tcolor :: Color
tcolor   = Color
defFG
  , tcolor2 :: Color
tcolor2  = Color
defFG
  , talter :: Word8
talter   = Word8
100
  , tfeature :: [Feature]
tfeature = [Feature
Dark]
      -- Bedrock being dark is bad for AI (forces it to backtrack to explore
      -- bedrock at corridor turns) and induces human micromanagement
      -- if there can be corridors joined diagonally (humans have to check
      -- with the xhair if the dark space is bedrock or unexplored).
      -- Lit bedrock would be even worse for humans, because it's harder
      -- to guess which tiles are unknown and which can be explored bedrock.
      -- The setup of Allure is ideal, with lit bedrock that is easily
      -- distinguished from an unknown tile. However, LH follows the NetHack,
      -- not the Angband, visual tradition, so we can't improve the situation,
      -- unless we turn to subtle shades of black or non-ASCII glyphs,
      -- but that is yet different aesthetics.
  }
wall :: TileKind
wall = TileKind
  { tsymbol :: Char
tsymbol  = Char
'|'
  , tname :: Text
tname    = Text
"granite wall"
  , tfreq :: Freqs TileKind
tfreq    = [ (GroupName TileKind
S_WALL_LIT, Int
100)
               , (GroupName TileKind
RECT_WINDOWS_VERTICAL_LIT, Int
80) ]
  , tcolor :: Color
tcolor   = Color
BrWhite
  , tcolor2 :: Color
tcolor2  = Color
defFG
  , talter :: Word8
talter   = Word8
100
  , tfeature :: [Feature]
tfeature = [GroupName TileKind -> Feature
BuildAs GroupName TileKind
S_SUSPECT_VERTICAL_WALL_LIT]
  }
wallSuspect :: TileKind
wallSuspect = TileKind  -- only on client
  { tsymbol :: Char
tsymbol  = Char
'|'
  , tname :: Text
tname    = Text
"suspect uneven wall"
  , tfreq :: Freqs TileKind
tfreq    = [(GroupName TileKind
S_SUSPECT_VERTICAL_WALL_LIT, 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_VERTICAL_DOOR_LIT
               , GroupName TileKind -> Feature
ObscureAs GroupName TileKind
OBSCURED_VERTICAL_WALL_LIT
               ]
  }
wallObscured :: TileKind
wallObscured = TileKind
  { tsymbol :: Char
tsymbol  = Char
'|'
  , tname :: Text
tname    = Text
"scratched wall"
  , tfreq :: Freqs TileKind
tfreq    = [(GroupName TileKind
OBSCURED_VERTICAL_WALL_LIT, 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
SCRATCH_ON_WALL
               , GroupName TileKind -> Feature
HideAs GroupName TileKind
S_SUSPECT_VERTICAL_WALL_LIT
               ]
  }
wallH :: TileKind
wallH = TileKind
  { tsymbol :: Char
tsymbol  = Char
'-'
  , tname :: Text
tname    = Text
"sandstone wall"
  , tfreq :: Freqs TileKind
tfreq    = [ (GroupName TileKind
S_WALL_HORIZONTAL_LIT, Int
100)
               , (GroupName TileKind
RECT_WINDOWS_HORIZONTAL_LIT, Int
80) ]
  , tcolor :: Color
tcolor   = Color
BrWhite
  , tcolor2 :: Color
tcolor2  = Color
defFG
  , talter :: Word8
talter   = Word8
100
  , tfeature :: [Feature]
tfeature = [GroupName TileKind -> Feature
BuildAs GroupName TileKind
S_SUSPECT_HORIZONTAL_WALL_LIT]
  }
wallSuspectH :: TileKind
wallSuspectH = TileKind  -- only on client
  { tsymbol :: Char
tsymbol  = Char
'-'
  , tname :: Text
tname    = Text
"suspect painted wall"
  , tfreq :: Freqs TileKind
tfreq    = [(GroupName TileKind
S_SUSPECT_HORIZONTAL_WALL_LIT, 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_HORIZONAL_DOOR_LIT
               , GroupName TileKind -> Feature
ObscureAs GroupName TileKind
OBSCURED_HORIZONTAL_WALL_LIT
               ]
  }
wallObscuredDefacedH :: TileKind
wallObscuredDefacedH = TileKind
  { tsymbol :: Char
tsymbol  = Char
'-'
  , tname :: Text
tname    = Text
"defaced wall"
  , tfreq :: Freqs TileKind
tfreq    = [(GroupName TileKind
OBSCURED_HORIZONTAL_WALL_LIT, Int
90)]
  , 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_HORIZONTAL_WALL_LIT
               ]
  }
wallObscuredFrescoedH :: TileKind
wallObscuredFrescoedH = TileKind
  { tsymbol :: Char
tsymbol  = Char
'-'
  , tname :: Text
tname    = Text
"frescoed wall"
  , tfreq :: Freqs TileKind
tfreq    = [(GroupName TileKind
OBSCURED_HORIZONTAL_WALL_LIT, Int
10)]
  , 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_HORIZONTAL_WALL_LIT
               ]  -- a bit beneficial, but AI would loop if allowed to trigger
                  -- so no @ConsideredByAI@
  }
pillar :: TileKind
pillar = TileKind
  { tsymbol :: Char
tsymbol  = Char
'0'
  , tname :: Text
tname    = Text
"rock outcrop"
  , tfreq :: Freqs TileKind
tfreq    = [ (GroupName TileKind
S_PILLAR, Int
1), (GroupName TileKind
CACHE_OR_NOT, Int
70)
               , (GroupName TileKind
STAIR_TERMINAL_LIT, Int
100), (GroupName TileKind
STAIR_TERMINAL_DARK, Int
100)
               , (GroupName TileKind
EMPTY_SET_LIT, Int
20), (GroupName TileKind
NOISE_SET_LIT, Int
700)
               , (GroupName TileKind
POWER_SET_DARK, Int
700)
               , (GroupName TileKind
BATTLE_SET_DARK, Int
200), (GroupName TileKind
BRAWL_SET_LIT, Int
50)
               , (GroupName TileKind
SHOOTOUT_SET_LIT, Int
10), (GroupName TileKind
ZOO_SET_DARK, Int
10) ]
  , 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
  { tsymbol :: Char
tsymbol  = Char
'0'
  , tname :: Text
tname    = Text
"smoothed outcrop"
  , tfreq :: Freqs TileKind
tfreq    = [(GroupName TileKind
CACHE_OR_NOT, Int
30), (GroupName TileKind
CACHE, Int
1), (GroupName TileKind
STAIR_TERMINAL_DARK, Int
4)]
                 -- treasure only in dark staircases
  , tcolor :: Color
tcolor   = Color
BrBlue
  , tcolor2 :: Color
tcolor2  = Color
Blue
  , talter :: Word8
talter   = Word8
5
  , tfeature :: [Feature]
tfeature = [ GroupName ItemKind -> Feature
Embed GroupName ItemKind
TREASURE_CACHE, GroupName ItemKind -> Feature
Embed GroupName ItemKind
TREASURE_CACHE_TRAP
               , GroupName TileKind -> Feature
ChangeTo GroupName TileKind
CACHE_OR_NOT, Feature
ConsideredByAI ]
      -- Not explorable, but prominently placed, so hard to miss.
      -- Very beneficial, so AI eager to trigger, unless wary of traps.
  }
lampPost :: TileKind
lampPost = 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 = []
  }
signboardUnread :: TileKind
signboardUnread = 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
               , GroupName TileKind -> Feature
RevealAs GroupName TileKind
SIGNBOARD  -- to display as hidden
               ]
  }
signboardRead :: TileKind
signboardRead = TileKind
  { tsymbol :: Char
tsymbol  = Char
'0'
  , tname :: Text
tname    = Text
"signboard"
  , tfreq :: Freqs TileKind
tfreq    = [(GroupName TileKind
SIGNBOARD, Int
1), (GroupName TileKind
FLIGHT_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
SIGNAGE, GroupName TileKind -> Feature
HideAs GroupName TileKind
S_SIGNBOARD_UNREAD]
  }
tree :: TileKind
tree = TileKind
  { tsymbol :: Char
tsymbol  = Char
'0'
  , tname :: Text
tname    = Text
"tree"
  , tfreq :: Freqs TileKind
tfreq    = [ (GroupName TileKind
BRAWL_SET_LIT, Int
140), (GroupName TileKind
SHOOTOUT_SET_LIT, Int
10)
               , (GroupName TileKind
FLIGHT_SET_LIT, Int
35), (GroupName TileKind
AMBUSH_SET_LIT, Int
3)
               , (GroupName TileKind
S_TREE_LIT, Int
1) ]
  , tcolor :: Color
tcolor   = Color
BrGreen
  , tcolor2 :: Color
tcolor2  = Color
Green
  , talter :: Word8
talter   = Word8
50
  , tfeature :: [Feature]
tfeature = []
  }
treeBurnt :: TileKind
treeBurnt = TileKind
tree
  { tname    = "burnt tree"
  , tfreq    = [ (AMBUSH_SET_DARK, 3), (ZOO_SET_DARK, 7), (BATTLE_SET_DARK, 50)
               , (TREE_BURNING_OR_NOT, 30) ]
  , tcolor   = BrBlack
  , tcolor2  = BrBlack
  , tfeature = Dark : tfeature tree
  }
treeBurning :: TileKind
treeBurning = TileKind
tree
  { tname    = "burning tree"
  , tfreq    = [ (AMBUSH_SET_DARK, 15), (ZOO_SET_DARK, 70)
               , (TREE_BURNING_OR_NOT, 70) ]
  , tcolor   = BrRed
  , tcolor2  = Red
  , talter   = 5
  , tfeature = Embed BIG_FIRE : ChangeTo TREE_BURNING_OR_NOT : tfeature tree
      -- TODO: dousing off the tree will have more sense when it periodically
      -- explodes, hitting and lighting up the team and so betraying it
  }
rubble :: TileKind
rubble = TileKind
  { tsymbol :: Char
tsymbol  = Char
'&'
  , tname :: Text
tname    = Text
"rubble pile"
  , tfreq :: Freqs TileKind
tfreq    = [ (GroupName TileKind
S_RUBBLE_PILE, Int
1)
               , (GroupName TileKind
STAIR_TERMINAL_LIT, Int
4), (GroupName TileKind
STAIR_TERMINAL_DARK, Int
4)
               , (GroupName TileKind
EMPTY_SET_LIT, Int
10), (GroupName TileKind
EMPTY_SET_DARK, Int
10)
               , (GroupName TileKind
NOISE_SET_LIT, Int
50), (GroupName TileKind
POWER_SET_DARK, Int
50)
               , (GroupName TileKind
ZOO_SET_DARK, Int
100), (GroupName TileKind
AMBUSH_SET_DARK, Int
10) ]
  , tcolor :: Color
tcolor   = Color
BrYellow
  , tcolor2 :: Color
tcolor2  = Color
Brown
  , talter :: Word8
talter   = Word8
4  -- boss can dig through
  , tfeature :: [Feature]
tfeature = [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.
  }
rubbleSpice :: TileKind
rubbleSpice = TileKind
rubble
  { tfreq    = [(SMOKE_CLUMP_LIT, 1), (SMOKE_CLUMP_DARK, 1)]
  , tfeature = Spice : tfeature rubble
  }
doorTrapped :: TileKind
doorTrapped = TileKind
  { tsymbol :: Char
tsymbol  = Char
'+'
  , tname :: Text
tname    = Text
"trapped door"
  , tfreq :: Freqs TileKind
tfreq    = [(GroupName TileKind
TRAPPED_VERTICAL_DOOR_LIT, Int
1)]
  , tcolor :: Color
tcolor   = Color
BrRed
  , tcolor2 :: Color
tcolor2  = Color
Red
  , talter :: Word8
talter   = Word8
2
  , tfeature :: [Feature]
tfeature = [ GroupName ItemKind -> Feature
Embed GroupName ItemKind
DOORWAY_TRAP
               , GroupName TileKind -> Feature
OpenTo GroupName TileKind
S_OPEN_VERTICAL_DOOR_LIT
               , GroupName TileKind -> Feature
HideAs GroupName TileKind
S_SUSPECT_VERTICAL_WALL_LIT
               ]
  }
doorClosed :: TileKind
doorClosed = TileKind
  { tsymbol :: Char
tsymbol  = Char
'+'
  , tname :: Text
tname    = Text
"closed door"
  , tfreq :: Freqs TileKind
tfreq    = [(GroupName TileKind
S_CLOSED_VERTICAL_DOOR_LIT, 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_VERTICAL_DOOR_LIT]  -- never hidden
  }
doorTrappedH :: TileKind
doorTrappedH = TileKind
  { tsymbol :: Char
tsymbol  = Char
'+'
  , tname :: Text
tname    = Text
"trapped door"
  , tfreq :: Freqs TileKind
tfreq    = [(GroupName TileKind
TRAPPED_HORIZONAL_DOOR_LIT, Int
1)]
  , tcolor :: Color
tcolor   = Color
BrRed
  , tcolor2 :: Color
tcolor2  = Color
Red
  , talter :: Word8
talter   = Word8
2
  , tfeature :: [Feature]
tfeature = [ GroupName ItemKind -> Feature
Embed GroupName ItemKind
DOORWAY_TRAP
               , GroupName TileKind -> Feature
OpenTo GroupName TileKind
S_OPEN_HORIZONTAL_DOOR_LIT
               , GroupName TileKind -> Feature
HideAs GroupName TileKind
S_SUSPECT_HORIZONTAL_WALL_LIT
               ]
  }
doorClosedH :: TileKind
doorClosedH = TileKind
  { tsymbol :: Char
tsymbol  = Char
'+'
  , tname :: Text
tname    = Text
"closed door"
  , tfreq :: Freqs TileKind
tfreq    = [(GroupName TileKind
S_CLOSED_HORIZONTAL_DOOR_LIT, 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_HORIZONTAL_DOOR_LIT]  -- never hidden
  }
stairsUp :: TileKind
stairsUp = TileKind
  { tsymbol :: Char
tsymbol  = Char
'<'
  , tname :: Text
tname    = Text
"staircase up"
  , tfreq :: Freqs TileKind
tfreq    = [(GroupName TileKind
STAIRCASE_UP, Int
9), (GroupName TileKind
ORDINARY_STAIRCASE_UP, Int
1)]
  , tcolor :: Color
tcolor   = Color
BrWhite
  , tcolor2 :: Color
tcolor2  = Color
defFG
  , talter :: Word8
talter   = Word8
talterForStairs
  , tfeature :: [Feature]
tfeature = [GroupName ItemKind -> Feature
Embed GroupName ItemKind
STAIRS_UP, Feature
ConsideredByAI]
  }
stairsTrappedUp :: TileKind
stairsTrappedUp = TileKind
  { tsymbol :: Char
tsymbol  = Char
'<'
  , tname :: Text
tname    = Text
"windy staircase up"
  , tfreq :: Freqs TileKind
tfreq    = [(GroupName TileKind
STAIRCASE_UP, Int
1)]
  , 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
  { tname    = "signpost pointing backward"
  , tfreq    = [(STAIRCASE_OUTDOOR_UP, 1)]
  }
stairsGatedUp :: TileKind
stairsGatedUp = TileKind
stairsUp
  { tname    = "gated staircase up"
  , tfreq    = [(GATED_STAIRCASE_UP, 1)]
  , talter   = talterForStairs + 2  -- animals and bosses can't use
  }
stairsDown :: TileKind
stairsDown = TileKind
  { tsymbol :: Char
tsymbol  = Char
'>'
  , tname :: Text
tname    = Text
"staircase down"
  , tfreq :: Freqs TileKind
tfreq    = [(GroupName TileKind
STAIRCASE_DOWN, Int
9), (GroupName TileKind
ORDINARY_STAIRCASE_DOWN, Int
1)]
  , tcolor :: Color
tcolor   = Color
BrWhite
  , tcolor2 :: Color
tcolor2  = Color
defFG
  , talter :: Word8
talter   = Word8
talterForStairs
  , tfeature :: [Feature]
tfeature = [GroupName ItemKind -> Feature
Embed GroupName ItemKind
STAIRS_DOWN, Feature
ConsideredByAI]
  }
stairsTrappedDown :: TileKind
stairsTrappedDown = TileKind
  { tsymbol :: Char
tsymbol  = Char
'>'
  , tname :: Text
tname    = Text
"crooked staircase down"
  , tfreq :: Freqs TileKind
tfreq    = [(GroupName TileKind
STAIRCASE_DOWN, Int
1)]
  , 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
  { tname    = "signpost pointing forward"
  , tfreq    = [(STAIRCASE_OUTDOOR_DOWN, 1)]
  }
stairsGatedDown :: TileKind
stairsGatedDown = TileKind
stairsDown
  { tname    = "gated staircase down"
  , tfreq    = [(GATED_STAIRCASE_DOWN, 1)]
  , talter   = talterForStairs + 2  -- animals and bosses can't use
  }
escapeUp :: TileKind
escapeUp = 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
  { 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    = "escape back to town"
  , tfreq    = [(TILE_OUTDOOR_ESCAPE_DOWN, 1)]
  }

-- *** Clear

wallGlass :: TileKind
wallGlass = TileKind
  { tsymbol :: Char
tsymbol  = Char
'|'
  , tname :: Text
tname    = Text
"polished crystal wall"
  , tfreq :: Freqs TileKind
tfreq    = [(GroupName TileKind
GLASSHOUSE_VERTICAL_LIT, Int
1)]
  , tcolor :: Color
tcolor   = Color
BrBlue
  , tcolor2 :: Color
tcolor2  = Color
Blue
  , talter :: Word8
talter   = Word8
10
  , tfeature :: [Feature]
tfeature = [GroupName TileKind -> Feature
BuildAs GroupName TileKind
S_CLOSED_VERTICAL_DOOR_LIT, Feature
Clear]
  }
wallGlassSpice :: TileKind
wallGlassSpice = TileKind
wallGlass
  { tfreq    = [(RECT_WINDOWS_VERTICAL_LIT, 20)]
  , tfeature = Spice : tfeature wallGlass
  }
wallGlassH :: TileKind
wallGlassH = TileKind
  { tsymbol :: Char
tsymbol  = Char
'-'
  , tname :: Text
tname    = Text
"polished crystal wall"
  , tfreq :: Freqs TileKind
tfreq    = [(GroupName TileKind
GLASSHOUSE_HORIZONTAL_LIT, Int
1)]
  , tcolor :: Color
tcolor   = Color
BrBlue
  , tcolor2 :: Color
tcolor2  = Color
Blue
  , talter :: Word8
talter   = Word8
10
  , tfeature :: [Feature]
tfeature = [GroupName TileKind -> Feature
BuildAs GroupName TileKind
S_CLOSED_HORIZONTAL_DOOR_LIT, Feature
Clear]
  }
wallGlassHSpice :: TileKind
wallGlassHSpice = TileKind
wallGlassH
  { tfreq    = [(RECT_WINDOWS_HORIZONTAL_LIT, 20)]
  , tfeature = Spice : tfeature wallGlassH
  }
pillarIce :: TileKind
pillarIce = TileKind
  { tsymbol :: Char
tsymbol  = Char
'^'
  , tname :: Text
tname    = Text
"icy outcrop"
  , tfreq :: Freqs TileKind
tfreq    = [(GroupName TileKind
POWER_SET_DARK, Int
300)]
  , 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]
  }
pulpit :: TileKind
pulpit = TileKind
  { tsymbol :: Char
tsymbol  = Char
'%'
  , tname :: Text
tname    = Text
"pulpit"
  , 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 = [Feature
Clear, GroupName ItemKind -> Feature
Embed GroupName ItemKind
LECTERN]
                 -- mixed blessing, so AI ignores, saved for player fun
  }
bush :: TileKind
bush = TileKind
  { tsymbol :: Char
tsymbol  = Char
'%'
  , tname :: Text
tname    = Text
"bush"
  , tfreq :: Freqs TileKind
tfreq    = [ (GroupName TileKind
S_BUSH_LIT, Int
1), (GroupName TileKind
SHOOTOUT_SET_LIT, Int
30), (GroupName TileKind
FLIGHT_SET_LIT, Int
40)
               , (GroupName TileKind
AMBUSH_SET_LIT, Int
3), (GroupName TileKind
BUSH_CLUMP_LIT, Int
1) ]
  , tcolor :: Color
tcolor   = Color
BrGreen
  , tcolor2 :: Color
tcolor2  = Color
Green
  , talter :: Word8
talter   = Word8
10
  , tfeature :: [Feature]
tfeature = [Feature
Clear]
  }
bushBurnt :: TileKind
bushBurnt = TileKind
bush
  { tname    = "burnt bush"
  , tfreq    = [ (BATTLE_SET_DARK, 30), (ZOO_SET_DARK, 30), (AMBUSH_SET_DARK, 3)
               , (BUSH_BURNING_OR_NOT, 70) ]
  , tcolor   = BrBlack
  , tcolor2  = BrBlack
  , tfeature = Dark : tfeature bush
  }
bushBurning :: TileKind
bushBurning = TileKind
bush
  { tname    = "burning bush"
  , tfreq    = [ (AMBUSH_SET_DARK, 15), (ZOO_SET_DARK, 300)
               , (BUSH_BURNING_OR_NOT, 30) ]
  , tcolor   = BrRed
  , tcolor2  = Red
  , talter   = 5
  , tfeature = Embed SMALL_FIRE : ChangeTo BUSH_BURNING_OR_NOT
               : tfeature bush
  }

-- ** Walkable

-- *** Not clear

fog :: TileKind
fog = TileKind
  { 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
50), (GroupName TileKind
NOISE_SET_LIT, Int
100)
               , (GroupName TileKind
SHOOTOUT_SET_LIT, Int
20)
               , (GroupName TileKind
FOG_CLUMP_LIT, Int
60), (GroupName TileKind
FOG_CLUMP_DARK, Int
60) ]
      -- 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
  { tname    = "thick fog"
  , tfreq    = [ (EMPTY_SET_DARK, 50), (POWER_SET_DARK, 100)
               , (FLIGHT_SET_DARK, 50) ]
  , tfeature = Dark : tfeature fog
  }
smoke :: TileKind
smoke = TileKind
  { 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
4)
               , (GroupName TileKind
SMOKE_CLUMP_LIT, Int
3), (GroupName TileKind
SMOKE_CLUMP_DARK, Int
3) ]
  , 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
  { tname    = "lingering smoke"
  , tfreq    = [ (STAIR_TERMINAL_DARK, 4), (AMBUSH_SET_DARK, 40)
               , (ZOO_SET_DARK, 20), (BATTLE_SET_DARK, 5) ]
  , tfeature = Dark : tfeature smoke
  }

-- *** Clear

doorOpen :: TileKind
doorOpen = TileKind
  { tsymbol :: Char
tsymbol  = Char
'-'
  , tname :: Text
tname    = Text
"open door"
  , tfreq :: Freqs TileKind
tfreq    = [(GroupName TileKind
S_OPEN_VERTICAL_DOOR_LIT, 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_VERTICAL_DOOR_LIT
                   -- not explorable due to that
               ]
  }
doorOpenH :: TileKind
doorOpenH = TileKind
  { tsymbol :: Char
tsymbol  = Char
'|'
  , tname :: Text
tname    = Text
"open door"
  , tfreq :: Freqs TileKind
tfreq    = [(GroupName TileKind
S_OPEN_HORIZONTAL_DOOR_LIT, 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_HORIZONTAL_DOOR_LIT
                   -- not explorable due to that
               ]
  }
floorCorridor :: TileKind
floorCorridor = TileKind
  { tsymbol :: Char
tsymbol  = Char
'#'
  , tname :: Text
tname    = Text
"corridor"
  , 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]
  }
floorArena :: TileKind
floorArena = TileKind
floorCorridor
  { tsymbol  = floorSymbol
  , tname    = "stone floor"
  , tfreq    = [ (FLOOR_ARENA_LIT, 1), (ARENA_SET_LIT, 1), (EMPTY_SET_LIT, 900)
               , (ZOO_SET_LIT, 600) ]
  }
floorDamp :: TileKind
floorDamp = TileKind
floorArena
  { tname    = "damp stone floor"
  , tfreq    = [ (NOISE_SET_LIT, 600), (POWER_SET_LIT, 600)
               , (DAMP_FLOOR_LIT, 1), (STAIR_TERMINAL_LIT, 20) ]
  }
floorDirt :: TileKind
floorDirt = TileKind
floorArena
  { tname    = "dirt floor"
  , tfreq    = [ (SHOOTOUT_SET_LIT, 1000), (FLIGHT_SET_LIT, 1000)
               , (AMBUSH_SET_LIT, 1000), (BATTLE_SET_LIT, 1000)
               , (BRAWL_SET_LIT, 1000), (DIRT_LIT, 1) ]
  }
floorDirtSpice :: TileKind
floorDirtSpice = TileKind
floorDirt
  { tfreq    = [(TREE_SHADE_WALKABLE_LIT, 1), (BUSH_CLUMP_LIT, 1)]
  , tfeature = Spice : tfeature floorDirt
  }
floorActor :: TileKind
floorActor = TileKind
floorArena
  { tfreq    = [(S_FLOOR_ACTOR_LIT, 1)]
  , tfeature = OftenActor : tfeature floorArena
  }
floorActorItem :: TileKind
floorActorItem = TileKind
floorActor
  { tfreq    = [(FLOOR_ACTOR_ITEM_LIT, 1)]
  , tfeature = VeryOftenItem : tfeature floorActor
  }
floorAshes :: TileKind
floorAshes = TileKind
floorActor
  { tfreq    = [ (SMOKE_CLUMP_LIT, 2), (SMOKE_CLUMP_DARK, 2)
               , (S_FLOOR_ASHES_LIT, 1), (S_FLOOR_ASHES_DARK, 1) ]
  , tname    = "dirt and ash pile"
  , tcolor   = Brown
  , tcolor2  = Brown
  }
shallowWater :: TileKind
shallowWater = TileKind
  { tsymbol :: Char
tsymbol  = Char
'~'
  , tname :: Text
tname    = Text
"water puddle"
  , tfreq :: Freqs TileKind
tfreq    = [ (GroupName TileKind
S_SHALLOW_WATER_LIT, Int
1)
               , (GroupName TileKind
EMPTY_SET_LIT, Int
5), (GroupName TileKind
NOISE_SET_LIT, Int
20)
               , (GroupName TileKind
POWER_SET_LIT, Int
20), (GroupName TileKind
SHOOTOUT_SET_LIT, Int
5) ]
  , tcolor :: Color
tcolor   = Color
BrCyan
  , tcolor2 :: Color
tcolor2  = Color
Cyan
  , talter :: Word8
talter   = Word8
0
  , tfeature :: [Feature]
tfeature = GroupName ItemKind -> Feature
Embed GroupName ItemKind
SHALLOW_WATER Feature -> [Feature] -> [Feature]
forall a. a -> [a] -> [a]
: TileKind -> [Feature]
tfeature TileKind
floorActor
  }
shallowWaterSpice :: TileKind
shallowWaterSpice = TileKind
shallowWater
  { tfreq    = [(FOG_CLUMP_LIT, 40)]
  , tfeature = Spice : tfeature shallowWater
  }
floorRed :: TileKind
floorRed = TileKind
floorCorridor
  { tsymbol  = floorSymbol
  , tname    = "brick pavement"
  , tfreq    = [(TRAIL_LIT, 70), (SAFE_TRAIL_LIT, 70)]
  , tcolor   = BrRed
  , tcolor2  = Red
  , tfeature = [Embed STRAIGHT_PATH, Trail, Walkable, Clear]
  }
floorBlue :: TileKind
floorBlue = TileKind
floorRed
  { tname    = "frozen trail"
  , tfreq    = [(TRAIL_LIT, 100)]
  , tcolor   = BrBlue
  , tcolor2  = Blue
  , tfeature = [Embed FROZEN_GROUND, Trail, Walkable, Clear]
  }
floorGreen :: TileKind
floorGreen = TileKind
floorRed
  { tname    = "mossy stone path"
  , tfreq    = [(TRAIL_LIT, 70), (SAFE_TRAIL_LIT, 70)]
  , tcolor   = BrGreen
  , tcolor2  = Green
  }
floorBrown :: TileKind
floorBrown = TileKind
floorRed
  { tname    = "rotting mahogany deck"
  , tfreq    = [(TRAIL_LIT, 50), (SAFE_TRAIL_LIT, 50)]
  , tcolor   = BrMagenta
  , tcolor2  = Magenta
  }
floorArenaShade :: TileKind
floorArenaShade = TileKind
floorActor
  { tname    = "shaded ground"
  , tfreq    = [(S_SHADED_GROUND, 1), (TREE_SHADE_WALKABLE_LIT, 2)]
  , tcolor2  = BrBlack
  , tfeature = Dark : NoItem : tfeature floorActor
  }

outdoorFence :: TileKind
outdoorFence = TileKind
  { tsymbol :: Char
tsymbol  = Char
' '
  , tname :: Text
tname    = Text
"event horizon"
  , tfreq :: Freqs TileKind
tfreq    = [(GroupName TileKind
OUTDOOR_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]
  }

-- * 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
                 darkFrequency :: Freqs TileKind
                 darkFrequency :: Freqs TileKind
darkFrequency = ((GroupName TileKind, Int) -> (GroupName TileKind, Int))
-> Freqs TileKind -> Freqs TileKind
forall a b. (a -> b) -> [a] -> [b]
map ((GroupName TileKind -> GroupName TileKind)
-> (GroupName TileKind, Int) -> (GroupName TileKind, Int)
forall b c d. (b -> c) -> (b, d) -> (c, d)
forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> a (b, d) (c, d)
first GroupName TileKind -> GroupName TileKind
darkenText) (Freqs TileKind -> Freqs TileKind)
-> Freqs TileKind -> Freqs TileKind
forall a b. (a -> b) -> a -> b
$ TileKind -> Freqs TileKind
tfreq TileKind
k
                 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    = darkFrequency
                  , tfeature = Dark : mapMaybe darkFeat (tfeature k)
                  }

makeDarkColor :: TileKind -> TileKind
makeDarkColor :: TileKind -> TileKind
makeDarkColor TileKind
k = (TileKind -> TileKind
makeDark TileKind
k) {tcolor2 = BrBlack}