{-# LANGUAGE DeriveGeneric #-} -- | The type of kinds of terrain tiles. module Game.LambdaHack.Content.TileKind ( TileKind(..), Feature(..) , makeData , isUknownSpace, unknownId , isSuspectKind, isOpenableKind, isClosableKind , talterForStairs, floorSymbol #ifdef EXPOSE_INTERNAL -- * Internal operations , validateSingle, validateAll , validateDups, hardwiredTileGroups #endif ) where import Prelude () import Game.LambdaHack.Core.Prelude import Control.DeepSeq import Data.Binary import qualified Data.Char as Char import Data.Hashable import GHC.Generics (Generic) import Game.LambdaHack.Content.ItemKind (ItemKind) import Game.LambdaHack.Definition.Color import Game.LambdaHack.Definition.ContentData import Game.LambdaHack.Definition.Defs -- | The type of kinds of terrain tiles. See @Tile.hs@ for explanation -- of the absence of a corresponding type @Tile@ that would hold -- particular concrete tiles in the dungeon. -- Note that tile names (and any other content names) should not be plural -- (that would lead to "a stairs"), so "road with cobblestones" is fine, -- but "granite cobblestones" is wrong. -- -- Tile kind for unknown space has the minimal @ContentId@ index. -- The @talter@ for unknown space is @1@ and no other tile kind has that value. data TileKind = TileKind { tsymbol :: Char -- ^ map symbol , tname :: Text -- ^ short description , tfreq :: Freqs TileKind -- ^ frequency within groups , tcolor :: Color -- ^ map color , tcolor2 :: Color -- ^ map color when not in FOV , talter :: Word8 -- ^ minimal skill needed to alter the tile , tfeature :: [Feature] -- ^ properties } deriving Show -- No Eq and Ord to make extending logically sound -- | All possible terrain tile features. data Feature = Embed (GroupName ItemKind) -- ^ initially an item of this group is embedded; -- we assume the item has effects and is supposed to be triggered | OpenTo (GroupName TileKind) -- ^ goes from a closed to (randomly closed or) open tile when altered | CloseTo (GroupName TileKind) -- ^ goes from an open to (randomly opened or) closed tile when altered | ChangeTo (GroupName TileKind) -- ^ alters tile, but does not change walkability | HideAs (GroupName TileKind) -- ^ when hidden, looks as the unique tile of the group | BuildAs (GroupName TileKind) -- ^ when generating, may be transformed to the unique tile of the group | RevealAs (GroupName TileKind) -- ^ when generating in opening, can be revealed to belong to the group | ObscureAs (GroupName TileKind) -- ^ when generating in solid wall, can be revealed to belong to the group | Walkable -- ^ actors can walk through | Clear -- ^ actors can see through | Dark -- ^ is not lit with an ambient light | OftenItem -- ^ initial items often generated there | VeryOftenItem -- ^ initial items very often generated there | OftenActor -- ^ initial actors often generated there | NoItem -- ^ no items ever generated there | NoActor -- ^ no actors ever generated there | ConsideredByAI -- ^ even if otherwise uninteresting, taken into -- account for triggering by AI | Trail -- ^ used for visible trails throughout the level | Spice -- ^ in place normal legend and in override, -- don't roll a tile kind only once per place, -- but roll for each position; one non-spicy -- (according to frequencies of non-spicy) and -- at most one spicy (according to their frequencies) -- is rolled per place and then, once for each -- position, one of the two is semi-randomly chosen -- (according to their individual frequencies only) deriving (Show, Eq, Ord, Generic) instance Binary Feature instance Hashable Feature instance NFData Feature -- | Validate a single tile kind. validateSingle :: TileKind -> [Text] validateSingle t@TileKind{..} = [ "suspect tile is walkable" | Walkable `elem` tfeature && isSuspectKind t ] ++ [ "openable tile is open" | Walkable `elem` tfeature && isOpenableKind t ] ++ [ "closable tile is closed" | Walkable `notElem` tfeature && isClosableKind t ] ++ [ "walkable tile is considered for triggering by AI" | Walkable `elem` tfeature && ConsideredByAI `elem` tfeature ] ++ [ "trail tile not walkable" | Walkable `notElem` tfeature && Trail `elem` tfeature ] ++ [ "OftenItem and NoItem on a tile" | OftenItem `elem` tfeature && NoItem `elem` tfeature ] ++ [ "OftenActor and NoActor on a tile" | OftenItem `elem` tfeature && NoItem `elem` tfeature ] ++ (let f :: Feature -> Bool f OpenTo{} = True f CloseTo{} = True f ChangeTo{} = True f _ = False ts = filter f tfeature in [ "more than one OpenTo, CloseTo and ChangeTo specification" | length ts > 1 ]) ++ (let f :: Feature -> Bool f HideAs{} = True f _ = False ts = filter f tfeature in ["more than one HideAs specification" | length ts > 1]) ++ (let f :: Feature -> Bool f BuildAs{} = True f _ = False ts = filter f tfeature in ["more than one BuildAs specification" | length ts > 1]) ++ concatMap (validateDups t) [ Walkable, Clear, Dark, OftenItem, OftenActor, NoItem, NoActor , ConsideredByAI, Trail, Spice ] validateDups :: TileKind -> Feature -> [Text] validateDups TileKind{..} feat = let ts = filter (== feat) tfeature in ["more than one" <+> tshow feat <+> "specification" | length ts > 1] -- | Validate all tile kinds. -- -- We don't check it any more, but if tiles look the same on the map -- (symbol and color), their substantial features should be the same, too, -- unless there is a good reason they shouldn't. Otherwise the player has -- to inspect manually all the tiles with this look to see if any is special. -- This tends to be tedious. Note that tiles may freely differ wrt text blurb, -- dungeon generation rules, AI preferences, etc., whithout causing the tedium. validateAll :: ContentData ItemKind -> [TileKind] -> ContentData TileKind -> [Text] validateAll coitem content cotile = let g :: Feature -> Maybe (GroupName TileKind) g (OpenTo grp) = Just grp g (CloseTo grp) = Just grp g (ChangeTo grp) = Just grp g (HideAs grp) = Just grp g (BuildAs grp) = Just grp g (RevealAs grp) = Just grp g (ObscureAs grp) = Just grp g _ = Nothing missingTileGroups = [ (tname k, absGroups) | k <- content , let grps = mapMaybe g $ tfeature k absGroups = filter (not . omemberGroup cotile) grps , not $ null absGroups ] h :: Feature -> Maybe (GroupName ItemKind) h (Embed grp) = Just grp h _ = Nothing missingItemGroups = [ (tname k, absGroups) | k <- content , let grps = mapMaybe h $ tfeature k absGroups = filter (not . omemberGroup coitem) grps , not $ null absGroups ] missingHardwiredGroups = filter (not . omemberGroup cotile) hardwiredTileGroups in [ "unknown tile (the first) should be the unknown one" | talter (head content) /= 1 || tname (head content) /= "unknown space" ] ++ [ "no tile other than the unknown (the first) should require skill 1" | all (\tk -> talter tk == 1) (tail content) ] ++ [ "only unknown tile may have talter 1" | any ((== 1) . talter) $ tail content ] ++ [ "mentioned tile groups not in content:" <+> tshow missingTileGroups | not $ null missingTileGroups ] ++ [ "embedded item groups not in content:" <+> tshow missingItemGroups | not $ null missingItemGroups ] ++ [ "hardwired groups not in content:" <+> tshow missingHardwiredGroups | not $ null missingHardwiredGroups ] hardwiredTileGroups :: [GroupName TileKind] hardwiredTileGroups = [ "unknown space", "legendLit", "legendDark", "unknown outer fence" , "basic outer fence" ] isUknownSpace :: ContentId TileKind -> Bool {-# INLINE isUknownSpace #-} isUknownSpace tt = toContentId 0 == tt unknownId :: ContentId TileKind {-# INLINE unknownId #-} unknownId = toContentId 0 isSuspectKind :: TileKind -> Bool isSuspectKind t = let getTo RevealAs{} = True getTo ObscureAs{} = True getTo _ = False in any getTo $ tfeature t isOpenableKind :: TileKind -> Bool isOpenableKind t = let getTo OpenTo{} = True getTo _ = False in any getTo $ tfeature t isClosableKind :: TileKind -> Bool isClosableKind t = let getTo CloseTo{} = True getTo _ = False in any getTo $ tfeature t talterForStairs :: Word8 talterForStairs = 3 floorSymbol :: Char.Char floorSymbol = Char.chr 183 -- Alter skill schema: -- 0 can be altered by everybody (escape) -- 1 unknown only -- 2 openable and suspect -- 3 stairs -- 4 closable -- 5 changeable (e.g., caches) -- 10 weak obstructions -- 50 considerable obstructions -- 100 walls -- maxBound impenetrable walls, etc., can never be altered makeData :: ContentData ItemKind -> [TileKind] -> ContentData TileKind makeData coitem = makeContentData "TileKind" tname tfreq validateSingle (validateAll coitem)