draw multiple sets of points, debug features

CHANGELOG.md

@@ -20,6 +20,21 @@ and this project adheres to [Semantic Versioning](https://semver.org/spec/v2.0.0
 - use `Double` rather than `FLoat` for internal calculations
     - `cursorPos`, `dt` natively `Double` already
 
+## [0.4.0] - 2025-12-21
+
+### Added
+
+- cube as array of points
+- debug feature where `t` and `g` raise and lower speed respectively
+
+### Changed
+
+- `initResources` now takes `[[V3 GL.GLfloat]]` rather than `[V3 GL.GLfloat]`
+    - to migrate: rather than passing `a` pass `[a]`; behaviour is the same
+- reduce view distance to 1'000 from 10'000
+- color pixels based on normalized coordinates
+- use `haskellPackages.callCabal2nix` in `flake.nix` for brevity, same behaviour
+
 ## [0.3.0] - 2025-12-08
 
 ### Added

flake.nix

@@ -7,41 +7,11 @@
     self,
     ...
   }: let
-    versionString = "0.3.0";
-    package = {
-      mkDerivation,
-      base,
-      bytestring,
-      GLFW-b,
-      lens,
-      lib,
-      linear,
-      OpenGL,
-    }:
-      mkDerivation {
-        pname = "hs-game";
-        version = versionString;
-        src = ./.;
-        isLibrary = false;
-        isExecutable = true;
-        executableHaskellDepends = [
-          base
-          bytestring
-          GLFW-b
-          lens
-          linear
-          OpenGL
-        ];
-        homepage = "https://git.mtgmonkey.net/Andromeda/hs-game";
-        license = lib.licenses.bsd3;
-        mainProgram = "hs-game";
-      };
     system = "x86_64-linux";
     pkgs = nixpkgs.legacyPackages.${system};
   in {
     packages.${system} = {
-      default =
-        pkgs.haskellPackages.callPackage package {};
+      default = pkgs.haskellPackages.callCabal2nix "hs-game" ./. {};
     };
     devShells.${system} = {
       default = pkgs.mkShell {

hs-game.cabal

@@ -1,6 +1,6 @@
 cabal-version:      3.0
 name:               hs-game
-version:            0.3.0
+version:            0.4.0
 -- synopsis:
 -- description:
 homepage:           https://git.mtgmonkey.net/Andromeda/hs-game

src/Game/Internal.hs

@@ -43,15 +43,10 @@ import Linear (V3(..))
 -- Shader creation and object initialisation
 --------------------------------------------------------------------------------
 -- | loads models, shaders
-initResources :: [V3 GL.GLfloat] -> IO ([Object], GL.Program)
-initResources array = do
+initResources :: [[V3 GL.GLfloat]] -> IO ([Object], GL.Program)
+initResources arrays = 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]
+  objects <- listIOsToIOlist [ createObject arr 3 GL.TriangleStrip | arr <- arrays ] []
   -- load shaders
   program <-
     loadShaders
@@ -61,6 +56,12 @@ initResources array = do
   GL.currentProgram $= Just program
   return (objects, program)
 
+listIOsToIOlist :: [IO a] -> [a] -> IO [a]
+listIOsToIOlist [] out = return out
+listIOsToIOlist (io:ios) out = do
+  ioVal <- io
+  listIOsToIOlist ios (ioVal:out)
+
 -- a_ vertex shader input
 -- v_ varying
 -- u_ uniform
@@ -87,7 +88,7 @@ fragShader =
     ++ "in vec3 v_pos;\n"
     ++ "void main()\n"
     ++ "{\n"
-    ++ "  o_vColor = vec4(0.5 + 0.5 * v_pos, 1);\n"
+    ++ "  o_vColor = vec4(0.5 + 0.5 * normalize(v_pos), 1);\n"
     ++ "}"
 
 --------------------------------------------------------------------------------

src/Main.hs

@@ -47,7 +47,8 @@ main = do
   GLFW.setKeyCallback window $ Just (keyPressed Nothing)
   GLFW.setCursorInputMode window GLFW.CursorInputMode'Hidden
   GLFW.setCursorPosCallback window $ Just (cursorPosHandler Nothing)
-  (objects, program) <- initResources testVertices
+  (objects, program) <- initResources
+    [ map (+ V3 a 0 0) cube | a <- take 100 [0,2..]]
   -- init model
   let model =
         mkModel
@@ -73,10 +74,55 @@ main = do
 --------------------------------------------------------------------------------
 -- Arrays
 --------------------------------------------------------------------------------
--- | centered unit square
-testVertices :: [V3 GL.GLfloat]
-testVertices =
-  [V3 (-0.5) (-0.5) 0, V3 0.5 (-0.5) 0, V3 (-0.5) 0.5 0, V3 0.5 0.5 0]
+top :: [V3 GL.GLfloat]
+top =
+  [ V3 p 0 p
+  , V3 p 0 m
+  , V3 m 0 p
+  , V3 m 0 m
+  ]
+side :: [V3 GL.GLfloat]
+side =
+  [ V3 0 p p
+  , V3 0 p m
+  , V3 0 m p
+  , V3 0 m m
+  ]
+front :: [V3 GL.GLfloat]
+front =
+  [ V3 p p 0
+  , V3 p m 0
+  , V3 m p 0
+  , V3 m m 0
+  ]
+
+m = (0 - p)
+p = 0.5
+
+-- TODO optimise cube
+-- | cube vertices
+cube :: [V3 GL.GLfloat]
+cube =
+  [ V3 p p p -- front
+  , V3 p m p
+  , V3 m p p
+  , V3 m m p -- down
+  , V3 m m m
+  , V3 p m p
+  , V3 p m m -- right
+  , V3 p p m
+  , V3 p m p
+  , V3 p p p -- up
+  , V3 m p p
+  , V3 p p m
+  , V3 m p m -- back
+  , V3 p m m
+  , V3 p p m
+  , V3 m m m -- left
+  , V3 m p m
+  , V3 m m p
+  , V3 m p p
+  ]
 
 --------------------------------------------------------------------------------
 -- Elm-like data structures
@@ -84,7 +130,30 @@ testVertices =
 -- | update function
 update :: Float -> Model -> Model
 update dt model =
-  updateVelocity dt $ updateAcceleration dt $ updateCameraAngle dt model
+  updateVelocity dt
+  $ updateAcceleration dt
+  $ updateSpeed dt
+  $ updateCameraAngle dt model
+
+updateSpeed :: Float -> Model -> Model
+updateSpeed dt model =
+  if elem GLFW.Key'T model.keys then
+  model
+    { camera =
+        model.camera
+          { jumpStrength = model.camera.jumpStrength * 1.1
+          , strafeStrength = model.camera.strafeStrength * 1.1
+          }
+    }
+  else if elem GLFW.Key'G model.keys then
+  model
+    { camera =
+        model.camera
+          { jumpStrength = model.camera.jumpStrength * 0.99
+          , strafeStrength = model.camera.strafeStrength * 0.99
+          }
+    }
+  else model
 
 updateAcceleration :: Float -> Model -> Model
 updateAcceleration dt model =
@@ -198,7 +267,7 @@ view window model = do
           (model.camera.camPos - forward)
           model.wprop.up
       projectionMatrix =
-        L.perspective 1.5 (fromIntegral w / fromIntegral h) 0.01 10000
+        L.perspective 1.2 (fromIntegral w / fromIntegral h) 0.01 1000
   viewGLMatrix <-
     GL.newMatrix GL.RowMajor $ toGLMatrix viewMatrix :: IO
       (GL.GLmatrix GL.GLfloat)