add changelog; see changelog <3
This commit is contained in:
mtgmonkey
42
CHANGELOG.md
Normal file
42
CHANGELOG.md
Normal file
@@ -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
|
||||
@@ -4,9 +4,4 @@ cd hs-game
|
||||
nix run
|
||||
```
|
||||
|
||||
todo
|
||||
|
||||
- [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
|
||||
todo moved to CHANGELOG.md
|
||||
|
||||
267
src/Game/Internal.hs
Normal file
267
src/Game/Internal.hs
Normal file
@@ -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 ()
|
||||
@@ -13,7 +13,7 @@
|
||||
--
|
||||
--------------------------------------------------------------------------------
|
||||
|
||||
module Game.LoadShaders (
|
||||
module Game.Internal.LoadShaders (
|
||||
ShaderSource(..), ShaderInfo(..), loadShaders
|
||||
) where
|
||||
|
||||
@@ -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)
|
||||
253
src/Game/Main.hs
253
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
|
||||
@@ -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
|
||||
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 ()
|
||||
|
||||
Reference in New Issue
Block a user