diff options
Diffstat (limited to 'src')
| -rw-r--r-- | src/Game.hs | 36 | ||||
| -rw-r--r-- | src/Game/Internal.hs | 25 | ||||
| -rw-r--r-- | src/Game/Internal/Types.hs | 74 |
3 files changed, 63 insertions, 72 deletions
diff --git a/src/Game.hs b/src/Game.hs index 7aeb2a5..9af35d0 100644 --- a/src/Game.hs +++ b/src/Game.hs @@ -9,36 +9,24 @@ -} module Game (main) where -import Game.Internal.LoadShaders import Game.Internal.Types import Game.Internal -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, int2Double) +import Control.Lens ((^.)) +import Data.IORef (newIORef) +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 - ) +import Linear ( V3(..), _y ) -- | Main function runs game main :: IO () main = do - GLFW.init + _ <- GLFW.init GLFW.defaultWindowHints -- OpenGL core >=3.3 @@ -61,7 +49,7 @@ main = do GLFW.setCursorInputMode window GLFW.CursorInputMode'Hidden GLFW.setCursorPosCallback window $ Just (cursorPosHandler Nothing) - (objects, program) <- initResources window testVertices + (objects, program) <- initResources testVertices -- init model let @@ -123,8 +111,6 @@ update dt model = updateAcceleration :: Float -> Model -> Model updateAcceleration dt model = let - yaw = (L.rotate (L.axisAngle model.wprop.up model.camera.camYaw) model.camera.camReference) - front = L.normalize $ (V3 1 0 1) * (L.rotate (L.axisAngle (L.cross model.wprop.up yaw) model.camera.camPitch) yaw) zp = if elem GLFW.Key'S model.keys then 1 else 0 zn = if elem GLFW.Key'W model.keys then 1 else 0 xp = if elem GLFW.Key'D model.keys then 1 else 0 @@ -193,12 +179,6 @@ updateCameraAngle dt model = } } --- | 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 } - -- | views the model view :: GLFW.Window -> Model -> IO () view window model = do @@ -233,8 +213,8 @@ view window model = do projectionLocation <- GL.get $ GL.uniformLocation model.program "u_projection" GL.uniform projectionLocation $= projectionGLMatrix - -- draw objects - drawObjects model.objects + -- draw objects; returns IO [] + _ <- drawObjects model.objects -- swap to current buffer GLFW.swapBuffers window diff --git a/src/Game/Internal.hs b/src/Game/Internal.hs index bb9da57..a99b1b9 100644 --- a/src/Game/Internal.hs +++ b/src/Game/Internal.hs @@ -25,10 +25,8 @@ 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.IORef (IORef, modifyIORef', readIORef) import Data.List (delete) import Foreign.Marshal.Array (withArray) import Foreign.Ptr (nullPtr, plusPtr) @@ -39,20 +37,15 @@ 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 - ) +import Linear (V3(..)) -------------------------------------------------------------------------------- -- Shader creation and object initialisation -------------------------------------------------------------------------------- -- | loads models, shaders -initResources :: GLFW.Window -> [V3 GL.GLfloat] -> IO ([Object], GL.Program) -initResources window array = do +initResources :: [V3 GL.GLfloat] -> IO ([Object], GL.Program) +initResources 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 @@ -151,7 +144,7 @@ createObject array numComponents primitiveMode = do GL.bindVertexArrayObject $= Just vao -- vbo for vertices - createVBO array numComponents $ GL.AttribLocation 0 + _ <- createVBO array numComponents $ GL.AttribLocation 0 return (Object @@ -187,9 +180,9 @@ loop window dt update view modelRef = do -- end frame timer, wait the difference between expected and actual Just frameEnd <- GLFW.getTime let - dt = double2Float $ frameEnd - frameStart + drawTime = double2Float $ frameEnd - frameStart target = 1 / 60 :: Float - when (dt < target) $ threadDelay $ floor $ (target - dt) * 1000000 + when (drawTime < target) $ threadDelay $ floor $ (target - drawTime) * 1000000 Just frameEnd' <- GLFW.getTime let dt' = double2Float $ frameEnd' - frameStart @@ -254,9 +247,9 @@ resizeWindow _ _ _ = return () keyPressed :: Maybe (IORef Model) -> GLFW.KeyCallback keyPressed _ window GLFW.Key'Escape _ GLFW.KeyState'Pressed _ = shutdownWindow window -keyPressed (Just modelRef) window key _ GLFW.KeyState'Pressed _ = +keyPressed (Just modelRef) _ key _ GLFW.KeyState'Pressed _ = modifyIORef' modelRef $ updateKeyPressed key -keyPressed (Just modelRef) window key _ GLFW.KeyState'Released _ = +keyPressed (Just modelRef) _ key _ GLFW.KeyState'Released _ = modifyIORef' modelRef $ updateKeyReleased key keyPressed _ _ _ _ _ _ = return () diff --git a/src/Game/Internal/Types.hs b/src/Game/Internal/Types.hs index 719905e..ad220e4 100644 --- a/src/Game/Internal/Types.hs +++ b/src/Game/Internal/Types.hs @@ -1,9 +1,9 @@ {-# LANGUAGE NamedFieldPuns, OverloadedRecordDot #-} {- | - - Module : Game.Types + - Module : Game.Internal.Types - Description : - - Copyright : Andromeda 2025 - - License : WTFPL + - Copyright : 2025 Andromeda + - License : BSD 3-clause - Maintainer : Matrix @Andromeda:tchncs.de - Stability : Experimental -} @@ -44,18 +44,19 @@ import qualified Graphics.UI.GLFW as GLFW import qualified Graphics.Rendering.OpenGL as GL import qualified Linear as L -import Linear (Quaternion, V3, V3(..), V4(..)) +import Linear (V3, V3(..), V4(..)) -- | represents a single draw call data Object = Object - { vao :: GL.VertexArrayObject - , numIndicies :: GL.NumArrayIndices - , numComponents :: GL.NumComponents - , primitiveMode :: GL.PrimitiveMode + { vao :: GL.VertexArrayObject -- ^ vao of vertex buffer + , numIndicies :: GL.NumArrayIndices -- ^ number of vertices + , numComponents :: GL.NumComponents -- ^ dimensionallity; vec3, vec4, etc. + , primitiveMode :: GL.PrimitiveMode -- ^ primitive mode to be drawn with } deriving Show +-- | converts M44 to a 16array for OpenGL toGLMatrix :: L.M44 GL.GLfloat -> [GL.GLfloat] toGLMatrix (V4 @@ -73,34 +74,49 @@ toGLMatrix data Model = Model { camera :: Camera - , cursorDeltaPos :: (Double, Double) - , cursorPos :: (Double, Double) - , keys :: [GLFW.Key] - , objects :: [Object] - , program :: GL.Program + , cursorDeltaPos :: (Double, Double) -- ^ frame-on-frame delta mouse position + , cursorPos :: (Double, Double) -- ^ current mouse position + , keys :: [GLFW.Key] -- ^ currently pressed keys + , objects :: [Object] -- ^ draw calls + , program :: GL.Program -- ^ shader program , wprop :: WorldProperties } deriving Show -mkModel :: Camera -> [Object] -> GL.Program -> WorldProperties -> Model -mkModel camera objects program wprop = Model camera (0,0) (0,0) [] objects program wprop +-- | smart constructor for Model +mkModel + :: Camera + -> [Object] + -> GL.Program + -> WorldProperties + -> Model +mkModel camera objects program wprop = + Model + camera + (0,0) + (0,0) + [] + objects + program + wprop -- | camera data Camera = Camera - { camPos :: V3 Float - , camPitch :: Float - , camYaw :: Float - , camReference :: V3 Float - , camVel :: V3 Float - , mouseSensitivity :: Float - , strafeStrength :: Float - , jumpStrength :: Float - , hasJumped :: Bool - , airTime :: Float + { camPos :: V3 Float -- ^ position in world space + , camPitch :: Float -- ^ pitch in radians, up positive + , camYaw :: Float -- ^ yaw in radians, right positive + , camReference :: V3 Float -- ^ reference direction; orientation applied to + , camVel :: V3 Float -- ^ velocity in world space + , mouseSensitivity :: Float -- ^ scale factor for mouse movement + , strafeStrength :: Float -- ^ scale factor for strafe + , jumpStrength :: Float -- ^ scale factor for jump initial velocity + , hasJumped :: Bool -- ^ whether the camera still has jumping state + , airTime :: Float -- ^ time since jumping state entered in seconds } deriving Show +-- | smart constructor for Camera mkCamera :: V3 Float -> Float @@ -132,14 +148,16 @@ mkCamera False 0 +-- | physical properties of the world data WorldProperties = WorldProperties - { g :: Float -- ^ gravity `g` - , friction :: Float -- ^ floor friction - , up :: V3 Float + { g :: Float -- ^ gravity `g` + , friction :: Float -- ^ scale factor for floor friction + , up :: V3 Float -- ^ global up vector } deriving Show +-- | smart constructor for WorldProperties mkWorldProperties :: Float -> Float -> V3 Float-> WorldProperties mkWorldProperties g friction up = WorldProperties g friction (L.normalize up) |