From 2103dc0dcf42fd2489d5f9e4fec46146f7cc9db5 Mon Sep 17 00:00:00 2001
From: "Juan J. Martinez" <jjm@usebox.net>
Date: Sat, 4 Feb 2023 21:20:12 +0000
Subject: Initial import

---
 src/Game/Map.hs | 120 ++++++++++++++++++++++++++++++++++++++++++++++++++++++++
 1 file changed, 120 insertions(+)
 create mode 100644 src/Game/Map.hs

(limited to 'src/Game/Map.hs')

diff --git a/src/Game/Map.hs b/src/Game/Map.hs
new file mode 100644
index 0000000..7866f97
--- /dev/null
+++ b/src/Game/Map.hs
@@ -0,0 +1,120 @@
+module Game.Map
+  ( Map,
+    load,
+    render,
+    isBlocked,
+  )
+where
+
+import Control.Monad
+import qualified Game.Utils as U
+import qualified SDL
+import Text.JSON
+import Text.JSON.Types
+
+data Tileset = Tileset
+  { tsCols :: Int,
+    tsWidth :: Int,
+    tsHeight :: Int,
+    tsFirstGid :: Int
+  }
+  deriving (Show)
+
+data TileLayer = TileLayer
+  { tlName :: String,
+    tlTiles :: [Int]
+  }
+  deriving (Show)
+
+data MapData = MapData
+  { mWidth :: Int,
+    mHeight :: Int,
+    mTileset :: Tileset,
+    mLayers :: [TileLayer]
+  }
+  deriving (Show)
+
+data Map = Map MapData SDL.Texture
+
+instance JSON Tileset where
+  showJSON = undefined
+  readJSON (JSArray [JSObject obj]) = do
+    Tileset
+      <$> valFromObj "columns" obj
+      <*> valFromObj "tilewidth" obj
+      <*> valFromObj "tileheight" obj
+      <*> valFromObj "firstgid" obj
+  readJSON _ = mzero
+
+instance JSON TileLayer where
+  showJSON = undefined
+  readJSON (JSObject obj) =
+    case get_field obj "type" of
+      Just "tilelayer" ->
+        TileLayer
+          <$> valFromObj "name" obj
+          <*> valFromObj "data" obj
+      _ -> Error "unsupported layer type"
+  readJSON _ = mzero
+
+instance JSON MapData where
+  showJSON = undefined
+  readJSON (JSObject obj) =
+    MapData
+      <$> valFromObj "width" obj
+      <*> valFromObj "height" obj
+      <*> valFromObj "tilesets" obj
+      <*> valFromObj "layers" obj
+  readJSON _ = mzero
+
+-- | 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
+    Error e -> error e
+
+-- | Check for collision detection vs "Blocked" TileLayer that MUST be last layer.
+--   x and y in pixels.
+isBlocked :: Map -> Int -> Int -> Bool
+isBlocked (Map (MapData width _ ts layers) _) x y =
+  tiles !! ((x `div` tw) + (y `div` th) * width) >= firstgid
+  where
+    tiles = tlTiles (last layers)
+    tw = tsWidth ts
+    th = tsHeight ts
+    firstgid = tsFirstGid ts
+
+-- | Renders a map.
+render :: SDL.Renderer -> Map -> IO ()
+render renderer (Map mapData tex) = do
+  mapM_
+    ( \layer ->
+        mapM_
+          ( \(x, y) ->
+              renderTile x y $ tlTiles layer !! (x + (y * mWidth mapData))
+          )
+          index
+    )
+    (init $ mLayers mapData)
+  where
+    mw = mWidth mapData
+    mh = mHeight mapData
+    index = [(x, y) | x <- [0 .. mw - 1], y <- [0 .. mh - 1]]
+
+    ts = mTileset mapData
+    firstgid = tsFirstGid ts
+    cols = tsCols ts
+    tileWidth = tsWidth ts
+    tileHeight = tsHeight ts
+
+    renderTile :: Int -> Int -> Int -> IO ()
+    renderTile x y tile
+      | tile < firstgid = pure ()
+      | otherwise = do
+          let tx = (tile - firstgid) `rem` cols
+              ty = (tile - firstgid) `div` cols
+              src = U.rect (tx * tileWidth) (ty * tileHeight) tileWidth tileHeight
+              dst = U.rect (x * tileWidth) (y * tileHeight) tileWidth tileHeight
+          SDL.copy renderer tex (Just src) (Just dst)
-- 
cgit v1.2.3