module Game.LambdaHack.Common.Tile
(
speedupTile
, isClear, isLit, isWalkable, isDoor, isChangable
, isSuspect, isHideAs, consideredByAI, isExplorable
, isVeryOftenItem, isCommonItem, isOftenActor, isNoItem, isNoActor
, isEasyOpen, isEmbed, isAquatic, alterMinSkill, alterMinWalk
, kindHasFeature, hasFeature, openTo, closeTo, embeddedItems, revealAs
, obscureAs, hideAs, buildAs
, isEasyOpenKind, isOpenable, isClosable, isModifiable
#ifdef EXPOSE_INTERNAL
, createTab, createTabWithKey, accessTab, alterMinSkillKind, alterMinWalkKind
#endif
) where
import Prelude ()
import Game.LambdaHack.Core.Prelude
import qualified Data.Vector.Unboxed as U
import Data.Word (Word8)
import Game.LambdaHack.Common.Kind
import Game.LambdaHack.Content.ItemKind (ItemKind)
import Game.LambdaHack.Content.TileKind (TileKind, isUknownSpace)
import qualified Game.LambdaHack.Content.TileKind as TK
import Game.LambdaHack.Core.Random
import Game.LambdaHack.Definition.Defs
createTab :: U.Unbox a => ContentData TileKind -> (TileKind -> a) -> Tab a
createTab cotile prop = Tab $ U.convert $ omapVector cotile prop
createTabWithKey :: U.Unbox a
=> ContentData TileKind
-> (ContentId TileKind -> TileKind -> a)
-> Tab a
createTabWithKey cotile prop = Tab $ U.convert $ oimapVector cotile prop
accessTab :: U.Unbox a => Tab a -> ContentId TileKind -> a
{-# INLINE accessTab #-}
accessTab (Tab tab) ki = tab `U.unsafeIndex` contentIdIndex ki
speedupTile :: Bool -> ContentData TileKind -> TileSpeedup
speedupTile 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
isVeryOftenItemTab = createTab cotile $ kindHasFeature TK.VeryOftenItem
isCommonItemTab = createTab cotile $ \tk ->
kindHasFeature TK.OftenItem tk || kindHasFeature TK.VeryOftenItem tk
isOftenActorTab = createTab cotile $ kindHasFeature TK.OftenActor
isNoItemTab = createTab cotile $ kindHasFeature TK.NoItem
isNoActorTab = createTab cotile $ kindHasFeature TK.NoActor
isEasyOpenTab = createTab cotile isEasyOpenKind
isEmbedTab = createTab cotile $ \tk ->
let getTo TK.Embed{} = True
getTo _ = False
in any getTo $ TK.tfeature tk
isAquaticTab = createTab cotile $ \tk ->
maybe False (> 0) $ lookup "aquatic" $ TK.tfreq tk
alterMinSkillTab = createTabWithKey cotile alterMinSkillKind
alterMinWalkTab = createTabWithKey cotile alterMinWalkKind
in TileSpeedup {..}
alterMinSkillKind :: ContentId 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 :: ContentId 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
isClear :: TileSpeedup -> ContentId TileKind -> Bool
{-# INLINE isClear #-}
isClear TileSpeedup{isClearTab} = accessTab isClearTab
isLit :: TileSpeedup -> ContentId TileKind -> Bool
{-# INLINE isLit #-}
isLit TileSpeedup{isLitTab} = accessTab isLitTab
isWalkable :: TileSpeedup -> ContentId TileKind -> Bool
{-# INLINE isWalkable #-}
isWalkable TileSpeedup{isWalkableTab} = accessTab isWalkableTab
isDoor :: TileSpeedup -> ContentId TileKind -> Bool
{-# INLINE isDoor #-}
isDoor TileSpeedup{isDoorTab} = accessTab isDoorTab
isChangable :: TileSpeedup -> ContentId TileKind -> Bool
{-# INLINE isChangable #-}
isChangable TileSpeedup{isChangableTab} = accessTab isChangableTab
isSuspect :: TileSpeedup -> ContentId TileKind -> Bool
{-# INLINE isSuspect #-}
isSuspect TileSpeedup{isSuspectTab} = accessTab isSuspectTab
isHideAs :: TileSpeedup -> ContentId TileKind -> Bool
{-# INLINE isHideAs #-}
isHideAs TileSpeedup{isHideAsTab} = accessTab isHideAsTab
consideredByAI :: TileSpeedup -> ContentId TileKind -> Bool
{-# INLINE consideredByAI #-}
consideredByAI TileSpeedup{consideredByAITab} = accessTab consideredByAITab
isExplorable :: TileSpeedup -> ContentId TileKind -> Bool
isExplorable coTileSpeedup t =
isWalkable coTileSpeedup t && not (isDoor coTileSpeedup t)
isVeryOftenItem :: TileSpeedup -> ContentId TileKind -> Bool
{-# INLINE isVeryOftenItem #-}
isVeryOftenItem TileSpeedup{isVeryOftenItemTab} = accessTab isVeryOftenItemTab
isCommonItem :: TileSpeedup -> ContentId TileKind -> Bool
{-# INLINE isCommonItem #-}
isCommonItem TileSpeedup{isCommonItemTab} = accessTab isCommonItemTab
isOftenActor :: TileSpeedup -> ContentId TileKind -> Bool
{-# INLINE isOftenActor #-}
isOftenActor TileSpeedup{isOftenActorTab} = accessTab isOftenActorTab
isNoItem :: TileSpeedup -> ContentId TileKind -> Bool
{-# INLINE isNoItem #-}
isNoItem TileSpeedup{isNoItemTab} = accessTab isNoItemTab
isNoActor :: TileSpeedup -> ContentId TileKind -> Bool
{-# INLINE isNoActor #-}
isNoActor TileSpeedup{isNoActorTab} = accessTab isNoActorTab
isEasyOpen :: TileSpeedup -> ContentId TileKind -> Bool
{-# INLINE isEasyOpen #-}
isEasyOpen TileSpeedup{isEasyOpenTab} = accessTab isEasyOpenTab
isEmbed :: TileSpeedup -> ContentId TileKind -> Bool
{-# INLINE isEmbed #-}
isEmbed TileSpeedup{isEmbedTab} = accessTab isEmbedTab
isAquatic :: TileSpeedup -> ContentId TileKind -> Bool
{-# INLINE isAquatic #-}
isAquatic TileSpeedup{isAquaticTab} = accessTab isAquaticTab
alterMinSkill :: TileSpeedup -> ContentId TileKind -> Int
{-# INLINE alterMinSkill #-}
alterMinSkill TileSpeedup{alterMinSkillTab} =
fromEnum . accessTab alterMinSkillTab
alterMinWalk :: TileSpeedup -> ContentId TileKind -> Int
{-# INLINE alterMinWalk #-}
alterMinWalk TileSpeedup{alterMinWalkTab} =
fromEnum . accessTab alterMinWalkTab
kindHasFeature :: TK.Feature -> TileKind -> Bool
{-# INLINE kindHasFeature #-}
kindHasFeature f t = f `elem` TK.tfeature t
hasFeature :: ContentData TileKind -> TK.Feature -> ContentId TileKind -> Bool
{-# INLINE hasFeature #-}
hasFeature cotile f t = kindHasFeature f (okind cotile t)
openTo :: ContentData TileKind -> ContentId TileKind -> Rnd (ContentId TileKind)
openTo cotile t = do
let getTo (TK.OpenTo grp) acc = grp : acc
getTo _ acc = acc
case foldr getTo [] $ TK.tfeature $ okind cotile t of
[grp] -> fromMaybe (error $ "" `showFailure` grp)
<$> opick cotile grp (const True)
_ -> return t
closeTo :: ContentData TileKind -> ContentId TileKind
-> Rnd (ContentId TileKind)
closeTo cotile t = do
let getTo (TK.CloseTo grp) acc = grp : acc
getTo _ acc = acc
case foldr getTo [] $ TK.tfeature $ okind cotile t of
[grp] -> fromMaybe (error $ "" `showFailure` grp)
<$> opick cotile grp (const True)
_ -> return t
embeddedItems :: ContentData TileKind -> ContentId TileKind
-> [GroupName ItemKind]
embeddedItems cotile t =
let getTo (TK.Embed igrp) acc = igrp : acc
getTo _ acc = acc
in foldr getTo [] $ TK.tfeature $ okind cotile t
revealAs :: ContentData TileKind -> ContentId TileKind
-> Rnd (ContentId TileKind)
revealAs cotile t = do
let getTo (TK.RevealAs grp) acc = grp : acc
getTo _ acc = acc
case foldr getTo [] $ TK.tfeature $ okind cotile t of
[] -> return t
groups -> do
grp <- oneOf groups
fromMaybe (error $ "" `showFailure` grp) <$> opick cotile grp (const True)
obscureAs :: ContentData TileKind -> ContentId TileKind
-> Rnd (ContentId TileKind)
obscureAs cotile t = do
let getTo (TK.ObscureAs grp) acc = grp : acc
getTo _ acc = acc
case foldr getTo [] $ TK.tfeature $ okind cotile $ buildAs cotile t of
[] -> return t
groups -> do
grp <- oneOf groups
fromMaybe (error $ "" `showFailure` grp) <$> opick cotile grp (const True)
hideAs :: ContentData TileKind -> ContentId TileKind
-> Maybe (ContentId TileKind)
hideAs cotile t =
let getTo TK.HideAs{} = True
getTo _ = False
in case find getTo $ TK.tfeature $ okind cotile t of
Just (TK.HideAs grp) ->
let tHidden = ouniqGroup cotile grp
in assert (tHidden /= t) $ Just tHidden
_ -> Nothing
buildAs :: ContentData TileKind -> ContentId TileKind -> ContentId TileKind
buildAs cotile t =
let getTo TK.BuildAs{} = True
getTo _ = False
in case find getTo $ TK.tfeature $ okind cotile t of
Just (TK.BuildAs grp) -> ouniqGroup cotile 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 :: ContentData TileKind -> ContentId TileKind -> Bool
isOpenable cotile t = TK.isOpenableKind $ okind cotile t
isClosable :: ContentData TileKind -> ContentId TileKind -> Bool
isClosable cotile t = TK.isClosableKind $ okind cotile t
isModifiable :: TileSpeedup -> ContentId TileKind -> Bool
isModifiable coTileSpeedup t = isDoor coTileSpeedup t
|| isChangable coTileSpeedup t
|| isSuspect coTileSpeedup t