LambdaCube/Gtk.hs


1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
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) }