mitchell vitez blog music art media dark mode

Beginnings of a Haskell Game Engine

Recently I’ve been interested in how game engines work under the hood. Obviously, game engines can be incredibly complex pieces of software, with millions of lines of code necessitating rendering, physics, audio, and other systems all working together, but I was mostly interested in the foundations. How do we start from the basic pieces and create a platform on which we can build games?

Most of my learning about this has been from reading the books Game Engine Architecture by Jason Gregory, Learn OpenGL by Joey de Vries, and Real Time Rendering by Akenine-Möller, Haines, Hoffman, et al., as well as watching hundreds of hours of the Handmade Hero series by Casey Muratori, plus going through big chunks of both the Godot and Unreal engines’ documentation.

We’ll be using SDL 2 and OpenGL 3. There are existing Haskell bindings for both. You could drop down one more level and use platform-specific APIs directly, but I was more interested in building simple versions of game engine systems than in writing a platform layer. Near the end, we’ll also be linking against a C library directly using Haskell’s foreign function interface, to show how we can use libraries without pre-written Haskell bindings.

Garbage collection concerns

Haskell is a garbage-collected language, which raises concerns about collection pauses causing stuttering. To players, frame rate randomly dropping every so often is not a great experience.

However, nowadays there is a --nonmoving-gc GHC RTS flag that turns on concurrent garbage collection. It can be set in a cabal file’s ghc-options stanza like:

ghc-options: +RTS --nonmoving-gc -RTS

You can also use the -xn flag for short. For me in some quick tests this seemed to work great, but maybe in a full-fledged game engine GC would crop up as a concern again.

Creating a window and a game loop

At the core of almost any game’s software architecture is a game loop. This loop reads user input, makes adjustments to the state of the game based on that input, and outputs the next frame of the game. There’s also invariably some setup before we get into the loop, and some teardown steps afterwards as well.

We need to initialize SDL with initializeAll, create a basic window with the title Haskell Game Engine, and then our game loop is off to the races.

import SDL

main :: IO ()
main = do
  initializeAll
  window <- createWindow "Haskell Game Engine" defaultWindow
  gameLoop
  destroyWindow window

SDL provides user input to us in the form of Events such as “the key W was pressed” or “the window’s quit button was clicked”. Here’s a function that examines an Event and tells us whether that Event is intended to quit the game—e.g. clicking the close button on the window’s title bar, or pressing Q on a mac (the platform I’m using to write this code).

isQuitEvent :: Event -> Bool
isQuitEvent (Event _ QuitEvent) = True
isQuitEvent _ = False

On each frame of our “game”, we ask SDL if there are any new Events. Then, we search those for QuitEvents and if none are found, our game loop loops once again.

gameLoop :: IO ()
gameLoop = do
  events <- pollEvents
  unless (any isQuitEvent events) gameLoop

Game state and frame timing

Our game needs to have a sense of how much updating to do during each frame. For example, if we have a game object moving at one meter per second, if we know how many seconds the last frame took, we know how many in-game meters to move the object on this update.

We can get precise timing from the system clock via getSystemTime. On my system, this function returns the amount of time elapsed since January 1st 1970, with nanosecond resolution. We can convert a SystemTime to seconds like this:

type Seconds = Double

systemTimeToSeconds :: SystemTime -> Seconds
systemTimeToSeconds systemTime =
  fromIntegral (systemSeconds systemTime) +
  fromIntegral (systemNanoseconds systemTime) / 1_000_000_000

While we can pass this time around as an argument to our functions, it’s often much nicer to package it up in a bigger GameState record, along with some other useful information. Right now we want to keep track of:

data GameState = GameState
  { window :: Window
  , delta :: Seconds
  , showDelta :: Bool
  , lastFrameTime :: Seconds
  }

With our GameState nicely packaged up, we can now create a Game monad to keep track of it for us. Game is just a state transformer over IO.

type Game = StateT GameState IO

In our main function where we’re doing our setup, we initialize the very first game state. We pick reasonable defaults for values we don’t know yet (like delta being \(\frac{1}{60}\) of a second) to avoid any extreme-valued first-frame calculations.

  currentTime <- systemTimeToSeconds <$> getSystemTime

  let
    initialState = GameState
      { window
      , delta = 0.0167
      , lastFrameTime = currentTime
      , showDelta = True
      }

We’ll also need to change the type of gameLoop from IO () to Game (), and start using liftIO for any IO actions we do inside of it.

Then instead of a plain call to gameLoop, we run the state transformer, starting from the initialState we just defined.

  runStateT gameLoop initialState

Finally, our game loop can call a function that updates all these time-related values. When showDelta is true, we print out the current delta in seconds with 6 decimals places of precision (e.g. 0.000264s). On every frame, we calculate a new delta based on how long it’s been since the lastFrameTime.

updateTime :: Game ()
updateTime = do
  GameState{lastFrameTime, showDelta, delta} <- State.get

  when showDelta $
    liftIO . putStrLn $ showFFloat (Just 6) delta "s"

  curTime <- liftIO getSystemTime

  State.modify $ \gs -> gs
    { delta = systemTimeToSeconds curTime - lastFrameTime
    , lastFrameTime = systemTimeToSeconds curTime
    }

Note that because we’re using the Game monad, it’s easy to pick out only the exact information we need here, without dealing with passing function arguments everywhere. We’re not using GameState’s value of window, so we can just ignore it.

Because they are inverses, we can trivially print frames per second instead of printing out delta.

    liftIO . putStrLn $ showFFloat (Just 0) (1 / delta) "fps"

Checking the OpenGL version

To make sure our system’s OpenGL version will work, let’s print it out when our program starts. To do this, we have to deal with pointers and C strings in Haskell, which is always a fun time, but we’ll be doing much more of this coming up so it’s good to get used to it now.

In C, glGetString returns a pointer to GLubytes. C’s pointers are represented in Haskell with the Ptr X type, where X is a phantom type indicating the type of the thing being pointed to. Just like in C, under the hood Haskell’s Ptr is really just a raw (unboxed) address (Addr#).

peekCAString takes a C-style string (pointer to null-terminated characters) and gives us back a Haskell String. peekCAString takes a Ptr CChar, not a Ptr GLubyte, so we need to cast the versionStrPtr pointer for the types to line up. We use peekCAString rather than peekCString to indicate ASCII encoding. In the end, we get a Haskell String that we can print out.

  versionStrPtr <- glGetString GL_VERSION
  versionStr <- peekCAString $ castPtr versionStrPtr
  putStrLn $ "OpenGL version: " <> versionStr

On my machine, this prints out:

OpenGL version: 4.1 Metal - 89.3

It should be at least 3.3 since I’ll be using 3.3 below.

Rendering via an OpenGL context

SDL’s default window uses a software renderer, which is very slow. Let’s switch to actually using the graphics card via OpenGL.

There are a lot of window settings we can change to make our game more game-like. We want resizable windows that default to full-screen, high DPI, and multisampling. We’ll use OpenGL version 3.3 here as our window’s new rendering context.

  window <- createWindow "Haskell Game Engine" defaultWindow
    { windowResizable = True
    , windowMode = Fullscreen
    , windowGraphicsContext =
        OpenGLContext defaultOpenGL
          { glProfile = SDL.Core SDL.Normal 3 3
          , glMultisampleSamples = 4
          }
    , windowHighDPI = True
    }

There are a bunch of OpenGL setup calls we’ll want to make here as well. Besides creating the window context on OpenGL’s side, we’ll want things like smoothing, depth testing, and multisampling turned on.

  glCreateContext window

  glEnable GL_DEPTH_TEST
  glEnable GL_MULTISAMPLE
  glEnable GL_LINE_SMOOTH
  glEnable GL_POINT_SMOOTH
  glDisable GL_CULL_FACE

As our first bit of “actually using” OpenGL, let’s set our “clear color”—the color pixels become when the screen is cleared—to a nice dark gray. You could set it to whatever you want.

  glClearColor 0.1 0.1 0.1 1.0

Finally, we’ll add the beginnings of a rendering function that will use the current state of our game world and draw a representation of it to the screen. For now, this just clears both the color buffer and the depth buffer, and swaps the cleared buffer into the current window.

render :: Game ()
render = do
  GameState{window} <- State.get
  glClear $ GL_COLOR_BUFFER_BIT .|. GL_DEPTH_BUFFER_BIT
  glSwapWindow window

The current game loop looks like this:

gameLoop :: Game ()
gameLoop = do
  updateTime
  events <- pollEvents
  render
  unless (any isQuitEvent events) gameLoop

Window resize handler

Not only can OpenGL affect our window (by drawing pixels into it), but our window can affect OpenGL. One example is window resizing. When we see a window resize event come in from SDL, we should call an “event handler” (just a function) like the one below, to fix up OpenGL’s viewport accordingly.

resize :: Window -> IO ()
resize window = do
  (V2 width height) <- glGetDrawableSize window
  glViewport 0 0 (fromIntegral width) (fromIntegral height)

Rendering a 3d mesh

Next, let’s actually put something interesting on the screen—a rotating 3d mesh. The complexity here is mostly in understanding OpenGL concepts, so if you’re not familiar with those feel free to skim this section. To keep track of the rotation, let’s add a new variable to our GameState:

data GameState = GameState
  { ...
  , theta :: Double
  }

We’ll also add an updateWorld call just after updateTime in our gameLoop. This handles updates to game objects that happen on every frame. In this case, we’re just increasing theta by delta each frame.

updateWorld :: Game ()
updateWorld = do
  GameState{theta, delta} <- State.get
  State.modify $ \gs -> gs { theta = theta + delta }

Add a renderMesh call to render after clearing the screen and before swapping the window.

renderMesh :: Game ()
renderMesh = do
  GameState{window, theta} <- State.get
  ...

We’ll draw our mesh as an orange wireframe by setting OpenGL’s current drawing color, and changing polygon mode to GL_LINE.

  currentColor $= Color4 1.0 0.5 0.2 1.0
  liftIO $ glPolygonMode GL_FRONT_AND_BACK GL_LINE

Let’s set up our viewport based on the screen size. We’ll be using this Position later when we add in moving the model around based on user input.

  liftIO $ do
    (V2 screenWidth screenHeight) <- SDL.glGetDrawableSize window
    viewport $= (Position 0 0, Size (fromIntegral screenWidth) (fromIntegral screenHeight))

You could do any number of additional rendering setup steps here, like setting a projection matrix, but since this isn’t an OpenGL tutorial we’ll heavily gloss over this here.

  matrixMode $= Projection
  loadIdentity
  let aspect = fromIntegral width / fromIntegral height
  GL.perspective 45 aspect 1 100
  matrixMode $= Modelview 0
  loadIdentity

Again heavily glossing over OpenGL concepts, we set up a Vertex Array Object.

  vao <- liftIO $ alloca $ \ptr -> glGenVertexArrays 1 ptr >> peek ptr
  glBindVertexArray vao

In case you haven’t seen C’s alloca (or Haskell’s version of it), it’s a handy way to allocate some memory on the stack, so that it will be automatically freed when the function call returns (unlike malloc). Beware of stack overflows though—don’t use it to allocate large amounts of memory. In this situation, it’s mostly a handy way to get a Ptr that cleans itself up.

alloca :: Storable a => (Ptr a -> IO b) -> IO b 

We need some representation of the vertices of our 3d mesh.

mesh :: [(Float, Float, Float)]

In my case, I used Blender to make a simple 3d model of a star. Blender provides a Python console that we can run commands inside. We can grab the coordinates of all the vertices of the first mesh in our scene with this Python one-liner:

[tuple([*v.co]) for v in bpy.data.meshes[0].vertices]

Once we have a mesh, we can do more OpenGL-specific magic and create a Vertex Buffer Object. Note that we’re using theta to rotate our mesh, and then using the resulting vertexData as input to the buffer. glBufferData needs both the size of the buffer, as well as a pointer to the beginning. If this looks unwieldy, don’t worry too much—it is. We’re basically translating C-style code into a Haskell context.

  vbo <- liftIO $ alloca $ \ptr -> glGenBuffers 1 ptr >> peek ptr
  glBindBuffer GL_ARRAY_BUFFER vbo
  let vertexData = toVector $ rotatedBy (double2Float theta) mesh
  liftIO $ VecStor.unsafeWith vertexData $ \ptr ->
    glBufferData
      GL_ARRAY_BUFFER
      (fromIntegral $ VecStor.length vertexData * sizeOf (undefined :: GLfloat))
      (castPtr ptr)
      GL_STATIC_DRAW

We’re not quite done getting OpenGL to draw a 3d mesh for us. Here, all the offsets by 3 are because it takes 3 floats to describe each vertex’s position in space (x, y, z).

  glVertexAttribPointer 0 3 GL_FLOAT GL_FALSE (fromIntegral (3 * sizeOf (undefined :: GLfloat))) nullPtr
  glEnableVertexAttribArray 0

The last step is to draw our vertices as grouped into triangles using the primitive type GL_TRIANGLES.

  glBindVertexArray vao
  glDrawArrays GL_TRIANGLES 0 (fromIntegral (VecStor.length vertexData `div` 3))

With all of that done properly, you should have an orange wireframe model rotating around its vertical axis.

While it may not look like much, we know it’s possibly to draw pretty much arbitrarily-complicated graphics using OpenGL. So the most important bit here was the initial hooking up of OpenGL to be able to draw something simple. We actually took it a step further than we had to, by using a 3d model rather than drawing something 2d. The rest of the real-time rendering rabbit hole is extremely deep, but hopefully this was a nice peek into it.

Let’s take one more step and see how we can compile some shaders.

Compiling some shaders

Shaders are a pretty important step along the graphical path of most games. Here’s a basic vertex shader that takes in a vec3 position for each vertex and spits out a vec4 as required by gl_Position, with each final coordinate set to 1.

#version 330 core
layout (location = 0) in vec3 pos;

void main() {
  gl_Position = vec4(pos, 1.0);
}

A good way to represent these GLSL shaders inline in Haskell is with a raw String quasiquoter.

vertexShaderSource :: String
vertexShaderSource = [r|#version 330 core
layout (location = 0) in vec3 aPos;

void main() {
  gl_Position = vec4(aPos, 1.0);
}
|]

Slightly more interesting is this fragment shader (which helps determine the color of each pixel). This shader sets the color of each drawn fragment to the same orange color we were using before.

#version 330 core
out vec4 FragColor;

void main () {
  FragColor = vec4(1.0, 0.5, 0.2, 1.0);
}

As above, we also have fragmentShaderSource :: String in Haskell.

Shader compilation is mostly straightforward if you know your OpenGL. We take the GLSL source code as a String, call glCompileShader to compile it, and check for any compilation errors by peeking at the value held by a compilation status pointer to Int32 (errcodePtr). In case there’s an error, we allocate a buffer to hold the error string, convert from C to Haskell -style strings, and print it out. Finally, we give back a GLuint acting as a handle to the shader we just compiled.

compileShader :: GLenum -> String -> IO GLuint
compileShader shaderType src = do
  shader <- glCreateShader shaderType
  withCAString src $ \ptr -> with ptr $ \ptrPtr ->
    glShaderSource shader 1 ptrPtr nullPtr
  glCompileShader shader

  -- check for shader compilation errors
  alloca $ \(errcodePtr :: Ptr Int32) -> do
    glGetShaderiv shader GL_COMPILE_STATUS errcodePtr
    successInt <- peek errcodePtr
    when (successInt == 0) $
      alloca $ \infoLogPtr -> do
        glGetShaderInfoLog shader 512 nullPtr infoLogPtr
        infoLog <- peekCAString infoLogPtr
        putStrLn $ "\nError in compileShader:\n" <> infoLog

  pure shader

Each individual compiled shader can be combined into a “shader program”. We compile each shader, attach them to the program, link the program, check for errors in a way very similar to the above, delete the now-unused shaders, and return a handle to the overall program.

createShaderProgram :: IO GLuint
createShaderProgram = do
  vertShader <- compileShader GL_VERTEX_SHADER vertexShaderSource
  fragShader <- compileShader GL_FRAGMENT_SHADER fragmentShaderSource

  program <- glCreateProgram
  glAttachShader program vertShader
  glAttachShader program fragShader
  glLinkProgram program

  alloca $ \(errcodePtr :: Ptr Int32) -> do
    glGetProgramiv program GL_LINK_STATUS errcodePtr
    successInt <- peek errcodePtr
    when (successInt == 0) $
      alloca $ \infoLogPtr -> do
        glGetProgramInfoLog program 512 nullPtr infoLogPtr
        infoLog <- peekCAString infoLogPtr
        putStrLn $ "Error in createShaderProgram:\n" <> infoLog

  glDeleteShader vertShader
  glDeleteShader fragShader

  pure program

Now when setting up our engine, we just have to tell OpenGL to use that compiled shader program.

  shaderProgram <- createShaderProgram
  glUseProgram shaderProgram

User input from a keyboard

As mentioned above, SDL provides user input to us in the form of Events. Rather than use this input directly, let’s map it into a two-dimensional pair of axes (forward/back, and left/right) so we can use it for 2d directional movement.

First, let’s add more state to our GameState to track input from the keyboard. The initial state can be V2 0 0.

data GameState = GameState
  { ...
  , keyboardInput = V2 Float
  }

Let’s also add a new function to handle all user input. Right now, the only input we’re checking for is a QuitEvent. Let’s encode that in handleInput by returning a Bool that’s true when the game should quit.

handleInput :: Game Bool

This means our current gameLoop looks like:

gameLoop :: Game ()
gameLoop = do
  updateTime
  updateWorld
  shouldQuit <- handleInput
  render
  unless shouldQuit gameLoop

handleInput will read raw keyboard input Events, and convert them into the 2d axes of keyboardInput. Here we run into a bit of an annoyance: Event pattern matches can be quite long and unwieldy. For example, the pattern match meaning “the W key was pressed” is written out like:

Event _ (KeyboardEvent (KeyboardEventData _ Pressed False (Keysym _ KeycodeW _)))

Luckily, we can make this quite a bit simpler through the use of pattern synonyms. We only care about two things really: whether the key was Pressed or Released, and which keycode it has. If we write out a KeyEvent synonym like this:

pattern KeyEvent :: InputMotion -> Keycode -> Event
pattern KeyEvent pressedOrReleased keycode <- Event _ (KeyboardEvent (KeyboardEventData _ pressedOrReleased False (Keysym _ keycode _)))

Then the pattern match equivalent to the above is just:

KeyEvent Pressed KeycodeW

With that simplification in hand, we can pretty easily map any Event into a corresponding V2 Float based on the pressing of the WASD keys.

eventToOffsetModifier :: Event -> V2 Float
eventToOffsetModifier = \case
  KeyEvent Pressed  KeycodeW -> V2 0    (-1)
  KeyEvent Released KeycodeW -> V2 0    1
  KeyEvent Pressed  KeycodeA -> V2 (-1) 0
  KeyEvent Released KeycodeA -> V2 1    0
  KeyEvent Pressed  KeycodeS -> V2 0    1
  KeyEvent Released KeycodeS -> V2 0    (-1)
  KeyEvent Pressed  KeycodeD -> V2 1    0
  KeyEvent Released KeycodeD -> V2 (-1) 0
  _ -> V2 0 0

Let’s also combine all our inputs into a new GameState variable called offset. While we only have keyboard inputs now, this will help us ensure that e.g. our characters don’t move twice as fast as they should if both the keyboard and the controller inputs are active at the same time.

data GameState = GameState
  { ...
  , offset = V2 Float
  }

To make our game visually react to this input, we can add a few tweaks to renderMesh. Let’s grab the offset value, and instead of making our Position always be (0, 0), let’s adjust it based on the offset.

renderMesh :: Game ()
renderMesh = do
  GameState{window, theta, offset} <- State.get
  let V2 xOrigin yOrigin = offset
  ...
  viewport $=
    ( Position (round $ xOrigin * 1000) (round $ yOrigin * (-1000))
    , Size (fromIntegral screenWidth) (fromIntegral screenHeight)
    )

Now we can move around the onscreen mesh with WASD.

User input from a joystick

Now let’s add another input device, based on continuous input and not just a simple “is pressed / is released” binary.

Unlike with the keyboard, SDL wants us to open a connection to any joystick devices we’re using before we can receive their events. Luckily, SDL can get us a possibly-empty Vector of all the available joysticks.

  joysticks <- availableJoysticks

For simplicity, let’s grab the first joystick if it exists, and otherwise grab Nothing.

  let
    mJoystickDevice =
      if null joysticks
      then Nothing
      else Just $ Vec.head joysticks

We open the device if it exists.

  mJoystick <- case mJoystickDevice of
    Nothing -> pure Nothing
    Just device -> Just <$> openJoystick device

After a quit event, in the game’s teardown step, we can close the connection to the joystick device, if it exists.

  whenJust mJoystick closeJoystick

Just like all the other state in our game, we can track our possible joystick in GameState. This gives us access to it from places like handleInput.

data GameState = GameState
  { ...
  , joystick :: Maybe Joystick
  }

With the joystick I was using, input came in as a 16-bit integer. However, I wanted the input to be a float in the range (-1, 1) just like my keyboard input, which requires some remapping.

Additionally with joysticks, there is often some low-level noise when the stick is “standing still” from the perspective of the user. We can apply a deadzone to our input, setting any values below 0.2 out of 1 to instead be read as a true 0.

-- convert from (-32768, 32767) to (-1, 1)
-- with a zeroed-out deadzone
applyDeadzoneAndMapping :: Int16 -> Float
applyDeadzoneAndMapping x =
  if abs normalized < 0.2 then 0 else normalized
  where normalized = fromIntegral x / 32768.0

If no joystick exists, handleInput just sets offset to keyboardInput. Otherwise, we take each axis on the stick, apply deadzones and input remapping to them, and combine that input with any existing keyboard input, clamping the combined inputs to the range (-1, 1).

  case joystick of
    Nothing -> do
      State.modify $ \gs -> gs { offset = keyboardInput }
    Just stick -> do
      axisPos0 <- liftIO $ axisPosition stick 0
      axisPos1 <- liftIO $ axisPosition stick 1
      let stickInput = V2 (applyDeadzoneAndMapping axisPos0) (applyDeadzoneAndMapping axisPos1)
      State.modify $ \gs -> gs { offset = clamp $ stickInput + keyboardInput }

Now we can move around the mesh with either the keyboard or the joystick.

Playing audio

There are multiple ways to queue up audio to be played, but one of the biggest choices is whether to use a callback function as a way for the audio driver to request more bytes in its buffer, or whether to simply keep the buffer full enough by ourselves. Because we’re already running a game loop that can easily check every frame whether more audio is required, and because we expect that game loop to be called many times a second, we’ll skip the callback strategy here.

As with joysticks, we need to open audio devices in order to use them. We need to provide SDL with a desired AudioSpec, which it will try to match as closely as it can. We open the device and set it to play, returning its AudioDeviceId (which, as ever, we can keep track of in GameState).

getAudioDevice :: IO AudioDeviceID
getAudioDevice = do
  alloca @AudioSpec $ \audioSpecPtr -> do
    poke audioSpecPtr $ AudioSpec
      { audioSpecFreq = 44100
      , audioSpecFormat = SDL_AUDIO_S16LSB
      , audioSpecChannels = 2
      , audioSpecSilence = 0
      , audioSpecSamples = 4096
      , audioSpecSize = 0
      , audioSpecCallback = nullFunPtr -- null function pointer
      , audioSpecUserdata = nullPtr
      }

    let forPlayback = 0
    deviceId <- openAudioDevice nullPtr forPlayback audioSpecPtr nullPtr 0

    pauseAudioDevice deviceId 0 -- set device to play

    pure deviceId

The key to not getting glitchy audio or periods of silence is to always queue up enough bytes that the audio buffer doesn’t run out. It’s a race between you feeding bytes to the audio device, and the audio device consuming them. In my case, I found a buffer of 16,384 (\(2^{14}\)) bytes to be sufficient, but note that this is framerate dependent in our simple engine.

Every frame, we want to queue up more audio if there isn’t enough currently queued. We use an IORef to track audio samples (just a simple infinite-list sine-wave-generating sampler function sinSamples :: [Int16]) and add another bufSize * 2 bytes whenever we need to, consuming from the sampler function and producing for the audio device.

queueMoreAudio :: Game ()
queueMoreAudio = do
  GameState{audioSamples, audioDeviceId} <- State.get
  queuedAudioSize <- getQueuedAudioSize audioDeviceId
  let bufSize = 4096 :: Word32
  when (queuedAudioSize < bufSize * 4) $ liftIO $ do
    samples <- readIORef audioSamples
    void $ withArray (take (fromIntegral bufSize) samples) $ \samplesPtr -> do
      queueAudio audioDeviceId (coerce samplesPtr) (bufSize * 2) -- Int16 is two bytes, per sample
    writeIORef audioSamples $ drop (fromIntegral bufSize) samples

If this isn’t queuing audio fast enough, you could play with increasing the buffer size until glitches seem to drop out. It might also be informative to artificially make frames longer until audio starts glitching out. There really is just a simple race here between bytes being fed in and bytes being read out of the buffer.

With audio queuing in place, our final game loop looks like this:

gameLoop :: Game ()
gameLoop = do
  updateTime
  updateWorld
  shouldQuit <- handleInput
  render
  queueMoreAudio
  unless shouldQuit gameLoop

As you can see, we’ve handled all the basic aspects of a real game: frame timing, world updates (which in a real game might involve kinematics or other kinds of physics), input handling, rendering, and audio.

Loading textures

Let’s take one last step involving linking directly against a C library, to gain confidence that you really could use whatever low-level libraries you need for your engine, from inside Haskell.

OpenGL lets us map texture images onto our game objects, but we need some way to load an image first. We’ll use the stb_image library to load in a test.jpg file. First, we need to link against it.

Haskell projects commonly put any C files they’re using in a folder named cbits. In our case, let’s put the following text in a file called cbits/stb_image.c:

#define STB_IMAGE_IMPLEMENTATION

#include "stb_image.h"

We’ll also need a full copy of the stb_image.h header file which we can put in includes/stb_image.h. There’s a copy on GitHub.

We then need to add a few lines to our cabal file:

include-dirs: includes
includes:     stb_image.h
c-sources:    cbits/stb_image.c

That’s all for setup! Back to writing Haskell. Turn on the ForeignFunctionInterface language extension. We’ll actually only need two functions from stb_image: stbi_load and stbi_image_free.

In C, the signature of stbi_load is:

STBIDEF stbi_uc *stbi_load (char const *filename, int *x, int *y, int *channels_in_file, int desired_channels);

We start with foreign import ccall syntax, naming the header file we’re importing from and the name of the function we want to import. On the next line we provide the Haskell function name we want to use (just stbi_load again), and we need to provide Haskell types that correspond to the C types of the original. This is pretty straightforward if you poke around Foreign.C.Types for a little while.

foreign import ccall "stb_image.h stbi_load"
  stbi_load :: CString -> Ptr CInt -> Ptr CInt -> Ptr CInt -> CInt -> IO (Ptr CUChar)

We can do the same thing with stbi_image_free. In C it’s:

STBIDEF void stbi_image_free (void *retval_from_stbi_load);

Which corresponds to this Haskell:

foreign import ccall "stb_image.h stbi_image_free"
  stbi_image_free :: Ptr CUChar -> IO ()

We’ll encapsulate all the image loading in a single function named loadTexture that loads the image data, converts into an OpenGL-usable texture, and frees the loaded image, returning a GLuint reference to the texture.

While I’m simply erroring out if the texture fails to load since I expect it to always exist, you could do something smarter, especially if you were loading new textures at game runtime.

OpenGL wants us to bind a texture and set a bunch of parameters on it. We’re also generating mipmaps, and setting this texture to the active texture.

loadTexture :: String -> Word32 -> Word32 -> IO GLuint
loadTexture filename activeTexture rgbOrRgba = do
  alloca $ \widthPtr ->
    alloca $ \heightPtr ->
      alloca $ \numChannelsPtr -> do
        filenameCString <- newCAString filename
        dataPtr <- stbi_load filenameCString widthPtr heightPtr numChannelsPtr 0

        when (dataPtr == nullPtr) $
          error $ "Couldn't load texture: " <> filename

        width <- fromIntegral <$> peek widthPtr
        height <- fromIntegral <$> peek heightPtr

        alloca $ \texturePtr -> do
          glGenTextures 1 texturePtr
          texture <- peek texturePtr
          glBindTexture GL_TEXTURE_2D texture

          glTexParameteri GL_TEXTURE_2D GL_TEXTURE_WRAP_S (fromIntegral GL_REPEAT)
          glTexParameteri GL_TEXTURE_2D GL_TEXTURE_WRAP_T (fromIntegral GL_REPEAT)
          glTexParameteri GL_TEXTURE_2D GL_TEXTURE_MIN_FILTER (fromIntegral GL_LINEAR)
          glTexParameteri GL_TEXTURE_2D GL_TEXTURE_MAG_FILTER (fromIntegral GL_LINEAR)

          glTexImage2D GL_TEXTURE_2D 0 (fromIntegral rgbOrRgba) width height 0 rgbOrRgba GL_UNSIGNED_BYTE dataPtr
          glGenerateMipmap GL_TEXTURE_2D

          stbi_image_free dataPtr

          glActiveTexture activeTexture
          glBindTexture GL_TEXTURE_2D texture

          pure texture

Finally, we can load our texture and use it.

  texture <- loadTexture "test.jpg" GL_TEXTURE0 GL_RGB

Conclusion

This was only a taste of the various kinds of things you might want to do when making your own game engine. Hopefully this was enough to convince you of the possibilities here.

I’ve personally found so many of the various subfields here intensely technical, but also intensely fun. Rendering especially sticks out to me as an endless rabbit hole of new things to learn. Our engine currently only produces a constant sine wave for audio, and we didn’t even mention game physics like collision detection (as with GJK or similar algorithms).

People have made nontrivial games and game engines in Haskell, but I understand why there isn’t a full-fledged mainstream engine written in it—it’s a huge amount of work. However, I found it to be a pretty good language for keeping track of all the finicky details inherent in talking to low-level APIs.

Perhaps one day I’ll find the time….