pituicat/src/Map.hs
2020-10-12 06:29:09 +02:00

59 lines
1.5 KiB
Haskell

{-# LANGUAGE OverloadedStrings #-}
module Map where
import Linear
import Codec.Picture
import qualified Data.Vector as V
-- internal imports
import Types
import Texture
testLevelDesc :: LevelDescriptor
testLevelDesc = LevelDescriptor
[ (0, "res/maps/00_test/00_test.bmp")
]
0
"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
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.map
(\(py, px) -> case (pixelAt img px py) of
(PixelRGBA8 r g b _) -> Tile
(V2 (255 - fromIntegral g) (255 - fromIntegral b))
(case r of
255 -> Solid
254 -> Platform
_ -> Decoration
)
)
(V.fromList ((,) <$> [0 .. height - 1] <*> [0 .. width - 1]))
return (MapLayer layer, V2 width height)