{-# LANGUAGE DeriveGeneric #-} -- | The type of kinds of terrain tiles. module Game.LambdaHack.Content.TileKind ( TileKind(..), makeData , Feature(..), TileSpeedup(..), Tab(..) , emptyTileSpeedup, emptyTab , actionFeatures, isUknownSpace, unknownId , isSuspectKind, isOpenableKind, isClosableKind , talterForStairs, floorSymbol #ifdef EXPOSE_INTERNAL -- * Internal operations , validateSingle, validateAll , validateDups, hardwiredTileGroups #endif ) where import Prelude () import Game.LambdaHack.Common.Prelude import Control.DeepSeq import Data.Binary import qualified Data.Char as Char import Data.Hashable import qualified Data.IntSet as IS import qualified Data.Text as T import qualified Data.Vector.Unboxed as U import GHC.Generics (Generic) import Game.LambdaHack.Common.Color import Game.LambdaHack.Common.ContentData import Game.LambdaHack.Common.Misc import Game.LambdaHack.Content.ItemKind (ItemKind) -- | 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, Generic) -- No Eq and Ord to make extending logically sound instance NFData TileKind -- | 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 | 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 and -- at most one spicy is rolled per place and then -- one of the two is rolled for each position deriving (Show, Eq, Ord, Generic) instance Binary Feature instance Hashable Feature instance NFData Feature -- | A lot of tabulated maps from tile kind identifier to a property -- of the tile kind. data TileSpeedup = TileSpeedup { isClearTab :: Tab Bool , isLitTab :: Tab Bool , isWalkableTab :: Tab Bool , isDoorTab :: Tab Bool , isChangableTab :: Tab Bool , isSuspectTab :: Tab Bool , isHideAsTab :: Tab Bool , consideredByAITab :: Tab Bool , isOftenItemTab :: Tab Bool , isOftenActorTab :: Tab Bool , isNoItemTab :: Tab Bool , isNoActorTab :: Tab Bool , isEasyOpenTab :: Tab Bool , alterMinSkillTab :: Tab Word8 , alterMinWalkTab :: Tab Word8 } deriving Generic instance NFData TileSpeedup -- Vectors of booleans can be slower than arrays, because they are not packed, -- but with growing cache sizes they may as well turn out faster at some point. -- The advantage of vectors are exposed internals, in particular unsafe -- indexing. Also, in JS, bool arrays are obviously not packed. -- | A map morally indexed by @ContentId TileKind@. newtype Tab a = Tab (U.Vector a) deriving Generic instance NFData (Tab a) emptyTileSpeedup :: TileSpeedup emptyTileSpeedup = TileSpeedup emptyTab emptyTab emptyTab emptyTab emptyTab emptyTab emptyTab emptyTab emptyTab emptyTab emptyTab emptyTab emptyTab emptyTab emptyTab emptyTab :: U.Unbox a => Tab a emptyTab = Tab $! U.empty -- | 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 [ "first tile should be the unknown one" | talter (head content) /= 1 || tname (head content) /= "unknown space" ] ++ [ "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", "stair terminal" ] -- | Features of tiles that differentiate them substantially from one another. -- The intention is the player can easily tell such tiles apart by their -- behaviour and only looking at the map, not tile name nor description. -- So if running uses this function, it won't stop at places that the player -- can't himself tell from other places, and so running does not confer -- any advantages, except UI convenience. Hashes are accurate enough -- for our purpose, given that we use arbitrary heuristics anyway. actionFeatures :: Bool -> TileKind -> IS.IntSet actionFeatures markSuspect t = let stripLight grp = maybe grp toGroupName $ maybe (T.stripSuffix "Dark" $ tshow grp) Just $ T.stripSuffix "Lit" $ tshow grp f feat = case feat of Embed{} -> Just feat OpenTo grp -> Just $ OpenTo $ stripLight grp CloseTo grp -> Just $ CloseTo $ stripLight grp ChangeTo grp -> Just $ ChangeTo $ stripLight grp Walkable -> Just feat Clear -> Just feat HideAs{} -> Nothing BuildAs{} -> Nothing RevealAs{} -> if markSuspect then Just feat else Nothing ObscureAs{} -> if markSuspect then Just feat else Nothing Dark -> Nothing -- not important any longer, after FOV computed OftenItem -> Nothing OftenActor -> Nothing NoItem -> Nothing NoActor -> Nothing ConsideredByAI -> Nothing Trail -> Just feat -- doesn't affect tile behaviour, but important Spice -> Nothing in IS.fromList $ map hash $ mapMaybe f $ tfeature t isUknownSpace :: ContentId TileKind -> Bool {-# INLINE isUknownSpace #-} isUknownSpace tt = ContentId 0 == tt unknownId :: ContentId TileKind {-# INLINE unknownId #-} unknownId = ContentId 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)