Haskell roguelike - UI code
Boilerplate warning
There is a bit of support code that needs to be written to connect haskell and the browser UI. None of this is roguelike specific so it may be worth quickly skimming over the rest of this chapter and coming back when required. The remaining chapters will cover roguelike topics so don’t be discouraged by the infrastructure code below. Its also not nearly as bad as it looks.
The infrastructure
Scotty
I’m using Scotty for the HTTP and web-socket handling. It is simple and not particularly opinionated.
Scotty host code
First the require imports
01_web_ui/src/GameHost.hs (12 to 20)
import Protolude hiding (Map)
import qualified Web.Scotty as Sc
import qualified Data.ByteString.Lazy as BSL
import Control.Lens.TH (makeLenses)
import qualified Network.Wai as Wai
import qualified Network.Wai.Middleware.Gzip as Sc
import qualified Network.Wai.Handler.Warp as Warp
import qualified Network.Wai.Handler.WebSockets as WaiWs
import qualified Network.WebSockets as WS
The connection type lets us wrap up the scotty connection details so that other code can pass it around without having to know anything about scotty.
01_web_ui/src/GameHost.hs (24 to 28)
data Connection = Connection { _conSendData :: BSL.ByteString -> IO ()
, _conReceiveText :: IO Text
}
makeLenses ''Connection
runHost starts scotty listening on port 61492 and sets up the web sockets.
01_web_ui/src/GameHost.hs (32 to 36)
runHost :: (Connection -> IO ()) -> IO ()
runHost startHost = do
let settings = Warp.setPort 61492 $ Warp.setHost "127.0.0.1" Warp.defaultSettings
sapp <- scottyApp
Warp.runSettings settings $ WaiWs.websocketsOr WS.defaultConnectionOptions (wsapp startHost) sapp
scottyApp handles the serving of the static resources. Here several get routes have been configured.
01_web_ui/src/GameHost.hs (40 to 58)
scottyApp :: IO Wai.Application
scottyApp =
Sc.scottyApp $ do
Sc.middleware $ Sc.gzip $ Sc.def { Sc.gzipFiles = Sc.GzipCompress }
--Sc.middleware S.logStdoutDev
Sc.get "/" $
Sc.file "html/rogue.html"
Sc.get "/ping" $
Sc.text "pong"
Sc.get "/:res" $ do
res <- Sc.param "res"
Sc.file $ "html/" <> res
Sc.get "/images/:img" $ do
img <- Sc.param "img"
Sc.file $ "html/images/" <> img
Finally wsapp handles the web socket calls. A new connection object is created and passed to the startHost function
Communication between the browser and haskell
The browser will send haskell simple text based commands such as redraw. Haskell will send JSON encoded objects.
Types for the UI
These types are used to send data to the UI. They all have Aeson toJSON instances.
- UiMessage is used for sending simple messages to the UI
- UiConfig is used to send initial configuration to the UI. For now the config only contains shortcut key definitions. See the section on keyboard handling below.
01_web_ui/src/GameCore.hs (33 to 72)
data UiMessage = UiMessage { umCmd :: !Text
, umMessage :: !Text
}
deriving (Generic)
data UiConfig = UiConfig { ucCmd :: !Text
, ucData :: !UiConfigData
}
deriving (Generic)
newtype UiConfigData = UiConfigData { udKeys :: [UiKey]
}
deriving (Generic)
data UiKey = UiKey { ukShortcut :: !Text
, ukAction :: !Text
}
deriving (Generic)
instance Ae.ToJSON UiMessage where
toJSON = Ae.genericToJSON Ae.defaultOptions { Ae.fieldLabelModifier = renField 2 True }
instance Ae.ToJSON UiConfig where
toJSON = Ae.genericToJSON Ae.defaultOptions { Ae.fieldLabelModifier = renField 2 True }
instance Ae.ToJSON UiConfigData where
toJSON = Ae.genericToJSON Ae.defaultOptions { Ae.fieldLabelModifier = renField 2 True }
instance Ae.ToJSON UiKey where
toJSON = Ae.genericToJSON Ae.defaultOptions { Ae.fieldLabelModifier = renField 2 True }
-- | drop prefix, and then lower case
-- | renField 3 "tskBla" == "bla"
renField :: Int -> Bool -> [Char] -> [Char]
renField drp toLower =
Txt.unpack . (if toLower then mkLower else identity) . Txt.drop drp . Txt.pack
where
mkLower t = Txt.toLower (Txt.take 1 t) <> Txt.drop 1 t
Types for the game
- Player: The player represents the person playing the game. Currently it only stores the connection and the current screen size
- World: The world represents the entire game state
- Config: Configuration data, again for now just the shortcut keys
01_web_ui/src/GameCore.hs (19 to 28)
data Player = Player { _plConn :: !Host.Connection
, _plScreenSize :: !(Int, Int)
}
data World = World { _wdPlayer :: !Player
, _wdConfig :: !Config
}
newtype Config = Config { _cfgKeys :: Map Text Text
}
Running the host
runGame is called to start the host and pass control to manageConnection
01_web_ui/src/GameEngine.hs (22 to 23)
manageConnection waits for a command from the browser, parses it and executes the instruction.
If manageConnection gets a init command, it will created a new World and store it in a TVar. This is the mutable state of the world managed by STM.
01_web_ui/src/GameEngine.hs (28 to 58)
manageConnection :: Host.Connection -> IO ()
manageConnection conn = do
initCmd <- conn ^. conReceiveText
case parseCommand initCmd of
Just ("init", cmdData) ->
case initialiseConnection conn cmdData of
Right world -> do
worldV <- atomically $ newTVar world
sendConfig conn $ world ^. wdConfig
runConnection worldV
Left e ->
sendError conn e
_ ->
pass
where
runConnection worldV =
forever $ do
t <- conn ^. conReceiveText
case parseCommand t of
Nothing -> putText $ "error parsing: " <> t
Just (cmd, cmdData) -> runCmd conn worldV cmd cmdData
parseCommand :: Text -> Maybe (Text, [Text])
parseCommand t =
case Txt.splitOn "|" t of
(c:d) -> Just (c, d)
_ -> Nothing
The init command is expected to pass the size of the screen as a parameter. initialiseConnection and parseScreenSize handle this logic
01_web_ui/src/GameEngine.hs (63 to 70)
initialiseConnection :: Host.Connection -> [Text] -> Either Text World
initialiseConnection conn cmdData =
case parseScreenSize cmdData of
Nothing ->
Left "missing / invalid screen size"
Just (width, height) ->
Right $ bootWorld conn (width, height)
01_web_ui/src/GameEngine.hs (145 to 153)
parseScreenSize :: [Text] -> Maybe (Int, Int)
parseScreenSize cmd = do
(tx, ty) <- case cmd of
(tx : ty : _) -> Just (tx, ty)
_ -> Nothing
x <- (readMaybe . Txt.unpack $ tx) :: Maybe Int
y <- (readMaybe . Txt.unpack $ ty) :: Maybe Int
pure (x, y)
bootWorld creates a new World and Config. For this chapter it sets up a single shortcut key t, that should send the test command back
01_web_ui/src/GameEngine.hs (75 to 85)
bootWorld :: Host.Connection -> (Int, Int) -> World
bootWorld conn screenSize =
World { _wdPlayer = mkPlayer
, _wdConfig = mkConfig
}
where
mkConfig =
Config { _cfgKeys = Map.fromList [("t", "test")] }
mkPlayer =
Player conn screenSize
Once the world is initialised, a thread is started in manageConnection’s runConnection function that waits for commands from the web socket. Each command is passed to runCmd for handling
The current version of runCmd will
- Update the screen size when a redraw command is received
- Send a log message whenever a key press (from the shortcut keys) is received.
- Raise an error on all other commands
01_web_ui/src/GameEngine.hs (90 to 107)
runCmd :: Host.Connection -> TVar World -> Text -> [Text] -> IO ()
runCmd conn worldV cmd cmdData =
case cmd of
"redraw" ->
case parseScreenSize cmdData of
Nothing -> sendError conn "missing / invalid screen size"
Just (sx, sy) -> do
updatePlayer (plScreenSize .~ (sx, sy))
sendLog conn $ "TODO: " <> cmd
"key" ->
sendLog conn $ "TODO: " <> cmd <> ": " <> show cmdData
_ ->
sendError conn $ "Unknown command: " <> cmd
where
updatePlayer f = atomically $ modifyTVar' worldV (\w -> w & wdPlayer %~ f)
Since the JSON data payload could get large it is being compressed with bzip before being sent over the websocket. bzlib handles this for us.
01_web_ui/src/GameEngine.hs (137 to 140)
sendData :: Host.Connection -> Text -> IO ()
sendData conn t = do
let lz = Bz.compress . BSL.fromStrict . TxtE.encodeUtf8 $ t
conn ^. conSendData $ lz
And the final few helper functions.
01_web_ui/src/GameEngine.hs (112 to 133)
sendLog :: Host.Connection -> Text -> IO ()
sendLog conn err =
sendData conn $ Ae.encodeText $ UiMessage "log" err
sendError :: Host.Connection -> Text -> IO ()
sendError conn err =
sendData conn $ Ae.encodeText $ UiMessage "error" err
sendConfig :: Host.Connection -> Config -> IO ()
sendConfig conn config =
sendData conn . Ae.encodeText $ UiConfig "config" (buildConfig config)
buildConfig :: Config -> UiConfigData
buildConfig cfg =
UiConfigData $ buildKeys (cfg ^. cfgKeys)
where
buildKeys ks = buildKey <$> Map.toList ks
buildKey (s, a) = UiKey s a
Json encoding
As I’m using Text it would be nice to have an Aeson function that encodes to Text rather than ByteString. The Data.Aeson.Text.Extended module defines encodeText to do this and re-exports Data.Aeson
01_web_ui/src/Data/Aeson/Text/Extended.hs (2 to 17)
{-# LANGUAGE NoImplicitPrelude #-}
module Data.Aeson.Text.Extended
( encodeText
, module Data.Aeson.Text
)
where
import Protolude
import qualified Data.Text.Lazy as TxtL
import qualified Data.Aeson as Ae
import Data.Aeson.Text
encodeText :: Ae.ToJSON a => a -> Text
encodeText =
TxtL.toStrict . encodeToLazyText
HTML and Javascript
Here is the full HTML for the game. The core of the html is the canvas on which the tiles will be drawn. Notice that
- The CSS tries to removes all margins and paddings so that the game fills the page
- The canvas is set to fill the page
- There is a div on top of the canvas. It is responsible for capturing any mouse click etc
01_web_ui/html/rogue.html (2 to 47)
<html>
<head>
<title>RogueLike</title>
<style type="text/css">
body {
margin:0;
padding:0;
background: black;
}
canvas {
display:block;
width: 100%;
height: 100%
}
.container {
height: auto;
overflow: hidden;
padding: 0px;
margin: 0px;
height: 100%;
}
.title {
font-weight: bold;
}
</style>
<script src="bzip2.js"></script>
<script src="mousetrap.min.js"></script>
<script src="mousetrap.pause.min.js"></script>
<script src="ramda.min.js"></script>
<script src="rogue.js"></script>
</head>
<body onload="start()">
<div id="main" width="100%" class="container">
<canvas id="tilesCanvas" style="position: absolute; left: 0; top: 0; z-index: 0;"></canvas>
<!-- layer for mouse clicks etc, on top of all drawing layers -->
<div id="topInteractionLayer" style="display:block; position: absolute; left: 0; top: 0; z-index: 1000;"></div>
</div>
</body>
</html>
Javascript libraries
The following libraries are being used
- rogue.js: The java script for this roguelike
- mousetrap and mousetrap.pause: See keyboard handling below
- rambda: A library for functional programming in JS. I’ll mostly be using the forEach function
- bzip2: A JS implementation of bzip to decompress data being sent from haskell. See sendData above
Keyboard handling
Keyboard handling is made pretty simple by mousetrap. As an example here is how the ?
key is configured to do an alert
01_web_ui/html/rogue.js (152 to 152)
Mousetrap offers a few fantastic features that we’ll be using for the game
- Simple configuration
- Ability to pause keyboard handling
- Complex shortcuts / chords
As you saw above the haskell code sends the shortcut keys that should be setup. This makes it possible to control what shortcuts are available dynamically and sticks with the idea of keeping as much logic in haskell as possible.
The sendKey function is called when a key is pressed. It stops all further key presses and sends the key press command to the haskell server. Key presses are enabled again when a response is received by runWebSocket
01_web_ui/html/rogue.js (16 to 25)
function sendKey(k){
//Stop next moves, until the server responds
Mousetrap.pause();
const act = () => {
sendCmd("key", k);
};
act();
}
The websocket loop
runWebSocket handles the communication over websockets and responds to commands.
01_web_ui/html/rogue.js (29 to 81)
function runWebSocket(userName)
{
var ws = new WebSocket("ws://localhost:61492/");
ws.binaryType = 'arraybuffer';
ws.onopen = function() {
sendCmd = ( c, d ) => {
ws.send(c + "|" + (d || ""));
}
sendCmd("init", gridSizeStr());
};
ws.onmessage = function (evt) {
var bytes = new Uint8Array(evt.data);
var m = bzip2.simple(bzip2.array(bytes));
cmd = JSON.parse(m);
switch( cmd.cmd ){
case "config":
//Load keys
config.help = "";
for( var i in cmd.data.keys ){
const s = cmd.data.keys[i].shortcut;
const a = cmd.data.keys[i].action; //const avoids variable capture in the closure
Mousetrap.bind( s, () => sendKey( a ), "keyup" );
config.help += s + ": " + a + "\n";
}
sendCmd("redraw", gridSizeStr());
break;
case "log":
console.log( cmd.message );
break;
case "error":
alert( cmd.message );
break;
}
Mousetrap.unpause();
};
ws.onclose = function() {
sendCmd = ( c, d ) => {}
};
window.onbeforeunload = function(evt) {
sendCmd = ( c, d ) => {}
socket.close();
};
}
- The web socket connection is initiated and set to send data as an array buffer
01_web_ui/html/rogue.js (32 to 33)
- As soon as a connection is made, the init command is sent with the current screen size
01_web_ui/html/rogue.js (37 to 43)
ws.onopen = function() {
sendCmd = ( c, d ) => {
ws.send(c + "|" + (d || ""));
}
sendCmd("init", gridSizeStr());
};
- When a message arrives, it is uncompressed and parsed as JSON
01_web_ui/html/rogue.js (47 to 50)
ws.onmessage = function (evt) {
var bytes = new Uint8Array(evt.data);
var m = bzip2.simple(bzip2.array(bytes));
cmd = JSON.parse(m);
- The code then switches on the command being sent and performs the appropriate action
- For a config message
- The shortcut keys are bound
- Mousetrap is set to respond on keyup, this prevents key repeats
- A rather cheap keyboard help string is created
- A redraw command is sent to request a redraw
- log commands are written to the console
- error commands result in an alert
01_web_ui/html/rogue.js (54 to 75)
switch( cmd.cmd ){
case "config":
//Load keys
config.help = "";
for( var i in cmd.data.keys ){
const s = cmd.data.keys[i].shortcut;
const a = cmd.data.keys[i].action; //const avoids variable capture in the closure
Mousetrap.bind( s, () => sendKey( a ), "keyup" );
config.help += s + ": " + a + "\n";
}
sendCmd("redraw", gridSizeStr());
break;
case "log":
console.log( cmd.message );
break;
case "error":
alert( cmd.message );
break;
}
Dealing with resizing
The haskell code is going to need to know when the screen is resized so that it can act accordingly. E.g. it may need to recenter the player or clip tiles. The resizeCanvas function does this for us
- R.forEach is a rambda function that here calls resize for both the canvas and the “interaction div”
- The size of the grid is calculated. I.e. the actual pixels divided by the tile size (from the config object)
- A redraw command is sent
01_web_ui/html/rogue.js (5 to 11)
var config = { "drawId": 0,
"help": "",
"tileWidth": 32,
"tileHeight": 32,
"gridWidth": 0,
"gridHeight" : 0
};
01_web_ui/html/rogue.js (93 to 116)
function resizeCanvas() {
var container = document.getElementById("container");
var main = document.getElementById("main");
var mainr = main.getBoundingClientRect();
const resize = n => {
var e = document.getElementById(n);
e.style.main = mainr.x;
e.style.top = mainr.y
e.style.width = mainr.width;
e.style.height = mainr.height;
e.width = mainr.width;
e.height = mainr.height;
config.blank = null;
config.gridWidth = Math.floor(e.width / config.tileWidth);
config.gridHeight = Math.floor(e.height / config.tileHeight);
};
R.forEach( resize, ["tilesCanvas", "topInteractionLayer"] );
sendCmd("redraw", gridSizeStr() );
}
Browsers will trigger the redraw handler while the browser window is being resized, i.e. as the user is dragging it to the desired size. We definitely do not want to request a redraw hundreds of times while the window is being dragged. So a debounce routine is used to minimise the number of requests sent.
The window resize event is setup to call resizeCanvas after it has been debounced. Here I’m setting it up to only send the command after no subsequent resize events are triggered for 250ms.
01_web_ui/html/rogue.js (132 to 147)
//Debounce: https://gist.github.com/nmsdvid/8807205
function debounce(func, wait, immediate) {
var timeout;
return function() {
var context = this, args = arguments;
clearTimeout(timeout);
timeout = setTimeout(function() {
timeout = null;
if (!immediate)
func.apply(context, args);
}, wait);
if (immediate && !timeout) func.apply(context, args);
};
}
window.addEventListener('resize', debounce(resizeCanvas, 250), false);
Done
That is quite a lot of functionality for ~100 lines of JavaScript so far. There is about another 50 lines that needs to be added in later chapters to deal with drawing of the tiles. But that is it for the front-end logic, everything else happens in Haskell.