-- | 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
  ( -- * Construction of tile property lookup speedup tables
    speedupTile
    -- * Sped up 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
  , TileAction (..), parseTileAction
#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.Common.Item
import           Game.LambdaHack.Common.Kind
import           Game.LambdaHack.Common.Types
import           Game.LambdaHack.Content.ItemKind (ItemKind)
import qualified Game.LambdaHack.Content.ItemKind as IK
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 :: ContentData TileKind -> (TileKind -> a) -> Tab a
createTab cotile :: ContentData TileKind
cotile prop :: 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 cotile :: ContentData TileKind
cotile prop :: 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 tab :: Vector a
tab) ki :: ContentId TileKind
ki = Vector a
tab Vector a -> Int -> a
forall a. Unbox a => Vector a -> Int -> a
`U.unsafeIndex` ContentId TileKind -> Int
forall k. ContentId k -> Int
contentIdIndex ContentId TileKind
ki

speedupTile :: Bool -> ContentData TileKind -> TileSpeedup
speedupTile :: Bool -> ContentData TileKind -> TileSpeedup
speedupTile allClear :: Bool
allClear cotile :: 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
$ Bool -> Bool
not (Bool -> Bool) -> (TileKind -> Bool) -> TileKind -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (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
$ \tk :: 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
$ \tk :: TileKind
tk ->
        let getTo :: Feature -> [GroupName TileKind] -> [GroupName TileKind]
getTo (TK.OpenTo grp :: GroupName TileKind
grp) acc :: [GroupName TileKind]
acc = GroupName TileKind
grp GroupName TileKind -> [GroupName TileKind] -> [GroupName TileKind]
forall a. a -> [a] -> [a]
: [GroupName TileKind]
acc
            getTo _ acc :: [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
          [grp :: 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
          _ -> let getTo2 :: Feature -> [GroupName TileKind] -> [GroupName TileKind]
getTo2 (TK.CloseTo grp :: GroupName TileKind
grp) acc :: [GroupName TileKind]
acc = GroupName TileKind
grp GroupName TileKind -> [GroupName TileKind] -> [GroupName TileKind]
forall a. a -> [a] -> [a]
: [GroupName TileKind]
acc
                   getTo2 _ acc :: [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
                 [grp :: 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
                 _ -> 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
$ \tk :: TileKind
tk ->
        let getTo :: Feature -> Bool
getTo TK.ChangeTo{} = Bool
True
            getTo _ = 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
$ \tk :: TileKind
tk ->
        let getTo :: Feature -> Bool
getTo TK.OpenWith{} = Bool
True
            getTo TK.CloseWith{} = Bool
True
            getTo TK.ChangeWith{} = Bool
True
            getTo _ = 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
$ \tk :: TileKind
tk ->
        let getTo :: Feature -> Bool
getTo TK.HideAs{} = Bool
True
            getTo _ = 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
$ \tk :: 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
$ \tk :: TileKind
tk ->
        let getTo :: Feature -> Bool
getTo TK.Embed{} = Bool
True
            getTo _ = 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
$ \tk :: 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
> 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 $WTileSpeedup :: 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 {..}

-- 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 _k :: ContentId TileKind
_k tk :: 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 TK.ConsideredByAI = Bool
True
      getTo _ = 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 k :: ContentId TileKind
k tk :: 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 _ = Bool
False
  in if | Feature -> TileKind -> Bool
kindHasFeature Feature
TK.Walkable TileKind
tk -> 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 coTileSpeedup :: TileSpeedup
coTileSpeedup t :: 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 f :: Feature
f t :: 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 cotile :: ContentData TileKind
cotile t :: ContentId TileKind
t = do
  let getTo :: Feature -> [GroupName TileKind] -> [GroupName TileKind]
getTo (TK.OpenTo grp :: GroupName TileKind
grp) acc :: [GroupName TileKind]
acc = GroupName TileKind
grp GroupName TileKind -> [GroupName TileKind] -> [GroupName TileKind]
forall a. a -> [a] -> [a]
: [GroupName TileKind]
acc
      getTo _ acc :: [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
    [grp :: 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] -> 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)
    _ -> 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 cotile :: ContentData TileKind
cotile t :: ContentId TileKind
t = do
  let getTo :: Feature -> [GroupName TileKind] -> [GroupName TileKind]
getTo (TK.CloseTo grp :: GroupName TileKind
grp) acc :: [GroupName TileKind]
acc = GroupName TileKind
grp GroupName TileKind -> [GroupName TileKind] -> [GroupName TileKind]
forall a. a -> [a] -> [a]
: [GroupName TileKind]
acc
      getTo _ acc :: [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
    [grp :: 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] -> 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)
    _ -> 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 cotile :: ContentData TileKind
cotile t :: ContentId TileKind
t =
  let getTo :: Feature -> [GroupName ItemKind] -> [GroupName ItemKind]
getTo (TK.Embed igrp :: GroupName ItemKind
igrp) acc :: [GroupName ItemKind]
acc = GroupName ItemKind
igrp GroupName ItemKind -> [GroupName ItemKind] -> [GroupName ItemKind]
forall a. a -> [a] -> [a]
: [GroupName ItemKind]
acc
      getTo _ acc :: [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 cotile :: ContentData TileKind
cotile t :: ContentId TileKind
t = do
  let getTo :: Feature -> [GroupName TileKind] -> [GroupName TileKind]
getTo (TK.RevealAs grp :: GroupName TileKind
grp) acc :: [GroupName TileKind]
acc = GroupName TileKind
grp GroupName TileKind -> [GroupName TileKind] -> [GroupName TileKind]
forall a. a -> [a] -> [a]
: [GroupName TileKind]
acc
      getTo _ acc :: [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
    groups :: [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] -> 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 cotile :: ContentData TileKind
cotile t :: ContentId TileKind
t = do
  let getTo :: Feature -> [GroupName TileKind] -> [GroupName TileKind]
getTo (TK.ObscureAs grp :: GroupName TileKind
grp) acc :: [GroupName TileKind]
acc = GroupName TileKind
grp GroupName TileKind -> [GroupName TileKind] -> [GroupName TileKind]
forall a. a -> [a] -> [a]
: [GroupName TileKind]
acc
      getTo _ acc :: [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
    groups :: [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] -> 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 cotile :: ContentData TileKind
cotile t :: ContentId TileKind
t =
  let getTo :: Feature -> Bool
getTo TK.HideAs{} = Bool
True
      getTo _ = 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 grp :: 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 (ContentId TileKind)
forall a. Maybe a
Nothing

buildAs :: ContentData TileKind -> ContentId TileKind -> ContentId TileKind
buildAs :: ContentData TileKind -> ContentId TileKind -> ContentId TileKind
buildAs cotile :: ContentData TileKind
cotile t :: ContentId TileKind
t =
  let getTo :: Feature -> Bool
getTo TK.BuildAs{} = Bool
True
      getTo _ = 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 grp :: 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
       _ -> ContentId TileKind
t

isEasyOpenKind :: TileKind -> Bool
isEasyOpenKind :: TileKind -> Bool
isEasyOpenKind tk :: TileKind
tk =
  let getTo :: Feature -> Bool
getTo TK.OpenTo{} = Bool
True
      getTo TK.Walkable = Bool
True  -- very easy open
      getTo _ = Bool
False
  in TileKind -> Word8
TK.talter TileKind
tk Word8 -> Word8 -> Bool
forall a. Ord a => a -> a -> Bool
< 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 coTileSpeedup :: TileSpeedup
coTileSpeedup t :: 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

data TileAction =
    EmbedAction (ItemId, ItemQuant)
  | ToAction (GroupName TK.TileKind)
  | WithAction [(Int, GroupName ItemKind)] (GroupName TK.TileKind)
  deriving Int -> TileAction -> ShowS
[TileAction] -> ShowS
TileAction -> [Char]
(Int -> TileAction -> ShowS)
-> (TileAction -> [Char])
-> ([TileAction] -> ShowS)
-> Show TileAction
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
showList :: [TileAction] -> ShowS
$cshowList :: [TileAction] -> ShowS
show :: TileAction -> [Char]
$cshow :: TileAction -> [Char]
showsPrec :: Int -> TileAction -> ShowS
$cshowsPrec :: Int -> TileAction -> ShowS
Show

parseTileAction :: Bool -> Bool -> [(IK.ItemKind, (ItemId, ItemQuant))]
                -> TK.Feature
                -> Maybe TileAction
parseTileAction :: Bool
-> Bool
-> [(ItemKind, (ItemId, ItemQuant))]
-> Feature
-> Maybe TileAction
parseTileAction bproj :: Bool
bproj underFeet :: Bool
underFeet embedKindList :: [(ItemKind, (ItemId, ItemQuant))]
embedKindList feat :: Feature
feat = case Feature
feat of
  TK.Embed igroup :: GroupName ItemKind
igroup ->
      -- Greater or equal 0 to also cover template UNKNOWN items
      -- not yet identified by the client.
    let f :: (ItemKind, (ItemId, ItemQuant)) -> Bool
f (itemKind :: ItemKind
itemKind, _) =
          Int -> Maybe Int -> Int
forall a. a -> Maybe a -> a
fromMaybe (-1) (GroupName ItemKind -> [(GroupName ItemKind, Int)] -> Maybe Int
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup GroupName ItemKind
igroup ([(GroupName ItemKind, Int)] -> Maybe Int)
-> [(GroupName ItemKind, Int)] -> Maybe Int
forall a b. (a -> b) -> a -> b
$ ItemKind -> [(GroupName ItemKind, Int)]
IK.ifreq ItemKind
itemKind) Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= 0
    in case ((ItemKind, (ItemId, ItemQuant)) -> Bool)
-> [(ItemKind, (ItemId, ItemQuant))]
-> Maybe (ItemKind, (ItemId, ItemQuant))
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Maybe a
find (ItemKind, (ItemId, ItemQuant)) -> Bool
f [(ItemKind, (ItemId, ItemQuant))]
embedKindList of
      Nothing -> Maybe TileAction
forall a. Maybe a
Nothing
      Just (_, iidkit :: (ItemId, ItemQuant)
iidkit) -> TileAction -> Maybe TileAction
forall a. a -> Maybe a
Just (TileAction -> Maybe TileAction) -> TileAction -> Maybe TileAction
forall a b. (a -> b) -> a -> b
$ (ItemId, ItemQuant) -> TileAction
EmbedAction (ItemId, ItemQuant)
iidkit
  TK.OpenTo tgroup :: GroupName TileKind
tgroup | Bool -> Bool
not (Bool
underFeet Bool -> Bool -> Bool
|| Bool
bproj) -> TileAction -> Maybe TileAction
forall a. a -> Maybe a
Just (TileAction -> Maybe TileAction) -> TileAction -> Maybe TileAction
forall a b. (a -> b) -> a -> b
$ GroupName TileKind -> TileAction
ToAction GroupName TileKind
tgroup
  TK.CloseTo tgroup :: GroupName TileKind
tgroup | Bool -> Bool
not (Bool
underFeet Bool -> Bool -> Bool
|| Bool
bproj) -> TileAction -> Maybe TileAction
forall a. a -> Maybe a
Just (TileAction -> Maybe TileAction) -> TileAction -> Maybe TileAction
forall a b. (a -> b) -> a -> b
$ GroupName TileKind -> TileAction
ToAction GroupName TileKind
tgroup
  TK.ChangeTo tgroup :: GroupName TileKind
tgroup | Bool -> Bool
not Bool
bproj -> TileAction -> Maybe TileAction
forall a. a -> Maybe a
Just (TileAction -> Maybe TileAction) -> TileAction -> Maybe TileAction
forall a b. (a -> b) -> a -> b
$ GroupName TileKind -> TileAction
ToAction GroupName TileKind
tgroup
  TK.OpenWith proj :: ProjectileTriggers
proj grps :: [(Int, GroupName ItemKind)]
grps tgroup :: GroupName TileKind
tgroup | Bool -> Bool
not Bool
underFeet ->
    if ProjectileTriggers
proj ProjectileTriggers -> ProjectileTriggers -> Bool
forall a. Eq a => a -> a -> Bool
== ProjectileTriggers
TK.ProjNo Bool -> Bool -> Bool
&& Bool
bproj
    then Maybe TileAction
forall a. Maybe a
Nothing
    else TileAction -> Maybe TileAction
forall a. a -> Maybe a
Just (TileAction -> Maybe TileAction) -> TileAction -> Maybe TileAction
forall a b. (a -> b) -> a -> b
$ [(Int, GroupName ItemKind)] -> GroupName TileKind -> TileAction
WithAction [(Int, GroupName ItemKind)]
grps GroupName TileKind
tgroup
  TK.CloseWith proj :: ProjectileTriggers
proj grps :: [(Int, GroupName ItemKind)]
grps tgroup :: GroupName TileKind
tgroup | Bool -> Bool
not Bool
underFeet ->
    -- Not when standing on tile, not to autoclose doors under actor
    -- or close via dropping an item inside.
    if ProjectileTriggers
proj ProjectileTriggers -> ProjectileTriggers -> Bool
forall a. Eq a => a -> a -> Bool
== ProjectileTriggers
TK.ProjNo Bool -> Bool -> Bool
&& Bool
bproj
    then Maybe TileAction
forall a. Maybe a
Nothing
    else TileAction -> Maybe TileAction
forall a. a -> Maybe a
Just (TileAction -> Maybe TileAction) -> TileAction -> Maybe TileAction
forall a b. (a -> b) -> a -> b
$ [(Int, GroupName ItemKind)] -> GroupName TileKind -> TileAction
WithAction [(Int, GroupName ItemKind)]
grps GroupName TileKind
tgroup
  TK.ChangeWith proj :: ProjectileTriggers
proj grps :: [(Int, GroupName ItemKind)]
grps tgroup :: GroupName TileKind
tgroup ->
    if ProjectileTriggers
proj ProjectileTriggers -> ProjectileTriggers -> Bool
forall a. Eq a => a -> a -> Bool
== ProjectileTriggers
TK.ProjNo Bool -> Bool -> Bool
&& Bool
bproj
    then Maybe TileAction
forall a. Maybe a
Nothing
    else TileAction -> Maybe TileAction
forall a. a -> Maybe a
Just (TileAction -> Maybe TileAction) -> TileAction -> Maybe TileAction
forall a b. (a -> b) -> a -> b
$ [(Int, GroupName ItemKind)] -> GroupName TileKind -> TileAction
WithAction [(Int, GroupName ItemKind)]
grps GroupName TileKind
tgroup
  _ -> Maybe TileAction
forall a. Maybe a
Nothing