Add input handling

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