aboutsummaryrefslogtreecommitdiff
path: root/src
diff options
context:
space:
mode:
authorJuan J. Martinez <jjm@usebox.net>2023-02-09 17:41:31 +0000
committerJuan J. Martinez <jjm@usebox.net>2023-02-09 17:41:31 +0000
commitc2fb8cd922032e24962bc3aef65d5428c5361957 (patch)
treecbd4c371f676383205c238f50d40b2e378a2e442 /src
parentffc274d310b14eb663d018a00a64b78ba45d0fc5 (diff)
downloadspace-plat-hs-c2fb8cd922032e24962bc3aef65d5428c5361957.tar.gz
space-plat-hs-c2fb8cd922032e24962bc3aef65d5428c5361957.zip
Object layer support for map entities
Diffstat (limited to 'src')
-rw-r--r--src/Game/Map.hs91
1 files changed, 69 insertions, 22 deletions
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]]