{-# 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
#ifdef EXPOSE_INTERNAL
    -- * Internal operations
  , validateSingle, validateAll
#endif
  ) where

import Prelude ()

import Game.LambdaHack.Core.Prelude

import           Data.Binary
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

-- | 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 -> [(Char, GroupName TileKind)]
poverrideDark :: [(Char, GroupName TileKind)]  -- ^ dark legend override
  , PlaceKind -> [(Char, GroupName TileKind)]
poverrideLit  :: [(Char, GroupName TileKind)]  -- ^ lit legend override
  }
  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)

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 0

validateOverride :: [(Char, GroupName TileKind)] -> [Text]
validateOverride :: [(Char, GroupName TileKind)] -> [Text]
validateOverride ov :: [(Char, GroupName TileKind)]
ov =
  let symbols :: String
symbols = ShowS
forall a. Ord a => [a] -> [a]
sort ShowS -> ShowS
forall a b. (a -> b) -> a -> b
$ ((Char, GroupName TileKind) -> Char)
-> [(Char, GroupName TileKind)] -> String
forall a b. (a -> b) -> [a] -> [b]
map (Char, GroupName TileKind) -> Char
forall a b. (a, b) -> a
fst [(Char, GroupName TileKind)]
ov
      duplicated :: [(Char, Char)]
duplicated = ((Char, Char) -> Bool) -> [(Char, Char)] -> [(Char, Char)]
forall a. (a -> Bool) -> [a] -> [a]
filter ((Char -> Char -> Bool) -> (Char, Char) -> Bool
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
(==)) ([(Char, Char)] -> [(Char, Char)])
-> [(Char, Char)] -> [(Char, Char)]
forall a b. (a -> b) -> a -> b
$ String -> String -> [(Char, Char)]
forall a b. [a] -> [b] -> [(a, b)]
zip String
symbols ('\0' Char -> ShowS
forall a. a -> [a] -> [a]
: String
symbols)
  in [ "duplicated override symbols:"
        Text -> Text -> Text
<+> String -> Text
T.pack (Char -> ShowS
forall a. a -> [a] -> [a]
intersperse ' ' ShowS -> ShowS
forall a b. (a -> b) -> a -> b
$ ((Char, Char) -> Char) -> [(Char, Char)] -> String
forall a b. (a -> b) -> [a] -> [b]
map (Char, Char) -> Char
forall a b. (a, b) -> a
fst [(Char, Char)]
duplicated)
     | Bool -> Bool
not ([(Char, Char)] -> Bool
forall a. [a] -> Bool
null [(Char, Char)]
duplicated) ]

-- | Catch invalid place kind definitions. In particular, verify that
-- the top-left corner map is rectangular and not empty.
validateSingle :: PlaceKind -> [Text]
validateSingle :: PlaceKind -> [Text]
validateSingle PlaceKind{..} =
  let dxcorner :: Int
dxcorner = case [Text]
ptopLeft of
        [] -> 0
        l :: Text
l : _ -> Text -> Int
T.length Text
l
  in [ "top-left corner empty" | Int
dxcorner Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== 0 ]
     [Text] -> [Text] -> [Text]
forall a. [a] -> [a] -> [a]
++ [ "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]
++ Rarity -> [Text]
validateRarity Rarity
prarity
     [Text] -> [Text] -> [Text]
forall a. [a] -> [a] -> [a]
++ [(Char, GroupName TileKind)] -> [Text]
validateOverride [(Char, GroupName TileKind)]
poverrideDark
     [Text] -> [Text] -> [Text]
forall a. [a] -> [a] -> [a]
++ [(Char, GroupName TileKind)] -> [Text]
validateOverride [(Char, GroupName TileKind)]
poverrideLit

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

makeData :: [PlaceKind] -> [GroupName PlaceKind] -> [GroupName PlaceKind]
         -> ContentData PlaceKind
makeData :: [PlaceKind]
-> [GroupName PlaceKind]
-> [GroupName PlaceKind]
-> ContentData PlaceKind
makeData = 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 "PlaceKind" PlaceKind -> Text
pname PlaceKind -> Freqs PlaceKind
pfreq PlaceKind -> [Text]
validateSingle [PlaceKind] -> ContentData PlaceKind -> [Text]
validateAll