{-# 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 -> Char
psymbol     :: Char          -- ^ a symbol
  , 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
showList :: [PlaceKind] -> ShowS
$cshowList :: [PlaceKind] -> ShowS
show :: PlaceKind -> String
$cshow :: PlaceKind -> String
showsPrec :: Int -> PlaceKind -> ShowS
$cshowsPrec :: Int -> 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
showList :: [Cover] -> ShowS
$cshowList :: [Cover] -> ShowS
show :: Cover -> String
$cshow :: Cover -> String
showsPrec :: Int -> Cover -> ShowS
$cshowsPrec :: Int -> Cover -> ShowS
Show, Cover -> Cover -> Bool
(Cover -> Cover -> Bool) -> (Cover -> Cover -> Bool) -> Eq Cover
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Cover -> Cover -> Bool
$c/= :: Cover -> Cover -> Bool
== :: Cover -> Cover -> Bool
$c== :: 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
showList :: [Fence] -> ShowS
$cshowList :: [Fence] -> ShowS
show :: Fence -> String
$cshow :: Fence -> String
showsPrec :: Int -> Fence -> ShowS
$cshowsPrec :: Int -> Fence -> ShowS
Show, Fence -> Fence -> Bool
(Fence -> Fence -> Bool) -> (Fence -> Fence -> Bool) -> Eq Fence
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Fence -> Fence -> Bool
$c/= :: Fence -> Fence -> Bool
== :: Fence -> Fence -> Bool
$c== :: 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
showList :: [PlaceEntry] -> ShowS
$cshowList :: [PlaceEntry] -> ShowS
show :: PlaceEntry -> String
$cshow :: PlaceEntry -> String
showsPrec :: Int -> PlaceEntry -> ShowS
$cshowsPrec :: Int -> PlaceEntry -> ShowS
Show, PlaceEntry -> PlaceEntry -> Bool
(PlaceEntry -> PlaceEntry -> Bool)
-> (PlaceEntry -> PlaceEntry -> Bool) -> Eq PlaceEntry
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PlaceEntry -> PlaceEntry -> Bool
$c/= :: PlaceEntry -> PlaceEntry -> Bool
== :: PlaceEntry -> PlaceEntry -> Bool
$c== :: 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
$cto :: forall x. Rep PlaceEntry x -> PlaceEntry
$cfrom :: forall x. PlaceEntry -> Rep PlaceEntry x
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 :: EnumMap Char (GroupName TileKind)
plegendDark = [(Char, GroupName TileKind)] -> EnumMap Char (GroupName TileKind)
forall k a. Enum k => [(k, a)] -> EnumMap k a
EM.fromList [(Char, GroupName TileKind)]
l EnumMap Char (GroupName TileKind)
-> EnumMap Char (GroupName TileKind)
-> EnumMap Char (GroupName TileKind)
forall k a. EnumMap k a -> EnumMap k a -> EnumMap k a
`EM.union` PlaceKind -> EnumMap Char (GroupName TileKind)
plegendDark PlaceKind
pk
  , plegendLit :: EnumMap Char (GroupName TileKind)
plegendLit = [(Char, GroupName TileKind)] -> EnumMap Char (GroupName TileKind)
forall k a. Enum k => [(k, a)] -> EnumMap k a
EM.fromList [(Char, GroupName TileKind)]
l EnumMap Char (GroupName TileKind)
-> EnumMap Char (GroupName TileKind)
-> EnumMap Char (GroupName TileKind)
forall k a. EnumMap k a -> EnumMap k a -> EnumMap k a
`EM.union` PlaceKind -> EnumMap Char (GroupName TileKind)
plegendLit PlaceKind
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 :: EnumMap Char (GroupName TileKind)
plegendDark = [(Char, GroupName TileKind)] -> EnumMap Char (GroupName TileKind)
forall k a. Enum k => [(k, a)] -> EnumMap k a
EM.fromList [(Char, GroupName TileKind)]
lDark EnumMap Char (GroupName TileKind)
-> EnumMap Char (GroupName TileKind)
-> EnumMap Char (GroupName TileKind)
forall k a. EnumMap k a -> EnumMap k a -> EnumMap k a
`EM.union` PlaceKind -> EnumMap Char (GroupName TileKind)
plegendDark PlaceKind
pk
  , plegendLit :: EnumMap Char (GroupName TileKind)
plegendLit = [(Char, GroupName TileKind)] -> EnumMap Char (GroupName TileKind)
forall k a. Enum k => [(k, a)] -> EnumMap k a
EM.fromList [(Char, GroupName TileKind)]
lLit EnumMap Char (GroupName TileKind)
-> EnumMap Char (GroupName TileKind)
-> EnumMap Char (GroupName TileKind)
forall k a. EnumMap k a -> EnumMap k a -> EnumMap k a
`EM.union` PlaceKind -> EnumMap Char (GroupName TileKind)
plegendLit PlaceKind
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{Char
Rarity
Freqs PlaceKind
[Text]
EnumMap Char (GroupName TileKind)
Text
Fence
Cover
plegendLit :: EnumMap Char (GroupName TileKind)
plegendDark :: EnumMap Char (GroupName TileKind)
ptopLeft :: [Text]
pfence :: Fence
pcover :: Cover
prarity :: Rarity
pfreq :: Freqs PlaceKind
pname :: Text
psymbol :: Char
plegendLit :: PlaceKind -> EnumMap Char (GroupName TileKind)
plegendDark :: PlaceKind -> EnumMap Char (GroupName TileKind)
ptopLeft :: PlaceKind -> [Text]
pfence :: PlaceKind -> Fence
pcover :: PlaceKind -> Cover
prarity :: PlaceKind -> Rarity
pfreq :: PlaceKind -> Freqs PlaceKind
pname :: PlaceKind -> Text
psymbol :: PlaceKind -> Char
..} =
  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"
        | (Int -> Bool) -> [Int] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
/= Int
dxcorner) ((Text -> Int) -> [Text] -> [Int]
forall a b. (a -> b) -> [a] -> [b]
map 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