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

View File

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

View File

@ -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

View File

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