{-# LANGUAGE FlexibleContexts #-}
module Game.LambdaHack.Common.Tile
( kindHasFeature, hasFeature, isClear, isLit, isWalkable, isDoor, isChangable
, isSuspect, isHideAs, consideredByAI, isExplorable
, isOftenItem, isOftenActor, isNoItem, isNoActor, isEasyOpen
, speedup, alterMinSkill, alterMinWalk
, openTo, closeTo, embeddedItems, revealAs, obscureAs, hideAs, buildAs
, isEasyOpenKind, isOpenable, isClosable
#ifdef EXPOSE_INTERNAL
, createTab, createTabWithKey, accessTab
#endif
) where
import Prelude ()
import Game.LambdaHack.Common.Prelude
import qualified Data.Vector.Unboxed as U
import Data.Word (Word8)
import qualified Game.LambdaHack.Common.Kind as Kind
import Game.LambdaHack.Common.Misc
import Game.LambdaHack.Common.Random
import Game.LambdaHack.Content.ItemKind (ItemKind)
import Game.LambdaHack.Content.TileKind (TileKind, TileSpeedup (..),
isUknownSpace)
import qualified Game.LambdaHack.Content.TileKind as TK
createTab :: U.Unbox a => Kind.Ops TileKind -> (TileKind -> a) -> TK.Tab a
createTab Kind.Ops{ofoldrWithKey, olength} prop =
let f _ t acc = prop t : acc
in TK.Tab $ U.fromListN (fromEnum olength) $ ofoldrWithKey f []
createTabWithKey :: U.Unbox a
=> Kind.Ops TileKind -> (Kind.Id TileKind -> TileKind -> a)
-> TK.Tab a
createTabWithKey Kind.Ops{ofoldrWithKey, olength} prop =
let f k t acc = prop k t : acc
in TK.Tab $ U.fromListN (fromEnum olength) $ ofoldrWithKey f []
accessTab :: U.Unbox a => TK.Tab a -> Kind.Id TileKind -> a
{-# INLINE accessTab #-}
accessTab (TK.Tab tab) ki = tab `U.unsafeIndex` fromEnum ki
kindHasFeature :: TK.Feature -> TileKind -> Bool
{-# INLINE kindHasFeature #-}
kindHasFeature f t = f `elem` TK.tfeature t
hasFeature :: Kind.Ops TileKind -> TK.Feature -> Kind.Id TileKind -> Bool
{-# INLINE hasFeature #-}
hasFeature Kind.Ops{okind} f t = kindHasFeature f (okind t)
isClear :: TileSpeedup -> Kind.Id TileKind -> Bool
{-# INLINE isClear #-}
isClear TileSpeedup{isClearTab} = accessTab isClearTab
isLit :: TileSpeedup -> Kind.Id TileKind -> Bool
{-# INLINE isLit #-}
isLit TileSpeedup{isLitTab} = accessTab isLitTab
isWalkable :: TileSpeedup -> Kind.Id TileKind -> Bool
{-# INLINE isWalkable #-}
isWalkable TileSpeedup{isWalkableTab} = accessTab isWalkableTab
isDoor :: TileSpeedup -> Kind.Id TileKind -> Bool
{-# INLINE isDoor #-}
isDoor TileSpeedup{isDoorTab} = accessTab isDoorTab
isChangable :: TileSpeedup -> Kind.Id TileKind -> Bool
{-# INLINE isChangable #-}
isChangable TileSpeedup{isChangableTab} = accessTab isChangableTab
isSuspect :: TileSpeedup -> Kind.Id TileKind -> Bool
{-# INLINE isSuspect #-}
isSuspect TileSpeedup{isSuspectTab} = accessTab isSuspectTab
isHideAs :: TileSpeedup -> Kind.Id TileKind -> Bool
{-# INLINE isHideAs #-}
isHideAs TileSpeedup{isHideAsTab} = accessTab isHideAsTab
consideredByAI :: TileSpeedup -> Kind.Id TileKind -> Bool
{-# INLINE consideredByAI #-}
consideredByAI TileSpeedup{consideredByAITab} = accessTab consideredByAITab
isOftenItem :: TileSpeedup -> Kind.Id TileKind -> Bool
{-# INLINE isOftenItem #-}
isOftenItem TileSpeedup{isOftenItemTab} = accessTab isOftenItemTab
isOftenActor:: TileSpeedup -> Kind.Id TileKind -> Bool
{-# INLINE isOftenActor #-}
isOftenActor TileSpeedup{isOftenActorTab} = accessTab isOftenActorTab
isNoItem :: TileSpeedup -> Kind.Id TileKind -> Bool
{-# INLINE isNoItem #-}
isNoItem TileSpeedup{isNoItemTab} = accessTab isNoItemTab
isNoActor :: TileSpeedup -> Kind.Id TileKind -> Bool
{-# INLINE isNoActor #-}
isNoActor TileSpeedup{isNoActorTab} = accessTab isNoActorTab
isEasyOpen :: TileSpeedup -> Kind.Id TileKind -> Bool
{-# INLINE isEasyOpen #-}
isEasyOpen TileSpeedup{isEasyOpenTab} = accessTab isEasyOpenTab
alterMinSkill :: TileSpeedup -> Kind.Id TileKind -> Int
{-# INLINE alterMinSkill #-}
alterMinSkill TileSpeedup{alterMinSkillTab} =
fromEnum . accessTab alterMinSkillTab
alterMinWalk :: TileSpeedup -> Kind.Id TileKind -> Int
{-# INLINE alterMinWalk #-}
alterMinWalk TileSpeedup{alterMinWalkTab} =
fromEnum . accessTab alterMinWalkTab
isExplorable :: TileSpeedup -> Kind.Id TileKind -> Bool
isExplorable coTileSpeedup t =
(isWalkable coTileSpeedup t || isClear coTileSpeedup t)
&& not (isDoor coTileSpeedup t)
speedup :: Bool -> Kind.Ops TileKind -> TileSpeedup
speedup allClear cotile =
let isClearTab | allClear = createTab cotile
$ not . (== maxBound) . TK.talter
| otherwise = createTab cotile
$ kindHasFeature TK.Clear
isLitTab = createTab cotile $ not . kindHasFeature TK.Dark
isWalkableTab = createTab cotile $ kindHasFeature TK.Walkable
isDoorTab = createTab cotile $ \tk ->
let getTo TK.OpenTo{} = True
getTo TK.CloseTo{} = True
getTo _ = False
in any getTo $ TK.tfeature tk
isChangableTab = createTab cotile $ \tk ->
let getTo TK.ChangeTo{} = True
getTo _ = False
in any getTo $ TK.tfeature tk
isSuspectTab = createTab cotile TK.isSuspectKind
isHideAsTab = createTab cotile $ \tk ->
let getTo TK.HideAs{} = True
getTo _ = False
in any getTo $ TK.tfeature tk
consideredByAITab = createTab cotile $ kindHasFeature TK.ConsideredByAI
isOftenItemTab = createTab cotile $ kindHasFeature TK.OftenItem
isOftenActorTab = createTab cotile $ kindHasFeature TK.OftenActor
isNoItemTab = createTab cotile $ kindHasFeature TK.NoItem
isNoActorTab = createTab cotile $ kindHasFeature TK.NoActor
isEasyOpenTab = createTab cotile isEasyOpenKind
alterMinSkillTab = createTabWithKey cotile alterMinSkillKind
alterMinWalkTab = createTabWithKey cotile alterMinWalkKind
in TileSpeedup {..}
alterMinSkillKind :: Kind.Id TileKind -> TileKind -> Word8
alterMinSkillKind _k tk =
let getTo TK.OpenTo{} = True
getTo TK.CloseTo{} = True
getTo TK.ChangeTo{} = True
getTo TK.HideAs{} = True
getTo TK.RevealAs{} = True
getTo TK.ObscureAs{} = True
getTo TK.Embed{} = True
getTo TK.ConsideredByAI = True
getTo _ = False
in if any getTo $ TK.tfeature tk then TK.talter tk else maxBound
alterMinWalkKind :: Kind.Id TileKind -> TileKind -> Word8
alterMinWalkKind k tk =
let getTo TK.OpenTo{} = True
getTo TK.RevealAs{} = True
getTo TK.ObscureAs{} = True
getTo _ = False
in if | kindHasFeature TK.Walkable tk -> 0
| isUknownSpace k -> TK.talter tk
| any getTo $ TK.tfeature tk -> TK.talter tk
| otherwise -> maxBound
openTo :: Kind.Ops TileKind -> Kind.Id TileKind -> Rnd (Kind.Id TileKind)
openTo Kind.Ops{okind, opick} t = do
let getTo (TK.OpenTo grp) acc = grp : acc
getTo _ acc = acc
case foldr getTo [] $ TK.tfeature $ okind t of
[grp] -> fromMaybe (assert `failure` grp) <$> opick grp (const True)
_ -> return t
closeTo :: Kind.Ops TileKind -> Kind.Id TileKind -> Rnd (Kind.Id TileKind)
closeTo Kind.Ops{okind, opick} t = do
let getTo (TK.CloseTo grp) acc = grp : acc
getTo _ acc = acc
case foldr getTo [] $ TK.tfeature $ okind t of
[grp] -> fromMaybe (assert `failure` grp) <$> opick grp (const True)
_ -> return t
embeddedItems :: Kind.Ops TileKind -> Kind.Id TileKind -> [GroupName ItemKind]
embeddedItems Kind.Ops{okind} t =
let getTo (TK.Embed eff) acc = eff : acc
getTo _ acc = acc
in foldr getTo [] $ TK.tfeature $ okind t
revealAs :: Kind.Ops TileKind -> Kind.Id TileKind -> Rnd (Kind.Id TileKind)
revealAs Kind.Ops{okind, opick} t = do
let getTo (TK.RevealAs grp) acc = grp : acc
getTo _ acc = acc
case foldr getTo [] $ TK.tfeature $ okind t of
[] -> return t
groups -> do
grp <- oneOf groups
fromMaybe (assert `failure` grp) <$> opick grp (const True)
obscureAs :: Kind.Ops TileKind -> Kind.Id TileKind -> Rnd (Kind.Id TileKind)
obscureAs Kind.Ops{okind, opick} t = do
let getTo (TK.ObscureAs grp) acc = grp : acc
getTo _ acc = acc
case foldr getTo [] $ TK.tfeature $ okind t of
[] -> return t
groups -> do
grp <- oneOf groups
fromMaybe (assert `failure` grp) <$> opick grp (const True)
hideAs :: Kind.Ops TileKind -> Kind.Id TileKind -> Kind.Id TileKind
hideAs Kind.Ops{okind, ouniqGroup} t =
let getTo TK.HideAs{} = True
getTo _ = False
in case find getTo $ TK.tfeature $ okind t of
Just (TK.HideAs grp) -> ouniqGroup grp
_ -> t
buildAs :: Kind.Ops TileKind -> Kind.Id TileKind -> Kind.Id TileKind
buildAs Kind.Ops{okind, ouniqGroup} t =
let getTo TK.BuildAs{} = True
getTo _ = False
in case find getTo $ TK.tfeature $ okind t of
Just (TK.BuildAs grp) -> ouniqGroup grp
_ -> t
isEasyOpenKind :: TileKind -> Bool
isEasyOpenKind tk =
let getTo TK.OpenTo{} = True
getTo TK.Walkable = True
getTo _ = False
in TK.talter tk < 10 && any getTo (TK.tfeature tk)
isOpenable :: Kind.Ops TileKind -> Kind.Id TileKind -> Bool
isOpenable Kind.Ops{okind} t = TK.isOpenableKind $ okind t
isClosable :: Kind.Ops TileKind -> Kind.Id TileKind -> Bool
isClosable Kind.Ops{okind} t = TK.isClosableKind $ okind t