module Game.LambdaHack.Content.TileKind
( TileKind(..), validateSingleTileKind, validateAllTileKind, actionFeatures
) where
import Control.Exception.Assert.Sugar
import Data.Hashable (hash)
import qualified Data.IntSet as IS
import qualified Data.Map.Strict as M
import Data.Maybe
import Data.Text (Text)
import Game.LambdaHack.Common.Color
import qualified Game.LambdaHack.Common.Feature as F
import Game.LambdaHack.Common.Misc
import Game.LambdaHack.Common.Msg
data TileKind = TileKind
{ tsymbol :: !Char
, tname :: !Text
, tfreq :: !Freqs
, tcolor :: !Color
, tcolor2 :: !Color
, tfeature :: ![F.Feature]
}
deriving Show
validateSingleTileKind :: TileKind -> [Text]
validateSingleTileKind TileKind{..} =
[ "suspect tile is walkable" | F.Walkable `elem` tfeature
&& F.Suspect `elem` tfeature ]
validateAllTileKind :: [TileKind] -> [Text]
validateAllTileKind lt =
let listVis f = map (\kt -> ( ( tsymbol kt
, F.Suspect `elem` tfeature kt
, f kt
)
, [kt] ) ) lt
mapVis :: (TileKind -> Color) -> M.Map (Char, Bool, Color) [TileKind]
mapVis f = M.fromListWith (++) $ listVis f
namesUnequal [] = assert `failure` "no TileKind content" `twith` lt
namesUnequal (hd : tl) =
any (/= tname hd) (map tname tl)
|| any (/= actionFeatures True hd) (map (actionFeatures True) tl)
confusions f = filter namesUnequal $ M.elems $ mapVis f
in case confusions tcolor ++ confusions tcolor2 of
[] -> []
cfs -> ["tile confusions detected:" <+> tshow cfs]
actionFeatures :: Bool -> TileKind -> IS.IntSet
actionFeatures markSuspect t =
let f feat = case feat of
F.Cause{} -> Just feat
F.OpenTo{} -> Just $ F.OpenTo ""
F.CloseTo{} -> Just $ F.CloseTo ""
F.ChangeTo{} -> Just $ F.ChangeTo ""
F.Walkable -> Just feat
F.Clear -> Just feat
F.Suspect -> if markSuspect then Just feat else Nothing
F.Aura{} -> Just feat
F.Impenetrable -> Just feat
F.Trail -> Just feat
F.HideAs{} -> Nothing
F.RevealAs{} -> Nothing
F.Dark -> Nothing
F.OftenItem -> Nothing
F.OftenActor -> Nothing
F.NoItem -> Nothing
F.NoActor -> Nothing
in IS.fromList $ map hash $ mapMaybe f $ tfeature t