summaryrefslogtreecommitdiff
path: root/src
diff options
context:
space:
mode:
authormtgmonkey <mtgmonkey@nixos>2025-12-07 23:52:20 +0100
committermtgmonkey <mtgmonkey@nixos>2025-12-07 23:52:20 +0100
commit852244a49159097a83fc99edcdad26f84f999098 (patch)
treeb5dca9302d0352c513f1ad23a022a7a1a6b243e2 /src
parentea56936a1529e776602186c50f7e7f587ecbf2de (diff)
add changelog; see changelog <3
Diffstat (limited to 'src')
-rw-r--r--src/Game/Internal.hs267
-rw-r--r--src/Game/Internal/LoadShaders.hs (renamed from src/Game/LoadShaders.hs)2
-rw-r--r--src/Game/Internal/Types.hs (renamed from src/Game/Types.hs)23
-rw-r--r--src/Game/Main.hs253
4 files changed, 317 insertions, 228 deletions
diff --git a/src/Game/Internal.hs b/src/Game/Internal.hs
new file mode 100644
index 0000000..bb9da57
--- /dev/null
+++ b/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 ()
diff --git a/src/Game/LoadShaders.hs b/src/Game/Internal/LoadShaders.hs
index 3d24e78..ded2da9 100644
--- a/src/Game/LoadShaders.hs
+++ b/src/Game/Internal/LoadShaders.hs
@@ -13,7 +13,7 @@
--
--------------------------------------------------------------------------------
-module Game.LoadShaders (
+module Game.Internal.LoadShaders (
ShaderSource(..), ShaderInfo(..), loadShaders
) where
diff --git a/src/Game/Types.hs b/src/Game/Internal/Types.hs
index 738205f..719905e 100644
--- a/src/Game/Types.hs
+++ b/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)
diff --git a/src/Game/Main.hs b/src/Game/Main.hs
index 5ba5bd7..7aeb2a5 100644
--- a/src/Game/Main.hs
+++ b/src/Game/Main.hs
@@ -9,8 +9,9 @@
-}
module Game (main) where
-import Game.LoadShaders
-import Game.Types
+import Game.Internal.LoadShaders
+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
- GLFW.windowHint $ GLFW.WindowHint'Samples $ Just 4
+ -- MSAA
+ 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
@@ -104,157 +106,9 @@ testVertices =
]
--------------------------------------------------------------------------------
--- 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
- z = zn - zp
+ x = xp - xn
+ 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)
- newPitch' = if newPitch >= (pi / 2) then (0.9999 * pi / 2) else newPitch
- newPitch'' = if newPitch <= ((-1) * pi / 2) then ((-0.9999) * pi / 2) else newPitch
- newYaw = model.camera.camYaw + model.camera.mouseSensitivity * dt * (double2Float $ fst model.cursorDeltaPos)
- newYaw' = newYaw - (mod' newYaw pi)
+ scaleFactor = model.camera.mouseSensitivity * dt
+ newPitch = model.camera.camPitch -
+ scaleFactor * (double2Float $ snd model.cursorDeltaPos) -- mouse sensitivity, update pitch
+ newPitch' = if newPitch > 1.56 then 1.56 else newPitch
+ 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)
- , camYaw = model.camera.camYaw + dt * (double2Float $ fst model.cursorDeltaPos)
+ { camPitch = newPitch''
+ , 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 ()