diff --git a/renderer-tutorial.cabal b/renderer-tutorial.cabal index 439126a..8fb8ec2 100644 --- a/renderer-tutorial.cabal +++ b/renderer-tutorial.cabal @@ -39,5 +39,6 @@ executable renderer-tutorial , Shader , Renderer , Texture + , EventHandler hs-source-dirs: src default-language: Haskell2010 diff --git a/src/EventHandler.hs b/src/EventHandler.hs new file mode 100644 index 0000000..3d9aceb --- /dev/null +++ b/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 + ) diff --git a/src/Main.hs b/src/Main.hs index 48e240c..1a22c3d 100644 --- a/src/Main.hs +++ b/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 - 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 - let nmodel = mmodel !+! plusModel - setUniform sp "u_mvp" (mproj !*! mview !*! nmodel) - return nmodel - ) - return mview - ) - return mproj - ) - + moveQuad proj view model evs + mproj <- readMVar proj + mview <- readMVar view + mmodel <- readMVar model + setUniform sp "u_mvp" (mproj !*! mview !*! mmodel) -- the actual drawing happens here draw vao ibo sp