From 41bac9f6b1b87b7175b7f77e01840800f5b20b15 Mon Sep 17 00:00:00 2001 From: Yann Herklotz Date: Tue, 29 Dec 2020 01:22:29 +0000 Subject: Add input handling --- shaders/triangle.vert | 11 +++- src/Vivant.hs | 153 ++++++++++++++++++++++++++++++++++++++++++++++---- vivant.cabal | 5 +- 3 files changed, 154 insertions(+), 15 deletions(-) diff --git a/shaders/triangle.vert b/shaders/triangle.vert index cc5441d..3c61307 100644 --- a/shaders/triangle.vert +++ b/shaders/triangle.vert @@ -1,7 +1,12 @@ #version 150 -in vec2 position; +in vec3 position; -void main(void) { - gl_Position = vec4(position, 0.0, 1.0); +uniform mat4 model; +uniform mat4 view; +uniform mat4 projection; + +void main() +{ + gl_Position = projection * view * model * vec4(position, 1.0); } diff --git a/src/Vivant.hs b/src/Vivant.hs index fa356ad..1797737 100644 --- a/src/Vivant.hs +++ b/src/Vivant.hs @@ -17,7 +17,8 @@ module Main where import Control.Monad import Foreign.C.Types import Foreign.Ptr -import Foreign.Storable (sizeOf) +import Foreign.Storable (sizeOf, poke) +import Foreign.Marshal.Alloc (malloc, free) import SDL.Vect import System.Exit (exitFailure) import System.IO @@ -27,7 +28,15 @@ import SDL.Raw.Video as SDL (glSetAttribute) import SDL.Raw.Enum as SDL import Data.Word (Word32) import Linear - +import Control.Lens ((^.), (.~)) +import Data.Fixed (mod') +import Data.Function ((&)) +import qualified Data.Set as Set +import Data.Set (Set) +import Data.Int (Int32) + +import qualified Graphics.Rendering.OpenGL.GL.Shaders.Uniform as GL (UniformLocation(..)) +import qualified Graphics.GL.Functions as GL (glUniformMatrix4fv) import qualified Graphics.Rendering.OpenGL as GL import qualified Data.ByteString as BS import qualified Data.Vector.Storable as V @@ -50,7 +59,7 @@ data Camera = Camera initialCamera :: Camera initialCamera = Camera - { cameraPos = V3 0 0 3 + { cameraPos = V3 0 0 10 , cameraUp = V3 0 1 0 , cameraFront = V3 0 0 (-1) , cameraSpeed = 0.05 @@ -77,6 +86,19 @@ initialGameState = Game , gameCamera = initialCamera } +data MouseInputs = MouseInputs + { mousePosition :: Point V2 Int32 + , mouseRelative :: V2 Int32 + , mousePositionOld :: Maybe (V2 Int32) + } deriving (Show) + +initialMouse :: MouseInputs +initialMouse = MouseInputs + { mousePosition = P (V2 400 300) + , mouseRelative = V2 0 0 + , mousePositionOld = Nothing + } + main :: IO () main = do SDL.initialize [SDL.InitVideo] @@ -106,20 +128,76 @@ main = do game <- initResources - let loop = do - events <- SDL.pollEvents - let quit = elem SDL.QuitEvent $ map SDL.eventPayload events + let loop key mouse = do + (keys', mouse') <- parseEvents key mouse draw game SDL.glSwapWindow window - unless quit loop + unless (Set.member escapeKey keys') (loop keys' mouse') - loop + loop Set.empty initialMouse + + mapM_ free [ gameModelP game + , gameViewP game + , gameProjectionP game + ] SDL.destroyWindow window SDL.quit +noKeyModifier :: SDL.KeyModifier +noKeyModifier = SDL.KeyModifier False False False False False False False False False False False + +escapeKey :: SDL.Keysym +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) + +handleEvents + :: SDL.EventPayload + -> (Set SDL.Keysym, MouseInputs) -> (Set SDL.Keysym, MouseInputs) +handleEvents event (k, m) = + case event of + SDL.KeyboardEvent (SDL.KeyboardEventData { SDL.keyboardEventKeyMotion = e + , SDL.keyboardEventKeysym = k'}) -> + ((if e == SDL.Released then Set.delete else Set.insert) k' k, m) + + SDL.MouseMotionEvent (SDL.MouseMotionEventData { SDL.mouseMotionEventPos = pos + , SDL.mouseMotionEventRelMotion = vel + }) -> + (k, MouseInputs pos vel Nothing) + + SDL.QuitEvent{} -> + (Set.insert escapeKey k, m) + + _ -> (k, m) + + +updateMouse :: MouseInputs -> Game -> Game +updateMouse mouse game = + game { gameCamera = (gameCamera game) + { cameraFront = front + , cameraPitch = pitchDegrees + , cameraYaw = yawDegrees + } + } + 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 + setVertexAttribute :: GL.Program -> String -> Int -> Int -> Int -> IO () setVertexAttribute program name vertices stride offset = do let floatSize = sizeOf (1.0 :: Float) @@ -129,6 +207,9 @@ setVertexAttribute program name vertices stride offset = do (plusPtr nullPtr (offset * floatSize))) GL.vertexAttribArray attrib $= GL.Enabled +getUniformLocation :: GL.UniformLocation -> GL.GLint +getUniformLocation (GL.UniformLocation i) = i + initResources :: IO Game initResources = do vao <- GL.genObjectName @@ -143,25 +224,62 @@ initResources = do setVertexAttribute prog "position" 2 0 0 - return $ initialGameState { gameProgram = Just prog, gameVao = Just vao } + modelP <- malloc + viewP <- malloc + projectionP <- malloc + + return $ initialGameState { gameProgram = Just prog + , gameVao = Just vao + , gameModelP = modelP + , gameViewP = viewP + , gameProjectionP = projectionP + } + +-- | Convert degrees to radians +toRadians :: Float -> Float +toRadians = (*) (pi / 180) + +scaledMat :: V4 (V4 Float) -> V4 (V4 Float) +scaledMat n = ((n * identity) & _w . _w .~ 1) draw :: Game -> IO () draw game@(Game {gameProgram = Just p, gameVao = Just v}) = do + tick <- ticks GL.clearColor $= GL.Color4 1 1 1 1 GL.clear [GL.ColorBuffer, GL.DepthBuffer] GL.currentProgram $= gameProgram game GL.bindVertexArrayObject $= gameVao game + model <- getUniformLocation <$> GL.uniformLocation p "model" + view <- getUniformLocation <$> GL.uniformLocation p "view" + projection <- getUniformLocation <$> GL.uniformLocation p "projection" + + let camera = gameCamera game + cameraPosition = cameraPos camera + targetPosition = cameraPosition ^+^ cameraFront camera + viewMatrix = lookAt cameraPosition targetPosition (cameraUp camera) + projectionMatrix = perspective (toRadians 45) (640/480) 0.1 100 + + poke (gameViewP game) viewMatrix + poke (gameProjectionP game) projectionMatrix + + GL.glUniformMatrix4fv view 1 1 (castPtr (gameViewP game)) + GL.glUniformMatrix4fv projection 1 1 (castPtr (gameProjectionP game)) + ourColorLoc <- GL.uniformLocation p "ourColour" - tick <- ticks GL.uniform ourColorLoc $= (GL.Vector4 (1::Float) (sin (fromIntegral tick / 500) / 2 + 0.5) 1 1) - GL.drawArrays GL.Triangles 0 6 + forM_ locs $ \l -> do + let modelMatrix = mkTransformation (axisAngle (V3 1 0 0) 0) l + poke (gameModelP game) modelMatrix + GL.glUniformMatrix4fv model 1 1 (castPtr (gameModelP game)) + GL.drawArrays GL.Triangles 0 6 GL.bindVertexArrayObject $= Nothing return () +vectorSize :: (Num b, V.Storable a) => V.Vector a -> b vectorSize array = fromIntegral $ V.length array * sizeOf (1.0 :: Float) vertices :: V.Vector Float @@ -173,6 +291,19 @@ vertices = V.fromList [ 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 + ] + texCoords :: V.Vector Float texCoords = V.fromList [ 0, 0 , 1, 0 diff --git a/vivant.cabal b/vivant.cabal index fcae8ab..2d73afd 100644 --- a/vivant.cabal +++ b/vivant.cabal @@ -30,9 +30,12 @@ executable vivant build-depends: base >=4.14 && <4.15, sdl2 >=2.5.3.0 && <2.6, OpenGL >=3.0.3.0 && <3.1, + OpenGLRaw >= 3.3 && <3.4, bytestring >=0.10 && <0.11, vector >=0.12.1.2 && <0.13, JuicyPixels >=3.3 && <3.4, - linear >=1.21 && <1.22 + linear >=1.21 && <1.22, + lens >=4.19 && <4.20, + containers >=0.6 && <0.7 hs-source-dirs: src default-language: Haskell2010 -- cgit