flip windows

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);"
   , "}"
   ]

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 ()

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

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
   }