From dc68854f19a4a9cd8f8e8b7992337cf1bd4284e2 Mon Sep 17 00:00:00 2001 From: nek0 Date: Mon, 10 Aug 2020 15:09:23 +0200 Subject: [PATCH] finished episode 23 --- src/EventHandler.hs | 45 ++++++++++++++++++++++++++++++++---- src/Main.hs | 56 +++++++++++++++++++++++++++++---------------- src/Renderer.hs | 1 - 3 files changed, 76 insertions(+), 26 deletions(-) diff --git a/src/EventHandler.hs b/src/EventHandler.hs index 614e581..880dcca 100644 --- a/src/EventHandler.hs +++ b/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 + ) diff --git a/src/Main.hs b/src/Main.hs index 5af4d53..583d941 100644 --- a/src/Main.hs +++ b/src/Main.hs @@ -87,11 +87,11 @@ main = do -- define vertices (positions of the rectangle corners) as List of Floats -- 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 + -- 3D positions | texture coordinates + [ -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) diff --git a/src/Renderer.hs b/src/Renderer.hs index 9e06c17..d9090b0 100644 --- a/src/Renderer.hs +++ b/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