aboutsummaryrefslogtreecommitdiff
path: root/src/Game
diff options
context:
space:
mode:
authorJuan J. Martinez <jjm@usebox.net>2023-04-30 08:16:34 +0100
committerJuan J. Martinez <jjm@usebox.net>2023-04-30 08:16:34 +0100
commit1c9a6a667591c1b1705f9c3016743db67fa54680 (patch)
treed20184fc544b15891bbf528ba54dcb4d64c01bb2 /src/Game
parent0e65f214d2b8ced4deaf6aac43a6ea0872ba1654 (diff)
downloadspace-plat-hs-1c9a6a667591c1b1705f9c3016743db67fa54680.tar.gz
space-plat-hs-1c9a6a667591c1b1705f9c3016743db67fa54680.zip
Support for multiple tilesets
- first one defines the tile layer tile size (e.g. 8x8) - can be of different size - parsing animation data for tile animations (WIP)
Diffstat (limited to 'src/Game')
-rw-r--r--src/Game/Map.hs68
1 files changed, 49 insertions, 19 deletions
diff --git a/src/Game/Map.hs b/src/Game/Map.hs
index 31aa043..e22d18f 100644
--- a/src/Game/Map.hs
+++ b/src/Game/Map.hs
@@ -28,7 +28,9 @@ data Tileset = Tileset
{ cols :: Int,
width :: Int,
height :: Int,
- firstGid :: Int
+ firstGid :: Int,
+ tilecount :: Int,
+ tiles :: [Tile]
}
deriving (Show)
@@ -57,11 +59,17 @@ data Object
data JsonMapData = JsonMapData
{ width :: Int,
height :: Int,
- tileset :: Tileset,
+ tilesets :: [Tileset],
layers :: [Layer]
}
deriving (Show)
+newtype Frame = Frame Int deriving (Show)
+
+data Tile = Tile
+ {id :: Int, animation :: [Frame]}
+ deriving (Show)
+
instance JSON Property where
showJSON = undefined
readJSON (JSObject obj) = do
@@ -74,14 +82,30 @@ instance JSON Property where
_ -> Error "unsupported property value type"
readJSON _ = mzero
+instance JSON Frame where
+ showJSON = undefined
+ readJSON (JSObject obj) = do
+ Frame <$> valFromObj "tileid" obj
+ readJSON _ = mzero
+
+instance JSON Tile where
+ showJSON = undefined
+ readJSON (JSObject obj) = do
+ Tile
+ <$> valFromObj "id" obj
+ <*> valFromObj "animation" obj
+ readJSON _ = mzero
+
instance JSON Tileset where
showJSON = undefined
- readJSON (JSArray [JSObject obj]) = do
+ readJSON (JSObject obj) = do
Tileset
<$> valFromObj "columns" obj
<*> valFromObj "tilewidth" obj
<*> valFromObj "tileheight" obj
<*> valFromObj "firstgid" obj
+ <*> valFromObj "tilecount" obj
+ <*> (valFromObj "tiles" obj <|> pure [])
readJSON _ = mzero
instance JSON Layer where
@@ -143,7 +167,7 @@ instance JSON JsonMapData where
data MapData = MapData
{ width :: Int,
height :: Int,
- tileset :: Tileset,
+ tilesets :: [Tileset],
tileLayers :: [[Int]],
blocked :: [Int],
objects :: [Object]
@@ -178,7 +202,7 @@ load filename tex = do
MapData
{ width = s.width,
height = s.height,
- tileset = s.tileset,
+ tilesets = s.tilesets,
tileLayers = tileLayers,
blocked = blockedLayer,
objects = concat $ mapMaybe filterObjectLayer s.layers
@@ -198,8 +222,10 @@ load filename tex = do
-- | Check for collision detection vs "Blocked" TileLayer.
-- x and y in pixels.
isBlocked :: Map -> Int -> Int -> Bool
-isBlocked (Map (MapData mapWidth _ ts _ blocked _) _) x y =
+isBlocked (Map (MapData mapWidth _ tilesets _ blocked _) _) x y =
blocked !! ((x `div` ts.width) + (y `div` ts.height) * mapWidth) >= ts.firstGid
+ where
+ ts = head tilesets
-- | Return the objects in a map.
objects :: Map -> [Object]
@@ -225,8 +251,9 @@ viewport renderer (Map mapData _) vx vy vw vh offs = do
SDL.rendererViewport renderer $= Just mapRect
pure $ Viewport newx newy vw vh
where
- mapWidth = mapData.width * mapData.tileset.width
- mapHeight = mapData.height * mapData.tileset.height
+ tileset = head mapData.tilesets
+ mapWidth = mapData.width * tileset.width
+ mapHeight = mapData.height * tileset.height
halfViewportWidth = vw `div` 2
halfViewportHeight = vh `div` 2
@@ -257,8 +284,9 @@ render renderer (Map mapData tex) (Viewport vx vy vw vh) = do
)
mapData.tileLayers
where
- tileWidth = mapData.tileset.width
- tileHeight = mapData.tileset.height
+ tileset = head mapData.tilesets
+ tileWidth = tileset.width
+ tileHeight = tileset.height
-- origin x, y in tiles
ox = vx `div` tileWidth
@@ -271,15 +299,17 @@ render renderer (Map mapData tex) (Viewport vx vy vw vh) = do
-- we draw one extra row/col
index = [(x, y) | x <- [ox .. ox + drawWidth], y <- [oy .. oy + drawHeight]]
- columns = mapData.tileset.cols
- firstgid = mapData.tileset.firstGid
+ -- XXX: performance of this?
+ findTileset :: Int -> Maybe Tileset
+ findTileset tile = find (\t -> t.firstGid + t.tilecount > tile && t.firstGid <= tile) mapData.tilesets
renderTile :: Int -> Int -> Int -> IO ()
- renderTile x y tile
- | tile < firstgid = pure ()
- | otherwise = do
- let tx = (tile - firstgid) `rem` columns
- ty = (tile - firstgid) `div` columns
- src = U.rect (tx * tileWidth) (ty * tileHeight) tileWidth tileHeight
- dst = U.rect (x * tileWidth) (y * tileHeight) tileWidth tileHeight
+ renderTile x y tile =
+ case findTileset tile of
+ Nothing -> pure ()
+ Just ts -> do
+ let tx = (tile - ts.firstGid) `rem` ts.cols
+ ty = (tile - ts.firstGid) `div` ts.cols
+ src = U.rect (tx * ts.width) (ty * ts.height) ts.width ts.height
+ dst = U.rect (x * tileWidth) (y * tileHeight) ts.width ts.height
SDL.copy renderer tex (Just src) (Just dst)