Scroll using SDL's viewport

Horizontal needs testing.

4 files changed, 79 insertions, 18 deletions

diff --git a/src/Game.hs b/src/Game.hs
index 85445b8..8f921e9 100644
--- a/src/Game.hs
+++ b/src/Game.hs
@@ -180,16 +180,18 @@ gameLoop = do
           map' = env.map
           entities = env.entities
           hud = env.hud
-          mapRect = U.rect 0 (fromIntegral gameHeight - M.height map') (fromIntegral gameWidth) (M.height map')
 
       updated <- E.updateAll =<< readIORef entities
       entities $= updated
 
+      -- update the map viewport
+      let (px, py) = E.playerPosition updated
+
       -- render map and entities
       void $ do
-        SDL.rendererViewport renderer $= Just mapRect
-        M.render renderer map'
-        E.render renderer updated
+        viewport <- M.viewport renderer map' px py (fromIntegral gameWidth) (fromIntegral gameHeight - H.height)
+        M.render renderer map' viewport
+        E.renderVisible renderer updated viewport
         SDL.rendererViewport renderer $= Nothing
         H.render renderer hud
 
diff --git a/src/Game/Entities.hs b/src/Game/Entities.hs
index 7e0e0cf..4e5a686 100644
--- a/src/Game/Entities.hs
+++ b/src/Game/Entities.hs
@@ -1,4 +1,4 @@
-module Game.Entities (Entities, Entity, mkEntities, updateAll, render) where
+module Game.Entities (Entities, Entity, mkEntities, updateAll, render, renderVisible, playerPosition) where
 
 import Control.Monad
 import Data.Bits (Bits (..))
@@ -35,6 +35,13 @@ mkEntities sprites m controls stateRef = do
     toEntity playerRef (M.BatteryEntity x y) = mkBattery sprites x y (collision playerRef 16) (collectedBattery stateRef)
     toEntity _ (M.PlayerEntity _ _) = error "Player already processed"
 
+-- | Return the player's entity position (x, y).
+playerPosition :: Entities -> (Int, Int)
+playerPosition (Entities _ _ _ entities) =
+  (player.x, player.y)
+  where
+    player = head entities
+
 processSpawn :: S.SpriteSheet -> Spawn -> IO Entity
 processSpawn sprites (DustEffectSpawn x y) = mkEffect sprites x y "dust"
 
@@ -73,6 +80,18 @@ updateAll es = do
       TypeEnemy -> False
       _ -> True
 
+-- | Render only visible entities according to the provided viewport.
+renderVisible :: SDL.Renderer -> Entities -> M.Viewport -> IO ()
+renderVisible renderer (Entities sprites player state entities) v =
+  render renderer (Entities sprites player state visible)
+  where
+    -- FIXME: entities should have size so we can be exact here and
+    -- avoid the hardcoded size
+    visible = filter (\e -> isVisible v e.x e.y 16 16) entities
+    isVisible :: M.Viewport -> Int -> Int -> Int -> Int -> Bool
+    isVisible (M.Viewport vx vy vw vh) x y w h =
+      x < vx + vw && vx < x + w && y < vy + vh && vy < y + h
+
 render :: SDL.Renderer -> Entities -> IO ()
 render renderer es = do
   state <- readIORef es.state
diff --git a/src/Game/Hud.hs b/src/Game/Hud.hs
index 1e51993..880de50 100644
--- a/src/Game/Hud.hs
+++ b/src/Game/Hud.hs
@@ -1,10 +1,13 @@
-module Game.Hud (Hud, mkHud, render) where
+module Game.Hud (Hud, mkHud, render, height) where
 
 import Data.IORef
 import qualified Game.Sprites as S
 import qualified Game.State as GS
 import qualified SDL
 
+height :: Int
+height = 16
+
 data Hud = Hud
   { sprite :: S.Sprite,
     stateRef :: IORef GS.State
@@ -21,4 +24,5 @@ render renderer hud = do
   let xs = [0 .. state.totalBatteries - 1]
    in mapM_ (\x -> S.render renderer hud.sprite (4 + x * 8) 4 0 (if state.batteries <= x then 0 else 1)) xs
   let xs = [0 .. state.totalLives - 1]
-   in mapM_ (\x -> S.render renderer hud.sprite (320 - 4 - state.totalLives * 8 + x * 8) 4 0 (if state.lives <= x then 2 else 3)) xs
+   in -- magic numbers
+      mapM_ (\x -> S.render renderer hud.sprite (320 - 4 - state.totalLives * 8 + x * 8) 4 0 (if state.lives <= x then 2 else 3)) xs
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