Add cube to renderable items

3 files changed, 112 insertions, 58 deletions

diff --git a/shaders/triangle.frag b/shaders/triangle.frag
index 2d290fd..23f2f59 100644
--- a/shaders/triangle.frag
+++ b/shaders/triangle.frag
@@ -2,8 +2,10 @@
 
 uniform vec4 ourColour;
 
+in vec4 colour;
+
 out vec4 fragColor;
 
 void main() {
-    fragColor = ourColour;
+    fragColor = vec4(1.0, 0.5, 1.0, 1.0);
 }
diff --git a/shaders/triangle.vert b/shaders/triangle.vert
index 3c61307..939f4a4 100644
--- a/shaders/triangle.vert
+++ b/shaders/triangle.vert
@@ -6,7 +6,10 @@ uniform mat4 model;
 uniform mat4 view;
 uniform mat4 projection;
 
+out vec4 colour;
+
 void main()
 {
     gl_Position = projection * view * model * vec4(position, 1.0);
+    colour = vec4(position, 1.0);
 }
diff --git a/src/Vivant.hs b/src/Vivant.hs
index 19548ce..45ed667 100644
--- a/src/Vivant.hs
+++ b/src/Vivant.hs
@@ -59,17 +59,17 @@ data Camera = Camera
 initialCamera :: Camera
 initialCamera =
   Camera
-    { cameraPos = V3 0 0 10,
-      cameraUp = V3 0 1 0,
-      cameraFront = V3 0 0 (-1),
+    { cameraPos = V3 0 (-10) 10,
+      cameraUp = normalize (V3 0 10 10),
+      cameraFront = normalize (V3 0 10 (-10)),
       cameraSpeed = 0.05,
       cameraPitch = 0,
       cameraYaw = (-90)
     }
 
 data Game = Game
-  { gameProgram :: Maybe (GL.Program),
-    gameVao :: Maybe (GL.VertexArrayObject),
+  { gameProgram :: Maybe GL.Program,
+    gameVao :: Maybe GL.VertexArrayObject,
     gameModelP :: Ptr (M44 Float),
     gameViewP :: Ptr (M44 Float),
     gameProjectionP :: Ptr (M44 Float),
@@ -91,7 +91,8 @@ initialGameState =
 data MouseInputs = MouseInputs
   { mousePosition :: Point V2 Int32,
     mouseRelative :: V2 Int32,
-    mousePositionOld :: Maybe (V2 Int32)
+    mousePositionOld :: Maybe (V2 Int32),
+    mousePressed :: Bool
   }
   deriving (Show)
 
@@ -100,7 +101,8 @@ initialMouse =
   MouseInputs
     { mousePosition = P (V2 400 300),
       mouseRelative = V2 0 0,
-      mousePositionOld = Nothing
+      mousePositionOld = Nothing,
+      mousePressed = False
     }
 
 main :: IO ()
@@ -135,15 +137,17 @@ main = do
 
   game <- initResources
 
-  let loop key mouse = do
+  let loop game key mouse = do
         (keys', mouse') <- parseEvents key mouse
+        let game' = updateMouse mouse' game
+
+        draw game'
 
-        draw game
         SDL.glSwapWindow window
 
-        unless (Set.member escapeKey keys') (loop keys' mouse')
+        unless (Set.member escapeKey keys') (loop game' keys' mouse')
 
-  loop Set.empty initialMouse
+  loop game Set.empty initialMouse
 
   mapM_
     free
@@ -164,7 +168,15 @@ escapeKey = SDL.Keysym SDL.ScancodeEscape SDL.KeycodeEscape noKeyModifier
 parseEvents :: Set SDL.Keysym -> MouseInputs -> IO (Set SDL.Keysym, MouseInputs)
 parseEvents keys mouse = do
   events <- SDL.pollEvents
-  return $ foldr handleEvents (keys, mouse) (fmap SDL.eventPayload events)
+  let events' = fmap SDL.eventPayload events
+  let isMoving = (> 0) . length $ filter mouseMoving events'
+  let (k, m) = foldr handleEvents (keys, mouse) events'
+  return (if isMoving
+          then (k, m)
+          else (k, m {mouseRelative = V2 0 0}))
+  where
+    mouseMoving (SDL.MouseMotionEvent{}) = True
+    mouseMoving _ = False
 
 handleEvents ::
   SDL.EventPayload ->
@@ -185,7 +197,17 @@ handleEvents event (k, m) =
             SDL.mouseMotionEventRelMotion = vel
           }
         ) ->
-        (k, MouseInputs pos vel Nothing)
+        (k, MouseInputs pos vel (mousePositionOld m) (mousePressed m))
+    SDL.MouseButtonEvent
+      (SDL.MouseButtonEventData
+       { SDL.mouseButtonEventMotion = SDL.Pressed
+       }) ->
+      (k, m {mousePressed = True})
+    SDL.MouseButtonEvent
+      (SDL.MouseButtonEventData
+       { SDL.mouseButtonEventMotion = SDL.Released
+       }) ->
+      (k, m {mousePressed = False})
     SDL.QuitEvent {} ->
       (Set.insert escapeKey k, m)
     _ -> (k, m)
@@ -195,24 +217,20 @@ updateMouse mouse game =
   game
     { gameCamera =
         (gameCamera game)
-          { cameraFront = front,
-            cameraPitch = pitchDegrees,
-            cameraYaw = yawDegrees
+          {
+            cameraPos = newPos,
+            cameraFront = normalize (V3 0 0 0 ^-^ newPos),
+            cameraUp = newUp
           }
     }
   where
-    camera = gameCamera game
-    front = normalize $ V3 (cos pitch * cos yaw) (sin pitch) (cos pitch * sin yaw)
-    pitch = toRadians pitchDegrees
-    yaw = toRadians yawDegrees
-    pitchDegrees = min 89 . max (-89) $ cameraPitch camera + negate dy
-    yawDegrees = (`mod'` 360) $ cameraYaw camera + dx
-    sensitivity = 0.05
-    V2 dx dy =
-      (* sensitivity) . fromIntegral
-        <$> if P (mouseRelative mouse) == mousePosition mouse
-          then V2 0 0
-          else mouseRelative mouse
+    rotation v
+      | mousePressed mouse = rotate (axisAngle (V3 0 0 1)
+                                     ((/ 2) . toRadians . fromIntegral
+                                      $ - (mouseRelative mouse ^. _x))) v
+      | otherwise = v
+    newPos = rotation . cameraPos $ gameCamera game
+    newUp = rotation . cameraUp $ gameCamera game
 
 setVertexAttribute :: GL.Program -> String -> Int -> Int -> Int -> IO ()
 setVertexAttribute program name vertices stride offset = do
@@ -221,7 +239,7 @@ setVertexAttribute program name vertices stride offset = do
   GL.vertexAttribPointer attrib
     $= ( GL.ToFloat,
          GL.VertexArrayDescriptor
-           2
+           (fromIntegral vertices)
            GL.Float
            (fromIntegral $ stride * floatSize)
            (plusPtr nullPtr (offset * floatSize))
@@ -238,12 +256,12 @@ initResources = do
 
   vbo <- GL.genObjectName
   GL.bindBuffer GL.ArrayBuffer $= Just vbo
-  V.unsafeWith vertices $ \ptr ->
-    GL.bufferData GL.ArrayBuffer $= (vectorSize vertices, castPtr ptr, GL.StaticDraw)
+  V.unsafeWith square $ \ptr ->
+    GL.bufferData GL.ArrayBuffer $= (vectorSize square, castPtr ptr, GL.StaticDraw)
 
   prog <- createProgram
 
-  setVertexAttribute prog "position" 2 0 0
+  setVertexAttribute prog "position" 3 0 0
 
   modelP <- malloc
   viewP <- malloc
@@ -291,13 +309,13 @@ draw game@(Game {gameProgram = Just p, gameVao = Just v}) = do
   GL.glUniformMatrix4fv projection 1 1 (castPtr (gameProjectionP game))
 
   ourColorLoc <- GL.uniformLocation p "ourColour"
-  GL.uniform ourColorLoc $= (GL.Vector4 (1 :: Float) (sin (fromIntegral tick / 500) / 2 + 0.5) 1 1)
+  GL.uniform ourColorLoc $= (GL.Vector4 (1 :: Float) 0.5 1 1)
 
   forM_ locs $ \l -> do
-    let modelMatrix = mkTransformation (axisAngle (V3 1 0 0) 0) l
+    let modelMatrix = mkTransformation (axisAngle (V3 0 0 0) 0) l !*! scaledMat 5
     poke (gameModelP game) modelMatrix
     GL.glUniformMatrix4fv model 1 1 (castPtr (gameModelP game))
-    GL.drawArrays GL.Triangles 0 6
+    GL.drawArrays GL.Triangles 0 36
 
   GL.bindVertexArrayObject $= Nothing
   return ()
@@ -308,32 +326,63 @@ vectorSize array = fromIntegral $ V.length array * sizeOf (1.0 :: Float)
 vertices :: V.Vector Float
 vertices =
   V.fromList
-    [ 0.5,
-      -0.5,
-      -0.5,
-      -0.5,
-      0.5,
-      0.5,
-      -0.5,
-      0.5,
-      -0.5,
-      -0.5,
-      0.5,
-      0.5
+    [ 0.5, -0.5,  0,
+      -0.5, -0.5, 0,
+      0.5, 0.5,   0,
+      -0.5, 0.5,  0,
+      -0.5, -0.5, 0,
+      0.5, 0.5,   0
     ]
 
+square :: V.Vector Float
+square =
+  V.fromList
+  [ -0.5, -0.5, -0.5,
+     0.5, -0.5, -0.5,
+     0.5,  0.5, -0.5,
+     0.5,  0.5, -0.5,
+    -0.5,  0.5, -0.5,
+    -0.5, -0.5, -0.5,
+
+    -0.5, -0.5,  0.5,
+     0.5, -0.5,  0.5,
+     0.5,  0.5,  0.5,
+     0.5,  0.5,  0.5,
+    -0.5,  0.5,  0.5,
+    -0.5, -0.5,  0.5,
+
+    -0.5,  0.5,  0.5,
+    -0.5,  0.5, -0.5,
+    -0.5, -0.5, -0.5,
+    -0.5, -0.5, -0.5,
+    -0.5, -0.5,  0.5,
+    -0.5,  0.5,  0.5,
+
+     0.5,  0.5,  0.5,
+     0.5,  0.5, -0.5,
+     0.5, -0.5, -0.5,
+     0.5, -0.5, -0.5,
+     0.5, -0.5,  0.5,
+     0.5,  0.5,  0.5,
+
+    -0.5, -0.5, -0.5,
+     0.5, -0.5, -0.5,
+     0.5, -0.5,  0.5,
+     0.5, -0.5,  0.5,
+    -0.5, -0.5,  0.5,
+    -0.5, -0.5, -0.5,
+
+    -0.5,  0.5, -0.5,
+     0.5,  0.5, -0.5,
+     0.5,  0.5,  0.5,
+     0.5,  0.5,  0.5,
+    -0.5,  0.5,  0.5,
+    -0.5,  0.5, -0.5
+  ]
+
 locs :: [V3 Float]
 locs =
-  [ V3 0 0 0,
-    V3 1 0 0,
-    V3 2 0 0,
-    V3 3 0 0,
-    V3 4 0 0,
-    V3 0 1 0,
-    V3 1 1 0,
-    V3 2 1 0,
-    V3 3 1 0,
-    V3 4 1 0
+  [ V3 0 0 0
   ]
 
 texCoords :: V.Vector Float