{-# LANGUAGE DeriveGeneric #-}
module Game.LambdaHack.Content.PlaceKind
( PlaceKind(..), makeData
, Cover(..), Fence(..)
, PlaceEntry(..), deadEndId
#ifdef EXPOSE_INTERNAL
, validateSingle, validateAll
#endif
) where
import Prelude ()
import Game.LambdaHack.Core.Prelude
import Data.Binary
import Data.Char (chr)
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
data PlaceKind = PlaceKind
{ psymbol :: Char
, pname :: Text
, pfreq :: Freqs PlaceKind
, prarity :: Rarity
, pcover :: Cover
, pfence :: Fence
, ptopLeft :: [Text]
, poverrideDark :: [(Char, GroupName TileKind)]
, poverrideLit :: [(Char, GroupName TileKind)]
}
deriving Show
data Cover =
CAlternate
| CStretch
| CReflect
| CVerbatim
| CMirror
deriving (Show, Eq)
data Fence =
FWall
| FFloor
| FGround
| FNone
deriving (Show, Eq)
data PlaceEntry =
PEntry (ContentId PlaceKind)
| PAround (ContentId PlaceKind)
| PEnd (ContentId PlaceKind)
deriving (Show, Eq, Generic)
instance Binary PlaceEntry
deadEndId :: ContentId PlaceKind
{-# INLINE deadEndId #-}
deadEndId = toContentId 0
validateOverride :: [(Char, GroupName TileKind)] -> [Text]
validateOverride ov =
let symbols = sort $ map fst ov
duplicated = filter (uncurry (==)) $ zip symbols (chr 0 : symbols)
in if null duplicated
then []
else [ "duplicated override symbols:"
<+> T.pack (intersperse ' ' $ map fst duplicated) ]
validateSingle :: PlaceKind -> [Text]
validateSingle PlaceKind{..} =
let dxcorner = case ptopLeft of
[] -> 0
l : _ -> T.length l
in [ "top-left corner empty" | dxcorner == 0 ]
++ [ "top-left corner not rectangular"
| any (/= dxcorner) (map T.length ptopLeft) ]
++ validateRarity prarity
++ validateOverride poverrideDark
++ validateOverride poverrideLit
validateAll :: ContentData TileKind -> [PlaceKind] -> ContentData PlaceKind
-> [Text]
validateAll cotile content _ =
let overrides place = poverrideDark place ++ poverrideLit place
missingOverride = filter (not . omemberGroup cotile)
$ concatMap (map snd . overrides) content
in [ "override tile groups not in content:" <+> tshow missingOverride
| not $ null missingOverride ]
makeData :: ContentData TileKind -> [PlaceKind] -> ContentData PlaceKind
makeData cotile =
makeContentData "PlaceKind" pname pfreq validateSingle (validateAll cotile)