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)

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)