{-# LANGUAGE DeriveGeneric #-}
module Game.LambdaHack.Content.PlaceKind
( PlaceKind(..), makeData
, Cover(..), Fence(..)
, PlaceEntry(..), deadEndId, overridePlaceKind, override2PlaceKind
#ifdef EXPOSE_INTERNAL
, 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
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 -> EnumMap Char (GroupName TileKind)
plegendDark :: EM.EnumMap Char (GroupName TileKind)
, PlaceKind -> EnumMap Char (GroupName TileKind)
plegendLit :: EM.EnumMap 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 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 }
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' = []
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
validateAll :: [PlaceKind] -> ContentData PlaceKind -> [Text]
validateAll :: [PlaceKind] -> ContentData PlaceKind -> [Text]
validateAll [PlaceKind]
_ ContentData PlaceKind
_ = []
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