-- | 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 ESCAPE_SET_LIT, pattern ESCAPE_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 ESCAPE_UP, pattern ESCAPE_DOWN, pattern ESCAPE_OUTDOOR_DOWN
  , pattern S_LAMP_POST, pattern S_TREE_LIT, pattern S_TREE_DARK, pattern S_WALL_LIT, pattern S_WALL_HORIZONTAL_LIT, 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
  , groupNamesSingleton, groupNames
    -- * Content
  , content
  ) where

import Prelude ()

import Game.LambdaHack.Core.Prelude

import qualified Data.Text as T

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

-- * Group name patterns

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

groupNamesSingleton :: [GroupName TileKind]
groupNamesSingleton :: [GroupName TileKind]
groupNamesSingleton =
       [GroupName TileKind
S_LAMP_POST, GroupName TileKind
S_TREE_LIT, GroupName TileKind
S_TREE_DARK, GroupName TileKind
S_WALL_LIT, GroupName TileKind
S_WALL_HORIZONTAL_LIT, 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]
-> [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_RUBBLE_PILE, GroupName TileKind
S_SHALLOW_WATER_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_SHALLOW_WATER_DARK, GroupName TileKind
S_SUSPECT_HORIZONTAL_WALL_DARK, GroupName TileKind
S_SUSPECT_VERTICAL_WALL_DARK, GroupName TileKind
S_WALL_DARK, GroupName TileKind
S_WALL_HORIZONTAL_DARK]

-- ** Used in PlaceKind, but not in CaveKind.
pattern S_LAMP_POST, S_TREE_LIT, S_TREE_DARK, S_WALL_LIT, S_WALL_HORIZONTAL_LIT, 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 :: 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_RUBBLE_PILE, S_SHALLOW_WATER_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_SHALLOW_WATER_DARK, S_SUSPECT_HORIZONTAL_WALL_DARK, S_SUSPECT_VERTICAL_WALL_DARK, S_WALL_DARK, S_WALL_HORIZONTAL_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
ESCAPE_SET_LIT, GroupName TileKind
ESCAPE_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
ESCAPE_UP, GroupName TileKind
ESCAPE_DOWN, GroupName TileKind
ESCAPE_OUTDOOR_DOWN]
    [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, ESCAPE_SET_LIT, ESCAPE_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, ESCAPE_UP, ESCAPE_DOWN, ESCAPE_OUTDOOR_DOWN :: 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 $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 $bOUTDOOR_OUTER_FENCE :: GroupName TileKind
$mOUTDOOR_OUTER_FENCE :: forall r. GroupName TileKind -> (Void# -> r) -> (Void# -> r) -> r
OUTDOOR_OUTER_FENCE = GroupName "outdoor outer fence"
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"

-- ** 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 $bESCAPE_SET_LIT :: GroupName TileKind
$mESCAPE_SET_LIT :: forall r. GroupName TileKind -> (Void# -> r) -> (Void# -> r) -> r
ESCAPE_SET_LIT = GroupName "escapeSetLit"
pattern $bESCAPE_SET_DARK :: GroupName TileKind
$mESCAPE_SET_DARK :: forall r. GroupName TileKind -> (Void# -> r) -> (Void# -> r) -> r
ESCAPE_SET_DARK = GroupName "escapeSetDark"
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"

-- ** Used in PlaceKind, but not in CaveKind. Not singletons.
pattern $bRECT_WINDOWS_VERTICAL_LIT :: GroupName TileKind
$mRECT_WINDOWS_VERTICAL_LIT :: forall r. GroupName TileKind -> (Void# -> r) -> (Void# -> r) -> r
RECT_WINDOWS_VERTICAL_LIT = GroupName "rectWindowsVerticalLit"
pattern $bRECT_WINDOWS_VERTICAL_DARK :: GroupName TileKind
$mRECT_WINDOWS_VERTICAL_DARK :: forall r. GroupName TileKind -> (Void# -> r) -> (Void# -> r) -> r
RECT_WINDOWS_VERTICAL_DARK = GroupName "rectWindowsVerticalDark"
pattern $bRECT_WINDOWS_HORIZONTAL_LIT :: GroupName TileKind
$mRECT_WINDOWS_HORIZONTAL_LIT :: forall r. GroupName TileKind -> (Void# -> r) -> (Void# -> r) -> r
RECT_WINDOWS_HORIZONTAL_LIT = GroupName "rectWindowsHorizontalLit"
pattern $bRECT_WINDOWS_HORIZONTAL_DARK :: GroupName TileKind
$mRECT_WINDOWS_HORIZONTAL_DARK :: forall r. GroupName TileKind -> (Void# -> r) -> (Void# -> r) -> r
RECT_WINDOWS_HORIZONTAL_DARK = GroupName "rectWindowsHorizontalDark"
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 $bGLASSHOUSE_VERTICAL_LIT :: GroupName TileKind
$mGLASSHOUSE_VERTICAL_LIT :: forall r. GroupName TileKind -> (Void# -> r) -> (Void# -> r) -> r
GLASSHOUSE_VERTICAL_LIT = GroupName "glasshouseVerticalLit"
pattern $bGLASSHOUSE_VERTICAL_DARK :: GroupName TileKind
$mGLASSHOUSE_VERTICAL_DARK :: forall r. GroupName TileKind -> (Void# -> r) -> (Void# -> r) -> r
GLASSHOUSE_VERTICAL_DARK = GroupName "glasshouseVerticalDark"
pattern $bGLASSHOUSE_HORIZONTAL_LIT :: GroupName TileKind
$mGLASSHOUSE_HORIZONTAL_LIT :: forall r. GroupName TileKind -> (Void# -> r) -> (Void# -> r) -> r
GLASSHOUSE_HORIZONTAL_LIT = GroupName "glasshouseHorizontalLit"
pattern $bGLASSHOUSE_HORIZONTAL_DARK :: GroupName TileKind
$mGLASSHOUSE_HORIZONTAL_DARK :: forall r. GroupName TileKind -> (Void# -> r) -> (Void# -> r) -> r
GLASSHOUSE_HORIZONTAL_DARK = GroupName "glasshouseHorizontalDark"
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 $bCACHE :: GroupName TileKind
$mCACHE :: forall r. GroupName TileKind -> (Void# -> r) -> (Void# -> r) -> r
CACHE = GroupName "cache"
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 $bESCAPE_UP :: GroupName TileKind
$mESCAPE_UP :: forall r. GroupName TileKind -> (Void# -> r) -> (Void# -> r) -> r
ESCAPE_UP = GroupName "escape up"
pattern $bESCAPE_DOWN :: GroupName TileKind
$mESCAPE_DOWN :: forall r. GroupName TileKind -> (Void# -> r) -> (Void# -> r) -> r
ESCAPE_DOWN = GroupName "escape down"
pattern $bESCAPE_OUTDOOR_DOWN :: GroupName TileKind
$mESCAPE_OUTDOOR_DOWN :: forall r. GroupName TileKind -> (Void# -> r) -> (Void# -> r) -> r
ESCAPE_OUTDOOR_DOWN = GroupName "escape outdoor down"

-- ** Used in PlaceKind, but not in CaveKind. Singletons.
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_WALL_LIT :: GroupName TileKind
$mS_WALL_LIT :: forall r. GroupName TileKind -> (Void# -> r) -> (Void# -> r) -> r
S_WALL_LIT = GroupName "wall Lit"
pattern $bS_WALL_HORIZONTAL_LIT :: GroupName TileKind
$mS_WALL_HORIZONTAL_LIT :: forall r. GroupName TileKind -> (Void# -> r) -> (Void# -> r) -> r
S_WALL_HORIZONTAL_LIT = GroupName "wall horizontal Lit"
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"

-- ** Used only internally in other TileKind definitions. Not singletons.
pattern $bOBSCURED_VERTICAL_WALL_LIT :: GroupName TileKind
$mOBSCURED_VERTICAL_WALL_LIT :: forall r. GroupName TileKind -> (Void# -> r) -> (Void# -> r) -> r
OBSCURED_VERTICAL_WALL_LIT = GroupName "obscured vertical wall Lit"
pattern $bOBSCURED_HORIZONTAL_WALL_LIT :: GroupName TileKind
$mOBSCURED_HORIZONTAL_WALL_LIT :: forall r. GroupName TileKind -> (Void# -> r) -> (Void# -> r) -> r
OBSCURED_HORIZONTAL_WALL_LIT = GroupName "obscured horizontal wall Lit"
pattern $bTRAPPED_VERTICAL_DOOR_LIT :: GroupName TileKind
$mTRAPPED_VERTICAL_DOOR_LIT :: forall r. GroupName TileKind -> (Void# -> r) -> (Void# -> r) -> r
TRAPPED_VERTICAL_DOOR_LIT = GroupName "trapped vertical door Lit"
pattern $bTRAPPED_HORIZONAL_DOOR_LIT :: GroupName TileKind
$mTRAPPED_HORIZONAL_DOOR_LIT :: forall r. GroupName TileKind -> (Void# -> r) -> (Void# -> r) -> r
TRAPPED_HORIZONAL_DOOR_LIT = GroupName "trapped horizontal door Lit"
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"
pattern $bCACHE_OR_NOT :: GroupName TileKind
$mCACHE_OR_NOT :: forall r. GroupName TileKind -> (Void# -> r) -> (Void# -> r) -> r
CACHE_OR_NOT = GroupName "cache or not"

-- ** Used only internally in other TileKind definitions. Singletons.
pattern $bS_SUSPECT_VERTICAL_WALL_LIT :: GroupName TileKind
$mS_SUSPECT_VERTICAL_WALL_LIT :: forall r. GroupName TileKind -> (Void# -> r) -> (Void# -> r) -> r
S_SUSPECT_VERTICAL_WALL_LIT = GroupName "suspect vertical wall Lit"
pattern $bS_SUSPECT_HORIZONTAL_WALL_LIT :: GroupName TileKind
$mS_SUSPECT_HORIZONTAL_WALL_LIT :: forall r. GroupName TileKind -> (Void# -> r) -> (Void# -> r) -> r
S_SUSPECT_HORIZONTAL_WALL_LIT = GroupName "suspect horizontal wall Lit"
pattern $bS_CLOSED_VERTICAL_DOOR_LIT :: GroupName TileKind
$mS_CLOSED_VERTICAL_DOOR_LIT :: forall r. GroupName TileKind -> (Void# -> r) -> (Void# -> r) -> r
S_CLOSED_VERTICAL_DOOR_LIT = GroupName "closed vertical door Lit"
pattern $bS_CLOSED_HORIZONTAL_DOOR_LIT :: GroupName TileKind
$mS_CLOSED_HORIZONTAL_DOOR_LIT :: forall r. GroupName TileKind -> (Void# -> r) -> (Void# -> r) -> r
S_CLOSED_HORIZONTAL_DOOR_LIT = GroupName "closed horizontal door Lit"
pattern $bS_OPEN_VERTICAL_DOOR_LIT :: GroupName TileKind
$mS_OPEN_VERTICAL_DOOR_LIT :: forall r. GroupName TileKind -> (Void# -> r) -> (Void# -> r) -> r
S_OPEN_VERTICAL_DOOR_LIT = GroupName "open vertical door Lit"
pattern $bS_OPEN_HORIZONTAL_DOOR_LIT :: GroupName TileKind
$mS_OPEN_HORIZONTAL_DOOR_LIT :: forall r. GroupName TileKind -> (Void# -> r) -> (Void# -> r) -> r
S_OPEN_HORIZONTAL_DOOR_LIT = GroupName "open horizontal door Lit"
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_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_SIGNBOARD_UNREAD :: GroupName TileKind
$mS_SIGNBOARD_UNREAD :: forall r. GroupName TileKind -> (Void# -> r) -> (Void# -> r) -> r
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 $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 $bOBSCURED_HORIZONTAL_WALL_DARK :: GroupName TileKind
$mOBSCURED_HORIZONTAL_WALL_DARK :: forall r. GroupName TileKind -> (Void# -> r) -> (Void# -> r) -> r
OBSCURED_HORIZONTAL_WALL_DARK =
  GroupName "obscured horizontal wall Dark"
pattern $bOBSCURED_VERTICAL_WALL_DARK :: GroupName TileKind
$mOBSCURED_VERTICAL_WALL_DARK :: forall r. GroupName TileKind -> (Void# -> r) -> (Void# -> r) -> r
OBSCURED_VERTICAL_WALL_DARK = GroupName "obscured vertical wall Dark"
pattern $bSHOOTOUT_SET_DARK :: GroupName TileKind
$mSHOOTOUT_SET_DARK :: forall r. GroupName TileKind -> (Void# -> r) -> (Void# -> r) -> r
SHOOTOUT_SET_DARK = GroupName "shootoutSetDark"
pattern $bTRAPPED_HORIZONAL_DOOR_DARK :: GroupName TileKind
$mTRAPPED_HORIZONAL_DOOR_DARK :: forall r. GroupName TileKind -> (Void# -> r) -> (Void# -> r) -> r
TRAPPED_HORIZONAL_DOOR_DARK = GroupName "trapped horizontal door Dark"
pattern $bTRAPPED_VERTICAL_DOOR_DARK :: GroupName TileKind
$mTRAPPED_VERTICAL_DOOR_DARK :: forall r. GroupName TileKind -> (Void# -> r) -> (Void# -> r) -> r
TRAPPED_VERTICAL_DOOR_DARK = GroupName "trapped vertical door Dark"

-- * 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"
pattern $bS_CLOSED_HORIZONTAL_DOOR_DARK :: GroupName TileKind
$mS_CLOSED_HORIZONTAL_DOOR_DARK :: forall r. GroupName TileKind -> (Void# -> r) -> (Void# -> r) -> r
S_CLOSED_HORIZONTAL_DOOR_DARK = GroupName "closed horizontal door Dark"
pattern $bS_CLOSED_VERTICAL_DOOR_DARK :: GroupName TileKind
$mS_CLOSED_VERTICAL_DOOR_DARK :: forall r. GroupName TileKind -> (Void# -> r) -> (Void# -> r) -> r
S_CLOSED_VERTICAL_DOOR_DARK = GroupName "closed vertical door Dark"
pattern $bS_OPEN_HORIZONTAL_DOOR_DARK :: GroupName TileKind
$mS_OPEN_HORIZONTAL_DOOR_DARK :: forall r. GroupName TileKind -> (Void# -> r) -> (Void# -> r) -> r
S_OPEN_HORIZONTAL_DOOR_DARK = GroupName "open horizontal door Dark"
pattern $bS_OPEN_VERTICAL_DOOR_DARK :: GroupName TileKind
$mS_OPEN_VERTICAL_DOOR_DARK :: forall r. GroupName TileKind -> (Void# -> r) -> (Void# -> r) -> r
S_OPEN_VERTICAL_DOOR_DARK = GroupName "open vertical door Dark"
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"
pattern $bS_SUSPECT_HORIZONTAL_WALL_DARK :: GroupName TileKind
$mS_SUSPECT_HORIZONTAL_WALL_DARK :: forall r. GroupName TileKind -> (Void# -> r) -> (Void# -> r) -> r
S_SUSPECT_HORIZONTAL_WALL_DARK =
  GroupName "suspect horizontal wall Dark"
pattern $bS_SUSPECT_VERTICAL_WALL_DARK :: GroupName TileKind
$mS_SUSPECT_VERTICAL_WALL_DARK :: forall r. GroupName TileKind -> (Void# -> r) -> (Void# -> r) -> r
S_SUSPECT_VERTICAL_WALL_DARK = GroupName "suspect vertical wall Dark"
pattern $bS_WALL_DARK :: GroupName TileKind
$mS_WALL_DARK :: forall r. GroupName TileKind -> (Void# -> r) -> (Void# -> r) -> r
S_WALL_DARK = GroupName "wall Dark"
pattern $bS_WALL_HORIZONTAL_DARK :: GroupName TileKind
$mS_WALL_HORIZONTAL_DARK :: forall r. GroupName TileKind -> (Void# -> r) -> (Void# -> r) -> r
S_WALL_HORIZONTAL_DARK = GroupName "wall horizontal 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 = $WTileKind :: 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  = ' '
  , tname :: Text
tname    = "unknown space"
  , tfreq :: Freqs TileKind
tfreq    = [(GroupName TileKind
S_UNKNOWN_SPACE, 1)]
  , tcolor :: Color
tcolor   = Color
defFG
  , tcolor2 :: Color
tcolor2  = Color
defFG
  , talter :: Word8
talter   = 1
  , tfeature :: [Feature]
tfeature = [Feature
Dark]
  }
unknownOuterFence :: TileKind
unknownOuterFence = $WTileKind :: Char
-> Text
-> Freqs TileKind
-> Color
-> Color
-> Word8
-> [Feature]
-> TileKind
TileKind
  { tsymbol :: Char
tsymbol  = ' '
  , tname :: Text
tname    = "unknown space"
  , tfreq :: Freqs TileKind
tfreq    = [(GroupName TileKind
S_UNKNOWN_OUTER_FENCE, 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 = $WTileKind :: Char
-> Text
-> Freqs TileKind
-> Color
-> Color
-> Word8
-> [Feature]
-> TileKind
TileKind
  { tsymbol :: Char
tsymbol  = ' '
  , tname :: Text
tname    = "impenetrable bedrock"
  , tfreq :: Freqs TileKind
tfreq    = [(GroupName TileKind
S_BASIC_OUTER_FENCE, 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 = $WTileKind :: Char
-> Text
-> Freqs TileKind
-> Color
-> Color
-> Word8
-> [Feature]
-> TileKind
TileKind
  { tsymbol :: Char
tsymbol  = ' '
  , tname :: Text
tname    = "bedrock"
  , tfreq :: Freqs TileKind
tfreq    = [(GroupName TileKind
FILLER_WALL, 1), (GroupName TileKind
LEGEND_LIT, 100), (GroupName TileKind
LEGEND_DARK, 100)]
  , tcolor :: Color
tcolor   = Color
defFG
  , tcolor2 :: Color
tcolor2  = Color
defFG
  , talter :: Word8
talter   = 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 = $WTileKind :: Char
-> Text
-> Freqs TileKind
-> Color
-> Color
-> Word8
-> [Feature]
-> TileKind
TileKind
  { tsymbol :: Char
tsymbol  = '|'
  , tname :: Text
tname    = "granite wall"
  , tfreq :: Freqs TileKind
tfreq    = [ (GroupName TileKind
LEGEND_LIT, 100), (GroupName TileKind
S_WALL_LIT, 100)
               , (GroupName TileKind
RECT_WINDOWS_VERTICAL_LIT, 80) ]
  , tcolor :: Color
tcolor   = Color
BrWhite
  , tcolor2 :: Color
tcolor2  = Color
defFG
  , talter :: Word8
talter   = 100
  , tfeature :: [Feature]
tfeature = [GroupName TileKind -> Feature
BuildAs GroupName TileKind
S_SUSPECT_VERTICAL_WALL_LIT]
  }
wallSuspect :: TileKind
wallSuspect = $WTileKind :: Char
-> Text
-> Freqs TileKind
-> Color
-> Color
-> Word8
-> [Feature]
-> TileKind
TileKind  -- only on client
  { tsymbol :: Char
tsymbol  = '|'
  , tname :: Text
tname    = "suspect uneven wall"
  , tfreq :: Freqs TileKind
tfreq    = [(GroupName TileKind
S_SUSPECT_VERTICAL_WALL_LIT, 1)]
  , tcolor :: Color
tcolor   = Color
BrWhite
  , tcolor2 :: Color
tcolor2  = Color
defFG
  , talter :: Word8
talter   = 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 = $WTileKind :: Char
-> Text
-> Freqs TileKind
-> Color
-> Color
-> Word8
-> [Feature]
-> TileKind
TileKind
  { tsymbol :: Char
tsymbol  = '|'
  , tname :: Text
tname    = "scratched wall"
  , tfreq :: Freqs TileKind
tfreq    = [(GroupName TileKind
OBSCURED_VERTICAL_WALL_LIT, 1)]
  , tcolor :: Color
tcolor   = Color
BrWhite
  , tcolor2 :: Color
tcolor2  = Color
defFG
  , talter :: Word8
talter   = 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 = $WTileKind :: Char
-> Text
-> Freqs TileKind
-> Color
-> Color
-> Word8
-> [Feature]
-> TileKind
TileKind
  { tsymbol :: Char
tsymbol  = '-'
  , tname :: Text
tname    = "sandstone wall"
  , tfreq :: Freqs TileKind
tfreq    = [ (GroupName TileKind
LEGEND_LIT, 100), (GroupName TileKind
S_WALL_HORIZONTAL_LIT, 100)
               , (GroupName TileKind
RECT_WINDOWS_HORIZONTAL_LIT, 80) ]
  , tcolor :: Color
tcolor   = Color
BrWhite
  , tcolor2 :: Color
tcolor2  = Color
defFG
  , talter :: Word8
talter   = 100
  , tfeature :: [Feature]
tfeature = [GroupName TileKind -> Feature
BuildAs GroupName TileKind
S_SUSPECT_HORIZONTAL_WALL_LIT]
  }
wallSuspectH :: TileKind
wallSuspectH = $WTileKind :: Char
-> Text
-> Freqs TileKind
-> Color
-> Color
-> Word8
-> [Feature]
-> TileKind
TileKind  -- only on client
  { tsymbol :: Char
tsymbol  = '-'
  , tname :: Text
tname    = "suspect painted wall"
  , tfreq :: Freqs TileKind
tfreq    = [(GroupName TileKind
S_SUSPECT_HORIZONTAL_WALL_LIT, 1)]
  , tcolor :: Color
tcolor   = Color
BrWhite
  , tcolor2 :: Color
tcolor2  = Color
defFG
  , talter :: Word8
talter   = 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 = $WTileKind :: Char
-> Text
-> Freqs TileKind
-> Color
-> Color
-> Word8
-> [Feature]
-> TileKind
TileKind
  { tsymbol :: Char
tsymbol  = '-'
  , tname :: Text
tname    = "defaced wall"
  , tfreq :: Freqs TileKind
tfreq    = [(GroupName TileKind
OBSCURED_HORIZONTAL_WALL_LIT, 90)]
  , tcolor :: Color
tcolor   = Color
BrWhite
  , tcolor2 :: Color
tcolor2  = Color
defFG
  , talter :: Word8
talter   = 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 = $WTileKind :: Char
-> Text
-> Freqs TileKind
-> Color
-> Color
-> Word8
-> [Feature]
-> TileKind
TileKind
  { tsymbol :: Char
tsymbol  = '-'
  , tname :: Text
tname    = "frescoed wall"
  , tfreq :: Freqs TileKind
tfreq    = [(GroupName TileKind
OBSCURED_HORIZONTAL_WALL_LIT, 10)]
  , tcolor :: Color
tcolor   = Color
BrWhite
  , tcolor2 :: Color
tcolor2  = Color
defFG
  , talter :: Word8
talter   = 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 = $WTileKind :: Char
-> Text
-> Freqs TileKind
-> Color
-> Color
-> Word8
-> [Feature]
-> TileKind
TileKind
  { tsymbol :: Char
tsymbol  = '0'
  , tname :: Text
tname    = "rock outcrop"
  , tfreq :: Freqs TileKind
tfreq    = [ (GroupName TileKind
CACHE_OR_NOT, 70)
               , (GroupName TileKind
STAIR_TERMINAL_LIT, 100), (GroupName TileKind
STAIR_TERMINAL_DARK, 100)
               , (GroupName TileKind
LEGEND_LIT, 100), (GroupName TileKind
LEGEND_DARK, 100)
               , (GroupName TileKind
EMPTY_SET_LIT, 20), (GroupName TileKind
NOISE_SET_LIT, 700)
               , (GroupName TileKind
POWER_SET_DARK, 700)
               , (GroupName TileKind
BATTLE_SET_DARK, 200), (GroupName TileKind
BRAWL_SET_LIT, 50)
               , (GroupName TileKind
SHOOTOUT_SET_LIT, 10), (GroupName TileKind
ZOO_SET_DARK, 10) ]
  , tcolor :: Color
tcolor   = Color
BrCyan  -- not BrWhite, to tell from heroes
  , tcolor2 :: Color
tcolor2  = Color
Cyan
  , talter :: Word8
talter   = 100
  , tfeature :: [Feature]
tfeature = []
  }
pillarCache :: TileKind
pillarCache = $WTileKind :: Char
-> Text
-> Freqs TileKind
-> Color
-> Color
-> Word8
-> [Feature]
-> TileKind
TileKind
  { tsymbol :: Char
tsymbol  = '0'
  , tname :: Text
tname    = "smoothed outcrop"
  , tfreq :: Freqs TileKind
tfreq    = [(GroupName TileKind
CACHE_OR_NOT, 30), (GroupName TileKind
CACHE, 1), (GroupName TileKind
STAIR_TERMINAL_DARK, 4)]
                 -- treasure only in dark staircases
  , tcolor :: Color
tcolor   = Color
BrBlue
  , tcolor2 :: Color
tcolor2  = Color
Blue
  , talter :: Word8
talter   = 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 = $WTileKind :: Char
-> Text
-> Freqs TileKind
-> Color
-> Color
-> Word8
-> [Feature]
-> TileKind
TileKind
  { tsymbol :: Char
tsymbol  = '0'
  , tname :: Text
tname    = "lamp post"
  , tfreq :: Freqs TileKind
tfreq    = [(GroupName TileKind
S_LAMP_POST, 1)]
  , tcolor :: Color
tcolor   = Color
BrYellow
  , tcolor2 :: Color
tcolor2  = Color
Brown
  , talter :: Word8
talter   = 100
  , tfeature :: [Feature]
tfeature = []
  }
signboardUnread :: TileKind
signboardUnread = $WTileKind :: Char
-> Text
-> Freqs TileKind
-> Color
-> Color
-> Word8
-> [Feature]
-> TileKind
TileKind  -- client only, indicates never used by this faction
  { tsymbol :: Char
tsymbol  = '0'
  , tname :: Text
tname    = "signboard"
  , tfreq :: Freqs TileKind
tfreq    = [(GroupName TileKind
S_SIGNBOARD_UNREAD, 1)]
  , tcolor :: Color
tcolor   = Color
BrCyan
  , tcolor2 :: Color
tcolor2  = Color
Cyan
  , talter :: Word8
talter   = 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 = $WTileKind :: Char
-> Text
-> Freqs TileKind
-> Color
-> Color
-> Word8
-> [Feature]
-> TileKind
TileKind
  { tsymbol :: Char
tsymbol  = '0'
  , tname :: Text
tname    = "signboard"
  , tfreq :: Freqs TileKind
tfreq    = [(GroupName TileKind
SIGNBOARD, 1), (GroupName TileKind
ESCAPE_SET_DARK, 1)]
  , tcolor :: Color
tcolor   = Color
BrCyan
  , tcolor2 :: Color
tcolor2  = Color
Cyan
  , talter :: Word8
talter   = 5
  , tfeature :: [Feature]
tfeature = [GroupName ItemKind -> Feature
Embed GroupName ItemKind
SIGNAGE, GroupName TileKind -> Feature
HideAs GroupName TileKind
S_SIGNBOARD_UNREAD]
  }
tree :: TileKind
tree = $WTileKind :: Char
-> Text
-> Freqs TileKind
-> Color
-> Color
-> Word8
-> [Feature]
-> TileKind
TileKind
  { tsymbol :: Char
tsymbol  = '0'
  , tname :: Text
tname    = "tree"
  , tfreq :: Freqs TileKind
tfreq    = [ (GroupName TileKind
BRAWL_SET_LIT, 140), (GroupName TileKind
SHOOTOUT_SET_LIT, 10)
               , (GroupName TileKind
ESCAPE_SET_LIT, 35), (GroupName TileKind
AMBUSH_SET_LIT, 3)
               , (GroupName TileKind
S_TREE_LIT, 1) ]
  , tcolor :: Color
tcolor   = Color
BrGreen
  , tcolor2 :: Color
tcolor2  = Color
Green
  , talter :: Word8
talter   = 50
  , tfeature :: [Feature]
tfeature = []
  }
treeBurnt :: TileKind
treeBurnt = TileKind
tree
  { tname :: Text
tname    = "burnt tree"
  , tfreq :: Freqs TileKind
tfreq    = [ (GroupName TileKind
AMBUSH_SET_DARK, 3), (GroupName TileKind
ZOO_SET_DARK, 7), (GroupName TileKind
BATTLE_SET_DARK, 50)
               , (GroupName TileKind
TREE_BURNING_OR_NOT, 30) ]
  , tcolor :: Color
tcolor   = Color
BrBlack
  , tcolor2 :: Color
tcolor2  = Color
BrBlack
  , tfeature :: [Feature]
tfeature = Feature
Dark Feature -> [Feature] -> [Feature]
forall a. a -> [a] -> [a]
: TileKind -> [Feature]
tfeature TileKind
tree
  }
treeBurning :: TileKind
treeBurning = TileKind
tree
  { tname :: Text
tname    = "burning tree"
  , tfreq :: Freqs TileKind
tfreq    = [ (GroupName TileKind
AMBUSH_SET_DARK, 15), (GroupName TileKind
ZOO_SET_DARK, 70)
               , (GroupName TileKind
TREE_BURNING_OR_NOT, 70) ]
  , tcolor :: Color
tcolor   = Color
BrRed
  , tcolor2 :: Color
tcolor2  = Color
Red
  , talter :: Word8
talter   = 5
  , tfeature :: [Feature]
tfeature = GroupName ItemKind -> Feature
Embed GroupName ItemKind
BIG_FIRE Feature -> [Feature] -> [Feature]
forall a. a -> [a] -> [a]
: GroupName TileKind -> Feature
ChangeTo GroupName TileKind
TREE_BURNING_OR_NOT Feature -> [Feature] -> [Feature]
forall a. a -> [a] -> [a]
: TileKind -> [Feature]
tfeature TileKind
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 = $WTileKind :: Char
-> Text
-> Freqs TileKind
-> Color
-> Color
-> Word8
-> [Feature]
-> TileKind
TileKind
  { tsymbol :: Char
tsymbol  = '&'
  , tname :: Text
tname    = "rubble pile"
  , tfreq :: Freqs TileKind
tfreq    = [ (GroupName TileKind
S_RUBBLE_PILE, 1), (GroupName TileKind
LEGEND_LIT, 1), (GroupName TileKind
LEGEND_DARK, 1)
               , (GroupName TileKind
STAIR_TERMINAL_LIT, 4), (GroupName TileKind
STAIR_TERMINAL_DARK, 4)
               , (GroupName TileKind
EMPTY_SET_LIT, 10), (GroupName TileKind
EMPTY_SET_DARK, 10)
               , (GroupName TileKind
NOISE_SET_LIT, 50), (GroupName TileKind
POWER_SET_DARK, 50)
               , (GroupName TileKind
ZOO_SET_DARK, 100), (GroupName TileKind
AMBUSH_SET_DARK, 10) ]
  , tcolor :: Color
tcolor   = Color
BrYellow
  , tcolor2 :: Color
tcolor2  = Color
Brown
  , talter :: Word8
talter   = 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 :: Freqs TileKind
tfreq    = [(GroupName TileKind
SMOKE_CLUMP_LIT, 1), (GroupName TileKind
SMOKE_CLUMP_DARK, 1)]
  , tfeature :: [Feature]
tfeature = Feature
Spice Feature -> [Feature] -> [Feature]
forall a. a -> [a] -> [a]
: TileKind -> [Feature]
tfeature TileKind
rubble
  }
doorTrapped :: TileKind
doorTrapped = $WTileKind :: Char
-> Text
-> Freqs TileKind
-> Color
-> Color
-> Word8
-> [Feature]
-> TileKind
TileKind
  { tsymbol :: Char
tsymbol  = '+'
  , tname :: Text
tname    = "trapped door"
  , tfreq :: Freqs TileKind
tfreq    = [(GroupName TileKind
TRAPPED_VERTICAL_DOOR_LIT, 1)]
  , tcolor :: Color
tcolor   = Color
BrRed
  , tcolor2 :: Color
tcolor2  = Color
Red
  , talter :: Word8
talter   = 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 = $WTileKind :: Char
-> Text
-> Freqs TileKind
-> Color
-> Color
-> Word8
-> [Feature]
-> TileKind
TileKind
  { tsymbol :: Char
tsymbol  = '+'
  , tname :: Text
tname    = "closed door"
  , tfreq :: Freqs TileKind
tfreq    = [(GroupName TileKind
S_CLOSED_VERTICAL_DOOR_LIT, 1)]
  , tcolor :: Color
tcolor   = Color
Brown
  , tcolor2 :: Color
tcolor2  = Color
BrBlack
  , talter :: Word8
talter   = 2
  , tfeature :: [Feature]
tfeature = [GroupName TileKind -> Feature
OpenTo GroupName TileKind
S_OPEN_VERTICAL_DOOR_LIT]  -- never hidden
  }
doorTrappedH :: TileKind
doorTrappedH = $WTileKind :: Char
-> Text
-> Freqs TileKind
-> Color
-> Color
-> Word8
-> [Feature]
-> TileKind
TileKind
  { tsymbol :: Char
tsymbol  = '+'
  , tname :: Text
tname    = "trapped door"
  , tfreq :: Freqs TileKind
tfreq    = [(GroupName TileKind
TRAPPED_HORIZONAL_DOOR_LIT, 1)]
  , tcolor :: Color
tcolor   = Color
BrRed
  , tcolor2 :: Color
tcolor2  = Color
Red
  , talter :: Word8
talter   = 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 = $WTileKind :: Char
-> Text
-> Freqs TileKind
-> Color
-> Color
-> Word8
-> [Feature]
-> TileKind
TileKind
  { tsymbol :: Char
tsymbol  = '+'
  , tname :: Text
tname    = "closed door"
  , tfreq :: Freqs TileKind
tfreq    = [(GroupName TileKind
S_CLOSED_HORIZONTAL_DOOR_LIT, 1)]
  , tcolor :: Color
tcolor   = Color
Brown
  , tcolor2 :: Color
tcolor2  = Color
BrBlack
  , talter :: Word8
talter   = 2
  , tfeature :: [Feature]
tfeature = [GroupName TileKind -> Feature
OpenTo GroupName TileKind
S_OPEN_HORIZONTAL_DOOR_LIT]  -- never hidden
  }
stairsUp :: TileKind
stairsUp = $WTileKind :: Char
-> Text
-> Freqs TileKind
-> Color
-> Color
-> Word8
-> [Feature]
-> TileKind
TileKind
  { tsymbol :: Char
tsymbol  = '<'
  , tname :: Text
tname    = "staircase up"
  , tfreq :: Freqs TileKind
tfreq    = [(GroupName TileKind
STAIRCASE_UP, 9), (GroupName TileKind
ORDINARY_STAIRCASE_UP, 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 = $WTileKind :: Char
-> Text
-> Freqs TileKind
-> Color
-> Color
-> Word8
-> [Feature]
-> TileKind
TileKind
  { tsymbol :: Char
tsymbol  = '<'
  , tname :: Text
tname    = "windy staircase up"
  , tfreq :: Freqs TileKind
tfreq    = [(GroupName TileKind
STAIRCASE_UP, 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 :: Text
tname    = "signpost pointing backward"
  , tfreq :: Freqs TileKind
tfreq    = [(GroupName TileKind
STAIRCASE_OUTDOOR_UP, 1)]
  }
stairsGatedUp :: TileKind
stairsGatedUp = TileKind
stairsUp
  { tname :: Text
tname    = "gated staircase up"
  , tfreq :: Freqs TileKind
tfreq    = [(GroupName TileKind
GATED_STAIRCASE_UP, 1)]
  , talter :: Word8
talter   = Word8
talterForStairs Word8 -> Word8 -> Word8
forall a. Num a => a -> a -> a
+ 2  -- animals and bosses can't use
  }
stairsDown :: TileKind
stairsDown = $WTileKind :: Char
-> Text
-> Freqs TileKind
-> Color
-> Color
-> Word8
-> [Feature]
-> TileKind
TileKind
  { tsymbol :: Char
tsymbol  = '>'
  , tname :: Text
tname    = "staircase down"
  , tfreq :: Freqs TileKind
tfreq    = [(GroupName TileKind
STAIRCASE_DOWN, 9), (GroupName TileKind
ORDINARY_STAIRCASE_DOWN, 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 = $WTileKind :: Char
-> Text
-> Freqs TileKind
-> Color
-> Color
-> Word8
-> [Feature]
-> TileKind
TileKind
  { tsymbol :: Char
tsymbol  = '>'
  , tname :: Text
tname    = "crooked staircase down"
  , tfreq :: Freqs TileKind
tfreq    = [(GroupName TileKind
STAIRCASE_DOWN, 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 :: Text
tname    = "signpost pointing forward"
  , tfreq :: Freqs TileKind
tfreq    = [(GroupName TileKind
STAIRCASE_OUTDOOR_DOWN, 1)]
  }
stairsGatedDown :: TileKind
stairsGatedDown = TileKind
stairsDown
  { tname :: Text
tname    = "gated staircase down"
  , tfreq :: Freqs TileKind
tfreq    = [(GroupName TileKind
GATED_STAIRCASE_DOWN, 1)]
  , talter :: Word8
talter   = Word8
talterForStairs Word8 -> Word8 -> Word8
forall a. Num a => a -> a -> a
+ 2  -- animals and bosses can't use
  }
escapeUp :: TileKind
escapeUp = $WTileKind :: Char
-> Text
-> Freqs TileKind
-> Color
-> Color
-> Word8
-> [Feature]
-> TileKind
TileKind
  { tsymbol :: Char
tsymbol  = '<'
  , tname :: Text
tname    = "exit hatch up"
  , tfreq :: Freqs TileKind
tfreq    = [(GroupName TileKind
LEGEND_LIT, 1), (GroupName TileKind
LEGEND_DARK, 1), (GroupName TileKind
ESCAPE_UP, 1)]
  , tcolor :: Color
tcolor   = Color
BrYellow
  , tcolor2 :: Color
tcolor2  = Color
BrYellow
  , talter :: Word8
talter   = 0  -- anybody can escape (or guard escape)
  , tfeature :: [Feature]
tfeature = [GroupName ItemKind -> Feature
Embed GroupName ItemKind
ESCAPE, Feature
ConsideredByAI]
  }
escapeDown :: TileKind
escapeDown = $WTileKind :: Char
-> Text
-> Freqs TileKind
-> Color
-> Color
-> Word8
-> [Feature]
-> TileKind
TileKind
  { tsymbol :: Char
tsymbol  = '>'
  , tname :: Text
tname    = "exit trapdoor down"
  , tfreq :: Freqs TileKind
tfreq    = [(GroupName TileKind
LEGEND_LIT, 1), (GroupName TileKind
LEGEND_DARK, 1), (GroupName TileKind
ESCAPE_DOWN, 1)]
  , tcolor :: Color
tcolor   = Color
BrYellow
  , tcolor2 :: Color
tcolor2  = Color
BrYellow
  , talter :: Word8
talter   = 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    = "exit back to town"
  , tfreq :: Freqs TileKind
tfreq    = [(GroupName TileKind
ESCAPE_OUTDOOR_DOWN, 1)]
  }

-- *** Clear

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

-- ** Walkable

-- *** Not clear

fog :: TileKind
fog = $WTileKind :: Char
-> Text
-> Freqs TileKind
-> Color
-> Color
-> Word8
-> [Feature]
-> TileKind
TileKind
  { tsymbol :: Char
tsymbol  = ';'
  , tname :: Text
tname    = "faint fog"
  , tfreq :: Freqs TileKind
tfreq    = [ (GroupName TileKind
S_FOG_LIT, 1), (GroupName TileKind
EMPTY_SET_LIT, 50), (GroupName TileKind
NOISE_SET_LIT, 100)
               , (GroupName TileKind
SHOOTOUT_SET_LIT, 20)
               , (GroupName TileKind
FOG_CLUMP_LIT, 60), (GroupName TileKind
FOG_CLUMP_DARK, 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   = 0
  , tfeature :: [Feature]
tfeature = [Feature
Walkable, Feature
NoItem, Feature
OftenActor]
  }
fogDark :: TileKind
fogDark = TileKind
fog
  { tname :: Text
tname    = "thick fog"
  , tfreq :: Freqs TileKind
tfreq    = [ (GroupName TileKind
EMPTY_SET_DARK, 50), (GroupName TileKind
POWER_SET_DARK, 100)
               , (GroupName TileKind
ESCAPE_SET_DARK, 50) ]
  , tfeature :: [Feature]
tfeature = Feature
Dark Feature -> [Feature] -> [Feature]
forall a. a -> [a] -> [a]
: TileKind -> [Feature]
tfeature TileKind
fog
  }
smoke :: TileKind
smoke = $WTileKind :: Char
-> Text
-> Freqs TileKind
-> Color
-> Color
-> Word8
-> [Feature]
-> TileKind
TileKind
  { tsymbol :: Char
tsymbol  = ';'
  , tname :: Text
tname    = "billowing smoke"
  , tfreq :: Freqs TileKind
tfreq    = [ (GroupName TileKind
S_SMOKE_LIT, 1), (GroupName TileKind
LAB_TRAIL_LIT, 1), (GroupName TileKind
STAIR_TERMINAL_LIT, 4)
               , (GroupName TileKind
SMOKE_CLUMP_LIT, 3), (GroupName TileKind
SMOKE_CLUMP_DARK, 3) ]
  , tcolor :: Color
tcolor   = Color
Brown
  , tcolor2 :: Color
tcolor2  = Color
BrBlack
  , talter :: Word8
talter   = 0
  , tfeature :: [Feature]
tfeature = [Feature
Walkable, Feature
NoItem]  -- not dark, embers
  }
smokeDark :: TileKind
smokeDark = TileKind
smoke
  { tname :: Text
tname    = "lingering smoke"
  , tfreq :: Freqs TileKind
tfreq    = [ (GroupName TileKind
STAIR_TERMINAL_DARK, 4), (GroupName TileKind
AMBUSH_SET_DARK, 40)
               , (GroupName TileKind
ZOO_SET_DARK, 20), (GroupName TileKind
BATTLE_SET_DARK, 5) ]
  , tfeature :: [Feature]
tfeature = Feature
Dark Feature -> [Feature] -> [Feature]
forall a. a -> [a] -> [a]
: TileKind -> [Feature]
tfeature TileKind
smoke
  }

-- *** Clear

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

outdoorFence :: TileKind
outdoorFence = $WTileKind :: Char
-> Text
-> Freqs TileKind
-> Color
-> Color
-> Word8
-> [Feature]
-> TileKind
TileKind
  { tsymbol :: Char
tsymbol  = ' '
  , tname :: Text
tname    = "event horizon"
  , tfreq :: Freqs TileKind
tfreq    = [(GroupName TileKind
OUTDOOR_OUTER_FENCE, 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 k :: TileKind
k = let darkenText :: GroupName TileKind -> GroupName TileKind
                 darkenText :: GroupName TileKind -> GroupName TileKind
darkenText t :: 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 a. Text -> GroupName a
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
<> "Dark"))
                              (Maybe Text -> GroupName TileKind)
-> Maybe Text -> GroupName TileKind
forall a b. (a -> b) -> a -> b
$ Text -> Text -> Maybe Text
T.stripSuffix "Lit" (Text -> Maybe Text) -> Text -> Maybe Text
forall a b. (a -> b) -> a -> b
$ GroupName TileKind -> Text
forall a. GroupName a -> 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 (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 t :: 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 t :: 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 t :: 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 proj :: ProjectileTriggers
proj grps :: [(Int, GroupName ItemKind)]
grps t :: 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 proj :: ProjectileTriggers
proj grps :: [(Int, GroupName ItemKind)]
grps t :: 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 proj :: ProjectileTriggers
proj grps :: [(Int, GroupName ItemKind)]
grps t :: 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 t :: 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 t :: 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 t :: 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 t :: 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 VeryOftenItem = Feature -> Maybe Feature
forall a. a -> Maybe a
Just Feature
OftenItem
                 darkFeat OftenItem = Maybe Feature
forall a. Maybe a
Nothing  -- items not common in the dark
                 darkFeat feat :: 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)
                  }

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