    {-# LANGUAGE DeriveGeneric #-}
    -- | The type of place kinds. Every room in the game is an instantiated
    -- place kind.
    module Game.LambdaHack.Content.PlaceKind
      ( PlaceKind(..), makeData
      , Cover(..), Fence(..)
      , PlaceEntry(..), deadEndId, overridePlaceKind, override2PlaceKind
    #ifdef EXPOSE_INTERNAL
        -- * Internal operations
      , validateSingle, validateAll
    #endif
      ) where

    import Prelude ()

    import Game.LambdaHack.Core.Prelude

    import           Data.Binary
    import qualified Data.EnumMap.Strict as EM
    import qualified Data.Text as T
    import           GHC.Generics (Generic)

    import Game.LambdaHack.Content.TileKind (TileKind)
    import Game.LambdaHack.Definition.ContentData
    import Game.LambdaHack.Definition.Defs
    import Game.LambdaHack.Definition.DefsInternal

    -- | Parameters for the generation of small areas within a dungeon level.
    data PlaceKind = PlaceKind
      { PlaceKind -> Text
    pname       :: Text          -- ^ short description, singular or plural
      , PlaceKind -> Freqs PlaceKind
    pfreq       :: Freqs PlaceKind  -- ^ frequency within groups
      , PlaceKind -> Rarity
    prarity     :: Rarity        -- ^ rarity on given depths
      , PlaceKind -> Cover
    pcover      :: Cover         -- ^ how to fill whole place using the corner
      , PlaceKind -> Fence
    pfence      :: Fence         -- ^ whether to fence place with solid border
      , PlaceKind -> [Text]
    ptopLeft    :: [Text]        -- ^ plan of the top-left corner of the place
      , PlaceKind -> EnumMap Char (GroupName TileKind)
    plegendDark :: EM.EnumMap Char (GroupName TileKind)  -- ^ dark legend
      , PlaceKind -> EnumMap Char (GroupName TileKind)
    plegendLit  :: EM.EnumMap Char (GroupName TileKind)  -- ^ lit legend
      }
      deriving Int -> PlaceKind -> ShowS
    [PlaceKind] -> ShowS
    PlaceKind -> String
    (Int -> PlaceKind -> ShowS)
    -> (PlaceKind -> String)
    -> ([PlaceKind] -> ShowS)
    -> Show PlaceKind
    forall a.
    (Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
    $cshowsPrec :: Int -> PlaceKind -> ShowS
    showsPrec :: Int -> PlaceKind -> ShowS
    $cshow :: PlaceKind -> String
    show :: PlaceKind -> String
    $cshowList :: [PlaceKind] -> ShowS
    showList :: [PlaceKind] -> ShowS
    Show  -- No Eq and Ord to make extending logically sound

    -- | A method of filling the whole area (except for CVerbatim and CMirror,
    -- which are just placed in the middle of the area) by transforming
    -- a given corner.
    data Cover =
        CAlternate  -- ^ reflect every other corner, overlapping 1 row and column
      | CStretch    -- ^ fill symmetrically 4 corners and stretch their borders
      | CReflect    -- ^ tile separately and symmetrically quarters of the place
      | CVerbatim   -- ^ just build the given interior, without filling the area
      | CMirror     -- ^ build the given interior in one of 4 mirrored variants
      deriving (Int -> Cover -> ShowS
    [Cover] -> ShowS
    Cover -> String
    (Int -> Cover -> ShowS)
    -> (Cover -> String) -> ([Cover] -> ShowS) -> Show Cover
    forall a.
    (Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
    $cshowsPrec :: Int -> Cover -> ShowS
    showsPrec :: Int -> Cover -> ShowS
    $cshow :: Cover -> String
    show :: Cover -> String
    $cshowList :: [Cover] -> ShowS
    showList :: [Cover] -> ShowS
    Show, Cover -> Cover -> Bool
    (Cover -> Cover -> Bool) -> (Cover -> Cover -> Bool) -> Eq Cover
    forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
    $c== :: Cover -> Cover -> Bool
    == :: Cover -> Cover -> Bool
    $c/= :: Cover -> Cover -> Bool
    /= :: Cover -> Cover -> Bool
    Eq)

    -- | The choice of a fence type for the place.
    data Fence =
        FWall   -- ^ put a solid wall fence around the place
      | FFloor  -- ^ leave an empty space, like the room's floor
      | FGround -- ^ leave an empty space, like the cave's ground
      | FNone   -- ^ skip the fence and fill all with the place proper
      deriving (Int -> Fence -> ShowS
    [Fence] -> ShowS
    Fence -> String
    (Int -> Fence -> ShowS)
    -> (Fence -> String) -> ([Fence] -> ShowS) -> Show Fence
    forall a.
    (Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
    $cshowsPrec :: Int -> Fence -> ShowS
    showsPrec :: Int -> Fence -> ShowS
    $cshow :: Fence -> String
    show :: Fence -> String
    $cshowList :: [Fence] -> ShowS
    showList :: [Fence] -> ShowS
    Show, Fence -> Fence -> Bool
    (Fence -> Fence -> Bool) -> (Fence -> Fence -> Bool) -> Eq Fence
    forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
    $c== :: Fence -> Fence -> Bool
    == :: Fence -> Fence -> Bool
    $c/= :: Fence -> Fence -> Bool
    /= :: Fence -> Fence -> Bool
    Eq)

    -- | Places are rooms and other dungeon features, their names can be seen
    -- on a level map by aiming at a position that is an entry to the place
    -- (an individual entrance point, an approach area around the place
    -- or a phantom entry not on the map, but only used for statistics
    -- to witness the place exists). Entries are proxies for initial places
    -- created on the level (which may be otherwise eradicated by burrowing
    -- the walls, etc.) and so used for dungeon statistics.
    -- The statistics are presented in the @Dashboard/displace place lore@ menu.
    data PlaceEntry =
        PEntry (ContentId PlaceKind)
      | PAround (ContentId PlaceKind)
      | PExists (ContentId PlaceKind)
      deriving (Int -> PlaceEntry -> ShowS
    [PlaceEntry] -> ShowS
    PlaceEntry -> String
    (Int -> PlaceEntry -> ShowS)
    -> (PlaceEntry -> String)
    -> ([PlaceEntry] -> ShowS)
    -> Show PlaceEntry
    forall a.
    (Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
    $cshowsPrec :: Int -> PlaceEntry -> ShowS
    showsPrec :: Int -> PlaceEntry -> ShowS
    $cshow :: PlaceEntry -> String
    show :: PlaceEntry -> String
    $cshowList :: [PlaceEntry] -> ShowS
    showList :: [PlaceEntry] -> ShowS
    Show, PlaceEntry -> PlaceEntry -> Bool
    (PlaceEntry -> PlaceEntry -> Bool)
    -> (PlaceEntry -> PlaceEntry -> Bool) -> Eq PlaceEntry
    forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
    $c== :: PlaceEntry -> PlaceEntry -> Bool
    == :: PlaceEntry -> PlaceEntry -> Bool
    $c/= :: PlaceEntry -> PlaceEntry -> Bool
    /= :: PlaceEntry -> PlaceEntry -> Bool
    Eq, (forall x. PlaceEntry -> Rep PlaceEntry x)
    -> (forall x. Rep PlaceEntry x -> PlaceEntry) -> Generic PlaceEntry
    forall x. Rep PlaceEntry x -> PlaceEntry
    forall x. PlaceEntry -> Rep PlaceEntry x
    forall a.
    (forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
    $cfrom :: forall x. PlaceEntry -> Rep PlaceEntry x
    from :: forall x. PlaceEntry -> Rep PlaceEntry x
    $cto :: forall x. Rep PlaceEntry x -> PlaceEntry
    to :: forall x. Rep PlaceEntry x -> PlaceEntry
    Generic)

    instance Binary PlaceEntry

    deadEndId :: ContentId PlaceKind
    {-# INLINE deadEndId #-}
    deadEndId :: ContentId PlaceKind
    deadEndId = Word16 -> ContentId PlaceKind
    forall c. Word16 -> ContentId c
    toContentId Word16
    0

    overridePlaceKind :: [(Char, GroupName TileKind)] -> PlaceKind -> PlaceKind
    overridePlaceKind :: [(Char, GroupName TileKind)] -> PlaceKind -> PlaceKind
    overridePlaceKind [(Char, GroupName TileKind)]
    l PlaceKind
    pk = PlaceKind
    pk
      { plegendDark = EM.fromList l `EM.union` plegendDark pk
      , plegendLit = EM.fromList l `EM.union` plegendLit pk }

    override2PlaceKind :: [(Char, GroupName TileKind)]
                       -> [(Char, GroupName TileKind)]
                       -> PlaceKind
                       -> PlaceKind
    override2PlaceKind :: [(Char, GroupName TileKind)]
    -> [(Char, GroupName TileKind)] -> PlaceKind -> PlaceKind
    override2PlaceKind [(Char, GroupName TileKind)]
    lDark [(Char, GroupName TileKind)]
    lLit PlaceKind
    pk = PlaceKind
    pk
      { plegendDark = EM.fromList lDark `EM.union` plegendDark pk
      , plegendLit = EM.fromList lLit `EM.union` plegendLit pk }

    -- | Catch invalid place kind definitions. In particular, verify that
    -- the top-left corner map is rectangular and not empty.
    validateSingle :: ContentData TileKind -> PlaceKind -> [Text]
    validateSingle :: ContentData TileKind -> PlaceKind -> [Text]
    validateSingle ContentData TileKind
    cotile PlaceKind{Rarity
    Freqs PlaceKind
    [Text]
    EnumMap Char (GroupName TileKind)
    Text
    Fence
    Cover
    pname :: PlaceKind -> Text
    pfreq :: PlaceKind -> Freqs PlaceKind
    prarity :: PlaceKind -> Rarity
    pcover :: PlaceKind -> Cover
    pfence :: PlaceKind -> Fence
    ptopLeft :: PlaceKind -> [Text]
    plegendDark :: PlaceKind -> EnumMap Char (GroupName TileKind)
    plegendLit :: PlaceKind -> EnumMap Char (GroupName TileKind)
    pname :: Text
    pfreq :: Freqs PlaceKind
    prarity :: Rarity
    pcover :: Cover
    pfence :: Fence
    ptopLeft :: [Text]
    plegendDark :: EnumMap Char (GroupName TileKind)
    plegendLit :: EnumMap Char (GroupName TileKind)
    ..} =
      let dxcorner :: Int
    dxcorner = case [Text]
    ptopLeft of
            [] -> Int
    0
            Text
    l : [Text]
    _ -> Text -> Int
    T.length Text
    l
          inLegend :: Text -> EM.EnumMap Char (GroupName TileKind) -> Char -> [Text]
          inLegend :: Text -> EnumMap Char (GroupName TileKind) -> Char -> [Text]
    inLegend Text
    _ EnumMap Char (GroupName TileKind)
    _ Char
    'X' = []  -- special placeholder symbol; TODO: unhardwire
          inLegend Text
    legendName EnumMap Char (GroupName TileKind)
    m Char
    c = case Char
    -> EnumMap Char (GroupName TileKind) -> Maybe (GroupName TileKind)
    forall k a. Enum k => k -> EnumMap k a -> Maybe a
    EM.lookup Char
    c EnumMap Char (GroupName TileKind)
    m of
            Maybe (GroupName TileKind)
    Nothing -> [Char -> Text
    forall a. Show a => a -> Text
    tshow Char
    c Text -> Text -> Text
    <+> Text
    "tile code not found in" Text -> Text -> Text
    <+> Text
    legendName]
            Just GroupName TileKind
    grp -> [ Char -> Text
    forall a. Show a => a -> Text
    tshow Char
    c Text -> Text -> Text
    <+> Text
    "tile code has group"
                          Text -> Text -> Text
    <+> GroupName TileKind -> Text
    forall c. GroupName c -> Text
    displayGroupName GroupName TileKind
    grp
                          Text -> Text -> Text
    <+> Text
    "with null frequency in tile content"
                        | Bool -> Bool
    not (Bool -> Bool) -> Bool -> Bool
    forall a b. (a -> b) -> a -> b
    $ ContentData TileKind -> GroupName TileKind -> Bool
    forall a. ContentData a -> GroupName a -> Bool
    oexistsGroup ContentData TileKind
    cotile GroupName TileKind
    grp ]
          inLegendAll :: Text -> EnumMap Char (GroupName TileKind) -> [Text]
    inLegendAll Text
    legendName EnumMap Char (GroupName TileKind)
    m = (Char -> [Text]) -> String -> [Text]
    forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
    concatMap (Text -> EnumMap Char (GroupName TileKind) -> Char -> [Text]
    inLegend Text
    legendName EnumMap Char (GroupName TileKind)
    m)
                                               ((Text -> String) -> [Text] -> String
    forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
    concatMap Text -> String
    T.unpack [Text]
    ptopLeft)
      in [ Text
    "top-left corner empty" | Int
    dxcorner Int -> Int -> Bool
    forall a. Eq a => a -> a -> Bool
    == Int
    0 ]
         [Text] -> [Text] -> [Text]
    forall a. [a] -> [a] -> [a]
    ++ [ Text
    "top-left corner not rectangular"
            | (Text -> Bool) -> [Text] -> Bool
    forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
    any ((Int -> Int -> Bool
    forall a. Eq a => a -> a -> Bool
    /= Int
    dxcorner) (Int -> Bool) -> (Text -> Int) -> Text -> Bool
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Text -> Int
    T.length) [Text]
    ptopLeft ]
         [Text] -> [Text] -> [Text]
    forall a. [a] -> [a] -> [a]
    ++ Text -> EnumMap Char (GroupName TileKind) -> [Text]
    inLegendAll Text
    "plegendDark" EnumMap Char (GroupName TileKind)
    plegendDark
         [Text] -> [Text] -> [Text]
    forall a. [a] -> [a] -> [a]
    ++ Text -> EnumMap Char (GroupName TileKind) -> [Text]
    inLegendAll Text
    "plegendLit" EnumMap Char (GroupName TileKind)
    plegendLit
         [Text] -> [Text] -> [Text]
    forall a. [a] -> [a] -> [a]
    ++ Rarity -> [Text]
    validateRarity Rarity
    prarity

    -- | Validate all place kinds.
    validateAll :: [PlaceKind] -> ContentData PlaceKind -> [Text]
    validateAll :: [PlaceKind] -> ContentData PlaceKind -> [Text]
    validateAll [PlaceKind]
    _ ContentData PlaceKind
    _ = []  -- so far, always valid

    makeData :: ContentData TileKind
             -> [PlaceKind] -> [GroupName PlaceKind] -> [GroupName PlaceKind]
             -> ContentData PlaceKind
    makeData :: ContentData TileKind
    -> [PlaceKind]
    -> [GroupName PlaceKind]
    -> [GroupName PlaceKind]
    -> ContentData PlaceKind
    makeData ContentData TileKind
    cotile = String
    -> (PlaceKind -> Text)
    -> (PlaceKind -> Freqs PlaceKind)
    -> (PlaceKind -> [Text])
    -> ([PlaceKind] -> ContentData PlaceKind -> [Text])
    -> [PlaceKind]
    -> [GroupName PlaceKind]
    -> [GroupName PlaceKind]
    -> ContentData PlaceKind
    forall c.
    Show c =>
    String
    -> (c -> Text)
    -> (c -> Freqs c)
    -> (c -> [Text])
    -> ([c] -> ContentData c -> [Text])
    -> [c]
    -> [GroupName c]
    -> [GroupName c]
    -> ContentData c
    makeContentData String
    "PlaceKind" PlaceKind -> Text
    pname PlaceKind -> Freqs PlaceKind
    pfreq
                                      (ContentData TileKind -> PlaceKind -> [Text]
    validateSingle ContentData TileKind
    cotile) [PlaceKind] -> ContentData PlaceKind -> [Text]
    validateAll