diff --git a/src/Map.hs b/src/Map.hs index caf6859..9e6ea53 100644 --- a/src/Map.hs +++ b/src/Map.hs @@ -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