move code to external module

renderer-tutorial.cabal

@@ -39,5 +39,6 @@ executable renderer-tutorial
                      , Shader
                      , Renderer
                      , Texture
+                     , EventHandler
   hs-source-dirs:      src
   default-language:    Haskell2010

src/EventHandler.hs

@@ -0,0 +1,70 @@
+module EventHandler where
+
+import Control.Concurrent.MVar
+
+import Linear
+
+import qualified SDL
+
+import qualified Graphics.Rendering.OpenGL as GL
+
+moveQuad
+  :: MVar (M44 GL.GLfloat)
+  -> MVar (M44 GL.GLfloat)
+  -> MVar (M44 GL.GLfloat)
+  -> MVar [SDL.Event]
+  -> IO ()
+moveQuad proj view model evs =
+  modifyMVar_ proj (\mproj -> do
+    modifyMVar_ view (\mview -> do
+      modifyMVar_ model (\mmodel -> do
+        plusModel <- foldl (\acc ev -> case SDL.eventPayload ev of
+              (SDL.KeyboardEvent
+                ( SDL.KeyboardEventData
+                  _
+                  SDL.Pressed
+                  _
+                  (SDL.Keysym _ code mod)
+                ))
+                ->
+                  let trans =
+                        mkTransformationMat
+                          (identity :: M33 GL.GLfloat)
+                          ( ( if not (SDL.keyModifierLeftShift mod)
+                              then (-1)
+                              else 1
+                              )
+                            *
+                            ( case code of
+                              SDL.KeycodeX ->
+                                V3 1 0 0
+                              SDL.KeycodeY ->
+                                V3 0 1 0
+                              _ ->
+                                V3 0 0 0
+                              )
+                            )
+                        !-!
+                          (identity :: M44 GL.GLfloat)
+                  in acc !+! trans
+              _ -> acc !+!
+                (V4
+                  (V4 0 0 0 0)
+                  (V4 0 0 0 0)
+                  (V4 0 0 0 0)
+                  (V4 0 0 0 0)
+                  )
+              )
+              (V4
+                (V4 0 0 0 0)
+                (V4 0 0 0 0)
+                (V4 0 0 0 0)
+                (V4 0 0 0 0)
+                )
+              <$> readMVar evs
+        return $ mmodel !+! plusModel
+        )
+      return mview
+      )
+    return mproj
+    )

src/Main.hs

@@ -41,6 +41,7 @@ import IndexBuffer
 import Shader
 import Renderer
 import Texture
+import EventHandler
 
 main :: IO ()
 main = do
@@ -193,62 +194,11 @@ main = do
       let newRed = redValue + incrementValue
 
       -- retrieve matrices from MVars and modify them on demand
-      modifyMVar_ proj (\mproj -> do
+      moveQuad proj view model evs
-        modifyMVar_ view (\mview -> do
+      mproj <- readMVar proj
-          modifyMVar_ model (\mmodel -> do
+      mview <- readMVar view
-            plusModel <- foldl (\acc ev -> case SDL.eventPayload ev of
+      mmodel <- readMVar model
-                  (SDL.KeyboardEvent
+      setUniform sp "u_mvp" (mproj !*! mview !*! mmodel)
-                    ( SDL.KeyboardEventData
-                      _
-                      SDL.Pressed
-                      _
-                      (SDL.Keysym _ code mod)
-                    ))
-                    ->
-                      let trans =
-                            mkTransformationMat
-                              (identity :: M33 GL.GLfloat)
-                              ( ( if not (SDL.keyModifierLeftShift mod)
-                                  then (-1)
-                                  else 1
-                                  )
-                                *
-                                ( case code of
-                                  SDL.KeycodeX ->
-                                    V3 1 0 0
-                                  SDL.KeycodeY ->
-                                    V3 0 1 0
-                                  _ ->
-                                    V3 0 0 0
-                                  )
-                                )
-                            !-!
-                              (identity :: M44 GL.GLfloat)
-                      in acc !+! trans
-                  _ -> acc !+!
-                    (V4
-                      (V4 0 0 0 0)
-                      (V4 0 0 0 0)
-                      (V4 0 0 0 0)
-                      (V4 0 0 0 0)
-                      )
-                  )
-                  (V4
-                    (V4 0 0 0 0)
-                    (V4 0 0 0 0)
-                    (V4 0 0 0 0)
-                    (V4 0 0 0 0)
-                    )
-                  <$> readMVar evs
-            let nmodel = mmodel !+! plusModel
-            setUniform sp "u_mvp" (mproj !*! mview !*! nmodel)
-            return nmodel
-            )
-          return mview
-          )
-        return mproj
-        )
-
 
       -- the actual drawing happens here
       draw vao ibo sp