From 0a731e2100dbc13bb5392a5214cb480f520d895f Mon Sep 17 00:00:00 2001 From: nek0 Date: Sun, 3 Feb 2019 02:08:37 +0100 Subject: [PATCH] flip windows --- src/Draw.hs | 19 ++++++++++++++----- src/Events.hs | 29 ++++++++++++++++++++++------- src/Main.hs | 11 +++-------- src/Types.hs | 2 +- 4 files changed, 40 insertions(+), 21 deletions(-) diff --git a/src/Draw.hs b/src/Draw.hs index 15a5e45..5f5b730 100644 --- a/src/Draw.hs +++ b/src/Draw.hs @@ -88,8 +88,14 @@ draw state ident = do let win = fromJust (lookup ident $ stWindows st) dim <- get (SDL.windowSize win) fitViewport (800/600) (fmap fromIntegral dim) - GL.currentProgram $= (Just . GU.program $ fromJust $ lookup ident $ - stPrograms st) + GL.currentProgram $= (Just . GU.program $ stProgram st) + + GU.setUniform (stProgram st) "ident" ( + ( if ident == stPresentationWindow st + then 1 :: Float + else 0 :: Float + ) + ) GL.drawElements GL.Triangles 6 GL.UnsignedInt nullPtr @@ -104,12 +110,15 @@ vertexShader = foldl (\acc a -> acc `BS.append` "\n" `BS.append` a) BS.empty , "}" ] -fragmentShader :: Word -> BS.ByteString -fragmentShader ident = foldl (\acc a -> acc `BS.append` "\n" `BS.append` a) BS.empty +fragmentShader :: BS.ByteString +fragmentShader = foldl (\acc a -> acc `BS.append` "\n" `BS.append` a) BS.empty [ "#version 330 core" , "" + , "out vec4 FragColor;" + , "" + , "uniform float ident;" , "" , "void main() {" - , " gl_FragColor = vec4(" `BS.append` BC.pack (show (fromIntegral ident * (1 :: Float))) `BS.append` ", 0.5, 0.2, 1.0);" + , " FragColor = vec4(ident, 0.5, 0.2, 1.0);" , "}" ] diff --git a/src/Events.hs b/src/Events.hs index b681fb2..66e74f8 100644 --- a/src/Events.hs +++ b/src/Events.hs @@ -10,18 +10,33 @@ import Control.Concurrent.MVar import Util -eventHandler :: MVar Bool -> SDL.Event -> IO () -eventHandler run (SDL.Event _ payload) = - handlePayload run payload +import Types -handlePayload :: MVar Bool -> SDL.EventPayload -> IO () +eventHandler :: MVar Bool -> MVar State -> SDL.Event -> IO () +eventHandler run state (SDL.Event _ payload) = + handlePayload run state payload -handlePayload _ (SDL.WindowResizedEvent (SDL.WindowResizedEventData _ dim)) = +handlePayload :: MVar Bool -> MVar State -> SDL.EventPayload -> IO () + +handlePayload _ _ (SDL.WindowResizedEvent (SDL.WindowResizedEventData _ dim)) = fitViewport (800 / 600) dim -handlePayload run (SDL.WindowClosedEvent _) = do +handlePayload run _ (SDL.WindowClosedEvent _) = do _ <- swapMVar run False return () +handlePayload run state (SDL.KeyboardEvent (SDL.KeyboardEventData _ SDL.Pressed False sym)) + | SDL.keysymKeycode sym == SDL.KeycodeEscape = do + _ <- swapMVar run False + return () + | SDL.keysymKeycode sym == SDL.KeycodeF12 || SDL.keysymKeycode sym == SDL.KeycodeF = + modifyMVar_ state $ \st -> do + return st + { stPresentationWindow = + if length (stWindows st) > 1 && stPresentationWindow st == 0 + then 1 + else 0 + } + -- catch all other events -handlePayload _ _ = return () +handlePayload _ _ _ = return () diff --git a/src/Main.hs b/src/Main.hs index d34e313..3b9ace0 100644 --- a/src/Main.hs +++ b/src/Main.hs @@ -96,11 +96,7 @@ main = do verb opts "Initializing rendering pipeline" initVAO vebo <- initGL - programs <- mapM (\(ident, _) -> do - ret <- GU.simpleShaderProgramBS vertexShader (fragmentShader ident) - return (ident, ret) - ) - wins + program <- GU.simpleShaderProgramBS vertexShader fragmentShader verb opts "Initializing state" time <- getCurrentTime state <- newMVar ( @@ -109,7 +105,7 @@ main = do (last $ map fst wins) time wins - programs + program vebo ) verb opts "Displaying window(s)" @@ -119,12 +115,11 @@ main = do whileM_ (readMVar run) (do mapM_ (\(ident, window) -> do SDL.glMakeCurrent window context - mapM_ (eventHandler run) =<< SDL.pollEvents + mapM_ (eventHandler run state) =<< SDL.pollEvents GL.clear [GL.ColorBuffer, GL.DepthBuffer, GL.StencilBuffer] draw state ident SDL.glSwapWindow window ) wins - -- GL.flush ) verb opts "Deleting context" SDL.glDeleteContext context diff --git a/src/Types.hs b/src/Types.hs index 9a31e14..b4eb5e0 100644 --- a/src/Types.hs +++ b/src/Types.hs @@ -23,7 +23,7 @@ data State = State , stPresentationWindow :: Word , stStartTime :: UTCTime , stWindows :: [(Word, SDL.Window)] - , stPrograms :: [(Word, GU.ShaderProgram)] + , stProgram :: GU.ShaderProgram , stVEBO :: GLvebo }