{-# 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 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 -> IO (MapLayer, V2 Int) readLayer (idx, path) = do img <- either error convertRGBA8 <$> readImage path let width = imageWidth img height = imageHeight img layer = V.foldl (\acc (py, px) -> case (pixelAt img px py) of (PixelRGBA8 r g b _) -> if r >= 253 then acc `V.snoc` Tile (V2 (255 - fromIntegral g) (255 - fromIntegral b)) (case r of 255 -> Solid 254 -> Platform _ -> Decoration ) else acc ) V.empty (V.fromList ((,) <$> [0 .. height - 1] <*> [0 .. width - 1])) return (MapLayer layer, V2 width height)