summaryrefslogtreecommitdiff
path: root/src/Game
diff options
context:
space:
mode:
authormtgmonkey <mtgmonkey@nixos>2025-12-08 11:21:14 +0100
committermtgmonkey <mtgmonkey@nixos>2025-12-08 11:21:14 +0100
commit5585a49393a05c25b7df7a6a48d1f39db6324b69 (patch)
tree9f96a496c4c00da9fd286d2b6742d95eb8ae17e1 /src/Game
parente767a5ee5becd575039ff39db40a7373ccca7eaf (diff)
semantics, readability, relicense, initResource argument removal
Diffstat (limited to 'src/Game')
-rw-r--r--src/Game/Internal.hs25
-rw-r--r--src/Game/Internal/Types.hs74
2 files changed, 55 insertions, 44 deletions
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)