draw multiple sets of points, debug features

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)