Camera

Look At

Doing the Look At example is just as easy for us as it is with GLM. We just use the lookAt function from the Linear.Projection module:

let radius = 10
let camX = sin timeValue * radius
let camZ = cos timeValue * radius
let viewMat = lookAt (V3 camX 0 camZ) (V3 0 0 0) (V3 0 1 0)

Code

Walk Around

Oh my gosh, we're gonna have to track our own mutable state. In Haskell~! How horrible!

Not really.

So there's obviously a lot of ways to do this. We're going to skip the version where we adjust the camera position in the callback and go to the version where we just keep track of what keys are pressed or not in the callback. Then in the Main Loop we check the time

First, instead of some array of keys, we'll just use a Set from the containers package. It's maybe a tiny bit slower than an Array or Vector of Bool values that we index by scan code, but I think that it's also much more ergonomic to use, and since there will never be too many keys pressed at once it's not a huge deal. As the package suggests, we'll import the data type unqualified, and the rest of the module qualified by S,

-- containers
import Data.Set (Set)
import qualified Data.Set as S

We'll store the Set of currently pressed keys in an IORef from the Data.IORef module (in base). Since this is a single threaded application, and all of the event polling and callback scheduling happens on the main thread, this is fine. Keep in mind that if we wanted to do multi-threaded stuff we'd probably want to switch to MVar or possibly even a TVar if we really wanted to be cool.

So now our callback looks like this:

-- type KeyCallback = Window -> Key -> Int -> KeyState -> ModifierKeys -> IO ()
callback :: IORef (Set GLFW.Key) -> GLFW.KeyCallback
callback ref window key scanCode keyState modKeys = do
    putStrLn $ show keyState ++ " " ++ show key
    case keyState of
        GLFW.KeyState'Pressed -> modifyIORef ref (S.insert key)
        GLFW.KeyState'Released -> modifyIORef ref (S.delete  key)
        _ -> return ()
    when (key == GLFW.Key'Escape && keyState == GLFW.KeyState'Pressed)
        (GLFW.setWindowShouldClose window True)

and we connect it to our window like this

-- enable keys
ref <- newIORef S.empty
GLFW.setKeyCallback window (Just $ callback ref)

Partial application saves the day once again!

Now that we've got the concept of a Camera being several things to keep track of at once (three different vectors), we'll add a data type for it and some helpers. Note that we're declaring the Camera type in record style so that we can use record update syntax in the updateCamera function.

data Camera = Camera {
    cameraPos :: V3 GLfloat,
    cameraFront :: V3 GLfloat,
    cameraUp :: V3 GLfloat
    } deriving Show

updateCamera :: Set GLFW.Key -> GLfloat -> Camera -> Camera
updateCamera keySet speed cam = S.foldr (\key cam@(Camera pos front up) -> case key of
    GLFW.Key'W -> cam{cameraPos = pos ^+^ (speed *^ front)}
    GLFW.Key'S -> cam{cameraPos = pos ^-^ (speed *^ front)}
    GLFW.Key'A -> cam{cameraPos = pos ^-^ (speed *^ (normalize (cross front up)))}
    GLFW.Key'D -> cam{cameraPos = pos ^+^ (speed *^ (normalize (cross front up)))}
    _ -> cam
    ) cam keySet

toViewMatrix :: Camera -> M44 GLfloat
toViewMatrix (Camera pos front up) = lookAt pos (pos ^+^ front) up

Then in each iteration of our main loop, we'll pass along the last time and the old camera, using them to compute the new time, delta time, and new camera.

-- check time
timeValue <- maybe 0 realToFrac <$> GLFW.getTime
let deltaTime = timeValue - lastFrame
let cameraSpeed = 5 * deltaTime
keysDown <- readIORef ref
let camera = updateCamera keysDown cameraSpeed oldCamera

Code

One catch here is that our W/S movement and A/D movement don't combine into a single vector of movement which is normalized before it's applied, so you actually move faster if you go diagonally. That's really easy to fix without too much of a change. All we have to do is add up our movement vector, normalize it, then apply the speed factor and apply it to our position.

-- uses normalized movement
updateCamera :: Set GLFW.Key -> GLfloat -> Camera -> Camera
updateCamera keySet speed cam@(Camera pos front up) = let
    moveVector = S.foldr (\key vec -> case key of
            GLFW.Key'W -> vec ^+^ front
            GLFW.Key'S -> vec ^-^ front
            GLFW.Key'A -> vec ^-^ normalize (cross front up)
            GLFW.Key'D -> vec ^+^ normalize (cross front up)
            _ -> vec
            ) (V3 0 0 0) keySet
    in cam {cameraPos = pos ^+^ (speed *^ normalize moveVector)}

We'll use this going forward, but feel free to stick to the non-normalized movement if it suits you.

Look Around

Getting the final bit correct is tricker than it seems. Setting the window to lock the mouse and have a mouse callback is easy

-- configure the mouse
mouseRef <- newIORef $ MouseInfo Nothing (0,(-90)) (V3 0 0 (-1))
GLFW.setCursorInputMode window GLFW.CursorInputMode'Disabled
GLFW.setCursorPosCallback window (Just $ cursorPosCallback mouseRef)

But actually computing that callback is tricky, because the first time your mouse gives input it'll be at some arbitrary coordinate, which will throw the camera into a crazy direction. There's a few ways you could solve this, but I decided to just bundle up all of the mouse data into a record, and resolve it all during the mouse callback.

data MouseInfo = MouseInfo {
    lastXY :: Maybe (Double,Double),
    oldPitchYaw :: (Double, Double),
    frontVec :: V3 GLfloat
    } deriving Show

-- type CursorPosCallback = Window -> Double -> Double -> IO ()
cursorPosCallback :: IORef MouseInfo -> GLFW.CursorPosCallback
cursorPosCallback ref window xpos ypos = do
    --putStrLn $ "x: " ++ show x ++ ", y:" ++ show y
    modifyIORef ref $ \oldInfo -> let
        (lastX, lastY) = case lastXY oldInfo of
            Nothing -> (xpos,ypos)
            (Just (lastX,lastY)) -> (lastX,lastY)
        sensitivity = 0.05
        xoffset = (xpos - lastX) * sensitivity
        yoffset = (lastY - ypos) * sensitivity
        lastX' = xpos
        lastY' = ypos
        (oldPitch,oldYaw) = oldPitchYaw oldInfo
        newYaw = (oldYaw + xoffset) `mod'` 360.0
        newPitch = min (max (oldPitch + yoffset) (-89)) 89
        toRadians = realToFrac . (*(pi/180)) :: Double -> GLfloat
        pitchR = toRadians newPitch
        yawR = toRadians newYaw
        front = normalize $ V3 (cos yawR * cos pitchR) (sin pitchR) (sin yawR * cos pitchR)
        in MouseInfo (Just (lastX',lastY')) (newPitch, newYaw) front

Then we use it during the main loop by mixing the key input and the mouse input. I chose to have the keys resolved first, but you could do mouse first and it'd probably be fine.

-- read and use keys
keysDown <- readIORef keyRef
let cameraTemp = updateCamera keysDown cameraSpeed oldCamera
-- read and use mouse
mouseInfo <- readIORef mouseRef
let camera = cameraTemp{cameraFront = frontVec mouseInfo}

WASD Movement

Zoom

Adding in zoom isn't too hard. First we setup to detect scrolling before the loop.

-- FOV controls
fovRef <- newIORef 45
GLFW.setScrollCallback window (Just (\win xoffset yoffset -> do
    fov <- readIORef fovRef
    let newFov = min (max (fov - yoffset) 1) 45
    writeIORef fovRef newFov))

And then in the loop we use that instead of a fixed 45. Take note, the linear package expects the FOV value to be in radians, so we gotta convert

fovDegrees <- realToFrac <$> readIORef fovRef
let fovRadians = fovDegrees * pi / 180
let projMat = perspective fovRadians (screenWidthF / screenHeightF) 0.1 100.0