{-# 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 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
{ PlaceKind -> Char
psymbol :: Char
, PlaceKind -> Text
pname :: Text
, PlaceKind -> Freqs PlaceKind
pfreq :: Freqs PlaceKind
, PlaceKind -> Rarity
prarity :: Rarity
, PlaceKind -> Cover
pcover :: Cover
, PlaceKind -> Fence
pfence :: Fence
, PlaceKind -> [Text]
ptopLeft :: [Text]
, PlaceKind -> [(Char, GroupName TileKind)]
poverrideDark :: [(Char, GroupName TileKind)]
, PlaceKind -> [(Char, GroupName TileKind)]
poverrideLit :: [(Char, GroupName TileKind)]
}
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
data Cover =
CAlternate
| CStretch
| CReflect
| CVerbatim
| CMirror
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)
data Fence =
FWall
| FFloor
| FGround
| FNone
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) ]
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
validateAll :: [PlaceKind] -> ContentData PlaceKind -> [Text]
validateAll :: [PlaceKind] -> ContentData PlaceKind -> [Text]
validateAll _ _ = []
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