release v0.2.0

2025-12-08 13:40:11 +01:00
parent 852244a491
commit 20ecde081b
8 changed files with 218 additions and 147 deletions
--- a/src/Game/Main.hs
+++ b/src/Game/Main.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
--- 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 ()

--- 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)