Switched away from gtk-declarative.

1 files changed, 25 insertions, 0 deletions

diff --git a/LambdaCube/Gtk.hs b/LambdaCube/Gtk.hs
new file mode 100644
index 0000000..1a9c1b9
--- /dev/null
+++ b/LambdaCube/Gtk.hs
@@ -0,0 +1,25 @@
+module LambdaCube.Gtk where
+
+import Control.Monad.IO.Class
+import qualified Graphics.Rendering.OpenGL as GL
+import qualified Unsafe.Coerce
+
+import LambdaCube.GL.Type
+
+
+-- | LambdaCube.GL assumes we are rendering to the default framebuffer #0 but
+-- Gtk.GLArea actually uses an unpredictable framebuffer object target.  As a
+-- workaround, we read the current framebuffer target and patch up the render
+-- commands to use it instead of 0.
+fixupRenderTarget :: MonadIO m => GLRenderer -> m GLRenderer
+fixupRenderTarget r = do
+    fbo0 <- GL.get $ GL.bindFramebuffer GL.DrawFramebuffer
+    let fbo = Unsafe.Coerce.unsafeCoerce fbo0 :: GL.GLuint -- XXX: Is there a better way to get this?
+        setFBO rt | framebufferObject rt == 0  = rt { framebufferObject = fbo }
+                  | otherwise                  = rt
+        updateDC dc = dc { glRenderTarget = rt' } where rt' = setFBO (glRenderTarget dc)
+        update (GLClearRenderTarget rt imgs) = GLClearRenderTarget (setFBO rt) imgs
+        update (GLRenderSlot dc s p)         = GLRenderSlot (updateDC dc) s p
+        update (GLRenderStream dc s p)       = GLRenderStream (updateDC dc) s p
+    return r { glCommands = map update (glCommands r) }
+