module Game.LambdaHack.Dungeon
(
LevelId, levelNumber, levelDefault
, Dungeon, fromList, currentFirst, adjust, mapDungeon, (!), lookup, depth
) where
import Prelude hiding (lookup)
import Data.Binary
import qualified Data.Map as M
import qualified Data.List as L
import Game.LambdaHack.Utils.Assert
import Game.LambdaHack.Level
newtype LevelId = LambdaCave Int
deriving (Show, Eq, Ord)
instance Binary LevelId where
put (LambdaCave n) = put n
get = fmap LambdaCave get
levelNumber :: LevelId -> Int
levelNumber (LambdaCave n) = n
levelDefault :: Int -> LevelId
levelDefault = LambdaCave
data Dungeon = Dungeon
{ dungeonLevelMap :: M.Map LevelId Level
, dungeonDepth :: Int
}
deriving Show
instance Binary Dungeon where
put Dungeon{..} = do
put (M.toAscList dungeonLevelMap)
put dungeonDepth
get = do
lvls <- get
let dungeonLevelMap = M.fromDistinctAscList lvls
dungeonDepth <- get
return Dungeon{..}
fromList :: [(LevelId, Level)] -> Int -> Dungeon
fromList lvls d = assert (d <= L.length lvls `blame` (d, L.length lvls)) $
Dungeon (M.fromList lvls) d
currentFirst :: LevelId -> Dungeon -> [(LevelId, Level)]
currentFirst lid (Dungeon m _) =
(lid, m M.! lid)
: L.filter ((/= lid) . fst) (M.assocs m)
adjust :: (Level -> Level) -> LevelId -> Dungeon -> Dungeon
adjust f lid (Dungeon m d) = Dungeon (M.adjust f lid m) d
mapDungeon :: (Level -> Level) -> Dungeon -> Dungeon
mapDungeon f (Dungeon m d) = Dungeon (M.map f m) d
(!) :: Dungeon -> LevelId -> Level
(!) (Dungeon m _) lid = m M.! lid
lookup :: LevelId -> Dungeon -> Maybe Level
lookup lid (Dungeon m _) = M.lookup lid m
depth :: Dungeon -> Int
depth = dungeonDepth