lambdacube-gl 0.5.2.0 → 0.5.2.2

raw patch · 4 files changed

+211/−115 lines, 4 filesdep ~timePVP: major bump suggested

API removals or changes: PVP suggests a major version bump

Dependency ranges changed: time

API changes (from Hackage documentation)

Files

• lambdacube-gl.cabal +2/−2
• src/LambdaCube/GL/Backend.hs +174/−95
• src/LambdaCube/GL/Mesh.hs +1/−1
• src/LambdaCube/GL/Type.hs +34/−17

@@ -1,5 +1,5 @@ name:                lambdacube-gl-version:             0.5.2.0+version:             0.5.2.2 synopsis:            OpenGL 3.3 Core Profile backend for LambdaCube 3D description:         OpenGL 3.3 Core Profile backend for LambdaCube 3D homepage:            http://lambdacube3d.com@@ -125,7 +125,7 @@     base < 5,     containers >=0.5 && <0.6,     text >= 1.2 && <1.3,-    time >= 1.5 && <1.6,+    time >= 1.5 && <1.7,     exceptions >= 0.8 && <0.9,     bytestring >=0.10 && <0.11,     base64-bytestring >=1 && <1.1,

@@ -1,9 +1,9 @@-{-# LANGUAGE TupleSections, MonadComprehensions, RecordWildCards, LambdaCase #-}+{-# LANGUAGE TupleSections, MonadComprehensions, RecordWildCards, LambdaCase, FlexibleContexts #-} module LambdaCube.GL.Backend where  import Control.Applicative import Control.Monad-import Control.Monad.State+import Control.Monad.State.Strict import Data.Maybe import Data.Bits import Data.IORef@@ -13,10 +13,10 @@ import Data.Set (Set) import Data.Vector (Vector,(!),(//)) import qualified Data.Foldable as F-import qualified Data.IntMap as IM+import qualified Data.IntMap as IntMap import qualified Data.Map as Map import qualified Data.List as L-import qualified Data.Set as S+import qualified Data.Set as Set import qualified Data.Vector as V import qualified Data.Vector.Storable as SV @@ -279,7 +279,7 @@         , programObject         = po         , inputUniforms         = Map.fromList inUniforms         , inputTextures         = Map.fromList inTextures-        , inputTextureUniforms  = S.fromList $ texUnis+        , inputTextureUniforms  = Set.fromList $ texUnis         , inputStreams          = Map.fromList [(n,(idx, attrName)) | (n,idx) <- Map.toList $ attributes, let attrName = fromMaybe (error $ "missing attribute: " ++ n) $ Map.lookup n lcStreamName]         } @@ -443,7 +443,7 @@         uniCmds = [GLSetUniform i u | (n,i) <- uniMap, let u = topUni n]         uniMap  = Map.toList $ inputUniforms prg         topUni n = Map.findWithDefault (error "internal error (createStreamCommands)!") n topUnis-        texUnis = S.toList $ inputTextureUniforms prg+        texUnis = Set.toList $ inputTextureUniforms prg         texCmds = [ GLBindTexture (inputTypeToTextureTarget $ uniInputType u) texUnit u                   | n <- texUnis                   , let u = topUni n@@ -496,24 +496,34 @@     prgs <- V.mapM compileProgram $ programs p     -- texture unit mapping ioref trie     -- texUnitMapRefs :: Map UniformName (IORef TextureUnit)-    texUnitMapRefs <- Map.fromList <$> mapM (\k -> (k,) <$> newIORef 0) (S.toList $ S.fromList $ concat $ V.toList $ V.map (Map.keys . programInTextures) $ programs p)-    let (cmds,st) = runState (mapM (compileCommand texUnitMapRefs smps texs trgs prgs) $ V.toList $ commands p) initCGState+    texUnitMapRefs <- Map.fromList <$> mapM (\k -> (k,) <$> newIORef 0) (Set.toList $ Set.fromList $ concat $ V.toList $ V.map (Map.keys . programInTextures) $ programs p)+    let st = execState (mapM_ (compileCommand texUnitMapRefs smps texs trgs prgs) (V.toList $ commands p)) initCGState     input <- newIORef Nothing     -- default Vertex Array Object     vao <- alloca $! \pvao -> glGenVertexArrays 1 pvao >> peek pvao     strs <- V.mapM compileStreamData $ streams p+    drawContextRef <- newIORef $ error "missing DrawContext"+    forceSetup <- newIORef True+    vertexBufferRef <- newIORef 0+    indexBufferRef <- newIORef 0+    drawCallCounterRef <- newIORef 0     return $ GLRenderer         { glPrograms        = prgs         , glTextures        = texs         , glSamplers        = smps         , glTargets         = trgs-        , glCommands        = cmds+        , glCommands        = reverse $ drawCommands st         , glSlotPrograms    = V.map (V.toList . slotPrograms) $ IR.slots p         , glInput           = input         , glSlotNames       = V.map slotName $ IR.slots p         , glVAO             = vao         , glTexUnitMapping  = texUnitMapRefs         , glStreams         = strs+        , glDrawContextRef  = drawContextRef+        , glForceSetup      = forceSetup+        , glVertexBufferRef = vertexBufferRef+        , glIndexBufferRef  = indexBufferRef+        , glDrawCallCounterRef = drawCallCounterRef         }  disposeRenderer :: GLRenderer -> IO ()@@ -594,7 +604,7 @@             modifyIORef (pipelines icInput) $ \v -> v // [(icId,Nothing)]             V.forM_ icSlotMapPipelineToInput $ \slotIdx -> do                 slot <- readIORef (slotRefs ! slotIdx)-                forM_ (IM.elems $ objectMap slot) $ \obj -> do+                forM_ (objectMap slot) $ \obj -> do                     modifyIORef (objCommands obj) $ \v -> v // [(icId,V.empty)]     {-         addition:@@ -619,7 +629,7 @@                     return (i,Nothing)             -- create input connection             let sm      = slotMap input-                pToI    = [i | n <- glSlotNames, let i = fromMaybe (error $ "missing object array: " ++ n) $ Map.lookup n sm]+                pToI    = [i | n <- glSlotNames, let i = fromMaybe (error $ "setStorage - missing object array: " ++ n) $ Map.lookup n sm]                 iToP    = V.update (V.replicate (Map.size sm) Nothing) (V.imap (\i v -> (v, Just i)) pToI)             writeIORef glInput $ Just $ InputConnection idx input pToI iToP @@ -641,7 +651,7 @@                     Just l  -> V.concat [v,V.replicate l V.empty]             V.forM_ (V.zip pToI glSlotPrograms) $ \(slotIdx,prgs) -> do                 slot <- readIORef $ slotV ! slotIdx-                forM_ (IM.elems $ objectMap slot) $ \obj -> do+                forM_ (objectMap slot) $ \obj -> do                     let cmdV = emptyV // [(prgIdx,createObjectCommands glTexUnitMapping topUnis obj (progV ! prgIdx)) | prgIdx <- prgs]                     modifyIORef (objCommands obj) $ \v -> extend v // [(idx,cmdV)]             -- generate stream commands@@ -684,21 +694,28 @@     buffer binding on various targets: GL_ARRAY_BUFFER, GL_ELEMENT_ARRAY_BUFFER     glEnable/DisableVertexAttribArray -}-renderSlot :: [GLObjectCommand] -> IO ()-renderSlot cmds = forM_ cmds $ \cmd -> do+renderSlot :: IORef Int -> IORef GLuint -> IORef GLuint -> [GLObjectCommand] -> IO ()+renderSlot glDrawCallCounterRef glVertexBufferRef glIndexBufferRef cmds = forM_ cmds $ \cmd -> do+    let setup ref v m = do+          old <- readIORef ref+          unless (old == v) $ do+            writeIORef ref v+            m+     case cmd of         GLSetVertexAttribArray idx buf size typ ptr     -> do-                                                            glBindBuffer GL_ARRAY_BUFFER buf+                                                            setup glVertexBufferRef buf $ glBindBuffer GL_ARRAY_BUFFER buf                                                             glEnableVertexAttribArray idx                                                             glVertexAttribPointer idx size typ (fromIntegral GL_FALSE) 0 ptr         GLSetVertexAttribIArray idx buf size typ ptr    -> do-                                                            glBindBuffer GL_ARRAY_BUFFER buf+                                                            setup glVertexBufferRef buf $ glBindBuffer GL_ARRAY_BUFFER buf                                                             glEnableVertexAttribArray idx                                                             glVertexAttribIPointer idx size typ 0 ptr-        GLDrawArrays mode first count                   -> glDrawArrays mode first count+        GLDrawArrays mode first count                   -> glDrawArrays mode first count >> modifyIORef glDrawCallCounterRef succ         GLDrawElements mode count typ buf indicesPtr    -> do-                                                            glBindBuffer GL_ELEMENT_ARRAY_BUFFER buf+                                                            setup glIndexBufferRef buf $ glBindBuffer GL_ELEMENT_ARRAY_BUFFER buf                                                             glDrawElements mode count typ indicesPtr+                                                            modifyIORef glDrawCallCounterRef succ         GLSetUniform idx (GLUniform ty ref)             -> setUniform idx ty ref         GLBindTexture txTarget tuRef (GLUniform _ ref)  -> do                                                             txObjVal <- readIORef ref@@ -715,105 +732,167 @@     --isOk <- checkGL     --putStrLn $ isOk ++ " - " ++ show cmd +setupRenderTarget glInput GLRenderTarget{..} = do+  -- set target viewport+  ic' <- readIORef glInput+  case ic' of+      Nothing -> return ()+      Just ic -> do+                  let input = icInput ic+                  (w,h) <- readIORef $ screenSize input+                  glViewport 0 0 (fromIntegral w) (fromIntegral h)+  -- TODO: set FBO target viewport+  glBindFramebuffer GL_DRAW_FRAMEBUFFER framebufferObject+  case framebufferDrawbuffers of+      Nothing -> return ()+      Just bl -> withArray bl $ glDrawBuffers (fromIntegral $ length bl)++setupDrawContext glForceSetup glDrawContextRef glInput new = do+  old <- readIORef glDrawContextRef+  writeIORef glDrawContextRef new+  force <- readIORef glForceSetup+  writeIORef glForceSetup False++  let setup :: Eq a => (GLDrawContext -> a) -> (a -> IO ()) -> IO ()+      setup f m = case force of+        True -> m $ f new+        False -> do+          let a = f new+          unless (a == f old) $ m a++  setup glRenderTarget $ setupRenderTarget glInput+  setup glRasterContext $ setupRasterContext+  setup glAccumulationContext setupAccumulationContext+  setup glProgram glUseProgram++  -- setup texture mapping+  setup glTextureMapping $ mapM_ $ \(textureUnit,GLTexture{..}) -> do+    glActiveTexture (GL_TEXTURE0 + fromIntegral textureUnit)+    glBindTexture glTextureTarget glTextureObject++  -- setup sampler mapping+  setup glSamplerMapping $ mapM_ $ \(textureUnit,GLSampler{..}) -> do+    glBindSampler (GL_TEXTURE0 + fromIntegral textureUnit) glSamplerObject++  -- setup sampler uniform mapping+  forM_ (glSamplerUniformMapping new) $ \(textureUnit,GLSamplerUniform{..}) -> do+    glUniform1i glUniformBinding (fromIntegral textureUnit)+    writeIORef glUniformBindingRef (fromIntegral textureUnit)+ renderFrame :: GLRenderer -> IO ()-renderFrame glp = do-    glBindVertexArray (glVAO glp)-    forM_ (glCommands glp) $ \cmd -> do+renderFrame GLRenderer{..} = do+    writeIORef glForceSetup True+    writeIORef glVertexBufferRef 0+    writeIORef glIndexBufferRef 0+    writeIORef glDrawCallCounterRef 0+    glBindVertexArray glVAO+    forM_ glCommands $ \cmd -> do         case cmd of-            GLSetRasterContext rCtx         -> setupRasterContext rCtx-            GLSetAccumulationContext aCtx   -> setupAccumulationContext aCtx-            GLSetRenderTarget rt bufs       -> do-                                                -- set target viewport-                                               --when (rt == 0) $ do -- screen out-                                                ic' <- readIORef $ glInput glp-                                                case ic' of-                                                    Nothing -> return ()-                                                    Just ic -> do-                                                                let input = icInput ic-                                                                (w,h) <- readIORef $ screenSize input-                                                                glViewport 0 0 (fromIntegral w) (fromIntegral h)-                                                -- TODO: set FBO target viewport-                                                glBindFramebuffer GL_DRAW_FRAMEBUFFER rt-                                                case bufs of-                                                    Nothing -> return ()-                                                    Just bl -> withArray bl $ glDrawBuffers (fromIntegral $ length bl)-            GLSetProgram p                  -> glUseProgram p-            GLSetSamplerUniform i tu ref    -> glUniform1i i tu >> writeIORef ref tu-            GLSetTexture tu target tx       -> glActiveTexture tu >> glBindTexture target tx-            GLSetSampler tu s               -> glBindSampler tu s-            GLClearRenderTarget vals        -> clearRenderTarget vals-            GLGenerateMipMap tu target      -> glActiveTexture tu >> glGenerateMipmap target-            GLRenderStream streamIdx progIdx  -> do-                                                renderSlot =<< readIORef (glStreamCommands $ glStreams glp ! streamIdx)-            GLRenderSlot slotIdx progIdx    -> do-                                                input <- readIORef (glInput glp)-                                                case input of-                                                    Nothing -> putStrLn "Warning: No pipeline input!" >> return ()-                                                    Just ic -> do-                                                        let draw obj = do-                                                              enabled <- readIORef $ objEnabled obj-                                                              when enabled $ do-                                                                cmd <- readIORef $ objCommands obj-                                                                --putStrLn "Render object"-                                                                renderSlot ((cmd ! icId ic) ! progIdx)-                                                        --putStrLn $ "Rendering " ++ show (V.length objs) ++ " objects"-                                                        readIORef (slotVector (icInput ic) ! (icSlotMapPipelineToInput ic ! slotIdx)) >>= \case-                                                          GLSlot _ objs Ordered -> forM_ objs $ draw . snd-                                                          GLSlot objMap _ _ -> forM_ objMap draw-            {--            GLSetSampler-            GLSaveImage-            GLLoadImage-            -}+            GLClearRenderTarget rt vals -> do+              setupRenderTarget glInput rt+              clearRenderTarget vals+              modifyIORef glDrawContextRef $ \ctx -> ctx {glRenderTarget = rt}++            GLRenderStream ctx streamIdx progIdx -> do+              setupDrawContext glForceSetup glDrawContextRef glInput ctx+              drawcmd <- readIORef (glStreamCommands $ glStreams ! streamIdx)+              renderSlot glDrawCallCounterRef glVertexBufferRef glIndexBufferRef drawcmd++            GLRenderSlot ctx slotIdx progIdx -> do+              input <- readIORef glInput+              case input of+                  Nothing -> putStrLn "Warning: No pipeline input!" >> return ()+                  Just ic -> do+                      let draw setupDone obj = readIORef (objEnabled obj) >>= \case+                            False -> return setupDone+                            True  -> do+                              unless setupDone $ setupDrawContext glForceSetup glDrawContextRef glInput ctx+                              drawcmd <- readIORef $ objCommands obj+                              --putStrLn "Render object"+                              renderSlot glDrawCallCounterRef glVertexBufferRef glIndexBufferRef ((drawcmd ! icId ic) ! progIdx)+                              return True+                      --putStrLn $ "Rendering " ++ show (V.length objs) ++ " objects"+                      readIORef (slotVector (icInput ic) ! (icSlotMapPipelineToInput ic ! slotIdx)) >>= \case+                        GLSlot _ objs Ordered -> foldM_ (\a -> draw a . snd) False objs+                        GLSlot objMap _ _ -> foldM_ draw False objMap+         --isOk <- checkGL         --putStrLn $ isOk ++ " - " ++ show cmd+    --readIORef glDrawCallCounterRef >>= \n -> putStrLn (show n ++ " draw calls")  data CGState-    = CGState-    { currentProgram    :: ProgramName-    , textureBinding    :: IntMap GLTexture-    }+  = CGState+  { drawCommands          :: [GLCommand]+  -- draw context data+  , rasterContext         :: RasterContext+  , accumulationContext   :: AccumulationContext+  , renderTarget          :: GLRenderTarget+  , currentProgram        :: ProgramName+  , samplerUniformMapping :: IntMap GLSamplerUniform+  , textureMapping        :: IntMap GLTexture+  , samplerMapping        :: IntMap GLSampler+  }  initCGState = CGState-    { currentProgram    = error "CGState: empty currentProgram"-    , textureBinding    = IM.empty-    }+  { drawCommands          = mempty+  -- draw context data+  , rasterContext         = error "compileCommand: missing RasterContext"+  , accumulationContext   = error "compileCommand: missing AccumulationContext"+  , renderTarget          = error "compileCommand: missing RenderTarget"+  , currentProgram        = error "compileCommand: missing Program"+  , samplerUniformMapping = mempty+  , textureMapping        = mempty+  , samplerMapping        = mempty+  }  type CG a = State CGState a -compileCommand :: Map String (IORef GLint) -> Vector GLSampler -> Vector GLTexture -> Vector GLRenderTarget -> Vector GLProgram -> Command -> CG GLCommand+emit :: GLCommand -> CG ()+emit cmd = modify $ \s -> s {drawCommands = cmd : drawCommands s}++drawContext programs = do+  GLProgram{..} <- (programs !) <$> gets currentProgram+  let f = take (Set.size inputTextureUniforms) . IntMap.toList+  GLDrawContext <$> gets rasterContext+                <*> gets accumulationContext+                <*> gets renderTarget+                <*> pure programObject+                <*> gets (f . textureMapping)+                <*> gets (f . samplerMapping)+                <*> gets (f . samplerUniformMapping)++compileCommand :: Map String (IORef GLint) -> Vector GLSampler -> Vector GLTexture -> Vector GLRenderTarget -> Vector GLProgram -> Command -> CG () compileCommand texUnitMap samplers textures targets programs cmd = case cmd of-    SetRasterContext rCtx       -> return $ GLSetRasterContext rCtx-    SetAccumulationContext aCtx -> return $ GLSetAccumulationContext aCtx-    SetRenderTarget rt          -> let GLRenderTarget fbo bufs = targets ! rt in return $ GLSetRenderTarget fbo bufs-    SetProgram p                -> do-                                    modify (\s -> s {currentProgram = p})-                                    return $ GLSetProgram $ programObject $ programs ! p+    SetRasterContext rCtx       -> modify $ \s -> s {rasterContext = rCtx}+    SetAccumulationContext aCtx -> modify $ \s -> s {accumulationContext = aCtx}+    SetRenderTarget rt          -> modify $ \s -> s {renderTarget = targets ! rt}+    SetProgram p                -> modify $ \s -> s {currentProgram = p}     SetSamplerUniform n tu      -> do                                     p <- currentProgram <$> get                                     case Map.lookup n (inputTextures $ programs ! p) of-                                        Nothing -> return (GLSetProgram (programObject $ programs ! p) {-HACK!!! we have to emit something-}) -- TODO: some drivers does heavy cross stage (vertex/fragment) dead code elimination; fail $ "internal error (SetSamplerUniform)! - " ++ show cmd+                                        Nothing -> return () -- TODO: some drivers does heavy cross stage (vertex/fragment) dead code elimination; fail $ "internal error (SetSamplerUniform)! - " ++ show cmd                                         Just i  -> case Map.lookup n texUnitMap of                                             Nothing -> fail $ "internal error (SetSamplerUniform - IORef)! - " ++ show cmd-                                            Just r  -> return $ GLSetSamplerUniform i (fromIntegral tu) r-    SetTexture tu t             -> do-                                    let tex = textures ! t-                                    modify (\s -> s {textureBinding = IM.insert tu tex $ textureBinding s})-                                    return $ GLSetTexture (GL_TEXTURE0 + fromIntegral tu) (glTextureTarget tex) (glTextureObject tex)-    SetSampler tu s             -> return $ GLSetSampler (GL_TEXTURE0 + fromIntegral tu) (maybe 0 (glSamplerObject . (samplers !)) s)+                                            Just r  -> modify $ \s -> s {samplerUniformMapping = IntMap.insert tu (GLSamplerUniform i r) $ samplerUniformMapping s}+    SetTexture tu t             -> modify $ \s -> s {textureMapping = IntMap.insert tu (textures ! t) $ textureMapping s}+    SetSampler tu i             -> modify $ \s -> s {samplerMapping = IntMap.insert tu (maybe (GLSampler 0) (samplers !) i) $ samplerMapping s}++    -- draw commands     RenderSlot slot             -> do-                                    p <- currentProgram <$> get-                                    return $ GLRenderSlot slot p+                                    p <- gets currentProgram+                                    ctx <- drawContext programs+                                    emit $ GLRenderSlot ctx slot p     RenderStream stream         -> do-                                    p <- currentProgram <$> get-                                    return $ GLRenderStream stream p-    ClearRenderTarget vals      -> return $ GLClearRenderTarget $ V.toList vals+                                    p <- gets currentProgram+                                    ctx <- drawContext programs+                                    emit $ GLRenderStream ctx stream p+    ClearRenderTarget vals      -> do+                                    rt <- gets renderTarget+                                    emit $ GLClearRenderTarget rt $ V.toList vals+{-     GenerateMipMap tu           -> do                                     tb <- textureBinding <$> get                                     case IM.lookup tu tb of                                         Nothing     -> fail "internal error (GenerateMipMap)!"                                         Just tex    -> return $ GLGenerateMipMap (GL_TEXTURE0 + fromIntegral tu) (glTextureTarget tex)-{--    SaveImage _ _               -> undefined-    LoadImage _ _               -> undefined -}

@@ -50,7 +50,7 @@ addMeshToObjectArray :: GLStorage -> String -> [String] -> GPUMesh -> IO Object addMeshToObjectArray input slotName objUniNames (GPUMesh _ (GPUData prim streams indices _)) = do     -- select proper attributes-    let (ObjectArraySchema slotPrim slotStreams) = fromMaybe (error $ "missing object array: " ++ slotName) $ Map.lookup slotName $! objectArrays $! schema input+    let (ObjectArraySchema slotPrim slotStreams) = fromMaybe (error $ "addMeshToObjectArray - missing object array: " ++ slotName) $ Map.lookup slotName $! objectArrays $! schema input         filterStream n _ = Map.member n slotStreams     addObject input slotName prim indices (Map.filterWithKey filterStream streams) objUniNames 

@@ -128,7 +128,7 @@     = GLTexture     { glTextureObject   :: GLuint     , glTextureTarget   :: GLenum-    }+    } deriving Eq  data InputConnection     = InputConnection@@ -159,34 +159,51 @@     , glVAO             :: GLuint     , glTexUnitMapping  :: Map String (IORef GLint)   -- maps texture uniforms to texture units     , glStreams         :: Vector GLStream+    , glDrawContextRef  :: IORef GLDrawContext+    , glForceSetup      :: IORef Bool+    , glVertexBufferRef :: IORef GLuint+    , glIndexBufferRef  :: IORef GLuint+    , glDrawCallCounterRef :: IORef Int     }  data GLSampler     = GLSampler     { glSamplerObject :: GLuint-    }+    } deriving Eq  data GLRenderTarget     = GLRenderTarget     { framebufferObject         :: GLuint     , framebufferDrawbuffers    :: Maybe [GLenum]-    }+    } deriving Eq +type GLTextureUnit = Int+type GLUniformBinding = GLint++data GLSamplerUniform+  = GLSamplerUniform+  { glUniformBinding    :: !GLUniformBinding+  , glUniformBindingRef :: IORef GLUniformBinding+  }++instance Eq GLSamplerUniform where+  a == b = glUniformBinding a == glUniformBinding b++data GLDrawContext+  = GLDrawContext+  { glRasterContext         :: !RasterContext+  , glAccumulationContext   :: !AccumulationContext+  , glRenderTarget          :: !GLRenderTarget+  , glProgram               :: !GLuint+  , glTextureMapping        :: ![(GLTextureUnit,GLTexture)]+  , glSamplerMapping        :: ![(GLTextureUnit,GLSampler)]+  , glSamplerUniformMapping :: ![(GLTextureUnit,GLSamplerUniform)]+  }+ data GLCommand-    = GLSetRasterContext        !RasterContext-    | GLSetAccumulationContext  !AccumulationContext-    | GLSetRenderTarget         !GLuint !(Maybe [GLenum])-    | GLSetProgram              !GLuint-    | GLSetSamplerUniform       !GLint !GLint (IORef GLint)                     -- sampler index, texture unit, IORef stores the actual texture unit mapping-    | GLSetTexture              !GLenum !GLuint !GLuint-    | GLSetSampler              !GLuint !GLuint-    | GLRenderSlot              !SlotName !ProgramName-    | GLRenderStream            !StreamName !ProgramName-    | GLClearRenderTarget       [ClearImage]-    | GLGenerateMipMap          !GLenum !GLenum-    | GLSaveImage               FrameBufferComponent ImageRef                   -- from framebuffer component to texture (image)-    | GLLoadImage               ImageRef FrameBufferComponent                   -- from texture (image) to framebuffer component-    deriving Show+  = GLRenderSlot          !GLDrawContext !SlotName !ProgramName+  | GLRenderStream        !GLDrawContext !StreamName !ProgramName+  | GLClearRenderTarget   !GLRenderTarget ![ClearImage]  instance Show (IORef GLint) where     show _ = "(IORef GLint)"