diff --git a/src/Main.hs b/src/Main.hs index 2dbc3e3..8ada208 100644 --- a/src/Main.hs +++ b/src/Main.hs @@ -114,10 +114,14 @@ main = do -- -- MATRICES - let proj = ortho 0 800 0 600 (-1) 1 :: M44 GL.GLfloat - view = mkTransformationMat (identity :: M33 GL.GLfloat) (V3 (-100) 0 0) - model = mkTransformationMat (identity :: M33 GL.GLfloat) (V3 200 200 0) - mvp = proj !*! view !*! model + 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) + + -- store the mtrices for later adjustments + proj <- newMVar mproj + view <- newMVar mview + model <- newMVar mmodel -- -- TEXTURE @@ -142,7 +146,7 @@ main = do -- -- tell the shader where to find the texture bind sp setUniform sp "u_texture" (texSlot tex) - setUniform sp "u_mvp" mvp + setUniform sp "u_mvp" (mproj !*! mview !*! mmodel) -- -- UNIFORMS @@ -188,8 +192,63 @@ main = do redValue <- takeMVar red let newRed = redValue + incrementValue - -- write data to the uniform - -- setUniform sp "u_color" (GL.Color4 newRed 0.5 0 1 :: GL.Color4 GL.GLfloat) + -- retrieve matrices from MVars + 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 + ) + -- the actual drawing happens here draw vao ibo sp