module Game.LambdaHack.Common.Level
(
LevelId, Dungeon, ascendInBranch
, Container(..)
, SmellMap, ItemFloor, TileMap
, Level(..)
, updatePrio, updateSmell, updateFloor, updateTile
, at, atI, accessible, accessibleDir, hideTile
, findPos, findPosTry, mapLevelActors_, mapDungeonActors_
) where
import Data.Binary
import qualified Data.Bits as Bits
import qualified Data.EnumMap.Strict as EM
import qualified Data.List as L
import Data.Text (Text)
import GHC.Generics (Generic)
import Game.LambdaHack.Common.Actor
import qualified Game.LambdaHack.Common.Kind as Kind
import Game.LambdaHack.Common.Misc
import Game.LambdaHack.Common.Point
import Game.LambdaHack.Common.PointXY
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
import Game.LambdaHack.Utils.Assert
type Dungeon = EM.EnumMap LevelId Level
ascendInBranch :: Dungeon -> LevelId -> Int -> [LevelId]
ascendInBranch dungeon lid k =
let (minD, maxD) =
case (EM.minViewWithKey dungeon, EM.maxViewWithKey dungeon) of
(Just ((s, _), _), Just ((e, _), _)) -> (s, e)
_ -> assert `failure` dungeon
ln = max minD $ min maxD $ toEnum $ fromEnum lid k
in case EM.lookup ln dungeon of
Just _ | ln /= lid -> [ln]
_ -> []
data Container =
CFloor LevelId Point
| CActor ActorId InvChar
deriving (Show, Eq, Ord, Generic)
instance Binary Container
type ActorPrio = EM.EnumMap Time [ActorId]
type ItemFloor = EM.EnumMap Point ItemBag
type TileMap = Kind.Array Point TileKind
type SmellMap = EM.EnumMap Point SmellTime
data Level = Level
{ ldepth :: !Int
, lprio :: !ActorPrio
, lfloor :: !ItemFloor
, ltile :: !TileMap
, lxsize :: !X
, lysize :: !Y
, lsmell :: !SmellMap
, ldesc :: !Text
, lstair :: !(Point, Point)
, lseen :: !Int
, lclear :: !Int
, ltime :: !Time
, litemNum :: !Int
, lsecret :: !Int
, lhidden :: !Int
}
deriving (Show, Eq)
updatePrio :: (ActorPrio -> ActorPrio) -> Level -> Level
updatePrio f lvl = lvl {lprio = f (lprio lvl)}
updateSmell :: (SmellMap -> SmellMap) -> Level -> Level
updateSmell f lvl = lvl {lsmell = f (lsmell lvl)}
updateFloor :: (ItemFloor -> ItemFloor) -> Level -> Level
updateFloor f lvl = lvl {lfloor = f (lfloor lvl)}
updateTile :: (TileMap -> TileMap) -> Level -> Level
updateTile f lvl = lvl {ltile = f (ltile lvl)}
assertSparseItems :: ItemFloor -> ItemFloor
assertSparseItems m =
assert (EM.null (EM.filter EM.null m) `blame` m) m
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 litemNum
put lsecret
put lhidden
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
litemNum <- get
lsecret <- get
lhidden <- get
return Level{..}
at :: Level -> Point -> Kind.Id TileKind
at Level{ltile} p = ltile Kind.! p
atI :: Level -> Point -> ItemBag
atI Level{lfloor} p = EM.findWithDefault EM.empty p lfloor
accessible :: Kind.COps -> Level -> Point -> Point -> Bool
accessible Kind.COps{cotile=Kind.Ops{okind=okind}, corule}
lvl@Level{lxsize} spos tpos =
assert (chessDist lxsize spos tpos == 1) $
let check = raccessible $ Kind.stdRuleset corule
src = okind $ lvl `at` spos
tgt = okind $ lvl `at` tpos
in check lxsize spos src tpos tgt
accessibleDir :: Kind.COps -> Level -> Point -> Vector -> Bool
accessibleDir cops lvl spos dir = accessible cops lvl spos $ spos `shift` dir
hideTile :: Kind.Ops TileKind -> Point -> Level -> Kind.Id TileKind
hideTile cotile p lvl =
let t = lvl `at` p
ht = Tile.hiddenAs cotile t
in if ht == t
|| (lsecret lvl `Bits.rotateR` fromEnum p `Bits.xor` fromEnum p)
`mod` lhidden lvl == 0
then ht
else t
findPos :: TileMap -> (Point -> Kind.Id TileKind -> Bool) -> Rnd Point
findPos ltile p =
let search = do
pos <- randomR $ Kind.bounds ltile
let tile = ltile Kind.! pos
if p pos tile
then return pos
else search
in search
findPosTry :: Int
-> TileMap
-> [Point -> Kind.Id TileKind -> Bool]
-> Rnd Point
findPosTry _ ltile [] = findPos ltile (const (const True))
findPosTry _ ltile [p] = findPos ltile p
findPosTry numTries ltile l@(_ : tl) = assert (numTries > 0) $
let search 0 = findPosTry numTries ltile tl
search k = do
pos <- randomR $ Kind.bounds ltile
let tile = ltile Kind.! pos
if L.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