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.
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.
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 ()
= do
main
initializeAll<- createWindow "Haskell Game Engine" defaultWindow
window
gameLoop destroyWindow window
SDL provides user input to us in the form of Event
s 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
Event _ QuitEvent) = True
isQuitEvent (= False isQuitEvent _
On each frame of our “game”, we ask SDL if there are any new
Event
s. Then, we search those for QuitEvent
s
and if none are found, our game loop loops once again.
gameLoop :: IO ()
= do
gameLoop <- pollEvents
events any isQuitEvent events) gameLoop unless (
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:
Window
provided to us by SDLdelta
or deltaTime
)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.
<- systemTimeToSeconds <$> getSystemTime
currentTime
let
= GameState
initialState
{ window= 0.0167
, delta = currentTime
, lastFrameTime = True
, showDelta }
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 ()
= do
updateTime GameState{lastFrameTime, showDelta, delta} <- State.get
$
when showDelta . putStrLn $ showFFloat (Just 6) delta "s"
liftIO
<- liftIO getSystemTime
curTime
$ \gs -> gs
State.modify = systemTimeToSeconds curTime - lastFrameTime
{ delta = systemTimeToSeconds curTime
, lastFrameTime }
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
.
. putStrLn $ showFFloat (Just 0) (1 / delta) "fps" liftIO
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 GLubyte
s. 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.
<- glGetString GL_VERSION
versionStrPtr <- peekCAString $ castPtr versionStrPtr
versionStr 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.
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.
<- createWindow "Haskell Game Engine" defaultWindow
window = True
{ windowResizable = Fullscreen
, windowMode =
, windowGraphicsContext OpenGLContext defaultOpenGL
= SDL.Core SDL.Normal 3 3
{ glProfile = 4
, glMultisampleSamples
}= True
, windowHighDPI }
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
GL_DEPTH_TEST
glEnable GL_MULTISAMPLE
glEnable GL_LINE_SMOOTH
glEnable GL_POINT_SMOOTH
glEnable GL_CULL_FACE glDisable
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.
0.1 0.1 0.1 1.0 glClearColor
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 ()
= do
render GameState{window} <- State.get
$ GL_COLOR_BUFFER_BIT .|. GL_DEPTH_BUFFER_BIT
glClear glSwapWindow window
The current game loop looks like this:
gameLoop :: Game ()
= do
gameLoop
updateTime<- pollEvents
events
renderany isQuitEvent events) gameLoop unless (
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 ()
= do
resize window V2 width height) <- glGetDrawableSize window
(0 0 (fromIntegral width) (fromIntegral height) glViewport
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 ()
= do
updateWorld GameState{theta, delta} <- State.get
$ \gs -> gs { theta = theta + delta } State.modify
Add a renderMesh
call to render
after
clearing the screen and before swapping the window.
renderMesh :: Game ()
= do
renderMesh 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
.
$= Color4 1.0 0.5 0.2 1.0
currentColor $ glPolygonMode GL_FRONT_AND_BACK GL_LINE liftIO
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.
$ do
liftIO V2 screenWidth screenHeight) <- SDL.glGetDrawableSize window
($= (Position 0 0, Size (fromIntegral screenWidth) (fromIntegral screenHeight)) viewport
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.
$= Projection
matrixMode
loadIdentitylet aspect = fromIntegral width / fromIntegral height
45 aspect 1 100
GL.perspective $= Modelview 0
matrixMode loadIdentity
Again heavily glossing over OpenGL concepts, we set up a Vertex Array Object.
<- liftIO $ alloca $ \ptr -> glGenVertexArrays 1 ptr >> peek ptr
vao 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.
<- liftIO $ alloca $ \ptr -> glGenBuffers 1 ptr >> peek ptr
vbo GL_ARRAY_BUFFER vbo
glBindBuffer let vertexData = toVector $ rotatedBy (double2Float theta) mesh
$ VecStor.unsafeWith vertexData $ \ptr ->
liftIO
glBufferDataGL_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).
0 3 GL_FLOAT GL_FALSE (fromIntegral (3 * sizeOf (undefined :: GLfloat))) nullPtr
glVertexAttribPointer 0 glEnableVertexAttribArray
The last step is to draw our vertices as grouped into triangles using
the primitive type GL_TRIANGLES
.
glBindVertexArray vaoGL_TRIANGLES 0 (fromIntegral (VecStor.length vertexData `div` 3)) glDrawArrays
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.
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
= [r|#version 330 core
vertexShaderSource
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 () {
= vec4(1.0, 0.5, 0.2, 1.0);
FragColor }
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
= do
compileShader shaderType src <- glCreateShader shaderType
shader $ \ptr -> with ptr $ \ptrPtr ->
withCAString src 1 ptrPtr nullPtr
glShaderSource shader
glCompileShader shader
-- check for shader compilation errors
$ \(errcodePtr :: Ptr Int32) -> do
alloca GL_COMPILE_STATUS errcodePtr
glGetShaderiv shader <- peek errcodePtr
successInt == 0) $
when (successInt $ \infoLogPtr -> do
alloca 512 nullPtr infoLogPtr
glGetShaderInfoLog shader <- peekCAString infoLogPtr
infoLog 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
= do
createShaderProgram <- compileShader GL_VERTEX_SHADER vertexShaderSource
vertShader <- compileShader GL_FRAGMENT_SHADER fragmentShaderSource
fragShader
<- glCreateProgram
program
glAttachShader program vertShader
glAttachShader program fragShader
glLinkProgram program
$ \(errcodePtr :: Ptr Int32) -> do
alloca GL_LINK_STATUS errcodePtr
glGetProgramiv program <- peek errcodePtr
successInt == 0) $
when (successInt $ \infoLogPtr -> do
alloca 512 nullPtr infoLogPtr
glGetProgramInfoLog program <- peekCAString infoLogPtr
infoLog 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.
<- createShaderProgram
shaderProgram glUseProgram shaderProgram
As mentioned above, SDL provides user input to us in the form of
Event
s. 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
...
{ = V2 Float
, keyboardInput }
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 ()
= do
gameLoop
updateTime
updateWorld<- handleInput
shouldQuit
render unless shouldQuit gameLoop
handleInput
will read raw keyboard input
Event
s, 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
= \case
eventToOffsetModifier 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
...
{ = V2 Float
, offset }
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 ()
= do
renderMesh 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.
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.
<- availableJoysticks joysticks
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.
<- case mJoystickDevice of
mJoystick 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
$ \gs -> gs { offset = keyboardInput }
State.modify Just stick -> do
<- liftIO $ axisPosition stick 0
axisPos0 <- liftIO $ axisPosition stick 1
axisPos1 let stickInput = V2 (applyDeadzoneAndMapping axisPos0) (applyDeadzoneAndMapping axisPos1)
$ \gs -> gs { offset = clamp $ stickInput + keyboardInput } State.modify
Now we can move around the mesh with either the keyboard or the joystick.
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
= do
getAudioDevice @AudioSpec $ \audioSpecPtr -> do
alloca $ AudioSpec
poke audioSpecPtr = 44100
{ audioSpecFreq = SDL_AUDIO_S16LSB
, audioSpecFormat = 2
, audioSpecChannels = 0
, audioSpecSilence = 4096
, audioSpecSamples = 0
, audioSpecSize = nullFunPtr -- null function pointer
, audioSpecCallback = nullPtr
, audioSpecUserdata
}
let forPlayback = 0
<- openAudioDevice nullPtr forPlayback audioSpecPtr nullPtr 0
deviceId
0 -- set device to play
pauseAudioDevice deviceId
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 ()
= do
queueMoreAudio GameState{audioSamples, audioDeviceId} <- State.get
<- getQueuedAudioSize audioDeviceId
queuedAudioSize let bufSize = 4096 :: Word32
< bufSize * 4) $ liftIO $ do
when (queuedAudioSize <- readIORef audioSamples
samples $ withArray (take (fromIntegral bufSize) samples) $ \samplesPtr -> do
void * 2) -- Int16 is two bytes, per sample
queueAudio audioDeviceId (coerce samplesPtr) (bufSize $ drop (fromIntegral bufSize) samples writeIORef audioSamples
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 ()
= do
gameLoop
updateTime
updateWorld<- handleInput
shouldQuit
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.
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:
*stbi_load (char const *filename, int *x, int *y, int *channels_in_file, int desired_channels); STBIDEF stbi_uc
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.
import ccall "stb_image.h stbi_load"
foreign 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:
void stbi_image_free (void *retval_from_stbi_load); STBIDEF
Which corresponds to this Haskell:
import ccall "stb_image.h stbi_image_free"
foreign 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
= do
loadTexture filename activeTexture rgbOrRgba $ \widthPtr ->
alloca $ \heightPtr ->
alloca $ \numChannelsPtr -> do
alloca <- newCAString filename
filenameCString <- stbi_load filenameCString widthPtr heightPtr numChannelsPtr 0
dataPtr
== nullPtr) $
when (dataPtr error $ "Couldn't load texture: " <> filename
<- fromIntegral <$> peek widthPtr
width <- fromIntegral <$> peek heightPtr
height
$ \texturePtr -> do
alloca 1 texturePtr
glGenTextures <- peek texturePtr
texture GL_TEXTURE_2D texture
glBindTexture
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)
glTexParameteri
GL_TEXTURE_2D 0 (fromIntegral rgbOrRgba) width height 0 rgbOrRgba GL_UNSIGNED_BYTE dataPtr
glTexImage2D GL_TEXTURE_2D
glGenerateMipmap
stbi_image_free dataPtr
glActiveTexture activeTextureGL_TEXTURE_2D texture
glBindTexture
pure texture
Finally, we can load our texture and use it.
<- loadTexture "test.jpg" GL_TEXTURE0 GL_RGB texture
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….