GTK compatibility: render to non-default framebuffer.

1 files changed, 31 insertions, 12 deletions

diff --git a/src/LambdaCube/GL/Backend.hs b/src/LambdaCube/GL/Backend.hs
index 8c533f2..faeccff 100644
--- a/src/LambdaCube/GL/Backend.hs
+++ b/src/LambdaCube/GL/Backend.hs
@@ -337,7 +337,11 @@ compileRenderTarget texs glTexs (RenderTarget targets) = do
             let bufs = [cvt img | TargetItem Color img <- V.toList targets]
                 cvt a = case a of
                     Nothing                     -> GL_NONE
-                    Just (Framebuffer Color)    -> GL_BACK_LEFT
+                    Just (Framebuffer Color)    -> GL_BACK_LEFT -- GTK compatibility: this tentative value
+                                                   -- may be changed to GL_COLOR_ATTACHMENT0 later.  We
+                                                   -- avoid doing it now to allow for 'allocRenderer' to
+                                                   -- be called from GTK's "realize" signal before the
+                                                   -- actual frame buffer target is known.
                     _                           -> error "internal error (compileRenderTarget)!"
             return $ GLRenderTarget
                 { framebufferObject         = 0
@@ -787,9 +791,10 @@ renderSlot glDrawCallCounterRef glVertexBufferRef glIndexBufferRef cmds = forM_
     --isOk <- checkGL
     --putStrLn $ isOk ++ " - " ++ show cmd
 
-setupRenderTarget :: IORef (Maybe InputConnection)
+setupRenderTarget :: Maybe GLuint
+                           -> IORef (Maybe InputConnection)
                            -> GLRenderTarget -> IO ()
-setupRenderTarget glInput GLRenderTarget{..} = do
+setupRenderTarget boundfb glInput GLRenderTarget{..} = do
   -- set target viewport
   ic' <- readIORef glInput
   case ic' of
@@ -799,17 +804,24 @@ setupRenderTarget glInput GLRenderTarget{..} = do
                   (w,h) <- readIORef $ screenSize input
                   glViewport 0 0 (fromIntegral w) (fromIntegral h)
   -- TODO: set FBO target viewport
-  glBindFramebuffer GL_DRAW_FRAMEBUFFER framebufferObject
+  glBindFramebuffer GL_DRAW_FRAMEBUFFER
+    -- GTK compatibility: substitute initially bound framebuffer for default binding.
+    $ maybe id (\def -> \case { 0 -> def ; x -> x }) boundfb framebufferObject
   case framebufferDrawbuffers of
       Nothing -> return ()
-      Just bl -> withArray bl $ glDrawBuffers (fromIntegral $ length bl)
-
-setupDrawContext :: IORef Bool
+      Just bl -> withArray -- GTK compatibility: avoid using default-only buffer for a non-default binding.
+                           (case boundfb of
+                                Nothing -> bl
+                                Just _  -> \case { GL_BACK_LEFT -> GL_COLOR_ATTACHMENT0 ; x -> x } `map` bl)
+                           $ glDrawBuffers (fromIntegral $ length bl)
+
+setupDrawContext :: Maybe GLuint
+                          -> IORef Bool
                           -> IORef GLDrawContext
                           -> IORef (Maybe InputConnection)
                           -> GLDrawContext
                           -> IO ()
-setupDrawContext glForceSetup glDrawContextRef glInput new = do
+setupDrawContext boundfb glForceSetup glDrawContextRef glInput new = do
   old <- readIORef glDrawContextRef
   writeIORef glDrawContextRef new
   force <- readIORef glForceSetup
@@ -822,7 +834,7 @@ setupDrawContext glForceSetup glDrawContextRef glInput new = do
           let a = f new
           unless (a == f old) $ m a
 
-  setup glRenderTarget $ setupRenderTarget glInput
+  setup glRenderTarget $ setupRenderTarget boundfb glInput
   setup glRasterContext $ setupRasterContext
   setup glAccumulationContext setupAccumulationContext
   setup glProgram glUseProgram
@@ -847,16 +859,23 @@ renderFrame GLRenderer{..} = do
     writeIORef glVertexBufferRef 0
     writeIORef glIndexBufferRef 0
     writeIORef glDrawCallCounterRef 0
+    fb <- do
+        -- For GTK compatibility, we detect the currently bound draw buffer and use it instead of
+        -- the default framebuffer.
+        fbo <- alloca $! \pbo -> glGetIntegerv GL_DRAW_FRAMEBUFFER_BINDING pbo >> peek pbo
+        return $ case fbo of
+            0 -> Nothing
+            _ -> Just $ fromIntegral fbo
     glBindVertexArray glVAO
     forM_ glCommands $ \cmd -> do
         case cmd of
             GLClearRenderTarget rt vals -> do
-              setupRenderTarget glInput rt
+              setupRenderTarget fb glInput rt
               clearRenderTarget rt vals
               modifyIORef glDrawContextRef $ \ctx -> ctx {glRenderTarget = rt}
 
             GLRenderStream ctx streamIdx progIdx -> do
-              setupDrawContext glForceSetup glDrawContextRef glInput ctx
+              setupDrawContext fb glForceSetup glDrawContextRef glInput ctx
               drawcmd <- readIORef (glStreamCommands $ glStreams ! streamIdx)
               renderSlot glDrawCallCounterRef glVertexBufferRef glIndexBufferRef drawcmd
 
@@ -868,7 +887,7 @@ renderFrame GLRenderer{..} = do
                       let draw setupDone obj = readIORef (objEnabled obj) >>= \case
                             False -> return setupDone
                             True  -> do
-                              unless setupDone $ setupDrawContext glForceSetup glDrawContextRef glInput ctx
+                              unless setupDone $ setupDrawContext fb glForceSetup glDrawContextRef glInput ctx
                               drawcmd <- readIORef $ objCommands obj
                               --putStrLn "Render object"
                               renderSlot glDrawCallCounterRef glVertexBufferRef glIndexBufferRef ((drawcmd ! icId ic) ! progIdx)