{-# LANGUAGE OverloadedStrings #-} module Map where import qualified Graphics.Rendering.OpenGL as GL import Linear import Codec.Picture import Codec.Picture.Extra import qualified Data.Vector as V import Control.Monad (foldM) -- internal imports import Types import Graphics constructMap :: LevelDescriptor -> GL.GLuint -> IO LevelMap constructMap desc tilemapSlot = do tilemap <- uncurry TileMap <$> newTexture (levelTileMap desc) tilemapSlot (layers, dimensions) <- foldM (\(layers, dims) descTup -> do (nlayer, ndims) <- readLayer descTup (fmap fromIntegral $ tileMapDimensions tilemap) 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) 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 -> V2 Float -- ^ size of Tilemap in pixels -> IO ((V.Vector Tile), V2 Int) readLayer (_, path) (V2 tx ty) = do img <- flipVertically <$> convertRGBA8 <$> either error id <$> 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 (fromIntegral px) (fromIntegral py)) ( (V2 ((255 - fromIntegral g) * (32 / tx)) (1 - (255 - fromIntegral b + 1) * (32 / ty)) ) , (V2 ((255 - fromIntegral g + 1) * (32 / tx)) (1 - (255 - fromIntegral b) * (32 / ty)) ) ) (case r of 255 -> Solid 254 -> Platform _ -> Decoration ) else acc ) V.empty (V.fromList ((,) <$> [0 .. height - 1] <*> [0 .. width - 1])) return (layer, V2 width height)