finished episode 23

src/EventHandler.hs

@@ -1,6 +1,6 @@
 module EventHandler where
 
-import Control.Monad (when)
+import Control.Monad
 
 import Control.Concurrent.MVar
 
@@ -9,16 +9,17 @@ import Control.Lens as Lens
 import Linear
 
 import qualified SDL
+import qualified SDL.Internal.Numbered as SDL
 
 import qualified Graphics.Rendering.OpenGL as GL
 
-moveQuad
+moveObj
   :: MVar (M44 GL.GLfloat)
   -> MVar (M44 GL.GLfloat)
   -> MVar (M44 GL.GLfloat)
   -> MVar [SDL.Event]
   -> IO ()
-moveQuad proj view model evs =
+moveObj proj view model evs =
   modifyMVar_ proj (\mproj -> do
     modifyMVar_ view (\mview -> do
       modifyMVar_ model (\mmodel -> do
@@ -34,7 +35,7 @@ moveQuad proj view model evs =
                   let trans =
                         mkTransformationMat
                           (identity :: M33 GL.GLfloat)
-                          ( ( if not (SDL.keyModifierLeftShift mod)
+                          ( ( if SDL.keyModifierLeftShift mod
                               then (-1)
                               else 1
                               )
@@ -43,7 +44,7 @@ moveQuad proj view model evs =
                               SDL.KeycodeX ->
                                 V3 1 0 0
                               SDL.KeycodeY ->
-                                V3 0 (-1) 0
+                                V3 0 1 0
                               _ ->
                                 V3 0 0 0
                               )
@@ -65,3 +66,37 @@ moveQuad proj view model evs =
       )
     return mproj
     )
+
+switchObject
+  :: MVar (MVar (M44 GL.GLfloat))
+  -> [MVar (M44 GL.GLfloat)]
+  -> MVar [SDL.Event]
+  -> IO ()
+switchObject focus elems evs =
+  modifyMVar_ focus (\foc -> do
+    foldM
+      (\acc ev -> case SDL.eventPayload ev of
+        (SDL.KeyboardEvent
+          (SDL.KeyboardEventData
+          _
+          SDL.Pressed
+          _
+          (SDL.Keysym code _ mod)
+          ))
+          -> do
+            print code
+            let selectIndex = fromIntegral (SDL.toNumber code) - 30
+            if ((selectIndex < 10) && (selectIndex >= 0)) &&
+              (SDL.toNumber mod == 0) &&
+              (selectIndex < length elems) &&
+              (acc /= (elems !! selectIndex))
+            then do
+              print ("selected element number: " <> show selectIndex)
+              return $ elems !! selectIndex
+            else
+              return foc
+        _ -> return acc
+        )
+      foc
+    =<< readMVar evs
+    )

src/Main.hs

@@ -88,10 +88,10 @@ main = do
       -- with added in texture coordinates
   let vertexPositions =
         -- 3D positions     | texture coordinates
-        [ 100, 100, 0,       0, 0
-        , 233, 100, 0,       1, 0
-        , 233, 300, 0,       1, 1
-        , 100, 300, 0,       0, 1
+        [ -67, -100, 0,       0, 0
+        ,  67, -100, 0,       1, 0
+        ,  67,  100, 0,       1, 1
+        , -67,  100, 0,       0, 1
         ] :: [GL.GLfloat]
 
       -- create draw order indices
@@ -116,13 +116,15 @@ main = do
   -- -- MATRICES
 
   let mproj = ortho 0 800 0 600 (-1) 1 :: M44 GL.GLfloat
-      mview = mkTransformationMat (identity :: M33 GL.GLfloat) (V3 (-100) 0 0)
-      mmodel = mkTransformationMat (identity :: M33 GL.GLfloat) (V3 200 200 0)
+      mview = mkTransformationMat (identity :: M33 GL.GLfloat) (V3 0 0 0)
+      mmodel1 = mkTransformationMat (identity :: M33 GL.GLfloat) (V3 200 200 0)
+      mmodel2 = mkTransformationMat (identity :: M33 GL.GLfloat) (V3 400 400 0)
 
   -- store the mtrices for later adjustments
   proj <- newMVar mproj
   view <- newMVar mview
-  model <- newMVar mmodel
+  model1 <- newMVar mmodel1
+  model2 <- newMVar mmodel2
 
   -- -- TEXTURE
   
@@ -147,19 +149,16 @@ main = do
   -- -- tell the shader where to find the texture
   bind sp
   setUniform sp "u_texture" (texSlot tex)
-  setUniform sp "u_mvp" (mproj !*! mview !*! mmodel)
 
   -- -- UNIFORMS
 
-  -- create MVars for pulsating red channel
-  red <- newMVar 0
-  increment <- newMVar 0.05
-
   err <- get GL.errors
   print $ "pre-loop errors: " <> show err
 
   -- -- EVENTING AND DRAWING
 
+  switch <- newMVar model1
+
   -- -- UNBINDING ALL BUFFERS AND VERTEX ARRAYS
 
   unbind vao
@@ -186,19 +185,36 @@ main = do
       --   <*> pure 1
       -- GL.clearColor $= clearcol
 
-      -- -- rebind everything neccessary for draw call
-      bind sp
+      -- clear previous frame
+      clear
 
-      -- retrieve matrices from MVars and modify them on demand
-      moveQuad proj view model evs
+      -- retrieve matrices from MVars
       mproj <- readMVar proj
       mview <- readMVar view
-      mmodel <- readMVar model
-      setUniform sp "u_mvp" (mproj !*! mview !*! mmodel)
+
+      -- modify the mvars based on keystrokes
+      switchObject switch [model1, model2] evs
+      focus <- readMVar switch
+      moveObj proj view focus evs
+
+      -- -- bind shader and provide mvp for object1 and draw it
+
+      mmodel1 <- readMVar model1
+      bind sp
+      setUniform sp "u_mvp" (mproj !*! mview !*! mmodel1)
 
       -- the actual drawing happens here
       draw vao ibo sp
-      -- GL.drawElements GL.Triangles 6 GL.UnsignedInt nullPtr
+
+      -- -- bind shader and provide mvp for object2 and draw it
+
+      mmodel2 <- readMVar model2
+      bind sp
+      setUniform sp "u_mvp" (mproj !*! mview !*! mmodel2)
+
+      -- the actual drawing happens here
+      draw vao ibo sp
+
       err <- get GL.errors
       when (not $ null err) (print $ "loop errors: " <> show err)
 

src/Renderer.hs

@@ -15,7 +15,6 @@ import Shader
 
 draw :: VertexArray -> (IndexBuffer a) -> Shader -> IO ()
 draw va ib sp = do
-  clear
   bind sp
   bind va
   bind ib