Haskell roguelike - Viewport scrolling

Posted on April 2, 2018

start prev next

Viewport scrolling

Current the game still allows the player to move off the screen, i.e. out of the viewport. Different roguelikes have different options for dealing with viewport scrolling. Rather than picking a single one I’m going to implement five of them and give the player the option of choosing at runtime which they like best.

Styles

The five viewport scrolling styles I’m implementing are

  1. Scroll: Scroll the viewport as the player moves. E.g. if you move one position off the screen to the right, the world moves one tile.
  2. Center: The player is locked in the center of the screen, the world moves around you
  3. Locked: Like centre but the point that the player is at need not be the centre of the screen.
  4. Snap centre: Once you move off the screen the viewport is snapped back to the centre.
  5. Border: There is a set number of tiles border. As you move into this border the screen scrolls.

This is what the center style looks like

and this is what a 2 tile border style looks like

Personally I find the center style to be too disconcerting. I’ve selected the two tile border as the default as I find this the most intuitive. Its advantage over a simple scroll style is that if there is tile that you can not move over just off the screen (e.g. a wall) then that tile gets scrolled into the viewport. With scroll this does not happen and so you have no idea what is impeding your movement.

Code

Lets start by defining a type for the different styles

09_viewport_scroll/src/GameCore.hs (72 to 77)
data ViewPortStyle = ViewPortCentre
                   | ViewPortLock PlayerPos
                   | ViewPortScroll
                   | ViewPortSnapCentre
                   | ViewPortBorder Int
                   deriving (Show, Eq)

since the player is able to change view port style’s we’ll need an action

09_viewport_scroll/src/GameCore.hs (67 to 68)
data RogueAction = ActMovePlayer (Int, Int)
                 | ActSetPlayerViewPortStyle ViewPortStyle

plViewPortStyle stores the selected viewport style

09_viewport_scroll/src/GameCore.hs (34 to 39)
data Player = Player { _plConn :: !Host.Connection
                     , _plActor :: !Actor
                     , _plScreenSize :: !(Int, Int)
                     , _plWorldTopLeft :: !WorldPos
                     , _plViewPortStyle :: !ViewPortStyle
                     }

mkPlayer in bootWorld is changed to select the default viewport style

09_viewport_scroll/src/GameEngine.hs (125 to 131)
  mkPlayer =
    Player { _plConn = conn
           , _plScreenSize = screenSize
           , _plWorldTopLeft = WorldPos (0, 0)
           , _plActor = mkPlayersActor
           , _plViewPortStyle = ViewPortBorder 2
           }

Keys

The shortcut keys for viewport style selection must be added. I’ve chosen a chord of shift-v _ where V means viewport and _ is the style to select.

09_viewport_scroll/src/GameEngine.hs (114 to 118)
  , ("shift+v c", "Game:ViewPort:Centre")
  , ("shift+v s", "Game:ViewPort:Scroll")
  , ("shift+v p", "Game:ViewPort:Snap")
  , ("shift+v b", "Game:ViewPort:Border")
  , ("shift+v l", "Game:ViewPort:Lock")

handleKeys is updated to handle the key commands

09_viewport_scroll/src/GameEngine.hs (335 to 339)
  "Game:ViewPort:Centre" -> [ActSetPlayerViewPortStyle ViewPortCentre]
  "Game:ViewPort:Scroll" -> [ActSetPlayerViewPortStyle ViewPortScroll]
  "Game:ViewPort:Snap"   -> [ActSetPlayerViewPortStyle ViewPortSnapCentre]
  "Game:ViewPort:Border" -> [ActSetPlayerViewPortStyle $ ViewPortBorder 2]
  "Game:ViewPort:Lock"   -> [ActSetPlayerViewPortStyle $ ViewPortLock (worldCoordToPlayer topLeft $ actor ^. acWorldPos)]

runAction simply updates the player’s current viewport style

09_viewport_scroll/src/GameEngine.hs (358 to 359)
  ActSetPlayerViewPortStyle style ->
    world & (wdPlayer . plViewPortStyle) .~ style

The viewport logic

tryMoveActor calls updatePlayerViewport for each move.

09_viewport_scroll/src/GameEngine.hs (411 to 415)
-- | Update the player's view port
updatePlayerViewport :: World -> World
updatePlayerViewport w =
  let p = w ^. wdPlayer in
  w & wdPlayer .~ (p & plWorldTopLeft .~ calcViewPortTopLeft p)

updatePlayerViewport is just updating the player’s top-left coordinate by calling calcViewPortTopLeft, which is where the core of this logic lives.

09_viewport_scroll/src/GameEngine.hs (420 to 473)
calcViewPortTopLeft :: Player -> WorldPos
calcViewPortTopLeft player =
  let actor = player ^. plActor in

  case player ^. plViewPortStyle of
    -- These two styles put the player in the viewport, so no need to check
    ViewPortCentre -> centreOn (player ^. plScreenSize) (actor ^. acWorldPos)
    ViewPortLock focus -> focusOn focus $ actor ^. acWorldPos

    _ -> 
      let tl@(WorldPos (tX, tY)) = (player ^. plWorldTopLeft) in
      let sz@(width, height) = (player ^. plScreenSize) in
      let (outX, outY) = distanceOutOfViewPort sz tl (actor ^. acWorldPos) in
      
      case player ^. plViewPortStyle of
        ViewPortSnapCentre ->
          if outX /= 0 || outY /= 0
          then centreOn (player ^. plScreenSize) (actor ^. acWorldPos)
          else player ^. plWorldTopLeft

        ViewPortBorder d ->
          let (outX', outY') = distanceOutOfViewPort
                                 (width - d - d, height - d - d)
                                 (WorldPos (tX + d, tY - d))
                                 (actor ^. acWorldPos)
          in
          WorldPos (tX + outX', tY + outY')

        _ -> -- default to ViewPortScroll
          WorldPos (tX + outX, tY + outY)

  where
    centreOn :: (Int, Int) -> WorldPos -> WorldPos
    centreOn (screenWidth, screenHeight) (WorldPos (wAtX, wAtY)) =
      let (sMidX, sMidY) = (screenWidth `div` 2, screenHeight `div` 2) in
      WorldPos (wAtX - sMidX, wAtY + sMidY)
    
    focusOn :: PlayerPos -> WorldPos -> WorldPos
    focusOn (PlayerPos (focusX, focusY)) (WorldPos (atX, atY)) =
      WorldPos (atX - focusX, atY + focusY)
      
    
    distanceOutOfViewPort :: (Int, Int) -> WorldPos -> WorldPos -> (Int, Int)
    distanceOutOfViewPort (screenWidth, screenHeight) (WorldPos (topX, topY)) (WorldPos (atX, atY)) =
      let
        x = if | atX <  topX               -> atX - topX
               | atX >= topX + screenWidth -> atX - topX - screenWidth + 1
               | otherwise -> 0

        y = if | atY >  topY                -> atY - topY
               | atY <= topY - screenHeight -> atY - (topY - screenHeight + 1)
               | otherwise -> 0
      in
      (x, y)

The lock and centre styles are the simplest. There is no need to check if there player is moving off the screen since the screen is always moved to keep the player at a position. So They just call centreOn or focusOn which calculate a top-left that keeps the player at the desired position.

09_viewport_scroll/src/GameEngine.hs (425 to 428)
  case player ^. plViewPortStyle of
    -- These two styles put the player in the viewport, so no need to check
    ViewPortCentre -> centreOn (player ^. plScreenSize) (actor ^. acWorldPos)
    ViewPortLock focus -> focusOn focus $ actor ^. acWorldPos
09_viewport_scroll/src/GameEngine.hs (459 to 466)
  centreOn :: (Int, Int) -> WorldPos -> WorldPos
  centreOn (screenWidth, screenHeight) (WorldPos (wAtX, wAtY)) =
    let (sMidX, sMidY) = (screenWidth `div` 2, screenHeight `div` 2) in
    WorldPos (wAtX - sMidX, wAtY + sMidY)
  
  focusOn :: PlayerPos -> WorldPos -> WorldPos
  focusOn (PlayerPos (focusX, focusY)) (WorldPos (atX, atY)) =
    WorldPos (atX - focusX, atY + focusY)

scroll is also simple, we just update the top-left by the distance the player has moved out of the view port (see *distanceOutOfViewPort)

09_viewport_scroll/src/GameEngine.hs (453 to 454)
  _ -> -- default to ViewPortScroll
    WorldPos (tX + outX, tY + outY)

That leaves snap and border

09_viewport_scroll/src/GameEngine.hs (437 to 449)
      case player ^. plViewPortStyle of
        ViewPortSnapCentre ->
          if outX /= 0 || outY /= 0
          then centreOn (player ^. plScreenSize) (actor ^. acWorldPos)
          else player ^. plWorldTopLeft

        ViewPortBorder d ->
          let (outX', outY') = distanceOutOfViewPort
                                 (width - d - d, height - d - d)
                                 (WorldPos (tX + d, tY - d))
                                 (actor ^. acWorldPos)
          in
          WorldPos (tX + outX', tY + outY')

snap checks if the player is off the screen and if so then snaps the view port to the centre of the screen.

border calculates if the player is off the border, where the border is the size of the screen minus twice the border size. Then scroll the screen, this means that the screen scrolls before the player gets to the edge.

Finally distanceOutOfView is the helper function that checks how many tiles the player has moved off the screen.

09_viewport_scroll/src/GameEngine.hs (471 to 482)
    distanceOutOfViewPort :: (Int, Int) -> WorldPos -> WorldPos -> (Int, Int)
    distanceOutOfViewPort (screenWidth, screenHeight) (WorldPos (topX, topY)) (WorldPos (atX, atY)) =
      let
        x = if | atX <  topX               -> atX - topX
               | atX >= topX + screenWidth -> atX - topX - screenWidth + 1
               | otherwise -> 0

        y = if | atY >  topY                -> atY - topY
               | atY <= topY - screenHeight -> atY - (topY - screenHeight + 1)
               | otherwise -> 0
      in
      (x, y)

Teleportation

You may be tempted to scroll the viewport based on the key pressed. However this usually is a problem later on when you start adding more features to the game. For example teleporters or any other device that moves the player more than a single tile would then require special logic. Its much simpler to simply calculate the viewport from where the player actually was moved to.

Chapters

start prev next

Changes

src/GameCore.hs

diff -w -B -a -d -u -b --new-file 08_layers/src/GameCore.hs 09_viewport_scroll/src/GameCore.hs
--- 08_layers/src/GameCore.hs
+++ 09_viewport_scroll/src/GameCore.hs
@@ -30,12 +30,15 @@
                    , _acStdGen :: !Rnd.StdGen
                    }
 
+
 data Player = Player { _plConn :: !Host.Connection
                      , _plActor :: !Actor
                      , _plScreenSize :: !(Int, Int)
                      , _plWorldTopLeft :: !WorldPos
+                     , _plViewPortStyle :: !ViewPortStyle
                      }
 
+
 data World = World { _wdPlayer :: !Player
                    , _wdConfig :: !Config
                    , _wdMap :: !(Map WorldPos Entity)
@@ -60,7 +63,19 @@
 newtype WorldPos = WorldPos (Int, Int) deriving (Show, Eq, Ord)
 newtype PlayerPos = PlayerPos (Int, Int) deriving (Show, Eq, Ord)
 
-newtype RogueAction = ActMovePlayer (Int, Int)
+
+data RogueAction = ActMovePlayer (Int, Int)
+                 | ActSetPlayerViewPortStyle ViewPortStyle
+
+
+
+data ViewPortStyle = ViewPortCentre
+                   | ViewPortLock PlayerPos
+                   | ViewPortScroll
+                   | ViewPortSnapCentre
+                   | ViewPortBorder Int
+                   deriving (Show, Eq)
+
 
 
 data UiMessage = UiMessage { umCmd :: !Text

src/GameEngine.hs

diff -w -B -a -d -u -b --new-file 08_layers/src/GameEngine.hs 09_viewport_scroll/src/GameEngine.hs
--- 08_layers/src/GameEngine.hs
+++ 09_viewport_scroll/src/GameEngine.hs
@@ -109,17 +109,28 @@
                                        , ("end"     , "Move:down-left")
                                        , ("b"       , "Move:down-left")
                                        , ("pagedown", "Move:down-right")
+
+
+                                       , ("shift+v c", "Game:ViewPort:Centre")
+                                       , ("shift+v s", "Game:ViewPort:Scroll")
+                                       , ("shift+v p", "Game:ViewPort:Snap")
+                                       , ("shift+v b", "Game:ViewPort:Border")
+                                       , ("shift+v l", "Game:ViewPort:Lock")
+
                                        ]
-             , _cfgMinMaxBounds = (0, 30, -30, 0)
+             , _cfgMinMaxBounds = (-300, 300, -300, 300)
              }
 
+
     mkPlayer =
       Player { _plConn = conn
              , _plScreenSize = screenSize
              , _plWorldTopLeft = WorldPos (0, 0)
              , _plActor = mkPlayersActor
+             , _plViewPortStyle = ViewPortBorder 2
              }
 
+
     mkPlayersActor =
       Actor { _acId = Aid "player"
             , _acClass = ClassPlayer
@@ -151,7 +162,7 @@
       
     "key" -> do
       -- Handle the key press
-      atomically $ modifyTVar' worldV (\w -> runActions w $ handleKey cmdData)
+      atomically $ modifyTVar' worldV (\w -> runActions w $ handleKey w cmdData)
       -- Get the updated world
       w2 <- atomically $ readTVar worldV
       -- Draw
@@ -310,8 +316,11 @@
   world ^. wdPlayer ^. plActor : Map.elems (world ^. wdActors)
 
 
-handleKey :: [Text] -> [RogueAction]
-handleKey (cmd:_) = 
+handleKey :: World -> [Text] -> [RogueAction]
+handleKey world (cmd:_) = 
+  let actor = world ^. wdPlayer ^. plActor in
+  let topLeft = world ^. wdPlayer ^. plWorldTopLeft in
+
   case cmd of
     "Move:up"         -> [ActMovePlayer ( 0,  1)]
     "Move:down"       -> [ActMovePlayer ( 0, -1)]
@@ -321,8 +330,17 @@
     "Move:up-left"    -> [ActMovePlayer (-1,  1)]
     "Move:down-right" -> [ActMovePlayer ( 1, -1)]
     "Move:down-left"  -> [ActMovePlayer (-1, -1)]
+
+
+    "Game:ViewPort:Centre" -> [ActSetPlayerViewPortStyle ViewPortCentre]
+    "Game:ViewPort:Scroll" -> [ActSetPlayerViewPortStyle ViewPortScroll]
+    "Game:ViewPort:Snap"   -> [ActSetPlayerViewPortStyle ViewPortSnapCentre]
+    "Game:ViewPort:Border" -> [ActSetPlayerViewPortStyle $ ViewPortBorder 2]
+    "Game:ViewPort:Lock"   -> [ActSetPlayerViewPortStyle $ ViewPortLock (worldCoordToPlayer topLeft $ actor ^. acWorldPos)]
+
+
     _                 -> []
-handleKey _ = []
+handleKey _ _ = []
 
 
 runActions :: World -> [RogueAction] -> World
@@ -337,6 +355,11 @@
       fromMaybe world $ tryMoveActor world (world ^. wdPlayer ^. plActor) move
 
 
+    ActSetPlayerViewPortStyle style ->
+      world & (wdPlayer . plViewPortStyle) .~ style
+
+
+
 tryMoveActor :: World -> Actor -> (Int, Int) -> Maybe World
 tryMoveActor world actor (dx, dy) =
   let
@@ -371,7 +394,7 @@
       if canMove
       then
         let movedActor = actor & acWorldPos .~ tryWorldTo' in
-        Just $ updateActor world movedActor
+        Just . updatePlayerViewport $ updateActor world movedActor
       else
         Nothing
 
@@ -382,3 +405,80 @@
   if w ^. wdPlayer ^. plActor ^. acId == (actor ^. acId)
   then w & (wdPlayer . plActor) .~ actor                         -- update the player's actor
   else w & wdActors %~ Map.adjust (const actor) (actor ^. acId)  -- update other actor, nop if aid not found
+
+
+
+-- | Update the player's view port
+updatePlayerViewport :: World -> World
+updatePlayerViewport w =
+  let p = w ^. wdPlayer in
+  w & wdPlayer .~ (p & plWorldTopLeft .~ calcViewPortTopLeft p)
+
+
+
+
+calcViewPortTopLeft :: Player -> WorldPos
+calcViewPortTopLeft player =
+  let actor = player ^. plActor in
+
+
+  case player ^. plViewPortStyle of
+    -- These two styles put the player in the viewport, so no need to check
+    ViewPortCentre -> centreOn (player ^. plScreenSize) (actor ^. acWorldPos)
+    ViewPortLock focus -> focusOn focus $ actor ^. acWorldPos
+
+
+    _ -> 
+      let tl@(WorldPos (tX, tY)) = (player ^. plWorldTopLeft) in
+      let sz@(width, height) = (player ^. plScreenSize) in
+      let (outX, outY) = distanceOutOfViewPort sz tl (actor ^. acWorldPos) in
+      
+
+      case player ^. plViewPortStyle of
+        ViewPortSnapCentre ->
+          if outX /= 0 || outY /= 0
+          then centreOn (player ^. plScreenSize) (actor ^. acWorldPos)
+          else player ^. plWorldTopLeft
+
+        ViewPortBorder d ->
+          let (outX', outY') = distanceOutOfViewPort
+                                 (width - d - d, height - d - d)
+                                 (WorldPos (tX + d, tY - d))
+                                 (actor ^. acWorldPos)
+          in
+          WorldPos (tX + outX', tY + outY')
+
+
+
+        _ -> -- default to ViewPortScroll
+          WorldPos (tX + outX, tY + outY)
+
+
+  where
+
+    centreOn :: (Int, Int) -> WorldPos -> WorldPos
+    centreOn (screenWidth, screenHeight) (WorldPos (wAtX, wAtY)) =
+      let (sMidX, sMidY) = (screenWidth `div` 2, screenHeight `div` 2) in
+      WorldPos (wAtX - sMidX, wAtY + sMidY)
+    
+    focusOn :: PlayerPos -> WorldPos -> WorldPos
+    focusOn (PlayerPos (focusX, focusY)) (WorldPos (atX, atY)) =
+      WorldPos (atX - focusX, atY + focusY)
+
+      
+    
+
+    distanceOutOfViewPort :: (Int, Int) -> WorldPos -> WorldPos -> (Int, Int)
+    distanceOutOfViewPort (screenWidth, screenHeight) (WorldPos (topX, topY)) (WorldPos (atX, atY)) =
+      let
+        x = if | atX <  topX               -> atX - topX
+               | atX >= topX + screenWidth -> atX - topX - screenWidth + 1
+               | otherwise -> 0
+
+        y = if | atY >  topY                -> atY - topY
+               | atY <= topY - screenHeight -> atY - (topY - screenHeight + 1)
+               | otherwise -> 0
+      in
+      (x, y)
+
+

Chapters

start prev next