add changelog; see changelog <3

CHANGELOG.md

@@ -0,0 +1,42 @@
+
+# Changelog
+
+All notable changes to this project will be documented in this file.
+
+The format is based on [Keep a Changelog](https://keepachangelog.com/en/1.1.0/),
+and this project adheres to [Semantic Versioning](https://semver.org/spec/v2.0.0.html).
+
+## [Unreleased]
+
+### Added
+
+- test suite for non-IO functions
+- debug/release outputs of Nix flake
+
+### Changed
+
+- use Rotors rather than Quaternions for rotation; easily extended to 4D
+
+### Fixed
+
+- semantic issues
+
+## [0.1.0] - 2025-12-07
+
+### Added
+
+- CHANGELOG.md
+- layer correctly drawn objects in the view function
+
+### Changed
+
+- 8xMSAA rather than 4xMSAA window hint to improve AA
+- todo and changelog in CHANGELOG.md rather than README.md
+- a nubmer fo functions from Game module now in Game.Internal
+- initResources takes an array of objects to draw rather than hardcoded arrays
+- square the far plane of the perspective transform
+- loop function takes delta time
+
+### Fixed
+
+- constrained pitch to disallow gimbal lock and an inverted view

README.md

@@ -4,9 +4,4 @@ cd hs-game
 nix run
 ```
 
-todo
+todo moved to CHANGELOG.md
-
-- [x] add proper mouse movement
-- [ ] abstract into `Game` and `Game.Internal` with appropriate exports
-- [ ] refactor for correctness
-- [ ] fix depth clipping; near squares show oft before far

src/Game/Internal.hs

@@ -0,0 +1,267 @@
+{-# LANGUAGE DisambiguateRecordFields, NamedFieldPuns, OverloadedRecordDot #-}
+{- |
+ - Module      : Game.Internal
+ - Description : 'hidden' functions
+ - Copyright   : Andromeda 2025
+ - License     : WTFPL
+ - Maintainer  : Matrix @Andromeda:tchncs.de
+ - Stability   : Experimental
+ -}
+module Game.Internal
+  ( cursorPosHandler
+  , drawObjects
+  , initResources
+  , keyPressed
+  , loop
+  , resizeWindow
+  , shutdownWindow
+  , updateCursorPos
+  , updateKeyPressed
+  , updateKeyReleased
+  )
+  where
+
+import Game.Internal.LoadShaders
+import Game.Internal.Types
+
+import Control.Concurrent    (threadDelay)
+import Control.Lens          ((^.), (+~), (&), (%~))
+import Control.Monad         (when)
+import Data.Fixed            (mod')
+import Data.IORef            (atomicModifyIORef', IORef, modifyIORef', newIORef, readIORef, writeIORef)
+import Data.List             (delete)
+import Foreign.Marshal.Array (withArray)
+import Foreign.Ptr           (nullPtr, plusPtr)
+import Foreign.Storable      (sizeOf, Storable)
+import GHC.Float             (double2Float)
+
+import qualified Graphics.UI.GLFW          as GLFW
+import qualified Graphics.Rendering.OpenGL as GL
+import           Graphics.Rendering.OpenGL as GL (($=))
+
+import qualified Linear as L
+import           Linear      ( V3(..)
+                             , _x
+                             , _y
+                             , _z
+                             )
+
+--------------------------------------------------------------------------------
+-- Shader creation and object initialisation
+--------------------------------------------------------------------------------
+
+-- | loads models, shaders
+initResources :: GLFW.Window -> [V3 GL.GLfloat] -> IO ([Object], GL.Program)
+initResources window array = do
+  -- create objects
+  testObject0 <- createObject (map (+(V3 (-1) (-1) (-1))) array) 3 GL.TriangleStrip
+  testObject1 <- createObject (map (+(V3 (1) (1) (1))) array) 3 GL.TriangleStrip
+  testObject2 <- createObject array 3 GL.TriangleStrip
+  let objects = [testObject0, testObject1, testObject2]
+
+  -- load shaders
+  program <- loadShaders
+    [ ShaderInfo GL.VertexShader (StringSource vertShader)
+    , ShaderInfo GL.FragmentShader (StringSource fragShader)
+    ]
+  GL.currentProgram $= Just program
+
+  return (objects, program)
+
+-- a_ vertex shader input
+-- v_ varying
+-- u_ uniform
+-- o_ fragment shader output
+
+-- | vertex shader
+vertShader :: String
+vertShader =
+  "#version 330 core\n" ++
+  "layout (location = 0) in vec3 a_vPos;\n" ++
+  "uniform mat4 u_view;\n" ++
+  "uniform mat4 u_projection;\n" ++
+  "out vec3 v_pos;\n" ++
+  "void main()\n" ++
+  "{\n" ++
+  "  gl_Position = u_projection * u_view * vec4(a_vPos.xyz, 1.0);\n" ++
+  "  v_pos = a_vPos;\n" ++
+  "}"
+  
+-- | fragment shader
+fragShader :: String
+fragShader =
+  "#version 330 core\n" ++
+  "out vec4 o_vColor;\n" ++
+  "in vec3 v_pos;\n" ++
+  "void main()\n" ++
+  "{\n" ++
+  "  o_vColor = vec4(0.5 + 0.5 * v_pos, 1);\n" ++
+  "}"
+
+--------------------------------------------------------------------------------
+-- Objects
+--------------------------------------------------------------------------------
+
+-- | calculates the size in memory of an array
+sizeOfArray :: (Storable a, Num b) => [a] -> b
+sizeOfArray [] = 0
+sizeOfArray (x:xs) = fromIntegral $ (*) (1 + length xs) $ sizeOf x
+
+-- | loads a given array into a given attribute index
+createVBO
+  :: Storable (a GL.GLfloat)
+  => [a GL.GLfloat]
+  -> GL.NumComponents
+  -> GL.AttribLocation
+  -> IO GL.BufferObject
+createVBO array numComponents attribLocation = do
+  -- vbo for buffer
+  buffer <- GL.genObjectName
+  GL.bindBuffer GL.ArrayBuffer $= Just buffer
+
+  -- populate buffer
+  withArray
+    array
+    $ \ptr ->
+        GL.bufferData GL.ArrayBuffer $= (sizeOfArray array, ptr, GL.StaticDraw)
+
+  -- create attribute pointer to buffer
+  GL.vertexAttribPointer attribLocation $=
+    ( GL.ToFloat
+    , GL.VertexArrayDescriptor
+        numComponents
+        GL.Float
+        0
+        (plusPtr nullPtr 0)
+    )
+  GL.vertexAttribArray attribLocation $= GL.Enabled
+
+  return buffer
+
+-- | creates an object from a given array; deals with vbos and everything
+createObject
+  :: Storable (a GL.GLfloat)
+  => [a GL.GLfloat]
+  -> GL.NumComponents
+  -> GL.PrimitiveMode
+  -> IO Object
+createObject array numComponents primitiveMode = do
+  -- vao for object
+  vao <- GL.genObjectName
+  GL.bindVertexArrayObject $= Just vao
+
+  -- vbo for vertices
+  createVBO array numComponents $ GL.AttribLocation 0
+
+  return
+    (Object
+      vao
+      (fromIntegral $ length array)
+      numComponents
+      primitiveMode
+    )
+
+--------------------------------------------------------------------------------
+-- Elm-like data structures
+--------------------------------------------------------------------------------
+
+-- | gameloop
+loop
+  :: GLFW.Window -- ^ window to display on
+  -> Float -- ^ dt
+  -> (Float -> Model -> Model) -- ^ update function
+  -> (GLFW.Window -> Model -> IO ()) -- ^ view function
+  -> IORef Model -- ^ model
+  -> IO ()
+loop window dt update view modelRef = do
+  -- start frame timer
+  Just frameStart <- GLFW.getTime
+
+  -- tick model
+  modifyIORef' modelRef $ update dt
+  model' <- readIORef modelRef
+
+  -- view new model
+  view window model'
+
+  -- end frame timer, wait the difference between expected and actual
+  Just frameEnd <- GLFW.getTime
+  let
+    dt = double2Float $ frameEnd - frameStart
+    target = 1 / 60 :: Float
+  when (dt < target) $ threadDelay $ floor $ (target - dt) * 1000000
+  Just frameEnd' <- GLFW.getTime
+  let
+    dt' = double2Float $ frameEnd' - frameStart
+
+  loop window dt' update view modelRef
+
+-- | updates given a keypress. escape case is probably caught by GLFW in the
+-- handler function itself
+updateKeyPressed :: GLFW.Key -> Model -> Model
+updateKeyPressed key model =
+  model { keys = key:model.keys }
+
+-- | updates given a keyrelease. escape case is probably caught by GLFW in the
+-- handler function itself
+updateKeyReleased :: GLFW.Key -> Model -> Model
+updateKeyReleased key model =
+  model { keys = (delete key model.keys) }
+
+applyToTuples :: (a -> b -> c) -> (a, a) -> (b, b) -> (c, c)
+applyToTuples f (x, y) (a, b) = (f x a, f y b)
+
+-- | updates cursor
+updateCursorPos :: Double -> Double -> Model ->  Model
+updateCursorPos x y model =
+  let
+    pyth = (((fst model.cursorPos) - x) ** 2 + ((snd model.cursorPos - y)) ** 2) ** 0.5
+  in
+  if pyth < 16 then
+    model
+      { cursorPos = (x, y)
+      , cursorDeltaPos = applyToTuples (-) model.cursorPos (x, y)
+      }
+  else 
+    model
+      { cursorPos = (x, y)
+      }
+
+-- | draws objects
+drawObjects :: [Object] -> IO ([Object])
+drawObjects [] = return []
+drawObjects
+  ((Object vao numVertices _ primitiveMode):objects) = do
+  GL.bindVertexArrayObject $= Just vao
+  GL.drawArrays primitiveMode 0 numVertices
+  drawObjects objects
+
+--------------------------------------------------------------------------------
+-- interrupts
+--------------------------------------------------------------------------------
+
+-- | shuts down GLFW
+shutdownWindow :: GLFW.WindowCloseCallback
+shutdownWindow window = do
+  GLFW.destroyWindow window
+  GLFW.terminate
+
+-- | resizes viewport with window
+resizeWindow :: GLFW.WindowSizeCallback
+resizeWindow _ _ _ = return ()
+
+-- | handles key presses
+keyPressed :: Maybe (IORef Model) -> GLFW.KeyCallback
+keyPressed _ window GLFW.Key'Escape _ GLFW.KeyState'Pressed _ =
+  shutdownWindow window
+keyPressed (Just modelRef) window key _ GLFW.KeyState'Pressed _ =
+  modifyIORef' modelRef $ updateKeyPressed key
+keyPressed (Just modelRef) window key _ GLFW.KeyState'Released _ =
+  modifyIORef' modelRef $ updateKeyReleased key
+keyPressed _ _ _ _ _ _ = return ()
+
+-- | handles cursor position updates
+cursorPosHandler :: Maybe (IORef Model) -> GLFW.CursorPosCallback
+cursorPosHandler (Just modelRef) _ x y =
+  modifyIORef' modelRef $ updateCursorPos x y
+cursorPosHandler Nothing _ _ _ = return ()

src/Game/Internal/LoadShaders.hs

@@ -13,7 +13,7 @@
 --
 --------------------------------------------------------------------------------
 
-module Game.LoadShaders (
+module Game.Internal.LoadShaders (
    ShaderSource(..), ShaderInfo(..), loadShaders
 ) where
 

src/Game/Internal/Types.hs

@@ -7,15 +7,32 @@
  - Maintainer  : Matrix @Andromeda:tchncs.de
  - Stability   : Experimental
  -}
-module Game.Types
+module Game.Internal.Types
   ( Object(..)
 
   , toGLMatrix
 
-  , Model (objects, camera, cursorDeltaPos, cursorPos, program, keys, wprop)
+  , Model ( camera
+          , objects
+          , cursorDeltaPos
+          , cursorPos
+          , program
+          , keys
+          , wprop
+          )
   , mkModel
 
-  , Camera (camPos, camPitch, camYaw, camReference, mouseSensitivity, camVel, strafeStrength, jumpStrength, hasJumped, airTime)
+  , Camera ( camPos
+           , camPitch
+           , camYaw
+           , camReference
+           , mouseSensitivity
+           , camVel
+           , strafeStrength
+           , jumpStrength
+           , hasJumped
+           , airTime
+           )
   , mkCamera
 
   , WorldProperties (g, friction, up)

src/Game/Main.hs

@@ -9,8 +9,9 @@
  -}
 module Game (main) where
 
-import Game.LoadShaders
+import Game.Internal.LoadShaders
-import Game.Types
+import Game.Internal.Types
+import Game.Internal
 
 import Control.Concurrent    (threadDelay)
 import Control.Lens          ((^.), (+~), (&), (%~))
@@ -21,7 +22,7 @@ import Data.List             (delete)
 import Foreign.Marshal.Array (withArray)
 import Foreign.Ptr           (nullPtr, plusPtr)
 import Foreign.Storable      (sizeOf, Storable)
-import GHC.Float             (double2Float)
+import GHC.Float             (double2Float, int2Double)
 
 import qualified Graphics.UI.GLFW          as GLFW
 import qualified Graphics.Rendering.OpenGL as GL
@@ -45,8 +46,8 @@ main = do
   GLFW.windowHint $ GLFW.WindowHint'ContextVersionMinor 3
   GLFW.windowHint $ GLFW.WindowHint'OpenGLProfile GLFW.OpenGLProfile'Core
   
-  -- 4x MSAA
+  -- MSAA
-  GLFW.windowHint $ GLFW.WindowHint'Samples $ Just 4
+  GLFW.windowHint $ GLFW.WindowHint'Samples $ Just 8
 
   -- create window
   monitor <- GLFW.getPrimaryMonitor
@@ -57,9 +58,10 @@ main = do
   GLFW.setWindowCloseCallback window $ Just shutdownWindow
   GLFW.setWindowSizeCallback window $ Just resizeWindow
   GLFW.setKeyCallback window $ Just (keyPressed Nothing)
+  GLFW.setCursorInputMode window GLFW.CursorInputMode'Hidden
   GLFW.setCursorPosCallback window $ Just (cursorPosHandler Nothing)
 
-  (objects, program) <- initResources window
+  (objects, program) <- initResources window testVertices
 
   -- init model
   let
@@ -71,7 +73,7 @@ main = do
           0 -- yaw
           (V3 0 0 (-1)) -- reference vector
           (V3 0 0 0) -- velocity
-          0.08 -- mouse sensitivity
+          2 -- mouse sensitivity
           16 -- strafe strength
           12 -- jump strength
         )
@@ -88,7 +90,7 @@ main = do
   GLFW.setKeyCallback window $ Just $ keyPressed $ Just modelRef
   GLFW.setCursorPosCallback window $ Just $ cursorPosHandler $ Just modelRef
 
-  loop window (update 0) view modelRef
+  loop window 0 update view modelRef
 
 --------------------------------------------------------------------------------
 -- Arrays
@@ -103,158 +105,10 @@ testVertices =
   , V3 0.5    0.5    0
   ]
 
---------------------------------------------------------------------------------
--- Shader creation and object initialisation
---------------------------------------------------------------------------------
-
--- | loads models, shaders
-initResources :: GLFW.Window -> IO ([Object], GL.Program)
-initResources window = do
-  -- create objects
-  testObject0 <- createObject (map (+(V3 (-1) (-1) (-1))) testVertices) 3 GL.TriangleStrip
-  testObject1 <- createObject (map (+(V3 (1) (1) (1))) testVertices) 3 GL.TriangleStrip
-  testObject2 <- createObject testVertices 3 GL.TriangleStrip
-  let objects = [testObject0, testObject1, testObject2]
-
-  -- load shaders
-  program <- loadShaders
-    [ ShaderInfo GL.VertexShader (StringSource vertShader)
-    , ShaderInfo GL.FragmentShader (StringSource fragShader)
-    ]
-  GL.currentProgram $= Just program
-
-  return (objects, program)
-
--- a_ vertex shader input
--- v_ varying
--- u_ uniform
--- o_ fragment shader output
-
--- | vertex shader
-vertShader :: String
-vertShader =
-  "#version 330 core\n" ++
-  "layout (location = 0) in vec3 a_vPos;\n" ++
-  "uniform mat4 u_view;\n" ++
-  "uniform mat4 u_projection;\n" ++
-  "out vec3 v_pos;\n" ++
-  "void main()\n" ++
-  "{\n" ++
-  "  gl_Position = u_projection * u_view * vec4(a_vPos.xyz, 1.0);\n" ++
-  "  v_pos = a_vPos;\n" ++
-  "}"
-  
--- | fragment shader
-fragShader :: String
-fragShader =
-  "#version 330 core\n" ++
-  "out vec4 o_vColor;\n" ++
-  "in vec3 v_pos;\n" ++
-  "void main()\n" ++
-  "{\n" ++
-  "  o_vColor = vec4(0.5 + 0.5 * v_pos, 1);\n" ++
-  "}"
-
---------------------------------------------------------------------------------
--- Objects
---------------------------------------------------------------------------------
-
--- | calculates the size in memory of an array
-sizeOfArray :: (Storable a, Num b) => [a] -> b
-sizeOfArray [] = 0
-sizeOfArray (x:xs) = fromIntegral $ (*) (1 + length xs) $ sizeOf x
-
--- | loads a given array into a given attribute index
-createVBO
-  :: Storable (a GL.GLfloat)
-  => [a GL.GLfloat]
-  -> GL.NumComponents
-  -> GL.AttribLocation
-  -> IO GL.BufferObject
-createVBO array numComponents attribLocation = do
-  -- vbo for buffer
-  buffer <- GL.genObjectName
-  GL.bindBuffer GL.ArrayBuffer $= Just buffer
-
-  -- populate buffer
-  withArray
-    array
-    $ \ptr ->
-        GL.bufferData GL.ArrayBuffer $= (sizeOfArray array, ptr, GL.StaticDraw)
-
-  -- create attribute pointer to buffer
-  GL.vertexAttribPointer attribLocation $=
-    ( GL.ToFloat
-    , GL.VertexArrayDescriptor
-        numComponents
-        GL.Float
-        0
-        (plusPtr nullPtr 0)
-    )
-  GL.vertexAttribArray attribLocation $= GL.Enabled
-
-  return buffer
-
--- | creates an object from a given array; deals with vbos and everything
-createObject
-  :: Storable (a GL.GLfloat)
-  => [a GL.GLfloat]
-  -> GL.NumComponents
-  -> GL.PrimitiveMode
-  -> IO Object
-createObject array numComponents primitiveMode = do
-  -- vao for object
-  vao <- GL.genObjectName
-  GL.bindVertexArrayObject $= Just vao
-
-  -- vbo for vertices
-  createVBO array numComponents $ GL.AttribLocation 0
-
-  return
-    (Object
-      vao
-      (fromIntegral $ length array)
-      numComponents
-      primitiveMode
-    )
-
 --------------------------------------------------------------------------------
 -- Elm-like data structures
 --------------------------------------------------------------------------------
 
--- | gameloop
-loop
-  :: GLFW.Window -- ^ window to display on
-  -> (Model -> Model) -- ^ update function
-  -> (GLFW.Window -> Model -> IO ()) -- ^ view function
-  -> IORef Model -- ^ model
-  -> IO ()
-loop window update view modelRef = do
-  -- start frame timer
-  Just frameStart <- GLFW.getTime
-
-  -- tick model
-  modifyIORef' modelRef $ update
-  model' <- readIORef modelRef
-
-  -- view new model
-  view window model'
-
-  putStrLn $ (++) "pitch" $ show model'.camera.camPitch
-  putStrLn $ (++) "yaw" $ show model'.camera.camYaw
-
-  -- end frame timer, wait the difference between expected and actual
-  Just frameEnd <- GLFW.getTime
-  let
-    dt = double2Float $ frameEnd - frameStart
-    target = 1 / 60 :: Float
-  when (dt < target) $ threadDelay $ floor $ (target - dt) * 1000000
-  Just frameEnd' <- GLFW.getTime
-  let
-    dt' = double2Float $ frameEnd' - frameStart
-
-  loop window (Game.update dt') view modelRef
-
 -- | update function
 update :: Float -> Model -> Model
 update dt model =
@@ -275,8 +129,8 @@ updateAcceleration dt model =
     zn = if elem GLFW.Key'W model.keys then 1 else 0
     xp = if elem GLFW.Key'D model.keys then 1 else 0
     xn = if elem GLFW.Key'A model.keys then 1 else 0
-    x = xn - xp
+    x = xp - xn
-    z = zn - zp
+    z = zp - zn
     friction = V3 (1 - model.wprop.friction) 1 (1 - model.wprop.friction)
     movement = L.normalize (V3 x 0 z) L.^* (dt * model.camera.strafeStrength)
     movement' = L.rotate (L.axisAngle model.wprop.up model.camera.camYaw) movement
@@ -323,17 +177,19 @@ updateVelocity dt model =
 updateCameraAngle :: Float -> Model -> Model
 updateCameraAngle dt model =
   let
-    newPitch = model.camera.camPitch - model.camera.mouseSensitivity * dt * (double2Float $ snd model.cursorDeltaPos)
+    scaleFactor = model.camera.mouseSensitivity * dt
-    newPitch' = if newPitch >= (pi / 2) then (0.9999 * pi / 2) else newPitch
+    newPitch = model.camera.camPitch -
-    newPitch'' = if newPitch <= ((-1) * pi / 2) then ((-0.9999) * pi / 2) else newPitch
+      scaleFactor * (double2Float $ snd model.cursorDeltaPos) -- mouse sensitivity, update pitch
-    newYaw = model.camera.camYaw + model.camera.mouseSensitivity * dt * (double2Float $ fst model.cursorDeltaPos)
+    newPitch' = if newPitch > 1.56 then 1.56 else newPitch
-    newYaw' = newYaw - (mod' newYaw pi)
+    newPitch'' = if newPitch' < (-1.56) then (-1.56) else newPitch'
+    newYaw = model.camera.camYaw +
+      scaleFactor * (double2Float $ fst model.cursorDeltaPos)
   in
   model
     { cursorDeltaPos = (0, 0)
     , camera = model.camera
-      { camPitch = model.camera.camPitch + dt * (double2Float $ snd model.cursorDeltaPos)
+      { camPitch = newPitch''
-      , camYaw = model.camera.camYaw + dt * (double2Float $ fst model.cursorDeltaPos)
+      , camYaw = newYaw
       }
     }
 
@@ -343,23 +199,6 @@ updateKeyPressed :: GLFW.Key -> Model -> Model
 updateKeyPressed key model =
   model { keys = key:model.keys }
 
--- | updates given a keyrelease. escape case is probably caught by GLFW in the
--- handler function itself
-updateKeyReleased :: GLFW.Key -> Model -> Model
-updateKeyReleased key model =
-  model { keys = (delete key model.keys) }
-
-applyToTuples :: (a -> b -> c) -> (a, a) -> (b, b) -> (c, c)
-applyToTuples f (x, y) (a, b) = (f x a, f y b)
-
--- | updates cursor
-updateCursorPos :: Double -> Double -> Model ->  Model
-updateCursorPos x y model =
-  model
-    { cursorPos = (x, y)
-    , cursorDeltaPos = applyToTuples (-) model.cursorPos (x, y)
-    }
-
 -- | views the model
 view :: GLFW.Window -> Model -> IO ()
 view window model = do
@@ -371,15 +210,20 @@ view window model = do
   GL.clearColor $= GL.Color4 1 0 1 1
   GL.clear [GL.ColorBuffer, GL.DepthBuffer]
 
+  -- depth
+  GL.depthFunc $= Just GL.Less
+
   -- apply transforms
   let
-    yaw = (L.rotate (L.axisAngle model.wprop.up model.camera.camYaw) model.camera.camReference)
+    pitch = model.camera.camPitch
+    yaw = model.camera.camYaw
+    forward = V3 (cos pitch * sin yaw) (sin pitch) (cos pitch * cos yaw)
     viewMatrix =
       L.lookAt
         model.camera.camPos
-        (model.camera.camPos + L.rotate (L.axisAngle (L.cross model.wprop.up yaw) model.camera.camPitch) yaw)
+        (model.camera.camPos - forward)
         model.wprop.up
-    projectionMatrix = L.perspective 1.5 (fromIntegral w / fromIntegral h) 0.1 100
+    projectionMatrix = L.perspective 1.5 (fromIntegral w / fromIntegral h) 0.01 10000
 
   viewGLMatrix <- GL.newMatrix GL.RowMajor $ toGLMatrix viewMatrix :: IO (GL.GLmatrix GL.GLfloat)
   viewLocation <- GL.get $ GL.uniformLocation model.program "u_view"
@@ -397,42 +241,3 @@ view window model = do
 
   -- check for interrupts
   GLFW.pollEvents
-
--- | draws objects
-drawObjects :: [Object] -> IO ([Object])
-drawObjects [] = return []
-drawObjects
-  ((Object vao numVertices _ primitiveMode):objects) = do
-  GL.bindVertexArrayObject $= Just vao
-  GL.drawArrays primitiveMode 0 numVertices
-  drawObjects objects
-
---------------------------------------------------------------------------------
--- interrupts
---------------------------------------------------------------------------------
-
--- | shuts down GLFW
-shutdownWindow :: GLFW.WindowCloseCallback
-shutdownWindow window = do
-  GLFW.destroyWindow window
-  GLFW.terminate
-
--- | resizes viewport with window
-resizeWindow :: GLFW.WindowSizeCallback
-resizeWindow _ _ _ = return ()
-
--- | handles key presses
-keyPressed :: Maybe (IORef Model) -> GLFW.KeyCallback
-keyPressed _ window GLFW.Key'Escape _ GLFW.KeyState'Pressed _ =
-  shutdownWindow window
-keyPressed (Just modelRef) window key _ GLFW.KeyState'Pressed _ =
-  modifyIORef' modelRef $ updateKeyPressed key
-keyPressed (Just modelRef) window key _ GLFW.KeyState'Released _ =
-  modifyIORef' modelRef $ updateKeyReleased key
-keyPressed _ _ _ _ _ _ = return ()
-
--- | handles cursor position updates
-cursorPosHandler :: Maybe (IORef Model) -> GLFW.CursorPosCallback
-cursorPosHandler (Just modelRef) _ x y =
-  modifyIORef' modelRef $ updateCursorPos x y
-cursorPosHandler Nothing _ _ _ = return ()