flip windows

This commit is contained in:
nek0 2019-02-03 02:08:37 +01:00
parent 08e69c5064
commit 0a731e2100
4 changed files with 40 additions and 21 deletions

View file

@ -88,8 +88,14 @@ draw state ident = do
let win = fromJust (lookup ident $ stWindows st) let win = fromJust (lookup ident $ stWindows st)
dim <- get (SDL.windowSize win) dim <- get (SDL.windowSize win)
fitViewport (800/600) (fmap fromIntegral dim) fitViewport (800/600) (fmap fromIntegral dim)
GL.currentProgram $= (Just . GU.program $ fromJust $ lookup ident $ GL.currentProgram $= (Just . GU.program $ stProgram st)
stPrograms st)
GU.setUniform (stProgram st) "ident" (
( if ident == stPresentationWindow st
then 1 :: Float
else 0 :: Float
)
)
GL.drawElements GL.Triangles 6 GL.UnsignedInt nullPtr 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 :: BS.ByteString
fragmentShader ident = foldl (\acc a -> acc `BS.append` "\n" `BS.append` a) BS.empty fragmentShader = foldl (\acc a -> acc `BS.append` "\n" `BS.append` a) BS.empty
[ "#version 330 core" [ "#version 330 core"
, "" , ""
, "out vec4 FragColor;"
, ""
, "uniform float ident;"
, "" , ""
, "void main() {" , "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);"
, "}" , "}"
] ]

View file

@ -10,18 +10,33 @@ import Control.Concurrent.MVar
import Util import Util
eventHandler :: MVar Bool -> SDL.Event -> IO () import Types
eventHandler run (SDL.Event _ payload) =
handlePayload run payload
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 fitViewport (800 / 600) dim
handlePayload run (SDL.WindowClosedEvent _) = do handlePayload run _ (SDL.WindowClosedEvent _) = do
_ <- swapMVar run False _ <- swapMVar run False
return () 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 -- catch all other events
handlePayload _ _ = return () handlePayload _ _ _ = return ()

View file

@ -96,11 +96,7 @@ main = do
verb opts "Initializing rendering pipeline" verb opts "Initializing rendering pipeline"
initVAO initVAO
vebo <- initGL vebo <- initGL
programs <- mapM (\(ident, _) -> do program <- GU.simpleShaderProgramBS vertexShader fragmentShader
ret <- GU.simpleShaderProgramBS vertexShader (fragmentShader ident)
return (ident, ret)
)
wins
verb opts "Initializing state" verb opts "Initializing state"
time <- getCurrentTime time <- getCurrentTime
state <- newMVar ( state <- newMVar (
@ -109,7 +105,7 @@ main = do
(last $ map fst wins) (last $ map fst wins)
time time
wins wins
programs program
vebo vebo
) )
verb opts "Displaying window(s)" verb opts "Displaying window(s)"
@ -119,12 +115,11 @@ main = do
whileM_ (readMVar run) (do whileM_ (readMVar run) (do
mapM_ (\(ident, window) -> do mapM_ (\(ident, window) -> do
SDL.glMakeCurrent window context SDL.glMakeCurrent window context
mapM_ (eventHandler run) =<< SDL.pollEvents mapM_ (eventHandler run state) =<< SDL.pollEvents
GL.clear [GL.ColorBuffer, GL.DepthBuffer, GL.StencilBuffer] GL.clear [GL.ColorBuffer, GL.DepthBuffer, GL.StencilBuffer]
draw state ident draw state ident
SDL.glSwapWindow window SDL.glSwapWindow window
) wins ) wins
-- GL.flush
) )
verb opts "Deleting context" verb opts "Deleting context"
SDL.glDeleteContext context SDL.glDeleteContext context

View file

@ -23,7 +23,7 @@ data State = State
, stPresentationWindow :: Word , stPresentationWindow :: Word
, stStartTime :: UTCTime , stStartTime :: UTCTime
, stWindows :: [(Word, SDL.Window)] , stWindows :: [(Word, SDL.Window)]
, stPrograms :: [(Word, GU.ShaderProgram)] , stProgram :: GU.ShaderProgram
, stVEBO :: GLvebo , stVEBO :: GLvebo
} }