Haskell roguelike - Moving the player
Moving
The previous chapter ended with three actors being drawn on the world map (a bug, a snake and the player). Now lets look at what is required to handle moving the player.
Key bindings
I wanted to support both strait and diagonal movement. This RogueBasin article has a good set of key bindings to use: Preferred Key Controls.
y k u home ^ pgup
\|/ \|/
h-+-l <-+->
/|\ /|\
b j n end v pgdn
vi-keys numpad The standard arrow keys and VIM hjkl keys are supported. Then yubn and the keypad are used for diagonal movement.
Which is easy enough to configure in the backend
06_moving/src/GameEngine.hs (97 to 114)
Config { _cfgKeys = Map.fromList [ ("up" , "Move:up")
, ("k" , "Move:up")
, ("down" , "Move:down")
, ("j" , "Move:down")
, ("left" , "Move:left")
, ("h" , "Move:left")
, ("right" , "Move:right")
, ("l" , "Move:right")
, ("u" , "Move:up-right")
, ("pageup" , "Move:up-right")
, ("y" , "Move:up-left")
, ("home" , "Move:up-left")
, ("n" , "Move:down-right")
, ("end" , "Move:down-left")
, ("b" , "Move:down-left")
, ("pagedown", "Move:down-right")
]
}Handling the key press command
The key handling code is changed to handle the key press
06_moving/src/GameEngine.hs (154 to 160)
"key" -> do
-- Handle the key press
atomically $ modifyTVar' worldV (\w -> runActions w $ handleKey cmdData)
-- Get the updated world
w2 <- atomically $ readTVar worldV
-- Draw
drawAndSend w2This is similar to the “redraw” handler
- Get and modify the current world (using modifyTVar’) by calling runActions*
- Get the updated world
- Draw
Notice the use of modifyTVar' rather than modifyTVar. The former is strict and what you probably want to be using by default.
Actions
The code above is calling a function named runActions with the result of handleKey. handleKey looks like this
06_moving/src/GameEngine.hs (310 to 322)
handleKey :: [Text] -> [RogueAction]
handleKey (cmd:_) =
case cmd of
"Move:up" -> [ActMovePlayer ( 0, 1)]
"Move:down" -> [ActMovePlayer ( 0, -1)]
"Move:left" -> [ActMovePlayer (-1, 0)]
"Move:right" -> [ActMovePlayer ( 1, 0)]
"Move:up-right" -> [ActMovePlayer ( 1, 1)]
"Move:up-left" -> [ActMovePlayer (-1, 1)]
"Move:down-right" -> [ActMovePlayer ( 1, -1)]
"Move:down-left" -> [ActMovePlayer (-1, -1)]
_ -> []
handleKey _ = []06_moving/src/GameCore.hs (63 to 63)
And then runActions and runAction actually do the work of moving the player
06_moving/src/GameEngine.hs (327 to 336)
runActions :: World -> [RogueAction] -> World
runActions world actions =
foldl' runAction world actions
runAction :: World -> RogueAction -> World
runAction world action =
case action of
ActMovePlayer (dx, dy) ->
world & (wdPlayer . plActor . acWorldPos) %~ (\(WorldPos (x, y)) -> WorldPos (x + dx, y + dy))Notice that handleKey returns an array of RogueAction. There is a bit of indirection here, handleKey could simply implement the movement logic. The advantages of having actions like this is that as the game gets more complicated it keeps a clean separation between code asking for actions and the code that performs them. The array of actions means that an event (like a key press) can have more than one action.
This line of code may be worth discussing quickly, as there are a few things going on
06_moving/src/GameEngine.hs (337 to 337)
world & (wdPlayer . plActor . acWorldPos)is a lens to get to the player’s world position%~is going to update that position by sending it to a function(\(WorldPos (x, y)) -> WorldPos (x + dx, y + dy))is the lambda function being called.- Destructure the WorldPos to get the (x, y)
- Created a new WorldPos adding the delta-x and delta-y from the ActMovePlayer
And with that the player can now be moved around the world. Not too bad for the few lines of code we needed to add, and its worth pointing out that no front-end changes were required.
Chapters
Changes
src/GameCore.hs
diff -w -B -a -d -u -b --new-file 05_actors/src/GameCore.hs 06_moving/src/GameCore.hs
--- 05_actors/src/GameCore.hs
+++ 06_moving/src/GameCore.hs
@@ -66,6 +60,10 @@
newtype PlayerPos = PlayerPos (Int, Int) deriving (Show, Eq, Ord)
+newtype RogueAction = ActMovePlayer (Int, Int)
+
+
+
data UiMessage = UiMessage { umCmd :: !Text
, umMessage :: !Text
}
src/GameEngine.hs
diff -w -B -a -d -u -b --new-file 05_actors/src/GameEngine.hs 06_moving/src/GameEngine.hs
--- 05_actors/src/GameEngine.hs
+++ 06_moving/src/GameEngine.hs
@@ -94,7 +93,26 @@
}
where
mkConfig =
- Config { _cfgKeys = Map.fromList [("t", "test")] }
+
+ Config { _cfgKeys = Map.fromList [ ("up" , "Move:up")
+ , ("k" , "Move:up")
+ , ("down" , "Move:down")
+ , ("j" , "Move:down")
+ , ("left" , "Move:left")
+ , ("h" , "Move:left")
+ , ("right" , "Move:right")
+ , ("l" , "Move:right")
+ , ("u" , "Move:up-right")
+ , ("pageup" , "Move:up-right")
+ , ("y" , "Move:up-left")
+ , ("home" , "Move:up-left")
+ , ("n" , "Move:down-right")
+ , ("end" , "Move:down-left")
+ , ("b" , "Move:down-left")
+ , ("pagedown", "Move:down-right")
+ ]
+ }
+
mkPlayer =
Player { _plConn = conn
@@ -133,8 +150,15 @@
drawAndSend w
sendLog conn "draw"
- "key" ->
- sendLog conn $ "TODO: " <> cmd <> ": " <> show cmdData
+
+ "key" -> do
+ -- Handle the key press
+ atomically $ modifyTVar' worldV (\w -> runActions w $ handleKey cmdData)
+ -- Get the updated world
+ w2 <- atomically $ readTVar worldV
+ -- Draw
+ drawAndSend w2
+
_ ->
sendError conn $ "Unknown command: " <> cmd
@@ -278,9 +301,39 @@
x >= topX && x < bottomX && y > bottomY && y <= topY
-
-
getAllActors :: World -> [Actor]
getAllActors world =
world ^. wdPlayer ^. plActor : Map.elems (world ^. wdActors)
+
+
+handleKey :: [Text] -> [RogueAction]
+handleKey (cmd:_) =
+ case cmd of
+ "Move:up" -> [ActMovePlayer ( 0, 1)]
+ "Move:down" -> [ActMovePlayer ( 0, -1)]
+ "Move:left" -> [ActMovePlayer (-1, 0)]
+ "Move:right" -> [ActMovePlayer ( 1, 0)]
+ "Move:up-right" -> [ActMovePlayer ( 1, 1)]
+ "Move:up-left" -> [ActMovePlayer (-1, 1)]
+ "Move:down-right" -> [ActMovePlayer ( 1, -1)]
+ "Move:down-left" -> [ActMovePlayer (-1, -1)]
+ _ -> []
+handleKey _ = []
+
+
+
+
+runActions :: World -> [RogueAction] -> World
+runActions world actions =
+ foldl' runAction world actions
+
+
+runAction :: World -> RogueAction -> World
+runAction world action =
+ case action of
+ ActMovePlayer (dx, dy) ->
+
+ world & (wdPlayer . plActor . acWorldPos) %~ (\(WorldPos (x, y)) -> WorldPos (x + dx, y + dy))
+
+