-- | Operations concerning dungeon level tiles.
--
-- Unlike for many other content types, there is no type @Tile@,
-- of particular concrete tiles in the dungeon,
-- corresponding to 'TileKind' (the type of kinds of terrain tiles).
-- This is because the tiles are too numerous and there's not enough
-- storage space for a well-rounded @Tile@ type, on one hand,
-- and on the other hand, tiles are accessed
-- too often in performance critical code
-- to try to compress their representation and/or recompute them.
-- Instead, of defining a @Tile@ type, we express various properties
-- of concrete tiles by arrays or sparse EnumMaps, as appropriate.
--
-- Actors at normal speed (2 m/s) take one turn to move one tile (1 m by 1 m).
module Game.LambdaHack.Common.Tile
  ( -- * Tile property lookup speedup tables and their construction
    TileSpeedup(..), Tab(..), speedupTile
    -- * Speedup property lookups
  , isClear, isLit, isHideout, isWalkable, isDoor, isChangable
  , isSuspect, isHideAs, consideredByAI, isExplorable
  , isVeryOftenItem, isCommonItem, isOftenActor, isNoItem, isNoActor
  , isEasyOpen, isEmbed, isAquatic, alterMinSkill, alterMinWalk
    -- * Slow property lookups
  , kindHasFeature, openTo, closeTo, embeddedItems, revealAs
  , obscureAs, hideAs, buildAs
  , isEasyOpenKind, isOpenable, isClosable, isModifiable
#ifdef EXPOSE_INTERNAL
    -- * Internal operations
  , 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.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.ContentData
import           Game.LambdaHack.Definition.Defs

-- | A lot of tabulated maps from tile kind identifier to a property
-- of the tile kind.
data TileSpeedup = TileSpeedup
  { TileSpeedup -> Tab Bool
isClearTab          :: Tab Bool
  , TileSpeedup -> Tab Bool
isLitTab            :: Tab Bool
  , TileSpeedup -> Tab Bool
isHideoutTab        :: Tab Bool
  , TileSpeedup -> Tab Bool
isWalkableTab       :: Tab Bool
  , TileSpeedup -> Tab Bool
isDoorTab           :: Tab Bool
  , TileSpeedup -> Tab Bool
isOpenableTab       :: Tab Bool
  , TileSpeedup -> Tab Bool
isClosableTab       :: Tab Bool
  , TileSpeedup -> Tab Bool
isChangableTab      :: Tab Bool
  , TileSpeedup -> Tab Bool
isModifiableWithTab :: Tab Bool
  , TileSpeedup -> Tab Bool
isSuspectTab        :: Tab Bool
  , TileSpeedup -> Tab Bool
isHideAsTab         :: Tab Bool
  , TileSpeedup -> Tab Bool
consideredByAITab   :: Tab Bool
  , TileSpeedup -> Tab Bool
isVeryOftenItemTab  :: Tab Bool
  , TileSpeedup -> Tab Bool
isCommonItemTab     :: Tab Bool
  , TileSpeedup -> Tab Bool
isOftenActorTab     :: Tab Bool
  , TileSpeedup -> Tab Bool
isNoItemTab         :: Tab Bool
  , TileSpeedup -> Tab Bool
isNoActorTab        :: Tab Bool
  , TileSpeedup -> Tab Bool
isEasyOpenTab       :: Tab Bool
  , TileSpeedup -> Tab Bool
isEmbedTab          :: Tab Bool
  , TileSpeedup -> Tab Bool
isAquaticTab        :: Tab Bool
  , TileSpeedup -> Tab Word8
alterMinSkillTab    :: Tab Word8
  , TileSpeedup -> Tab Word8
alterMinWalkTab     :: Tab Word8
  }

-- Vectors of booleans can be slower than arrays, because they are not packed,
-- but with growing cache sizes they may as well turn out faster at some point.
-- The advantage of vectors are exposed internals, in particular unsafe
-- indexing. Also, in JS, bool arrays are obviously not packed.
-- An option: https://github.com/Bodigrim/bitvec
-- | A map morally indexed by @ContentId TileKind@.
newtype Tab a = Tab (U.Vector a)

createTab :: U.Unbox a => ContentData TileKind -> (TileKind -> a) -> Tab a
createTab :: ContentData TileKind -> (TileKind -> a) -> Tab a
createTab ContentData TileKind
cotile TileKind -> a
prop = Vector a -> Tab a
forall a. Vector a -> Tab a
Tab (Vector a -> Tab a) -> Vector a -> Tab a
forall a b. (a -> b) -> a -> b
$ Vector a -> Vector a
forall (v :: * -> *) a (w :: * -> *).
(Vector v a, Vector w a) =>
v a -> w a
U.convert (Vector a -> Vector a) -> Vector a -> Vector a
forall a b. (a -> b) -> a -> b
$ ContentData TileKind -> (TileKind -> a) -> Vector a
forall a b. ContentData a -> (a -> b) -> Vector b
omapVector ContentData TileKind
cotile TileKind -> a
prop

createTabWithKey :: U.Unbox a
                 => ContentData TileKind
                 -> (ContentId TileKind -> TileKind -> a)
                 -> Tab a
createTabWithKey :: ContentData TileKind
-> (ContentId TileKind -> TileKind -> a) -> Tab a
createTabWithKey ContentData TileKind
cotile ContentId TileKind -> TileKind -> a
prop = Vector a -> Tab a
forall a. Vector a -> Tab a
Tab (Vector a -> Tab a) -> Vector a -> Tab a
forall a b. (a -> b) -> a -> b
$ Vector a -> Vector a
forall (v :: * -> *) a (w :: * -> *).
(Vector v a, Vector w a) =>
v a -> w a
U.convert (Vector a -> Vector a) -> Vector a -> Vector a
forall a b. (a -> b) -> a -> b
$ ContentData TileKind
-> (ContentId TileKind -> TileKind -> a) -> Vector a
forall a b. ContentData a -> (ContentId a -> a -> b) -> Vector b
oimapVector ContentData TileKind
cotile ContentId TileKind -> TileKind -> a
prop

-- Unsafe indexing is pretty safe here, because we guard the vector
-- with the newtype.
accessTab :: U.Unbox a => Tab a -> ContentId TileKind -> a
{-# INLINE accessTab #-}
accessTab :: Tab a -> ContentId TileKind -> a
accessTab (Tab Vector a
tab) ContentId TileKind
ki = Vector a
tab Vector a -> Int -> a
forall a. Unbox a => Vector a -> Int -> a
`vectorUnboxedUnsafeIndex` ContentId TileKind -> Int
forall c. ContentId c -> Int
contentIdIndex ContentId TileKind
ki

speedupTile :: Bool -> ContentData TileKind -> TileSpeedup
speedupTile :: Bool -> ContentData TileKind -> TileSpeedup
speedupTile Bool
allClear ContentData TileKind
cotile =
  -- Vectors pack bools as Word8 by default. No idea if the extra memory
  -- taken makes random lookups more or less efficient, so not optimizing
  -- further, until I have benchmarks.
  let isClearTab :: Tab Bool
isClearTab | Bool
allClear = ContentData TileKind -> (TileKind -> Bool) -> Tab Bool
forall a.
Unbox a =>
ContentData TileKind -> (TileKind -> a) -> Tab a
createTab ContentData TileKind
cotile ((TileKind -> Bool) -> Tab Bool) -> (TileKind -> Bool) -> Tab Bool
forall a b. (a -> b) -> a -> b
$ (Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
/= Word8
forall a. Bounded a => a
maxBound) (Word8 -> Bool) -> (TileKind -> Word8) -> TileKind -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TileKind -> Word8
TK.talter
                 | Bool
otherwise = ContentData TileKind -> (TileKind -> Bool) -> Tab Bool
forall a.
Unbox a =>
ContentData TileKind -> (TileKind -> a) -> Tab a
createTab ContentData TileKind
cotile ((TileKind -> Bool) -> Tab Bool) -> (TileKind -> Bool) -> Tab Bool
forall a b. (a -> b) -> a -> b
$ Feature -> TileKind -> Bool
kindHasFeature Feature
TK.Clear
      isLitTab :: Tab Bool
isLitTab = ContentData TileKind -> (TileKind -> Bool) -> Tab Bool
forall a.
Unbox a =>
ContentData TileKind -> (TileKind -> a) -> Tab a
createTab ContentData TileKind
cotile ((TileKind -> Bool) -> Tab Bool) -> (TileKind -> Bool) -> Tab Bool
forall a b. (a -> b) -> a -> b
$ Bool -> Bool
not (Bool -> Bool) -> (TileKind -> Bool) -> TileKind -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Feature -> TileKind -> Bool
kindHasFeature Feature
TK.Dark
      isHideoutTab :: Tab Bool
isHideoutTab = ContentData TileKind -> (TileKind -> Bool) -> Tab Bool
forall a.
Unbox a =>
ContentData TileKind -> (TileKind -> a) -> Tab a
createTab ContentData TileKind
cotile ((TileKind -> Bool) -> Tab Bool) -> (TileKind -> Bool) -> Tab Bool
forall a b. (a -> b) -> a -> b
$ \TileKind
tk ->
        Feature -> TileKind -> Bool
kindHasFeature Feature
TK.Walkable TileKind
tk  -- implies not unknown
        Bool -> Bool -> Bool
&& Feature -> TileKind -> Bool
kindHasFeature Feature
TK.Dark TileKind
tk
      isWalkableTab :: Tab Bool
isWalkableTab = ContentData TileKind -> (TileKind -> Bool) -> Tab Bool
forall a.
Unbox a =>
ContentData TileKind -> (TileKind -> a) -> Tab a
createTab ContentData TileKind
cotile ((TileKind -> Bool) -> Tab Bool) -> (TileKind -> Bool) -> Tab Bool
forall a b. (a -> b) -> a -> b
$ Feature -> TileKind -> Bool
kindHasFeature Feature
TK.Walkable
      isDoorTab :: Tab Bool
isDoorTab = ContentData TileKind -> (TileKind -> Bool) -> Tab Bool
forall a.
Unbox a =>
ContentData TileKind -> (TileKind -> a) -> Tab a
createTab ContentData TileKind
cotile ((TileKind -> Bool) -> Tab Bool) -> (TileKind -> Bool) -> Tab Bool
forall a b. (a -> b) -> a -> b
$ \TileKind
tk ->
        let getTo :: Feature -> [GroupName TileKind] -> [GroupName TileKind]
getTo (TK.OpenTo GroupName TileKind
grp) [GroupName TileKind]
acc = GroupName TileKind
grp GroupName TileKind -> [GroupName TileKind] -> [GroupName TileKind]
forall a. a -> [a] -> [a]
: [GroupName TileKind]
acc
            getTo Feature
_ [GroupName TileKind]
acc = [GroupName TileKind]
acc
        in case (Feature -> [GroupName TileKind] -> [GroupName TileKind])
-> [GroupName TileKind] -> [Feature] -> [GroupName TileKind]
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr Feature -> [GroupName TileKind] -> [GroupName TileKind]
getTo [] ([Feature] -> [GroupName TileKind])
-> [Feature] -> [GroupName TileKind]
forall a b. (a -> b) -> a -> b
$ TileKind -> [Feature]
TK.tfeature TileKind
tk of
          [GroupName TileKind
grp] | ContentData TileKind -> GroupName TileKind -> Bool
forall a. ContentData a -> GroupName a -> Bool
oisSingletonGroup ContentData TileKind
cotile GroupName TileKind
grp ->
            TileKind -> Bool
TK.isClosableKind (TileKind -> Bool) -> TileKind -> Bool
forall a b. (a -> b) -> a -> b
$ ContentData TileKind -> ContentId TileKind -> TileKind
forall a. ContentData a -> ContentId a -> a
okind ContentData TileKind
cotile (ContentId TileKind -> TileKind) -> ContentId TileKind -> TileKind
forall a b. (a -> b) -> a -> b
$ ContentData TileKind -> GroupName TileKind -> ContentId TileKind
forall a. Show a => ContentData a -> GroupName a -> ContentId a
ouniqGroup ContentData TileKind
cotile GroupName TileKind
grp
          [GroupName TileKind]
_ -> let getTo2 :: Feature -> [GroupName TileKind] -> [GroupName TileKind]
getTo2 (TK.CloseTo GroupName TileKind
grp) [GroupName TileKind]
acc = GroupName TileKind
grp GroupName TileKind -> [GroupName TileKind] -> [GroupName TileKind]
forall a. a -> [a] -> [a]
: [GroupName TileKind]
acc
                   getTo2 Feature
_ [GroupName TileKind]
acc = [GroupName TileKind]
acc
               in case (Feature -> [GroupName TileKind] -> [GroupName TileKind])
-> [GroupName TileKind] -> [Feature] -> [GroupName TileKind]
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr Feature -> [GroupName TileKind] -> [GroupName TileKind]
getTo2 [] ([Feature] -> [GroupName TileKind])
-> [Feature] -> [GroupName TileKind]
forall a b. (a -> b) -> a -> b
$ TileKind -> [Feature]
TK.tfeature TileKind
tk of
                 [GroupName TileKind
grp] | ContentData TileKind -> GroupName TileKind -> Bool
forall a. ContentData a -> GroupName a -> Bool
oisSingletonGroup ContentData TileKind
cotile GroupName TileKind
grp ->
                   TileKind -> Bool
TK.isOpenableKind (TileKind -> Bool) -> TileKind -> Bool
forall a b. (a -> b) -> a -> b
$ ContentData TileKind -> ContentId TileKind -> TileKind
forall a. ContentData a -> ContentId a -> a
okind ContentData TileKind
cotile (ContentId TileKind -> TileKind) -> ContentId TileKind -> TileKind
forall a b. (a -> b) -> a -> b
$ ContentData TileKind -> GroupName TileKind -> ContentId TileKind
forall a. Show a => ContentData a -> GroupName a -> ContentId a
ouniqGroup ContentData TileKind
cotile GroupName TileKind
grp
                 [GroupName TileKind]
_ -> Bool
False
      isOpenableTab :: Tab Bool
isOpenableTab = ContentData TileKind -> (TileKind -> Bool) -> Tab Bool
forall a.
Unbox a =>
ContentData TileKind -> (TileKind -> a) -> Tab a
createTab ContentData TileKind
cotile TileKind -> Bool
TK.isOpenableKind
      isClosableTab :: Tab Bool
isClosableTab = ContentData TileKind -> (TileKind -> Bool) -> Tab Bool
forall a.
Unbox a =>
ContentData TileKind -> (TileKind -> a) -> Tab a
createTab ContentData TileKind
cotile TileKind -> Bool
TK.isClosableKind
      isChangableTab :: Tab Bool
isChangableTab = ContentData TileKind -> (TileKind -> Bool) -> Tab Bool
forall a.
Unbox a =>
ContentData TileKind -> (TileKind -> a) -> Tab a
createTab ContentData TileKind
cotile ((TileKind -> Bool) -> Tab Bool) -> (TileKind -> Bool) -> Tab Bool
forall a b. (a -> b) -> a -> b
$ \TileKind
tk ->
        let getTo :: Feature -> Bool
getTo TK.ChangeTo{} = Bool
True
            getTo Feature
_ = Bool
False
        in (Feature -> Bool) -> [Feature] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any Feature -> Bool
getTo ([Feature] -> Bool) -> [Feature] -> Bool
forall a b. (a -> b) -> a -> b
$ TileKind -> [Feature]
TK.tfeature TileKind
tk
      isModifiableWithTab :: Tab Bool
isModifiableWithTab = ContentData TileKind -> (TileKind -> Bool) -> Tab Bool
forall a.
Unbox a =>
ContentData TileKind -> (TileKind -> a) -> Tab a
createTab ContentData TileKind
cotile ((TileKind -> Bool) -> Tab Bool) -> (TileKind -> Bool) -> Tab Bool
forall a b. (a -> b) -> a -> b
$ \TileKind
tk ->
        let getTo :: Feature -> Bool
getTo TK.OpenWith{} = Bool
True
            getTo TK.CloseWith{} = Bool
True
            getTo TK.ChangeWith{} = Bool
True
            getTo Feature
_ = Bool
False
        in (Feature -> Bool) -> [Feature] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any Feature -> Bool
getTo ([Feature] -> Bool) -> [Feature] -> Bool
forall a b. (a -> b) -> a -> b
$ TileKind -> [Feature]
TK.tfeature TileKind
tk
      isSuspectTab :: Tab Bool
isSuspectTab = ContentData TileKind -> (TileKind -> Bool) -> Tab Bool
forall a.
Unbox a =>
ContentData TileKind -> (TileKind -> a) -> Tab a
createTab ContentData TileKind
cotile TileKind -> Bool
TK.isSuspectKind
      isHideAsTab :: Tab Bool
isHideAsTab = ContentData TileKind -> (TileKind -> Bool) -> Tab Bool
forall a.
Unbox a =>
ContentData TileKind -> (TileKind -> a) -> Tab a
createTab ContentData TileKind
cotile ((TileKind -> Bool) -> Tab Bool) -> (TileKind -> Bool) -> Tab Bool
forall a b. (a -> b) -> a -> b
$ \TileKind
tk ->
        let getTo :: Feature -> Bool
getTo TK.HideAs{} = Bool
True
            getTo Feature
_ = Bool
False
        in (Feature -> Bool) -> [Feature] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any Feature -> Bool
getTo ([Feature] -> Bool) -> [Feature] -> Bool
forall a b. (a -> b) -> a -> b
$ TileKind -> [Feature]
TK.tfeature TileKind
tk
      consideredByAITab :: Tab Bool
consideredByAITab = ContentData TileKind -> (TileKind -> Bool) -> Tab Bool
forall a.
Unbox a =>
ContentData TileKind -> (TileKind -> a) -> Tab a
createTab ContentData TileKind
cotile ((TileKind -> Bool) -> Tab Bool) -> (TileKind -> Bool) -> Tab Bool
forall a b. (a -> b) -> a -> b
$ Feature -> TileKind -> Bool
kindHasFeature Feature
TK.ConsideredByAI
      isVeryOftenItemTab :: Tab Bool
isVeryOftenItemTab = ContentData TileKind -> (TileKind -> Bool) -> Tab Bool
forall a.
Unbox a =>
ContentData TileKind -> (TileKind -> a) -> Tab a
createTab ContentData TileKind
cotile ((TileKind -> Bool) -> Tab Bool) -> (TileKind -> Bool) -> Tab Bool
forall a b. (a -> b) -> a -> b
$ Feature -> TileKind -> Bool
kindHasFeature Feature
TK.VeryOftenItem
      isCommonItemTab :: Tab Bool
isCommonItemTab = ContentData TileKind -> (TileKind -> Bool) -> Tab Bool
forall a.
Unbox a =>
ContentData TileKind -> (TileKind -> a) -> Tab a
createTab ContentData TileKind
cotile ((TileKind -> Bool) -> Tab Bool) -> (TileKind -> Bool) -> Tab Bool
forall a b. (a -> b) -> a -> b
$ \TileKind
tk ->
        Feature -> TileKind -> Bool
kindHasFeature Feature
TK.OftenItem TileKind
tk Bool -> Bool -> Bool
|| Feature -> TileKind -> Bool
kindHasFeature Feature
TK.VeryOftenItem TileKind
tk
      isOftenActorTab :: Tab Bool
isOftenActorTab = ContentData TileKind -> (TileKind -> Bool) -> Tab Bool
forall a.
Unbox a =>
ContentData TileKind -> (TileKind -> a) -> Tab a
createTab ContentData TileKind
cotile ((TileKind -> Bool) -> Tab Bool) -> (TileKind -> Bool) -> Tab Bool
forall a b. (a -> b) -> a -> b
$ Feature -> TileKind -> Bool
kindHasFeature Feature
TK.OftenActor
      isNoItemTab :: Tab Bool
isNoItemTab = ContentData TileKind -> (TileKind -> Bool) -> Tab Bool
forall a.
Unbox a =>
ContentData TileKind -> (TileKind -> a) -> Tab a
createTab ContentData TileKind
cotile ((TileKind -> Bool) -> Tab Bool) -> (TileKind -> Bool) -> Tab Bool
forall a b. (a -> b) -> a -> b
$ Feature -> TileKind -> Bool
kindHasFeature Feature
TK.NoItem
      isNoActorTab :: Tab Bool
isNoActorTab = ContentData TileKind -> (TileKind -> Bool) -> Tab Bool
forall a.
Unbox a =>
ContentData TileKind -> (TileKind -> a) -> Tab a
createTab ContentData TileKind
cotile ((TileKind -> Bool) -> Tab Bool) -> (TileKind -> Bool) -> Tab Bool
forall a b. (a -> b) -> a -> b
$ Feature -> TileKind -> Bool
kindHasFeature Feature
TK.NoActor
      isEasyOpenTab :: Tab Bool
isEasyOpenTab = ContentData TileKind -> (TileKind -> Bool) -> Tab Bool
forall a.
Unbox a =>
ContentData TileKind -> (TileKind -> a) -> Tab a
createTab ContentData TileKind
cotile TileKind -> Bool
isEasyOpenKind
      isEmbedTab :: Tab Bool
isEmbedTab = ContentData TileKind -> (TileKind -> Bool) -> Tab Bool
forall a.
Unbox a =>
ContentData TileKind -> (TileKind -> a) -> Tab a
createTab ContentData TileKind
cotile ((TileKind -> Bool) -> Tab Bool) -> (TileKind -> Bool) -> Tab Bool
forall a b. (a -> b) -> a -> b
$ \TileKind
tk ->
        let getTo :: Feature -> Bool
getTo TK.Embed{} = Bool
True
            getTo Feature
_ = Bool
False
        in (Feature -> Bool) -> [Feature] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any Feature -> Bool
getTo ([Feature] -> Bool) -> [Feature] -> Bool
forall a b. (a -> b) -> a -> b
$ TileKind -> [Feature]
TK.tfeature TileKind
tk
      isAquaticTab :: Tab Bool
isAquaticTab = ContentData TileKind -> (TileKind -> Bool) -> Tab Bool
forall a.
Unbox a =>
ContentData TileKind -> (TileKind -> a) -> Tab a
createTab ContentData TileKind
cotile ((TileKind -> Bool) -> Tab Bool) -> (TileKind -> Bool) -> Tab Bool
forall a b. (a -> b) -> a -> b
$ \TileKind
tk ->
        Bool -> (Int -> Bool) -> Maybe Int -> Bool
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Bool
False (Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
0) (Maybe Int -> Bool) -> Maybe Int -> Bool
forall a b. (a -> b) -> a -> b
$ GroupName TileKind -> [(GroupName TileKind, Int)] -> Maybe Int
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup GroupName TileKind
TK.AQUATIC ([(GroupName TileKind, Int)] -> Maybe Int)
-> [(GroupName TileKind, Int)] -> Maybe Int
forall a b. (a -> b) -> a -> b
$ TileKind -> [(GroupName TileKind, Int)]
TK.tfreq TileKind
tk
      alterMinSkillTab :: Tab Word8
alterMinSkillTab = ContentData TileKind
-> (ContentId TileKind -> TileKind -> Word8) -> Tab Word8
forall a.
Unbox a =>
ContentData TileKind
-> (ContentId TileKind -> TileKind -> a) -> Tab a
createTabWithKey ContentData TileKind
cotile ContentId TileKind -> TileKind -> Word8
alterMinSkillKind
      alterMinWalkTab :: Tab Word8
alterMinWalkTab = ContentData TileKind
-> (ContentId TileKind -> TileKind -> Word8) -> Tab Word8
forall a.
Unbox a =>
ContentData TileKind
-> (ContentId TileKind -> TileKind -> a) -> Tab a
createTabWithKey ContentData TileKind
cotile ContentId TileKind -> TileKind -> Word8
alterMinWalkKind
  in TileSpeedup :: Tab Bool
-> Tab Bool
-> Tab Bool
-> Tab Bool
-> Tab Bool
-> Tab Bool
-> Tab Bool
-> Tab Bool
-> Tab Bool
-> Tab Bool
-> Tab Bool
-> Tab Bool
-> Tab Bool
-> Tab Bool
-> Tab Bool
-> Tab Bool
-> Tab Bool
-> Tab Bool
-> Tab Bool
-> Tab Bool
-> Tab Word8
-> Tab Word8
-> TileSpeedup
TileSpeedup {Tab Bool
Tab Word8
alterMinWalkTab :: Tab Word8
alterMinSkillTab :: Tab Word8
isAquaticTab :: Tab Bool
isEmbedTab :: Tab Bool
isEasyOpenTab :: Tab Bool
isNoActorTab :: Tab Bool
isNoItemTab :: Tab Bool
isOftenActorTab :: Tab Bool
isCommonItemTab :: Tab Bool
isVeryOftenItemTab :: Tab Bool
consideredByAITab :: Tab Bool
isHideAsTab :: Tab Bool
isSuspectTab :: Tab Bool
isModifiableWithTab :: Tab Bool
isChangableTab :: Tab Bool
isClosableTab :: Tab Bool
isOpenableTab :: Tab Bool
isDoorTab :: Tab Bool
isWalkableTab :: Tab Bool
isHideoutTab :: Tab Bool
isLitTab :: Tab Bool
isClearTab :: Tab Bool
alterMinWalkTab :: Tab Word8
alterMinSkillTab :: Tab Word8
isAquaticTab :: Tab Bool
isEmbedTab :: Tab Bool
isEasyOpenTab :: Tab Bool
isNoActorTab :: Tab Bool
isNoItemTab :: Tab Bool
isOftenActorTab :: Tab Bool
isCommonItemTab :: Tab Bool
isVeryOftenItemTab :: Tab Bool
consideredByAITab :: Tab Bool
isHideAsTab :: Tab Bool
isSuspectTab :: Tab Bool
isModifiableWithTab :: Tab Bool
isChangableTab :: Tab Bool
isClosableTab :: Tab Bool
isOpenableTab :: Tab Bool
isDoorTab :: Tab Bool
isWalkableTab :: Tab Bool
isHideoutTab :: Tab Bool
isLitTab :: Tab Bool
isClearTab :: Tab Bool
..}

-- Check that alter can be used, if not, @maxBound@.
-- For now, we assume only items with @Embed@ may have embedded items,
-- whether inserted at dungeon creation or later on.
-- This is used by UI and server to validate (sensibility of) altering.
-- See the comment for @alterMinWalkKind@ regarding @HideAs@.
alterMinSkillKind :: ContentId TileKind -> TileKind -> Word8
alterMinSkillKind :: ContentId TileKind -> TileKind -> Word8
alterMinSkillKind ContentId TileKind
_k TileKind
tk =
  let getTo :: Feature -> Bool
getTo TK.OpenTo{} = Bool
True
      getTo TK.CloseTo{} = Bool
True
      getTo TK.ChangeTo{} = Bool
True
      getTo TK.OpenWith{} = Bool
True
      getTo TK.CloseWith{} = Bool
True
      getTo TK.ChangeWith{} = Bool
True
      getTo TK.HideAs{} = Bool
True  -- in case tile swapped, but server sends hidden
      getTo TK.RevealAs{} = Bool
True
      getTo TK.ObscureAs{} = Bool
True
      getTo TK.Embed{} = Bool
True
      getTo Feature
TK.ConsideredByAI = Bool
True
      getTo Feature
_ = Bool
False
  in if (Feature -> Bool) -> [Feature] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any Feature -> Bool
getTo ([Feature] -> Bool) -> [Feature] -> Bool
forall a b. (a -> b) -> a -> b
$ TileKind -> [Feature]
TK.tfeature TileKind
tk then TileKind -> Word8
TK.talter TileKind
tk else Word8
forall a. Bounded a => a
maxBound

-- How high alter skill is needed to make it walkable. If already
-- walkable, put @0@, if can't, put @maxBound@. Used only by AI and Bfs
-- We don't include @HideAs@, because it's very unlikely anybody swapped
-- the tile while AI was not looking so AI can assume it's still uninteresting.
-- Pathfinding in UI will also not show such tile as passable, which is OK.
-- If a human player has a suspicion the tile was swapped, he can check
-- it manually, disregarding the displayed path hints.
alterMinWalkKind :: ContentId TileKind -> TileKind -> Word8
alterMinWalkKind :: ContentId TileKind -> TileKind -> Word8
alterMinWalkKind ContentId TileKind
k TileKind
tk =
  let getTo :: Feature -> Bool
getTo TK.OpenTo{} = Bool
True
-- enable when AI and humans can cope with unreachable areas
--      getTo TK.OpenWith{} = True
--        -- opening this may not be possible, but AI has to try, for there may
--        -- be no other path
      getTo TK.RevealAs{} = Bool
True
      getTo TK.ObscureAs{} = Bool
True
      getTo Feature
_ = Bool
False
  in if | Feature -> TileKind -> Bool
kindHasFeature Feature
TK.Walkable TileKind
tk -> Word8
0
        | ContentId TileKind -> Bool
isUknownSpace ContentId TileKind
k -> TileKind -> Word8
TK.talter TileKind
tk
        | (Feature -> Bool) -> [Feature] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any Feature -> Bool
getTo ([Feature] -> Bool) -> [Feature] -> Bool
forall a b. (a -> b) -> a -> b
$ TileKind -> [Feature]
TK.tfeature TileKind
tk -> TileKind -> Word8
TK.talter TileKind
tk
        | Bool
otherwise -> Word8
forall a. Bounded a => a
maxBound

-- | Whether a tile does not block vision.
-- Essential for efficiency of "FOV", hence tabulated.
isClear :: TileSpeedup -> ContentId TileKind -> Bool
{-# INLINE isClear #-}
isClear :: TileSpeedup -> ContentId TileKind -> Bool
isClear TileSpeedup{Tab Bool
isClearTab :: Tab Bool
isClearTab :: TileSpeedup -> Tab Bool
isClearTab} = Tab Bool -> ContentId TileKind -> Bool
forall a. Unbox a => Tab a -> ContentId TileKind -> a
accessTab Tab Bool
isClearTab

-- | Whether a tile has ambient light --- is lit on its own.
-- Essential for efficiency of "Perception", hence tabulated.
isLit :: TileSpeedup -> ContentId TileKind -> Bool
{-# INLINE isLit #-}
isLit :: TileSpeedup -> ContentId TileKind -> Bool
isLit TileSpeedup{Tab Bool
isLitTab :: Tab Bool
isLitTab :: TileSpeedup -> Tab Bool
isLitTab} = Tab Bool -> ContentId TileKind -> Bool
forall a. Unbox a => Tab a -> ContentId TileKind -> a
accessTab Tab Bool
isLitTab

-- | Whether a tile is a good hideout: walkable and dark.
isHideout :: TileSpeedup -> ContentId TileKind -> Bool
{-# INLINE isHideout #-}
isHideout :: TileSpeedup -> ContentId TileKind -> Bool
isHideout TileSpeedup{Tab Bool
isHideoutTab :: Tab Bool
isHideoutTab :: TileSpeedup -> Tab Bool
isHideoutTab} = Tab Bool -> ContentId TileKind -> Bool
forall a. Unbox a => Tab a -> ContentId TileKind -> a
accessTab Tab Bool
isHideoutTab

-- | Whether actors can walk into a tile.
-- Essential for efficiency of pathfinding, hence tabulated.
isWalkable :: TileSpeedup -> ContentId TileKind -> Bool
{-# INLINE isWalkable #-}
isWalkable :: TileSpeedup -> ContentId TileKind -> Bool
isWalkable TileSpeedup{Tab Bool
isWalkableTab :: Tab Bool
isWalkableTab :: TileSpeedup -> Tab Bool
isWalkableTab} = Tab Bool -> ContentId TileKind -> Bool
forall a. Unbox a => Tab a -> ContentId TileKind -> a
accessTab Tab Bool
isWalkableTab

-- | Whether a tile is a door, open or closed.
-- Essential for efficiency of pathfinding, hence tabulated.
isDoor :: TileSpeedup -> ContentId TileKind -> Bool
{-# INLINE isDoor #-}
isDoor :: TileSpeedup -> ContentId TileKind -> Bool
isDoor TileSpeedup{Tab Bool
isDoorTab :: Tab Bool
isDoorTab :: TileSpeedup -> Tab Bool
isDoorTab} = Tab Bool -> ContentId TileKind -> Bool
forall a. Unbox a => Tab a -> ContentId TileKind -> a
accessTab Tab Bool
isDoorTab

-- | Whether a tile kind (specified by its id) has an @OpenTo@ feature.
isOpenable :: TileSpeedup -> ContentId TileKind -> Bool
{-# INLINE isOpenable #-}
isOpenable :: TileSpeedup -> ContentId TileKind -> Bool
isOpenable TileSpeedup{Tab Bool
isOpenableTab :: Tab Bool
isOpenableTab :: TileSpeedup -> Tab Bool
isOpenableTab} = Tab Bool -> ContentId TileKind -> Bool
forall a. Unbox a => Tab a -> ContentId TileKind -> a
accessTab Tab Bool
isOpenableTab

-- | Whether a tile kind (specified by its id) has a @CloseTo@ feature.
isClosable :: TileSpeedup -> ContentId TileKind -> Bool
{-# INLINE isClosable #-}
isClosable :: TileSpeedup -> ContentId TileKind -> Bool
isClosable TileSpeedup{Tab Bool
isClosableTab :: Tab Bool
isClosableTab :: TileSpeedup -> Tab Bool
isClosableTab} = Tab Bool -> ContentId TileKind -> Bool
forall a. Unbox a => Tab a -> ContentId TileKind -> a
accessTab Tab Bool
isClosableTab

-- | Whether a tile is changable.
isChangable :: TileSpeedup -> ContentId TileKind -> Bool
{-# INLINE isChangable #-}
isChangable :: TileSpeedup -> ContentId TileKind -> Bool
isChangable TileSpeedup{Tab Bool
isChangableTab :: Tab Bool
isChangableTab :: TileSpeedup -> Tab Bool
isChangableTab} = Tab Bool -> ContentId TileKind -> Bool
forall a. Unbox a => Tab a -> ContentId TileKind -> a
accessTab Tab Bool
isChangableTab

-- | Whether a tile is modifiable with some items.
isModifiableWith :: TileSpeedup -> ContentId TileKind -> Bool
{-# INLINE isModifiableWith #-}
isModifiableWith :: TileSpeedup -> ContentId TileKind -> Bool
isModifiableWith TileSpeedup{Tab Bool
isModifiableWithTab :: Tab Bool
isModifiableWithTab :: TileSpeedup -> Tab Bool
isModifiableWithTab} =
  Tab Bool -> ContentId TileKind -> Bool
forall a. Unbox a => Tab a -> ContentId TileKind -> a
accessTab Tab Bool
isModifiableWithTab

-- | Whether a tile is suspect.
-- Essential for efficiency of pathfinding, hence tabulated.
isSuspect :: TileSpeedup -> ContentId TileKind -> Bool
{-# INLINE isSuspect #-}
isSuspect :: TileSpeedup -> ContentId TileKind -> Bool
isSuspect TileSpeedup{Tab Bool
isSuspectTab :: Tab Bool
isSuspectTab :: TileSpeedup -> Tab Bool
isSuspectTab} = Tab Bool -> ContentId TileKind -> Bool
forall a. Unbox a => Tab a -> ContentId TileKind -> a
accessTab Tab Bool
isSuspectTab

isHideAs :: TileSpeedup -> ContentId TileKind -> Bool
{-# INLINE isHideAs #-}
isHideAs :: TileSpeedup -> ContentId TileKind -> Bool
isHideAs TileSpeedup{Tab Bool
isHideAsTab :: Tab Bool
isHideAsTab :: TileSpeedup -> Tab Bool
isHideAsTab} = Tab Bool -> ContentId TileKind -> Bool
forall a. Unbox a => Tab a -> ContentId TileKind -> a
accessTab Tab Bool
isHideAsTab

consideredByAI :: TileSpeedup -> ContentId TileKind -> Bool
{-# INLINE consideredByAI #-}
consideredByAI :: TileSpeedup -> ContentId TileKind -> Bool
consideredByAI TileSpeedup{Tab Bool
consideredByAITab :: Tab Bool
consideredByAITab :: TileSpeedup -> Tab Bool
consideredByAITab} = Tab Bool -> ContentId TileKind -> Bool
forall a. Unbox a => Tab a -> ContentId TileKind -> a
accessTab Tab Bool
consideredByAITab

-- | Whether one can easily explore a tile, possibly finding a treasure,
-- either spawned there or dropped there by a (dying from poison) foe.
-- Doors can't be explorable since revealing a secret tile
-- should not change it's explorable status. Also, door explorable status
-- should not depend on whether they are open or not, so that
-- a foe opening a door doesn't force us to backtrack to explore it.
-- Still, a foe that digs through a wall will affect our exploration counter
-- and if content lets walls contain threasure, such backtraking makes sense.
isExplorable :: TileSpeedup -> ContentId TileKind -> Bool
isExplorable :: TileSpeedup -> ContentId TileKind -> Bool
isExplorable TileSpeedup
coTileSpeedup ContentId TileKind
t =
  TileSpeedup -> ContentId TileKind -> Bool
isWalkable TileSpeedup
coTileSpeedup ContentId TileKind
t Bool -> Bool -> Bool
&& Bool -> Bool
not (TileSpeedup -> ContentId TileKind -> Bool
isDoor TileSpeedup
coTileSpeedup ContentId TileKind
t)

isVeryOftenItem :: TileSpeedup -> ContentId TileKind -> Bool
{-# INLINE isVeryOftenItem #-}
isVeryOftenItem :: TileSpeedup -> ContentId TileKind -> Bool
isVeryOftenItem TileSpeedup{Tab Bool
isVeryOftenItemTab :: Tab Bool
isVeryOftenItemTab :: TileSpeedup -> Tab Bool
isVeryOftenItemTab} = Tab Bool -> ContentId TileKind -> Bool
forall a. Unbox a => Tab a -> ContentId TileKind -> a
accessTab Tab Bool
isVeryOftenItemTab

isCommonItem :: TileSpeedup -> ContentId TileKind -> Bool
{-# INLINE isCommonItem #-}
isCommonItem :: TileSpeedup -> ContentId TileKind -> Bool
isCommonItem TileSpeedup{Tab Bool
isCommonItemTab :: Tab Bool
isCommonItemTab :: TileSpeedup -> Tab Bool
isCommonItemTab} = Tab Bool -> ContentId TileKind -> Bool
forall a. Unbox a => Tab a -> ContentId TileKind -> a
accessTab Tab Bool
isCommonItemTab

isOftenActor :: TileSpeedup -> ContentId TileKind -> Bool
{-# INLINE isOftenActor #-}
isOftenActor :: TileSpeedup -> ContentId TileKind -> Bool
isOftenActor TileSpeedup{Tab Bool
isOftenActorTab :: Tab Bool
isOftenActorTab :: TileSpeedup -> Tab Bool
isOftenActorTab} = Tab Bool -> ContentId TileKind -> Bool
forall a. Unbox a => Tab a -> ContentId TileKind -> a
accessTab Tab Bool
isOftenActorTab

isNoItem :: TileSpeedup -> ContentId TileKind -> Bool
{-# INLINE isNoItem #-}
isNoItem :: TileSpeedup -> ContentId TileKind -> Bool
isNoItem TileSpeedup{Tab Bool
isNoItemTab :: Tab Bool
isNoItemTab :: TileSpeedup -> Tab Bool
isNoItemTab} = Tab Bool -> ContentId TileKind -> Bool
forall a. Unbox a => Tab a -> ContentId TileKind -> a
accessTab Tab Bool
isNoItemTab

isNoActor :: TileSpeedup -> ContentId TileKind -> Bool
{-# INLINE isNoActor #-}
isNoActor :: TileSpeedup -> ContentId TileKind -> Bool
isNoActor TileSpeedup{Tab Bool
isNoActorTab :: Tab Bool
isNoActorTab :: TileSpeedup -> Tab Bool
isNoActorTab} = Tab Bool -> ContentId TileKind -> Bool
forall a. Unbox a => Tab a -> ContentId TileKind -> a
accessTab Tab Bool
isNoActorTab

-- | Whether a tile kind (specified by its id) has an @OpenTo@ feature
-- or is walkable even without opening.
isEasyOpen :: TileSpeedup -> ContentId TileKind -> Bool
{-# INLINE isEasyOpen #-}
isEasyOpen :: TileSpeedup -> ContentId TileKind -> Bool
isEasyOpen TileSpeedup{Tab Bool
isEasyOpenTab :: Tab Bool
isEasyOpenTab :: TileSpeedup -> Tab Bool
isEasyOpenTab} = Tab Bool -> ContentId TileKind -> Bool
forall a. Unbox a => Tab a -> ContentId TileKind -> a
accessTab Tab Bool
isEasyOpenTab

isEmbed :: TileSpeedup -> ContentId TileKind -> Bool
{-# INLINE isEmbed #-}
isEmbed :: TileSpeedup -> ContentId TileKind -> Bool
isEmbed TileSpeedup{Tab Bool
isEmbedTab :: Tab Bool
isEmbedTab :: TileSpeedup -> Tab Bool
isEmbedTab} = Tab Bool -> ContentId TileKind -> Bool
forall a. Unbox a => Tab a -> ContentId TileKind -> a
accessTab Tab Bool
isEmbedTab

isAquatic :: TileSpeedup -> ContentId TileKind -> Bool
{-# INLINE isAquatic #-}
isAquatic :: TileSpeedup -> ContentId TileKind -> Bool
isAquatic TileSpeedup{Tab Bool
isAquaticTab :: Tab Bool
isAquaticTab :: TileSpeedup -> Tab Bool
isAquaticTab} = Tab Bool -> ContentId TileKind -> Bool
forall a. Unbox a => Tab a -> ContentId TileKind -> a
accessTab Tab Bool
isAquaticTab

alterMinSkill :: TileSpeedup -> ContentId TileKind -> Int
{-# INLINE alterMinSkill #-}
alterMinSkill :: TileSpeedup -> ContentId TileKind -> Int
alterMinSkill TileSpeedup{Tab Word8
alterMinSkillTab :: Tab Word8
alterMinSkillTab :: TileSpeedup -> Tab Word8
alterMinSkillTab} =
  Word8 -> Int
forall a. Enum a => a -> Int
fromEnum (Word8 -> Int)
-> (ContentId TileKind -> Word8) -> ContentId TileKind -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Tab Word8 -> ContentId TileKind -> Word8
forall a. Unbox a => Tab a -> ContentId TileKind -> a
accessTab Tab Word8
alterMinSkillTab

alterMinWalk :: TileSpeedup -> ContentId TileKind -> Int
{-# INLINE alterMinWalk #-}
alterMinWalk :: TileSpeedup -> ContentId TileKind -> Int
alterMinWalk TileSpeedup{Tab Word8
alterMinWalkTab :: Tab Word8
alterMinWalkTab :: TileSpeedup -> Tab Word8
alterMinWalkTab} =
  Word8 -> Int
forall a. Enum a => a -> Int
fromEnum (Word8 -> Int)
-> (ContentId TileKind -> Word8) -> ContentId TileKind -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Tab Word8 -> ContentId TileKind -> Word8
forall a. Unbox a => Tab a -> ContentId TileKind -> a
accessTab Tab Word8
alterMinWalkTab

-- | Whether a tile kind has the given feature.
kindHasFeature :: TK.Feature -> TileKind -> Bool
{-# INLINE kindHasFeature #-}
kindHasFeature :: Feature -> TileKind -> Bool
kindHasFeature Feature
f TileKind
t = Feature
f Feature -> [Feature] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` TileKind -> [Feature]
TK.tfeature TileKind
t

openTo :: ContentData TileKind -> ContentId TileKind -> Rnd (ContentId TileKind)
openTo :: ContentData TileKind
-> ContentId TileKind -> Rnd (ContentId TileKind)
openTo ContentData TileKind
cotile ContentId TileKind
t = do
  let getTo :: Feature -> [GroupName TileKind] -> [GroupName TileKind]
getTo (TK.OpenTo GroupName TileKind
grp) [GroupName TileKind]
acc = GroupName TileKind
grp GroupName TileKind -> [GroupName TileKind] -> [GroupName TileKind]
forall a. a -> [a] -> [a]
: [GroupName TileKind]
acc
      getTo Feature
_ [GroupName TileKind]
acc = [GroupName TileKind]
acc
  case (Feature -> [GroupName TileKind] -> [GroupName TileKind])
-> [GroupName TileKind] -> [Feature] -> [GroupName TileKind]
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr Feature -> [GroupName TileKind] -> [GroupName TileKind]
getTo [] ([Feature] -> [GroupName TileKind])
-> [Feature] -> [GroupName TileKind]
forall a b. (a -> b) -> a -> b
$ TileKind -> [Feature]
TK.tfeature (TileKind -> [Feature]) -> TileKind -> [Feature]
forall a b. (a -> b) -> a -> b
$ ContentData TileKind -> ContentId TileKind -> TileKind
forall a. ContentData a -> ContentId a -> a
okind ContentData TileKind
cotile ContentId TileKind
t of
    [GroupName TileKind
grp] -> ContentId TileKind
-> Maybe (ContentId TileKind) -> ContentId TileKind
forall a. a -> Maybe a -> a
fromMaybe ([Char] -> ContentId TileKind
forall a. HasCallStack => [Char] -> a
error ([Char] -> ContentId TileKind) -> [Char] -> ContentId TileKind
forall a b. (a -> b) -> a -> b
$ [Char]
"" [Char] -> GroupName TileKind -> [Char]
forall v. Show v => [Char] -> v -> [Char]
`showFailure` GroupName TileKind
grp)
             (Maybe (ContentId TileKind) -> ContentId TileKind)
-> StateT SMGen Identity (Maybe (ContentId TileKind))
-> Rnd (ContentId TileKind)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ContentData TileKind
-> GroupName TileKind
-> (TileKind -> Bool)
-> StateT SMGen Identity (Maybe (ContentId TileKind))
forall a.
Show a =>
ContentData a
-> GroupName a -> (a -> Bool) -> Rnd (Maybe (ContentId a))
opick ContentData TileKind
cotile GroupName TileKind
grp (Bool -> TileKind -> Bool
forall a b. a -> b -> a
const Bool
True)
    [GroupName TileKind]
_ -> ContentId TileKind -> Rnd (ContentId TileKind)
forall (m :: * -> *) a. Monad m => a -> m a
return ContentId TileKind
t

closeTo :: ContentData TileKind -> ContentId TileKind
        -> Rnd (ContentId TileKind)
closeTo :: ContentData TileKind
-> ContentId TileKind -> Rnd (ContentId TileKind)
closeTo ContentData TileKind
cotile ContentId TileKind
t = do
  let getTo :: Feature -> [GroupName TileKind] -> [GroupName TileKind]
getTo (TK.CloseTo GroupName TileKind
grp) [GroupName TileKind]
acc = GroupName TileKind
grp GroupName TileKind -> [GroupName TileKind] -> [GroupName TileKind]
forall a. a -> [a] -> [a]
: [GroupName TileKind]
acc
      getTo Feature
_ [GroupName TileKind]
acc = [GroupName TileKind]
acc
  case (Feature -> [GroupName TileKind] -> [GroupName TileKind])
-> [GroupName TileKind] -> [Feature] -> [GroupName TileKind]
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr Feature -> [GroupName TileKind] -> [GroupName TileKind]
getTo [] ([Feature] -> [GroupName TileKind])
-> [Feature] -> [GroupName TileKind]
forall a b. (a -> b) -> a -> b
$ TileKind -> [Feature]
TK.tfeature (TileKind -> [Feature]) -> TileKind -> [Feature]
forall a b. (a -> b) -> a -> b
$ ContentData TileKind -> ContentId TileKind -> TileKind
forall a. ContentData a -> ContentId a -> a
okind ContentData TileKind
cotile ContentId TileKind
t of
    [GroupName TileKind
grp] -> ContentId TileKind
-> Maybe (ContentId TileKind) -> ContentId TileKind
forall a. a -> Maybe a -> a
fromMaybe ([Char] -> ContentId TileKind
forall a. HasCallStack => [Char] -> a
error ([Char] -> ContentId TileKind) -> [Char] -> ContentId TileKind
forall a b. (a -> b) -> a -> b
$ [Char]
"" [Char] -> GroupName TileKind -> [Char]
forall v. Show v => [Char] -> v -> [Char]
`showFailure` GroupName TileKind
grp)
             (Maybe (ContentId TileKind) -> ContentId TileKind)
-> StateT SMGen Identity (Maybe (ContentId TileKind))
-> Rnd (ContentId TileKind)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ContentData TileKind
-> GroupName TileKind
-> (TileKind -> Bool)
-> StateT SMGen Identity (Maybe (ContentId TileKind))
forall a.
Show a =>
ContentData a
-> GroupName a -> (a -> Bool) -> Rnd (Maybe (ContentId a))
opick ContentData TileKind
cotile GroupName TileKind
grp (Bool -> TileKind -> Bool
forall a b. a -> b -> a
const Bool
True)
    [GroupName TileKind]
_ -> ContentId TileKind -> Rnd (ContentId TileKind)
forall (m :: * -> *) a. Monad m => a -> m a
return ContentId TileKind
t

embeddedItems :: ContentData TileKind -> ContentId TileKind
              -> [GroupName ItemKind]
embeddedItems :: ContentData TileKind -> ContentId TileKind -> [GroupName ItemKind]
embeddedItems ContentData TileKind
cotile ContentId TileKind
t =
  let getTo :: Feature -> [GroupName ItemKind] -> [GroupName ItemKind]
getTo (TK.Embed GroupName ItemKind
igrp) [GroupName ItemKind]
acc = GroupName ItemKind
igrp GroupName ItemKind -> [GroupName ItemKind] -> [GroupName ItemKind]
forall a. a -> [a] -> [a]
: [GroupName ItemKind]
acc
      getTo Feature
_ [GroupName ItemKind]
acc = [GroupName ItemKind]
acc
  in (Feature -> [GroupName ItemKind] -> [GroupName ItemKind])
-> [GroupName ItemKind] -> [Feature] -> [GroupName ItemKind]
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr Feature -> [GroupName ItemKind] -> [GroupName ItemKind]
getTo [] ([Feature] -> [GroupName ItemKind])
-> [Feature] -> [GroupName ItemKind]
forall a b. (a -> b) -> a -> b
$ TileKind -> [Feature]
TK.tfeature (TileKind -> [Feature]) -> TileKind -> [Feature]
forall a b. (a -> b) -> a -> b
$ ContentData TileKind -> ContentId TileKind -> TileKind
forall a. ContentData a -> ContentId a -> a
okind ContentData TileKind
cotile ContentId TileKind
t

revealAs :: ContentData TileKind -> ContentId TileKind
         -> Rnd (ContentId TileKind)
revealAs :: ContentData TileKind
-> ContentId TileKind -> Rnd (ContentId TileKind)
revealAs ContentData TileKind
cotile ContentId TileKind
t = do
  let getTo :: Feature -> [GroupName TileKind] -> [GroupName TileKind]
getTo (TK.RevealAs GroupName TileKind
grp) [GroupName TileKind]
acc = GroupName TileKind
grp GroupName TileKind -> [GroupName TileKind] -> [GroupName TileKind]
forall a. a -> [a] -> [a]
: [GroupName TileKind]
acc
      getTo Feature
_ [GroupName TileKind]
acc = [GroupName TileKind]
acc
  case (Feature -> [GroupName TileKind] -> [GroupName TileKind])
-> [GroupName TileKind] -> [Feature] -> [GroupName TileKind]
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr Feature -> [GroupName TileKind] -> [GroupName TileKind]
getTo [] ([Feature] -> [GroupName TileKind])
-> [Feature] -> [GroupName TileKind]
forall a b. (a -> b) -> a -> b
$ TileKind -> [Feature]
TK.tfeature (TileKind -> [Feature]) -> TileKind -> [Feature]
forall a b. (a -> b) -> a -> b
$ ContentData TileKind -> ContentId TileKind -> TileKind
forall a. ContentData a -> ContentId a -> a
okind ContentData TileKind
cotile ContentId TileKind
t of
    [] -> ContentId TileKind -> Rnd (ContentId TileKind)
forall (m :: * -> *) a. Monad m => a -> m a
return ContentId TileKind
t
    [GroupName TileKind]
groups -> do
      GroupName TileKind
grp <- [GroupName TileKind] -> Rnd (GroupName TileKind)
forall a. [a] -> Rnd a
oneOf [GroupName TileKind]
groups
      ContentId TileKind
-> Maybe (ContentId TileKind) -> ContentId TileKind
forall a. a -> Maybe a -> a
fromMaybe ([Char] -> ContentId TileKind
forall a. HasCallStack => [Char] -> a
error ([Char] -> ContentId TileKind) -> [Char] -> ContentId TileKind
forall a b. (a -> b) -> a -> b
$ [Char]
"" [Char] -> GroupName TileKind -> [Char]
forall v. Show v => [Char] -> v -> [Char]
`showFailure` GroupName TileKind
grp) (Maybe (ContentId TileKind) -> ContentId TileKind)
-> StateT SMGen Identity (Maybe (ContentId TileKind))
-> Rnd (ContentId TileKind)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ContentData TileKind
-> GroupName TileKind
-> (TileKind -> Bool)
-> StateT SMGen Identity (Maybe (ContentId TileKind))
forall a.
Show a =>
ContentData a
-> GroupName a -> (a -> Bool) -> Rnd (Maybe (ContentId a))
opick ContentData TileKind
cotile GroupName TileKind
grp (Bool -> TileKind -> Bool
forall a b. a -> b -> a
const Bool
True)

obscureAs :: ContentData TileKind -> ContentId TileKind
          -> Rnd (ContentId TileKind)
obscureAs :: ContentData TileKind
-> ContentId TileKind -> Rnd (ContentId TileKind)
obscureAs ContentData TileKind
cotile ContentId TileKind
t = do
  let getTo :: Feature -> [GroupName TileKind] -> [GroupName TileKind]
getTo (TK.ObscureAs GroupName TileKind
grp) [GroupName TileKind]
acc = GroupName TileKind
grp GroupName TileKind -> [GroupName TileKind] -> [GroupName TileKind]
forall a. a -> [a] -> [a]
: [GroupName TileKind]
acc
      getTo Feature
_ [GroupName TileKind]
acc = [GroupName TileKind]
acc
  case (Feature -> [GroupName TileKind] -> [GroupName TileKind])
-> [GroupName TileKind] -> [Feature] -> [GroupName TileKind]
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr Feature -> [GroupName TileKind] -> [GroupName TileKind]
getTo [] ([Feature] -> [GroupName TileKind])
-> [Feature] -> [GroupName TileKind]
forall a b. (a -> b) -> a -> b
$ TileKind -> [Feature]
TK.tfeature (TileKind -> [Feature]) -> TileKind -> [Feature]
forall a b. (a -> b) -> a -> b
$ ContentData TileKind -> ContentId TileKind -> TileKind
forall a. ContentData a -> ContentId a -> a
okind ContentData TileKind
cotile (ContentId TileKind -> TileKind) -> ContentId TileKind -> TileKind
forall a b. (a -> b) -> a -> b
$ ContentData TileKind -> ContentId TileKind -> ContentId TileKind
buildAs ContentData TileKind
cotile ContentId TileKind
t of
    [] -> ContentId TileKind -> Rnd (ContentId TileKind)
forall (m :: * -> *) a. Monad m => a -> m a
return ContentId TileKind
t
    [GroupName TileKind]
groups -> do
      GroupName TileKind
grp <- [GroupName TileKind] -> Rnd (GroupName TileKind)
forall a. [a] -> Rnd a
oneOf [GroupName TileKind]
groups
      ContentId TileKind
-> Maybe (ContentId TileKind) -> ContentId TileKind
forall a. a -> Maybe a -> a
fromMaybe ([Char] -> ContentId TileKind
forall a. HasCallStack => [Char] -> a
error ([Char] -> ContentId TileKind) -> [Char] -> ContentId TileKind
forall a b. (a -> b) -> a -> b
$ [Char]
"" [Char] -> GroupName TileKind -> [Char]
forall v. Show v => [Char] -> v -> [Char]
`showFailure` GroupName TileKind
grp) (Maybe (ContentId TileKind) -> ContentId TileKind)
-> StateT SMGen Identity (Maybe (ContentId TileKind))
-> Rnd (ContentId TileKind)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ContentData TileKind
-> GroupName TileKind
-> (TileKind -> Bool)
-> StateT SMGen Identity (Maybe (ContentId TileKind))
forall a.
Show a =>
ContentData a
-> GroupName a -> (a -> Bool) -> Rnd (Maybe (ContentId a))
opick ContentData TileKind
cotile GroupName TileKind
grp (Bool -> TileKind -> Bool
forall a b. a -> b -> a
const Bool
True)

hideAs :: ContentData TileKind -> ContentId TileKind
       -> Maybe (ContentId TileKind)
hideAs :: ContentData TileKind
-> ContentId TileKind -> Maybe (ContentId TileKind)
hideAs ContentData TileKind
cotile ContentId TileKind
t =
  let getTo :: Feature -> Bool
getTo TK.HideAs{} = Bool
True
      getTo Feature
_ = Bool
False
  in case (Feature -> Bool) -> [Feature] -> Maybe Feature
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Maybe a
find Feature -> Bool
getTo ([Feature] -> Maybe Feature) -> [Feature] -> Maybe Feature
forall a b. (a -> b) -> a -> b
$ TileKind -> [Feature]
TK.tfeature (TileKind -> [Feature]) -> TileKind -> [Feature]
forall a b. (a -> b) -> a -> b
$ ContentData TileKind -> ContentId TileKind -> TileKind
forall a. ContentData a -> ContentId a -> a
okind ContentData TileKind
cotile ContentId TileKind
t of
       Just (TK.HideAs GroupName TileKind
grp) -> ContentId TileKind -> Maybe (ContentId TileKind)
forall a. a -> Maybe a
Just (ContentId TileKind -> Maybe (ContentId TileKind))
-> ContentId TileKind -> Maybe (ContentId TileKind)
forall a b. (a -> b) -> a -> b
$ ContentData TileKind -> GroupName TileKind -> ContentId TileKind
forall a. Show a => ContentData a -> GroupName a -> ContentId a
ouniqGroup ContentData TileKind
cotile GroupName TileKind
grp
       Maybe Feature
_ -> Maybe (ContentId TileKind)
forall a. Maybe a
Nothing

buildAs :: ContentData TileKind -> ContentId TileKind -> ContentId TileKind
buildAs :: ContentData TileKind -> ContentId TileKind -> ContentId TileKind
buildAs ContentData TileKind
cotile ContentId TileKind
t =
  let getTo :: Feature -> Bool
getTo TK.BuildAs{} = Bool
True
      getTo Feature
_ = Bool
False
  in case (Feature -> Bool) -> [Feature] -> Maybe Feature
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Maybe a
find Feature -> Bool
getTo ([Feature] -> Maybe Feature) -> [Feature] -> Maybe Feature
forall a b. (a -> b) -> a -> b
$ TileKind -> [Feature]
TK.tfeature (TileKind -> [Feature]) -> TileKind -> [Feature]
forall a b. (a -> b) -> a -> b
$ ContentData TileKind -> ContentId TileKind -> TileKind
forall a. ContentData a -> ContentId a -> a
okind ContentData TileKind
cotile ContentId TileKind
t of
       Just (TK.BuildAs GroupName TileKind
grp) -> ContentData TileKind -> GroupName TileKind -> ContentId TileKind
forall a. Show a => ContentData a -> GroupName a -> ContentId a
ouniqGroup ContentData TileKind
cotile GroupName TileKind
grp
       Maybe Feature
_ -> ContentId TileKind
t

isEasyOpenKind :: TileKind -> Bool
isEasyOpenKind :: TileKind -> Bool
isEasyOpenKind TileKind
tk =
  let getTo :: Feature -> Bool
getTo TK.OpenTo{} = Bool
True
      getTo Feature
TK.Walkable = Bool
True  -- very easy open
      getTo Feature
_ = Bool
False
  in TileKind -> Word8
TK.talter TileKind
tk Word8 -> Word8 -> Bool
forall a. Ord a => a -> a -> Bool
< Word8
10 Bool -> Bool -> Bool
&& (Feature -> Bool) -> [Feature] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any Feature -> Bool
getTo (TileKind -> [Feature]
TK.tfeature TileKind
tk)

isModifiable :: TileSpeedup -> ContentId TileKind -> Bool
isModifiable :: TileSpeedup -> ContentId TileKind -> Bool
isModifiable TileSpeedup
coTileSpeedup ContentId TileKind
t = TileSpeedup -> ContentId TileKind -> Bool
isOpenable TileSpeedup
coTileSpeedup ContentId TileKind
t
                               Bool -> Bool -> Bool
|| TileSpeedup -> ContentId TileKind -> Bool
isClosable TileSpeedup
coTileSpeedup ContentId TileKind
t
                               Bool -> Bool -> Bool
|| TileSpeedup -> ContentId TileKind -> Bool
isChangable TileSpeedup
coTileSpeedup ContentId TileKind
t
                               Bool -> Bool -> Bool
|| TileSpeedup -> ContentId TileKind -> Bool
isModifiableWith TileSpeedup
coTileSpeedup ContentId TileKind
t
                               Bool -> Bool -> Bool
|| TileSpeedup -> ContentId TileKind -> Bool
isSuspect TileSpeedup
coTileSpeedup ContentId TileKind
t