module Game.LambdaHack.Common.Level
(
LevelId, AbsDepth, Dungeon, ascendInBranch
, Level(..), ActorPrio, ItemFloor, TileMap, SmellMap
, at, atI, checkAccess, checkDoorAccess
, accessible, accessibleUnknown, accessibleDir
, knownLsecret, isSecretPos, hideTile
, findPos, findPosTry, mapLevelActors_, mapDungeonActors_
) where
import Control.Exception.Assert.Sugar
import Data.Binary
import qualified Data.Bits as Bits
import qualified Data.EnumMap.Strict as EM
import Data.Maybe
import Data.Text (Text)
import Game.LambdaHack.Common.Actor
import Game.LambdaHack.Common.Item
import qualified Game.LambdaHack.Common.Kind as Kind
import Game.LambdaHack.Common.Misc
import Game.LambdaHack.Common.Point
import qualified Game.LambdaHack.Common.PointArray as PointArray
import Game.LambdaHack.Common.Random
import Game.LambdaHack.Common.Tile
import qualified Game.LambdaHack.Common.Tile as Tile
import Game.LambdaHack.Common.Time
import Game.LambdaHack.Common.Vector
import Game.LambdaHack.Content.RuleKind
import Game.LambdaHack.Content.TileKind
type Dungeon = EM.EnumMap LevelId Level
ascendInBranch :: Dungeon -> Int -> LevelId -> [LevelId]
ascendInBranch dungeon k lid =
let (minD, maxD) =
case (EM.minViewWithKey dungeon, EM.maxViewWithKey dungeon) of
(Just ((s, _), _), Just ((e, _), _)) -> (s, e)
_ -> assert `failure` "null dungeon" `twith` dungeon
ln = max minD $ min maxD $ toEnum $ fromEnum lid + k
in case EM.lookup ln dungeon of
Just _ | ln /= lid -> [ln]
_ | ln == lid -> []
_ -> ascendInBranch dungeon k ln
type ActorPrio = EM.EnumMap Time [ActorId]
type ItemFloor = EM.EnumMap Point ItemBag
type TileMap = PointArray.Array (Kind.Id TileKind)
type SmellMap = EM.EnumMap Point SmellTime
data Level = Level
{ ldepth :: !AbsDepth
, lprio :: !ActorPrio
, lfloor :: !ItemFloor
, ltile :: !TileMap
, lxsize :: !X
, lysize :: !Y
, lsmell :: !SmellMap
, ldesc :: !Text
, lstair :: !([Point], [Point])
, lseen :: !Int
, lclear :: !Int
, ltime :: !Time
, lactorCoeff :: !Int
, lactorFreq :: !Freqs
, litemNum :: !Int
, litemFreq :: !Freqs
, lsecret :: !Int
, lhidden :: !Int
, lescape :: !Bool
}
deriving (Show, Eq)
assertSparseItems :: ItemFloor -> ItemFloor
assertSparseItems m =
assert (EM.null (EM.filter EM.null m)
`blame` "null floors found" `twith` m) m
at :: Level -> Point -> Kind.Id TileKind
at Level{ltile} p = ltile PointArray.! p
atI :: Level -> Point -> ItemBag
atI Level{lfloor} p = EM.findWithDefault EM.empty p lfloor
checkAccess :: Kind.COps -> Level -> Maybe (Point -> Point -> Bool)
checkAccess Kind.COps{corule} _ =
case raccessible $ Kind.stdRuleset corule of
Nothing -> Nothing
Just ch -> Just $ \spos tpos -> ch spos tpos
checkDoorAccess :: Kind.COps -> Level -> Maybe (Point -> Point -> Bool)
checkDoorAccess Kind.COps{corule, cotile} lvl =
case raccessibleDoor $ Kind.stdRuleset corule of
Nothing -> Nothing
Just chDoor ->
Just $ \spos tpos ->
let st = lvl `at` spos
tt = lvl `at` tpos
in not (Tile.isDoor cotile st || Tile.isDoor cotile tt)
|| chDoor spos tpos
accessible :: Kind.COps -> Level -> Point -> Point -> Bool
accessible cops@Kind.COps{cotile} lvl =
let checkWalkability =
Just $ \_ tpos -> Tile.isWalkable cotile $ lvl `at` tpos
conditions = catMaybes [ checkWalkability
, checkAccess cops lvl
, checkDoorAccess cops lvl ]
in \spos tpos -> all (\f -> f spos tpos) conditions
accessibleUnknown :: Kind.COps -> Level -> Point -> Point -> Bool
accessibleUnknown cops@Kind.COps{cotile=cotile@Kind.Ops{ouniqGroup}} lvl =
let unknownId = ouniqGroup "unknown space"
checkWalkability =
Just $ \_ tpos -> let t = lvl `at` tpos
in Tile.isWalkable cotile t || t == unknownId
conditions = catMaybes [ checkWalkability
, checkAccess cops lvl
, checkDoorAccess cops lvl ]
in \spos tpos -> all (\f -> f spos tpos) conditions
accessibleDir :: Kind.COps -> Level -> Point -> Vector -> Bool
accessibleDir cops lvl spos dir = accessible cops lvl spos $ spos `shift` dir
knownLsecret :: Level -> Bool
knownLsecret lvl = lsecret lvl /= 0
isSecretPos :: Level -> Point -> Bool
isSecretPos lvl (Point x y) =
(lsecret lvl `Bits.rotateR` x `Bits.xor` y + x) `mod` lhidden lvl == 0
hideTile :: Kind.COps -> Level -> Point -> Kind.Id TileKind
hideTile Kind.COps{cotile} lvl p =
let t = lvl `at` p
ht = Tile.hideAs cotile t
in if isSecretPos lvl p then ht else t
findPos :: TileMap -> (Point -> Kind.Id TileKind -> Bool) -> Rnd Point
findPos ltile p =
let (x, y) = PointArray.sizeA ltile
search = do
px <- randomR (0, x 1)
py <- randomR (0, y 1)
let pos = Point{..}
tile = ltile PointArray.! pos
if p pos tile
then return $! pos
else search
in search
findPosTry :: Int
-> TileMap
-> (Point -> Kind.Id TileKind -> Bool)
-> [Point -> Kind.Id TileKind -> Bool]
-> Rnd Point
findPosTry _ ltile m [] = findPos ltile m
findPosTry numTries ltile m l@(_ : tl) = assert (numTries > 0) $
let (x, y) = PointArray.sizeA ltile
search 0 = findPosTry numTries ltile m tl
search k = do
px <- randomR (0, x 1)
py <- randomR (0, y 1)
let pos = Point{..}
tile = ltile PointArray.! pos
if m pos tile && all (\p -> p pos tile) l
then return $! pos
else search (k 1)
in search numTries
mapLevelActors_ :: Monad m => (ActorId -> m a) -> Level -> m ()
mapLevelActors_ f Level{lprio} = do
let as = concat $ EM.elems lprio
mapM_ f as
mapDungeonActors_ :: Monad m => (ActorId -> m a) -> Dungeon -> m ()
mapDungeonActors_ f dungeon = do
let ls = EM.elems dungeon
mapM_ (mapLevelActors_ f) ls
instance Binary Level where
put Level{..} = do
put ldepth
put lprio
put (assertSparseItems lfloor)
put ltile
put lxsize
put lysize
put lsmell
put ldesc
put lstair
put lseen
put lclear
put ltime
put lactorCoeff
put lactorFreq
put litemNum
put litemFreq
put lsecret
put lhidden
put lescape
get = do
ldepth <- get
lprio <- get
lfloor <- get
ltile <- get
lxsize <- get
lysize <- get
lsmell <- get
ldesc <- get
lstair <- get
lseen <- get
lclear <- get
ltime <- get
lactorCoeff <- get
lactorFreq <- get
litemNum <- get
litemFreq <- get
lsecret <- get
lhidden <- get
lescape <- get
return $! Level{..}