module Game.LambdaHack.Content.TileKind
( pattern S_UNKNOWN_SPACE, pattern S_UNKNOWN_OUTER_FENCE, pattern S_BASIC_OUTER_FENCE, pattern AQUATIC
, TileKind(..), ProjectileTriggers(..), Feature(..)
, makeData
, isUknownSpace, unknownId
, isSuspectKind, isOpenableKind, isClosableKind
, talterForStairs, floorSymbol
#ifdef EXPOSE_INTERNAL
, validateSingle, validateAll
, validateDups, mandatoryGroups, mandatoryGroupsSingleton
#endif
) where
import Prelude ()
import Game.LambdaHack.Core.Prelude
import Data.Word (Word8)
import Game.LambdaHack.Content.ItemKind (ItemKind)
import Game.LambdaHack.Definition.Color
import Game.LambdaHack.Definition.ContentData
import Game.LambdaHack.Definition.Defs
import Game.LambdaHack.Definition.DefsInternal
data TileKind = TileKind
{ TileKind -> Char
tsymbol :: Char
, TileKind -> Text
tname :: Text
, TileKind -> Freqs TileKind
tfreq :: Freqs TileKind
, TileKind -> Color
tcolor :: Color
, TileKind -> Color
tcolor2 :: Color
, TileKind -> Word8
talter :: Word8
, TileKind -> [Feature]
tfeature :: [Feature]
}
deriving Int -> TileKind -> ShowS
[TileKind] -> ShowS
TileKind -> String
(Int -> TileKind -> ShowS)
-> (TileKind -> String) -> ([TileKind] -> ShowS) -> Show TileKind
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [TileKind] -> ShowS
$cshowList :: [TileKind] -> ShowS
show :: TileKind -> String
$cshow :: TileKind -> String
showsPrec :: Int -> TileKind -> ShowS
$cshowsPrec :: Int -> TileKind -> ShowS
Show
data Feature =
Embed (GroupName ItemKind)
| OpenTo (GroupName TileKind)
| CloseTo (GroupName TileKind)
| ChangeTo (GroupName TileKind)
| OpenWith ProjectileTriggers
[(Int, GroupName ItemKind)] (GroupName TileKind)
| CloseWith ProjectileTriggers
[(Int, GroupName ItemKind)] (GroupName TileKind)
| ChangeWith ProjectileTriggers
[(Int, GroupName ItemKind)] (GroupName TileKind)
| HideAs (GroupName TileKind)
| BuildAs (GroupName TileKind)
| RevealAs (GroupName TileKind)
| ObscureAs (GroupName TileKind)
| Walkable
| Clear
| Dark
| OftenItem
| VeryOftenItem
| OftenActor
| NoItem
| NoActor
| ConsideredByAI
| Trail
| Spice
deriving (Int -> Feature -> ShowS
[Feature] -> ShowS
Feature -> String
(Int -> Feature -> ShowS)
-> (Feature -> String) -> ([Feature] -> ShowS) -> Show Feature
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Feature] -> ShowS
$cshowList :: [Feature] -> ShowS
show :: Feature -> String
$cshow :: Feature -> String
showsPrec :: Int -> Feature -> ShowS
$cshowsPrec :: Int -> Feature -> ShowS
Show, Feature -> Feature -> Bool
(Feature -> Feature -> Bool)
-> (Feature -> Feature -> Bool) -> Eq Feature
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Feature -> Feature -> Bool
$c/= :: Feature -> Feature -> Bool
== :: Feature -> Feature -> Bool
$c== :: Feature -> Feature -> Bool
Eq)
data ProjectileTriggers = ProjYes | ProjNo
deriving (Int -> ProjectileTriggers -> ShowS
[ProjectileTriggers] -> ShowS
ProjectileTriggers -> String
(Int -> ProjectileTriggers -> ShowS)
-> (ProjectileTriggers -> String)
-> ([ProjectileTriggers] -> ShowS)
-> Show ProjectileTriggers
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ProjectileTriggers] -> ShowS
$cshowList :: [ProjectileTriggers] -> ShowS
show :: ProjectileTriggers -> String
$cshow :: ProjectileTriggers -> String
showsPrec :: Int -> ProjectileTriggers -> ShowS
$cshowsPrec :: Int -> ProjectileTriggers -> ShowS
Show, ProjectileTriggers -> ProjectileTriggers -> Bool
(ProjectileTriggers -> ProjectileTriggers -> Bool)
-> (ProjectileTriggers -> ProjectileTriggers -> Bool)
-> Eq ProjectileTriggers
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ProjectileTriggers -> ProjectileTriggers -> Bool
$c/= :: ProjectileTriggers -> ProjectileTriggers -> Bool
== :: ProjectileTriggers -> ProjectileTriggers -> Bool
$c== :: ProjectileTriggers -> ProjectileTriggers -> Bool
Eq)
validateSingle :: TileKind -> [Text]
validateSingle :: TileKind -> [Text]
validateSingle t :: TileKind
t@TileKind{Char
Freqs TileKind
[Feature]
Word8
Text
Color
tfeature :: [Feature]
talter :: Word8
tcolor2 :: Color
tcolor :: Color
tfreq :: Freqs TileKind
tname :: Text
tsymbol :: Char
tfeature :: TileKind -> [Feature]
talter :: TileKind -> Word8
tcolor2 :: TileKind -> Color
tcolor :: TileKind -> Color
tfreq :: TileKind -> Freqs TileKind
tname :: TileKind -> Text
tsymbol :: TileKind -> Char
..} =
[ Text
"suspect tile is walkable" | Feature
Walkable Feature -> [Feature] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Feature]
tfeature
Bool -> Bool -> Bool
&& TileKind -> Bool
isSuspectKind TileKind
t ]
[Text] -> [Text] -> [Text]
forall a. [a] -> [a] -> [a]
++ [ Text
"openable tile is open" | Feature
Walkable Feature -> [Feature] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Feature]
tfeature
Bool -> Bool -> Bool
&& TileKind -> Bool
isOpenableKind TileKind
t ]
[Text] -> [Text] -> [Text]
forall a. [a] -> [a] -> [a]
++ [ Text
"closable tile is closed" | Feature
Walkable Feature -> [Feature] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`notElem` [Feature]
tfeature
Bool -> Bool -> Bool
&& TileKind -> Bool
isClosableKind TileKind
t ]
[Text] -> [Text] -> [Text]
forall a. [a] -> [a] -> [a]
++ [ Text
"walkable tile is considered for activating by AI"
| Feature
Walkable Feature -> [Feature] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Feature]
tfeature
Bool -> Bool -> Bool
&& Feature
ConsideredByAI Feature -> [Feature] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Feature]
tfeature ]
[Text] -> [Text] -> [Text]
forall a. [a] -> [a] -> [a]
++ [ Text
"trail tile not walkable" | Feature
Walkable Feature -> [Feature] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`notElem` [Feature]
tfeature
Bool -> Bool -> Bool
&& Feature
Trail Feature -> [Feature] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Feature]
tfeature ]
[Text] -> [Text] -> [Text]
forall a. [a] -> [a] -> [a]
++ [ Text
"OftenItem and NoItem on a tile" | Feature
OftenItem Feature -> [Feature] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Feature]
tfeature
Bool -> Bool -> Bool
&& Feature
NoItem Feature -> [Feature] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Feature]
tfeature ]
[Text] -> [Text] -> [Text]
forall a. [a] -> [a] -> [a]
++ [ Text
"OftenActor and NoActor on a tile" | Feature
OftenItem Feature -> [Feature] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Feature]
tfeature
Bool -> Bool -> Bool
&& Feature
NoItem Feature -> [Feature] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Feature]
tfeature ]
[Text] -> [Text] -> [Text]
forall a. [a] -> [a] -> [a]
++ (let f :: Feature -> Bool
f :: Feature -> Bool
f OpenTo{} = Bool
True
f CloseTo{} = Bool
True
f ChangeTo{} = Bool
True
f Feature
_ = Bool
False
ts :: [Feature]
ts = (Feature -> Bool) -> [Feature] -> [Feature]
forall a. (a -> Bool) -> [a] -> [a]
filter Feature -> Bool
f [Feature]
tfeature
in [ Text
"more than one OpenTo, CloseTo and ChangeTo specification"
| [Feature] -> Int
forall a. [a] -> Int
length [Feature]
ts Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
1 ])
[Text] -> [Text] -> [Text]
forall a. [a] -> [a] -> [a]
++ (let f :: Feature -> Bool
f :: Feature -> Bool
f HideAs{} = Bool
True
f Feature
_ = Bool
False
ts :: [Feature]
ts = (Feature -> Bool) -> [Feature] -> [Feature]
forall a. (a -> Bool) -> [a] -> [a]
filter Feature -> Bool
f [Feature]
tfeature
in [Text
"more than one HideAs specification" | [Feature] -> Int
forall a. [a] -> Int
length [Feature]
ts Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
1])
[Text] -> [Text] -> [Text]
forall a. [a] -> [a] -> [a]
++ (let f :: Feature -> Bool
f :: Feature -> Bool
f BuildAs{} = Bool
True
f Feature
_ = Bool
False
ts :: [Feature]
ts = (Feature -> Bool) -> [Feature] -> [Feature]
forall a. (a -> Bool) -> [a] -> [a]
filter Feature -> Bool
f [Feature]
tfeature
in [Text
"more than one BuildAs specification" | [Feature] -> Int
forall a. [a] -> Int
length [Feature]
ts Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
1])
[Text] -> [Text] -> [Text]
forall a. [a] -> [a] -> [a]
++ (Feature -> [Text]) -> [Feature] -> [Text]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (TileKind -> Feature -> [Text]
validateDups TileKind
t)
[ Feature
Walkable, Feature
Clear, Feature
Dark, Feature
OftenItem, Feature
OftenActor, Feature
NoItem, Feature
NoActor
, Feature
ConsideredByAI, Feature
Trail, Feature
Spice ]
validateDups :: TileKind -> Feature -> [Text]
validateDups :: TileKind -> Feature -> [Text]
validateDups TileKind{Char
Freqs TileKind
[Feature]
Word8
Text
Color
tfeature :: [Feature]
talter :: Word8
tcolor2 :: Color
tcolor :: Color
tfreq :: Freqs TileKind
tname :: Text
tsymbol :: Char
tfeature :: TileKind -> [Feature]
talter :: TileKind -> Word8
tcolor2 :: TileKind -> Color
tcolor :: TileKind -> Color
tfreq :: TileKind -> Freqs TileKind
tname :: TileKind -> Text
tsymbol :: TileKind -> Char
..} Feature
feat =
let ts :: [Feature]
ts = (Feature -> Bool) -> [Feature] -> [Feature]
forall a. (a -> Bool) -> [a] -> [a]
filter (Feature -> Feature -> Bool
forall a. Eq a => a -> a -> Bool
== Feature
feat) [Feature]
tfeature
in [Text
"more than one" Text -> Text -> Text
<+> Feature -> Text
forall a. Show a => a -> Text
tshow Feature
feat Text -> Text -> Text
<+> Text
"specification" | [Feature] -> Int
forall a. [a] -> Int
length [Feature]
ts Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
1]
validateAll :: [TileKind] -> ContentData TileKind -> [Text]
validateAll :: [TileKind] -> ContentData TileKind -> [Text]
validateAll [TileKind]
content ContentData TileKind
cotile =
let f :: Feature -> Bool
f :: Feature -> Bool
f HideAs{} = Bool
True
f BuildAs{} = Bool
True
f Feature
_ = Bool
False
wrongGrooup :: TileKind -> GroupName TileKind -> Bool
wrongGrooup TileKind
k GroupName TileKind
grp = Bool -> Bool
not (ContentData TileKind -> GroupName TileKind -> Bool
forall a. ContentData a -> GroupName a -> Bool
oisSingletonGroup ContentData TileKind
cotile GroupName TileKind
grp)
Bool -> Bool -> Bool
|| Maybe Int -> Bool
forall a. Maybe a -> Bool
isJust (GroupName TileKind
grp GroupName TileKind -> Freqs TileKind -> Maybe Int
forall a b. Eq a => a -> [(a, b)] -> Maybe b
`lookup` TileKind -> Freqs TileKind
tfreq TileKind
k)
wrongFooAsGroups :: [GroupName TileKind]
wrongFooAsGroups =
[ GroupName TileKind
cgroup
| TileKind
k <- [TileKind]
content
, let (GroupName TileKind
cgroup, Bool
notSingleton) = case (Feature -> Bool) -> [Feature] -> Maybe Feature
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Maybe a
find Feature -> Bool
f (TileKind -> [Feature]
tfeature TileKind
k) of
Just (HideAs GroupName TileKind
grp) | TileKind -> GroupName TileKind -> Bool
wrongGrooup TileKind
k GroupName TileKind
grp -> (GroupName TileKind
grp, Bool
True)
Just (BuildAs GroupName TileKind
grp) | TileKind -> GroupName TileKind -> Bool
wrongGrooup TileKind
k GroupName TileKind
grp -> (GroupName TileKind
grp, Bool
True)
Maybe Feature
_ -> (GroupName TileKind
forall a. HasCallStack => a
undefined, Bool
False)
, Bool
notSingleton
]
in [ Text
"HideAs or BuildAs groups not singletons or point to themselves:"
Text -> Text -> Text
<+> [GroupName TileKind] -> Text
forall a. Show a => a -> Text
tshow [GroupName TileKind]
wrongFooAsGroups
| Bool -> Bool
not (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$ [GroupName TileKind] -> Bool
forall a. [a] -> Bool
null [GroupName TileKind]
wrongFooAsGroups ]
[Text] -> [Text] -> [Text]
forall a. [a] -> [a] -> [a]
++ [ Text
"unknown tile (the first) should be the unknown one"
| TileKind -> Word8
talter ([TileKind] -> TileKind
forall a. [a] -> a
head [TileKind]
content) Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
/= Word8
1
Bool -> Bool -> Bool
|| TileKind -> Text
tname ([TileKind] -> TileKind
forall a. [a] -> a
head [TileKind]
content) Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
/= Text
"unknown space" ]
[Text] -> [Text] -> [Text]
forall a. [a] -> [a] -> [a]
++ [ Text
"no tile other than the unknown (the first) should require skill 1"
| (TileKind -> Bool) -> [TileKind] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (\TileKind
tk -> TileKind -> Word8
talter TileKind
tk Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
== Word8
1) ([TileKind] -> [TileKind]
forall a. [a] -> [a]
tail [TileKind]
content) ]
mandatoryGroupsSingleton :: [GroupName TileKind]
mandatoryGroupsSingleton :: [GroupName TileKind]
mandatoryGroupsSingleton =
[GroupName TileKind
S_UNKNOWN_SPACE, GroupName TileKind
S_UNKNOWN_OUTER_FENCE, GroupName TileKind
S_BASIC_OUTER_FENCE]
pattern S_UNKNOWN_SPACE, S_UNKNOWN_OUTER_FENCE, S_BASIC_OUTER_FENCE :: GroupName TileKind
mandatoryGroups :: [GroupName TileKind]
mandatoryGroups :: [GroupName TileKind]
mandatoryGroups = []
pattern $bS_UNKNOWN_SPACE :: GroupName TileKind
$mS_UNKNOWN_SPACE :: forall r. GroupName TileKind -> (Void# -> r) -> (Void# -> r) -> r
S_UNKNOWN_SPACE = GroupName "unknown space"
pattern $bS_UNKNOWN_OUTER_FENCE :: GroupName TileKind
$mS_UNKNOWN_OUTER_FENCE :: forall r. GroupName TileKind -> (Void# -> r) -> (Void# -> r) -> r
S_UNKNOWN_OUTER_FENCE = GroupName "unknown outer fence"
pattern $bS_BASIC_OUTER_FENCE :: GroupName TileKind
$mS_BASIC_OUTER_FENCE :: forall r. GroupName TileKind -> (Void# -> r) -> (Void# -> r) -> r
S_BASIC_OUTER_FENCE = GroupName "basic outer fence"
pattern AQUATIC :: GroupName TileKind
pattern $bAQUATIC :: GroupName TileKind
$mAQUATIC :: forall r. GroupName TileKind -> (Void# -> r) -> (Void# -> r) -> r
AQUATIC = GroupName "aquatic"
isUknownSpace :: ContentId TileKind -> Bool
{-# INLINE isUknownSpace #-}
isUknownSpace :: ContentId TileKind -> Bool
isUknownSpace ContentId TileKind
tt = Word16 -> ContentId TileKind
forall c. Word16 -> ContentId c
toContentId Word16
0 ContentId TileKind -> ContentId TileKind -> Bool
forall a. Eq a => a -> a -> Bool
== ContentId TileKind
tt
unknownId :: ContentId TileKind
{-# INLINE unknownId #-}
unknownId :: ContentId TileKind
unknownId = Word16 -> ContentId TileKind
forall c. Word16 -> ContentId c
toContentId Word16
0
isSuspectKind :: TileKind -> Bool
isSuspectKind :: TileKind -> Bool
isSuspectKind TileKind
t =
let getTo :: Feature -> Bool
getTo RevealAs{} = Bool
True
getTo ObscureAs{} = Bool
True
getTo Feature
_ = Bool
False
in (Feature -> Bool) -> [Feature] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any Feature -> Bool
getTo ([Feature] -> Bool) -> [Feature] -> Bool
forall a b. (a -> b) -> a -> b
$ TileKind -> [Feature]
tfeature TileKind
t
isOpenableKind :: TileKind -> Bool
isOpenableKind :: TileKind -> Bool
isOpenableKind TileKind
t =
let getTo :: Feature -> Bool
getTo OpenTo{} = Bool
True
getTo Feature
_ = Bool
False
in (Feature -> Bool) -> [Feature] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any Feature -> Bool
getTo ([Feature] -> Bool) -> [Feature] -> Bool
forall a b. (a -> b) -> a -> b
$ TileKind -> [Feature]
tfeature TileKind
t
isClosableKind :: TileKind -> Bool
isClosableKind :: TileKind -> Bool
isClosableKind TileKind
t =
let getTo :: Feature -> Bool
getTo CloseTo{} = Bool
True
getTo Feature
_ = Bool
False
in (Feature -> Bool) -> [Feature] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any Feature -> Bool
getTo ([Feature] -> Bool) -> [Feature] -> Bool
forall a b. (a -> b) -> a -> b
$ TileKind -> [Feature]
tfeature TileKind
t
talterForStairs :: Word8
talterForStairs :: Word8
talterForStairs = Word8
3
floorSymbol :: Char
floorSymbol :: Char
floorSymbol = Char
'·'
makeData :: [TileKind] -> [GroupName TileKind] -> [GroupName TileKind]
-> ContentData TileKind
makeData :: [TileKind]
-> [GroupName TileKind]
-> [GroupName TileKind]
-> ContentData TileKind
makeData [TileKind]
content [GroupName TileKind]
groupNamesAtMostOne [GroupName TileKind]
groupNames =
String
-> (TileKind -> Text)
-> (TileKind -> Freqs TileKind)
-> (TileKind -> [Text])
-> ([TileKind] -> ContentData TileKind -> [Text])
-> [TileKind]
-> [GroupName TileKind]
-> [GroupName TileKind]
-> ContentData TileKind
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
"TileKind" TileKind -> Text
tname TileKind -> Freqs TileKind
tfreq TileKind -> [Text]
validateSingle [TileKind] -> ContentData TileKind -> [Text]
validateAll [TileKind]
content
([GroupName TileKind]
mandatoryGroupsSingleton [GroupName TileKind]
-> [GroupName TileKind] -> [GroupName TileKind]
forall a. [a] -> [a] -> [a]
++ [GroupName TileKind]
groupNamesAtMostOne)
([GroupName TileKind]
mandatoryGroups [GroupName TileKind]
-> [GroupName TileKind] -> [GroupName TileKind]
forall a. [a] -> [a] -> [a]
++ [GroupName TileKind]
groupNames)