From c2fb8cd922032e24962bc3aef65d5428c5361957 Mon Sep 17 00:00:00 2001 From: "Juan J. Martinez" Date: Thu, 9 Feb 2023 17:41:31 +0000 Subject: Object layer support for map entities --- src/Game/Map.hs | 91 +++++++++++++++++++++++++++++++++++++++++++-------------- 1 file changed, 69 insertions(+), 22 deletions(-) (limited to 'src') diff --git a/src/Game/Map.hs b/src/Game/Map.hs index 94478bd..b872f4c 100644 --- a/src/Game/Map.hs +++ b/src/Game/Map.hs @@ -7,6 +7,7 @@ module Game.Map where import Control.Monad +import Data.Maybe (mapMaybe) import qualified Game.Utils as U import qualified SDL import Text.JSON @@ -20,22 +21,23 @@ data Tileset = Tileset } deriving (Show) -data TileLayer = TileLayer - { name :: String, - tiles :: [Int] - } +data Layer + = TileLayer + {name :: String, tiles :: [Int]} + | ObjectLayer + {name :: String, objects :: [MapObject]} deriving (Show) -data MapData = MapData +data MapObject = PlayerEntity Int Int deriving (Show) + +data JsonMapData = JsonMapData { width :: Int, height :: Int, tileset :: Tileset, - layers :: [TileLayer] + layers :: [Layer] } deriving (Show) -data Map = Map MapData SDL.Texture - instance JSON Tileset where showJSON = undefined readJSON (JSArray [JSObject obj]) = do @@ -46,42 +48,87 @@ instance JSON Tileset where <*> valFromObj "firstgid" obj readJSON _ = mzero -instance JSON TileLayer where +instance JSON Layer where showJSON = undefined readJSON (JSObject obj) = case get_field obj "type" of Just "tilelayer" -> - TileLayer - <$> valFromObj "name" obj - <*> valFromObj "data" obj + TileLayer <$> valFromObj "name" obj <*> valFromObj "data" obj + Just "objectgroup" -> + ObjectLayer <$> valFromObj "name" obj <*> valFromObj "objects" obj _ -> Error "unsupported layer type" readJSON _ = mzero -instance JSON MapData where +instance JSON MapObject where showJSON = undefined readJSON (JSObject obj) = - MapData + case get_field obj "name" of + Just "Player" -> + PlayerEntity <$> valFromObj "x" obj <*> valFromObj "y" obj + Just (JSString (JSONString s)) -> Error $ "unsupported entity " ++ show s + e -> Error $ "unsupported entity in " ++ show e + readJSON _ = mzero + +instance JSON JsonMapData where + showJSON = undefined + readJSON (JSObject obj) = + JsonMapData <$> valFromObj "width" obj <*> valFromObj "height" obj <*> valFromObj "tilesets" obj <*> valFromObj "layers" obj readJSON _ = mzero +data MapData = MapData + { width :: Int, + height :: Int, + tileset :: Tileset, + tileLayers :: [[Int]], + blocked :: [Int], + objects :: [MapObject] + } + deriving (Show) + +data Map = Map MapData SDL.Texture + -- | Loads a map from a JSON file. load :: String -> SDL.Texture -> IO Map load filename tex = do d <- readFile filename - case decode d :: Result MapData of - Ok s -> pure $ Map s tex + case decode d :: Result JsonMapData of + Ok s -> do + let tileLayers = mapMaybe (filterTileLayer (\l -> l.name /= "Blocked")) s.layers + blockedLayers = mapMaybe (filterTileLayer (\l -> l.name == "Blocked")) s.layers + blockedLayer <- case blockedLayers of + [l] -> pure l + xs -> error $ "1 \"Blocked\" layer expected, " ++ show (length xs) ++ " found" + pure $ + Map + MapData + { width = s.width, + height = s.height, + tileset = s.tileset, + tileLayers = tileLayers, + blocked = blockedLayer, + objects = concat $ mapMaybe filterObjectLayer s.layers + } + tex Error e -> error e + where + filterTileLayer :: (Layer -> Bool) -> Layer -> Maybe [Int] + filterTileLayer f l = case l of + TileLayer _ tiles -> if f l then Just tiles else Nothing + _ -> Nothing + filterObjectLayer :: Layer -> Maybe [MapObject] + filterObjectLayer l = case l of + ObjectLayer _ objs -> Just objs + _ -> Nothing --- | Check for collision detection vs "Blocked" TileLayer that MUST be last layer. +-- | Check for collision detection vs "Blocked" TileLayer. -- x and y in pixels. isBlocked :: Map -> Int -> Int -> Bool -isBlocked (Map (MapData mapWidth _ ts ls) _) x y = +isBlocked (Map (MapData mapWidth _ ts _ blocked _) _) x y = blocked !! ((x `div` ts.width) + (y `div` ts.height) * mapWidth) >= ts.firstGid - where - blocked = (last ls).tiles -- | Renders a map. render :: SDL.Renderer -> Map -> IO () @@ -90,11 +137,11 @@ render renderer (Map mapData tex) = do ( \layer -> mapM_ ( \(x, y) -> - renderTile x y $ layer.tiles !! (x + (y * mapData.width)) + renderTile x y $ layer !! (x + (y * mapData.width)) ) index ) - (init $ mapData.layers) + mapData.tileLayers where index = [(x, y) | x <- [0 .. mapData.width - 1], y <- [0 .. mapData.height - 1]] -- cgit v1.2.3