Scroll using SDL's viewport

Horizontal needs testing.

1 files changed, 47 insertions, 11 deletions

diff --git a/src/Game/Map.hs b/src/Game/Map.hs
index e1dd673..f412410 100644
--- a/src/Game/Map.hs
+++ b/src/Game/Map.hs
@@ -2,18 +2,20 @@ module Game.Map
   ( Map (..),
     Object (..),
     objects,
-    height,
     totalBatteries,
     load,
     render,
     isBlocked,
     isPlayer,
+    Viewport (..),
+    viewport,
   )
 where
 
 import Control.Monad
 import Data.Maybe (mapMaybe)
 import qualified Game.Utils as U
+import SDL (($=))
 import qualified SDL
 import Text.JSON
 import Text.JSON.Types
@@ -106,6 +108,8 @@ data MapData = MapData
   }
   deriving (Show)
 
+data Viewport = Viewport Int Int Int Int
+
 data Map = Map MapData SDL.Texture
 
 -- | Loads a map from a JSON file.
@@ -155,9 +159,6 @@ isPlayer :: Object -> Bool
 isPlayer (PlayerEntity _ _) = True
 isPlayer _ = False
 
-height :: Map -> Int
-height (Map md _) = md.height * md.tileset.height
-
 -- | Return the number of batteries in a map.
 totalBatteries :: Map -> Int
 totalBatteries m = length $ filter isBattery (objects m)
@@ -166,25 +167,60 @@ totalBatteries m = length $ filter isBattery (objects m)
     isBattery (BatteryEntity _ _) = True
     isBattery _ = False
 
--- | Renders a map.
-render :: SDL.Renderer -> Map -> IO ()
-render renderer (Map mapData tex) = do
+-- | Set the SDL viewport based on the map and the provided viewport coordinates.
+-- It returns the viewport to be used by render.
+viewport :: SDL.Renderer -> Map -> Int -> Int -> Int -> Int -> IO Viewport
+viewport renderer (Map mapData _) vx vy vw vh = 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
+
+    halfViewportWidth = vw `div` 2
+    halfViewportHeight = vh `div` 2
+
+    -- the coords are the center focus
+    fx = max (vx - halfViewportWidth) 0
+    fy = max (vy - halfViewportHeight) 0
+
+    newx = min (if fx + halfViewportWidth > mapWidth then mapWidth - vw else fx) (mapWidth - vw)
+    newy = min (if fy + halfViewportHeight > mapHeight then mapHeight - vh else fy) (mapHeight - vh)
+
+    mapRect = U.rect (-newx) (16 - newy) (newx + vw) vh
+
+-- | Render a map.
+-- Requires a Viewport from viewport.
+render :: SDL.Renderer -> Map -> Viewport -> IO ()
+render renderer (Map mapData tex) (Viewport vx vy vw vh) = do
   mapM_
     ( \layer ->
         mapM_
           ( \(x, y) ->
-              renderTile x y $ layer !! (x + (y * mapData.width))
+              -- clipping because we draw one extra row/col because the scroll
+              when (x < mapData.width && y < mapData.height) $
+                renderTile x y (layer !! (x + (y * mapData.width)))
           )
           index
     )
     mapData.tileLayers
   where
-    index = [(x, y) | x <- [0 .. mapData.width - 1], y <- [0 .. mapData.height - 1]]
+    tileWidth = mapData.tileset.width
+    tileHeight = mapData.tileset.height
+
+    -- origin x, y in tiles
+    ox = vx `div` tileWidth
+    oy = vy `div` tileHeight
+
+    -- viewport size in tiles
+    drawWidth = vw `div` tileWidth
+    drawHeight = vh `div` tileHeight
+
+    -- 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
-    tileWidth = mapData.tileset.width
-    tileHeight = mapData.tileset.height
 
     renderTile :: Int -> Int -> Int -> IO ()
     renderTile x y tile