From 36558a69e0d373aae8e62a4b8104790114ee2cce Mon Sep 17 00:00:00 2001 From: Yann Herklotz Date: Wed, 30 Dec 2020 11:25:31 +0000 Subject: Add cube to renderable items --- shaders/triangle.frag | 4 +- shaders/triangle.vert | 3 + src/Vivant.hs | 163 ++++++++++++++++++++++++++++++++------------------ 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 -- cgit