finish constructing maps

This commit is contained in:
nek0 2020-10-17 01:51:19 +02:00
parent 4eb31b1bf5
commit ada9c1368f
1 changed files with 22 additions and 16 deletions

View File

@ -1,12 +1,16 @@
{-# LANGUAGE OverloadedStrings #-}
module Map where
import qualified Graphics.Rendering.OpenGL as GL
import Linear
import Codec.Picture
import qualified Data.Vector as V
import Control.Monad (foldM)
-- internal imports
import Types
@ -20,22 +24,24 @@ testLevelDesc = LevelDescriptor
"res/tiles/00_test/00_test.png"
(3, 3)
-- constructMap :: LevelDescriptor -> IO LevelMap
-- constructMap desc = do
-- (layers, dimensions) <- foldM
-- (\(layers, dims) descTup -> do
-- (nlayer, ndims) <- readLayer descTup
-- if not (null layers) && ndims /= dims
-- then error ("Map Layer dimensions mismatch in: " <> snd descTup)
-- else return (dims ++ [nlayer], ndims)
-- )
-- ([], (0, 0))
-- (maplayers desc)
-- LevelMap
-- <$> pure layers
-- <*> pure (levelWalkLayer desc)
-- <*> pure dimensions
-- <*> -- TODO: TileMap
constructMap :: LevelDescriptor -> GL.GLuint -> IO LevelMap
constructMap desc tilemapSlot = do
(layers, dimensions) <- foldM
(\(layers, dims) descTup -> do
(nlayer, ndims) <- readLayer descTup
if not (null layers) && ndims /= dims
then error ("Map Layer dimensions mismatch in: " <> snd descTup)
else return (layers ++ [nlayer], ndims)
)
([], V2 0 0)
(V.fromList $ levelLayerPath desc)
tilemap <- uncurry TileMap <$> newTexture (levelTileMap desc) tilemapSlot
LevelMap
<$> pure (V.fromList layers)
<*> pure (levelWalkLayer desc)
<*> pure (fmap fromIntegral dimensions)
<*> pure tilemap
<*> pure (V2 (fst $ levelStartPos desc) (snd $ levelStartPos desc))
readLayer
:: (Word, FilePath) -- | index and path of the layer descriptor image