summaryrefslogtreecommitdiff
path: root/src
diff options
context:
space:
mode:
authormtgmonkey <mtgmonkey@nixos>2025-12-08 13:40:11 +0100
committermtgmonkey <mtgmonkey@nixos>2025-12-08 13:40:11 +0100
commit20ecde081bf47c7790e93dd2282d5e666e01b9ce (patch)
treee825e9091bbf3e169b9a86d4f545175cb99b3055 /src
parent852244a49159097a83fc99edcdad26f84f999098 (diff)
release v0.2.0
Diffstat (limited to 'src')
-rw-r--r--src/Game.hs (renamed from src/Game/Main.hs)40
-rw-r--r--src/Game/Internal.hs31
-rw-r--r--src/Game/Internal/Types.hs74
3 files changed, 68 insertions, 77 deletions
diff --git a/src/Game/Main.hs b/src/Game.hs
index 7aeb2a5..f120a6f 100644
--- a/src/Game/Main.hs
+++ b/src/Game.hs
@@ -2,43 +2,31 @@
{- |
- Module : Game
- Description : runs game
- - Copyright : Andromeda 2025
- - License : WTFPL
+ - Copyright : 2025 Andromeda
+ - License : BSD 3-clause
- Maintainer : Matrix @Andromeda:tchncs.de
- Stability : Experimental
-}
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..61832a9 100644
--- a/src/Game/Internal.hs
+++ b/src/Game/Internal.hs
@@ -1,9 +1,9 @@
{-# LANGUAGE DisambiguateRecordFields, NamedFieldPuns, OverloadedRecordDot #-}
{- |
- Module : Game.Internal
- - Description : 'hidden' functions
- - Copyright : Andromeda 2025
- - License : WTFPL
+ - Description : internal functions
+ - Copyright : 2025 Andromeda
+ - License : BSD 3-clause
- Maintainer : Matrix @Andromeda:tchncs.de
- Stability : Experimental
-}
@@ -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)