Haskell roguelike - UI code

start prev next

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)

runGame :: IO ()
runGame = Host.runHost manageConnection

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.bind( "?", () => alert( config.help ) ); 

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)

  var ws = new WebSocket("ws://localhost:61492/");
  ws.binaryType = 'arraybuffer';

• 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.

start prev next