module Game.LambdaHack.Common.Tile
( SmellTime
, kindHasFeature, kindHas, hasFeature
, isClear, isLit, isExplorable, similar, speedup
, changeTo, hiddenAs
) where
import qualified Data.Array.Unboxed as A
import qualified Data.List as L
import Game.LambdaHack.Content.TileKind
import qualified Game.LambdaHack.Common.Feature as F
import qualified Game.LambdaHack.Common.Kind as Kind
import Game.LambdaHack.Common.Random
import Game.LambdaHack.Common.Time
type SmellTime = Time
kindHasFeature :: F.Feature -> TileKind -> Bool
kindHasFeature f t = f `elem` tfeature t
kindHas :: [F.Feature] -> [F.Feature] -> TileKind -> Bool
kindHas yes no t = L.all (`kindHasFeature` t) yes
&& not (L.any (`kindHasFeature` t) no)
hasFeature :: Kind.Ops TileKind -> F.Feature -> Kind.Id TileKind -> Bool
hasFeature Kind.Ops{okind} f t =
kindHasFeature f (okind t)
isClear :: Kind.Ops TileKind -> Kind.Id TileKind -> Bool
isClear Kind.Ops{ospeedup = Kind.TileSpeedup{isClearTab}} = isClearTab
isLit :: Kind.Ops TileKind -> Kind.Id TileKind -> Bool
isLit Kind.Ops{ospeedup = Kind.TileSpeedup{isLitTab}} = isLitTab
isExplorable :: Kind.Ops TileKind -> Kind.Id TileKind -> Bool
isExplorable cops tk =
not (hasFeature cops F.Closable tk)
&& (isClear cops tk
|| hasFeature cops F.Walkable tk)
similar :: TileKind -> TileKind -> Bool
similar t u =
tsymbol t == tsymbol u &&
tname t == tname u &&
tcolor t == tcolor u &&
tcolor2 t == tcolor2 u
speedup :: Bool -> Kind.Ops TileKind -> Kind.Speedup TileKind
speedup allClear Kind.Ops{ofoldrWithKey, obounds} =
let createTab :: (TileKind -> Bool) -> A.UArray (Kind.Id TileKind) Bool
createTab p =
let f _ k acc = p k : acc
clearAssocs = ofoldrWithKey f []
in A.listArray obounds clearAssocs
tabulate :: (TileKind -> Bool) -> Kind.Id TileKind -> Bool
tabulate p = (createTab p A.!)
isClearTab | allClear = tabulate $ not . kindHasFeature F.Impenetrable
| otherwise = tabulate $ kindHasFeature F.Clear
isLitTab = tabulate $ kindHasFeature F.Lit
in Kind.TileSpeedup {isClearTab, isLitTab}
changeTo :: Kind.Ops TileKind -> Kind.Id TileKind -> Rnd (Kind.Id TileKind)
changeTo Kind.Ops{okind, opick} t =
let getTo (F.ChangeTo group) _ = Just group
getTo _ acc = acc
in case foldr getTo Nothing (tfeature (okind t)) of
Nothing -> return t
Just group -> opick group (const True)
hiddenAs :: Kind.Ops TileKind -> Kind.Id TileKind -> Kind.Id TileKind
hiddenAs Kind.Ops{okind, ouniqGroup} t =
let getTo (F.HiddenAs group) _ = Just group
getTo _ acc = acc
in case foldr getTo Nothing (tfeature (okind t)) of
Nothing -> t
Just group -> ouniqGroup group