module Game.LambdaHack.Content.TileKind
( TileKind(..), validateTileKind, actionFeatures
) where
import Control.Exception.Assert.Sugar
import qualified Data.Map.Strict as M
import Data.Maybe
import qualified Data.Set as S
import Data.Text (Text)
import Game.LambdaHack.Common.Color
import qualified Game.LambdaHack.Common.Feature as F
import Game.LambdaHack.Common.Misc
data TileKind = TileKind
{ tsymbol :: !Char
, tname :: !Text
, tfreq :: !Freqs
, tcolor :: !Color
, tcolor2 :: !Color
, tfeature :: ![F.Feature]
}
deriving Show
validateTileKind :: [TileKind] -> [TileKind]
validateTileKind lt =
let listFov f = map (\kt -> ( ( tsymbol kt
, F.Suspect `elem` tfeature kt
, f kt
)
, [kt] )) lt
mapFov :: (TileKind -> Color) -> M.Map (Char, Bool, Color) [TileKind]
mapFov f = M.fromListWith (++) $ listFov 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 $ mapFov f
in case confusions tcolor ++ confusions tcolor2 of
[] -> []
l : _ -> l
actionFeatures :: Bool -> TileKind -> S.Set F.Feature
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.CanItem -> Nothing
F.CanActor -> Nothing
in S.fromList $ mapMaybe f $ tfeature t