{-# LANGUAGE DeriveGeneric #-}
module Game.LambdaHack.Content.PlaceKind
( PlaceKind(..), makeData
, Cover(..), Fence(..)
#ifdef EXPOSE_INTERNAL
, validateSingle, validateAll
#endif
) where
import Prelude ()
import Game.LambdaHack.Common.Prelude
import qualified Data.Text as T
import Control.DeepSeq
import Game.LambdaHack.Common.ContentData
import Game.LambdaHack.Common.Misc
import Game.LambdaHack.Content.TileKind (TileKind)
import GHC.Generics (Generic)
data PlaceKind = PlaceKind
{ psymbol :: Char
, pname :: Text
, pfreq :: Freqs PlaceKind
, prarity :: Rarity
, pcover :: Cover
, pfence :: Fence
, ptopLeft :: [Text]
, poverride :: [(Char, GroupName TileKind)]
}
deriving (Show, Generic)
instance NFData PlaceKind
data Cover =
CAlternate
| CStretch
| CReflect
| CVerbatim
| CMirror
deriving (Show, Eq, Generic)
instance NFData Cover
data Fence =
FWall
| FFloor
| FGround
| FNone
deriving (Show, Eq, Generic)
instance NFData Fence
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
validateAll :: ContentData TileKind -> [PlaceKind] -> ContentData PlaceKind
-> [Text]
validateAll cotile content _ =
let missingOverride = filter (not . omemberGroup cotile)
$ concatMap (map snd . poverride) content
in [ "poverride 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)