Merge pull request #13 from deepfire/master

Keep track of GLRenderer outputs and fix integer render textures

10 files changed, 352 insertions, 33 deletions

diff --git a/.gitignore b/.gitignore
index 561a774..cf6ea4b 100644
--- a/.gitignore
+++ b/.gitignore
@@ -1,5 +1,7 @@
 *~
 dist
+dist-newstyle
 *.hi
 *.o
 .stack-work
+.ghc.environment.*
diff --git a/examples/pickInt.hs b/examples/pickInt.hs
new file mode 100644
index 0000000..2703e91
--- /dev/null
+++ b/examples/pickInt.hs
@@ -0,0 +1,192 @@
+{-# LANGUAGE PackageImports, LambdaCase, OverloadedStrings, StandaloneDeriving, ViewPatterns #-}
+import           Control.Monad
+import           Data.Aeson
+import           Data.Vect                            (Mat4(..), Vec3(..), Vec4(..))
+import           Graphics.GL.Core33                as GL
+import           LambdaCube.GL                     as LambdaCubeGL
+import           LambdaCube.GL.Mesh                as LambdaCubeGL
+import           Text.Printf
+import "GLFW-b"  Graphics.UI.GLFW                  as GLFW
+import qualified Data.ByteString                   as SB
+import qualified Data.Map                          as Map
+import qualified Data.Vect                         as Vc
+import qualified Data.Vector                       as V
+import qualified Foreign                           as F
+import qualified Foreign.C.Types                   as F
+import qualified LambdaCube.GL.Type                as LC
+import qualified LambdaCube.Linear                 as LCLin
+
+----------------------------------------------------
+--  See:  http://lambdacube3d.com/getting-started
+----------------------------------------------------
+
+screenDim :: (Int, Int)
+screenDim = (800, 600)
+(screenW, screenH) = screenDim
+
+main :: IO ()
+main = do
+    Just pipePickDesc <- decodeStrict <$> SB.readFile "pickInt.json"
+    Just pipeDrawDesc <- decodeStrict <$> SB.readFile "pickIntDraw.json"
+
+    win <- initWindow "LambdaCube 3D integer picking" 800 600
+
+    -- setup render data
+    let inputSchema = makeSchema $ do
+          defObjectArray "objects" Triangles $ do
+            "position"  @: Attribute_V2F
+            "id"        @: Attribute_Int
+            "color"     @: Attribute_V4F
+          defUniforms $ do
+            "viewProj"  @: M44F
+
+    storage <- LambdaCubeGL.allocStorage inputSchema
+
+    -- upload geometry to GPU and add to pipeline input
+    LambdaCubeGL.uploadMeshToGPU triangleA >>= LambdaCubeGL.addMeshToObjectArray storage "objects" []
+    LambdaCubeGL.uploadMeshToGPU triangleB >>= LambdaCubeGL.addMeshToObjectArray storage "objects" []
+
+    -- allocate GL pipeline
+    pipePick <- LambdaCubeGL.allocRenderer pipePickDesc
+    pipeDraw <- LambdaCubeGL.allocRenderer pipeDrawDesc
+    errPick  <- LambdaCubeGL.setStorage pipePick storage
+    errDraw  <- LambdaCubeGL.setStorage pipeDraw storage
+    case (errPick, errDraw) of -- check schema compatibility
+      (Just err, _) -> putStrLn err
+      (_, Just err) -> putStrLn err
+      (Nothing, Nothing) -> loop
+        where loop = do
+                -- update graphics input
+                GLFW.getWindowSize win >>= \(w,h) -> LambdaCubeGL.setScreenSize storage (fromIntegral w) (fromIntegral h)
+                LambdaCubeGL.updateUniforms storage $ do
+                  let (x, y)    = (,) 0 0
+                      cvpos     = Vec3 x (-y) 0
+                      toScreen  = screenM screenW screenH
+                  "viewProj" @= pure (mat4ToM44F $! (Vc.fromProjective $! Vc.translation cvpos) Vc..*. toScreen)
+
+                (curX, curY) <- GLFW.getCursorPos win
+                let pickPoints =   -- should be fb 0            fb 1 (pick)
+                      [ (clamp curX 800, clamp curY 600)
+                      , (0,   0)   --           black              0
+                      , (200, 200) --         ..blue, ffff0000     2
+                      , (600, 400) --         ..red,  ff0000ff     1
+                      ] :: [(Int, Int)]
+                    clamp v m = min (pred m) $ max 0 (floor v)
+
+                -- render to render texture
+                LambdaCubeGL.renderFrame pipePick
+                case LC.glOutputs pipePick of
+                  [LC.GLOutputRenderTexture (fromIntegral -> fbo) _rendTex] -> do
+                    rtexPicks <- collectPicks fbo pickPoints
+                    printPicks pickPoints rtexPicks
+                  x -> error $ "Unexpected outputs: " <> show x
+
+                -- render to framebuffer & pick
+                LambdaCubeGL.renderFrame pipeDraw
+                colorPicks <- collectPicks 0 pickPoints
+                printPicks pickPoints colorPicks
+
+                GLFW.swapBuffers win
+                GLFW.pollEvents
+
+                let keyIsPressed k = fmap (==KeyState'Pressed) $ GLFW.getKey win k
+                escape <- keyIsPressed Key'Escape
+                if escape then return () else loop
+              collectPicks :: Int -> [(Int, Int)] -> IO [Int]
+              collectPicks fb picks =
+                forM picks $ (fromIntegral <$>) . pickFrameBuffer fb screenDim
+              printPicks pickPoints colorPicks = do
+                forM_ (zip pickPoints colorPicks) $ \((x,y), col)-> do
+                  printf "%d:%d: %x   " x y col
+                putStrLn ""
+
+    LambdaCubeGL.disposeRenderer pipePick
+    LambdaCubeGL.disposeRenderer pipeDraw
+    LambdaCubeGL.disposeStorage storage
+    GLFW.destroyWindow win
+    GLFW.terminate
+
+deriving instance Show (LC.GLOutput)
+deriving instance Show (LC.GLTexture)
+
+-- geometry data: triangles
+scale = 250.0
+s     = scale
+
+triangleA :: LambdaCubeGL.Mesh
+triangleA = Mesh
+    { mAttributes   = Map.fromList
+        [ ("position",  A_V2F $ V.fromList [V2 s s, V2 s (-s), V2 (-s) (-s)])
+        , ("color",     A_V4F $ V.fromList $ take 4 $ repeat $ V4 1 0 0 1)
+        , ("id",        A_Int $ V.fromList [1, 1, 1])
+        ]
+    , mPrimitive    = P_Triangles
+    }
+
+triangleB :: LambdaCubeGL.Mesh
+triangleB = Mesh
+    { mAttributes   = Map.fromList
+        [ ("position",  A_V2F $ V.fromList [V2 s s, V2 (-s) (-s), V2 (-s) s])
+        , ("color",     A_V4F $ V.fromList $ take 4 $ repeat $ V4 0 0 1 1)
+        , ("id",        A_Int $ V.fromList [2, 2, 2])
+        ]
+    , mPrimitive    = P_Triangles
+    }
+
+vec4ToV4F :: Vec4 -> LCLin.V4F
+vec4ToV4F (Vc.Vec4 x y z w) = LCLin.V4 x y z w
+
+mat4ToM44F :: Mat4 -> LCLin.M44F
+mat4ToM44F (Mat4 a b c d) = LCLin.V4 (vec4ToV4F a) (vec4ToV4F b) (vec4ToV4F c) (vec4ToV4F d)
+
+screenM :: Int -> Int -> Mat4
+screenM w h = scaleM
+  where (fw, fh) = (fromIntegral w, fromIntegral h)
+        scaleM = Vc.Mat4 (Vc.Vec4 (1/fw)  0     0 0)
+                         (Vc.Vec4  0     (1/fh) 0 0)
+                         (Vc.Vec4  0      0     1 0)
+                         (Vc.Vec4  0      0     0 0.5)
+
+pickFrameBuffer
+  :: Int         -- ^ framebuffer
+  -> (Int, Int)  -- ^ FB dimensions
+  -> (Int, Int)  -- ^ pick coordinates
+  -> IO F.Word32 -- ^ resultant pixel value
+pickFrameBuffer fb (w, h) (x, y) = do
+  glFinish
+  glBindFramebuffer GL_READ_FRAMEBUFFER $ fromIntegral fb
+  let (fbmode, format) =
+        if fb == 0
+        then (GL_BACK_LEFT,         GL_RGBA)
+        else (GL_COLOR_ATTACHMENT0, GL_RGBA_INTEGER)
+  glReadBuffer fbmode
+  withFrameBuffer w format x (h - y - 1) 1 1 $ \p -> fromIntegral <$> F.peek (F.castPtr p :: F.Ptr F.Word32)
+
+withFrameBuffer :: Int -> GLenum -> Int -> Int -> Int -> Int -> (F.Ptr F.Word8 -> IO a) -> IO a
+withFrameBuffer rowLen format x y w h fn = F.allocaBytes (w*h*4) $ \p -> do
+  glPixelStorei GL_UNPACK_LSB_FIRST    0
+  glPixelStorei GL_UNPACK_SWAP_BYTES   0
+  glPixelStorei GL_UNPACK_ROW_LENGTH   $ fromIntegral rowLen
+  glPixelStorei GL_UNPACK_IMAGE_HEIGHT 0
+  glPixelStorei GL_UNPACK_SKIP_ROWS    0
+  glPixelStorei GL_UNPACK_SKIP_PIXELS  0
+  glPixelStorei GL_UNPACK_SKIP_IMAGES  0
+  glPixelStorei GL_UNPACK_ALIGNMENT    1
+  glReadPixels (fromIntegral x) (fromIntegral y) (fromIntegral w) (fromIntegral h) format GL_UNSIGNED_BYTE $ F.castPtr p
+  glPixelStorei GL_UNPACK_ROW_LENGTH   0
+  fn p
+
+initWindow :: String -> Int -> Int -> IO Window
+initWindow title width height = do
+    GLFW.init
+    GLFW.defaultWindowHints
+    mapM_ GLFW.windowHint
+      [ WindowHint'ContextVersionMajor 3
+      , WindowHint'ContextVersionMinor 3
+      , WindowHint'OpenGLProfile OpenGLProfile'Core
+      , WindowHint'OpenGLForwardCompat True
+      ]
+    Just win <- GLFW.createWindow width height title Nothing Nothing
+    GLFW.makeContextCurrent $ Just win
+    return win
+
diff --git a/examples/pickInt.json b/examples/pickInt.json
new file mode 100644
index 0000000..233cd61
--- /dev/null
+++ b/examples/pickInt.json
@@ -0,0 +1 @@
+{"textures":[{"textureBaseLevel":0,"textureSize":{"tag":"VV2U","arg0":{"x":800,"y":600}},"tag":"TextureDescriptor","textureMaxLevel":0,"textureSampler":{"samplerMaxLod":null,"samplerLodBias":0,"tag":"SamplerDescriptor","samplerBorderColor":{"tag":"VV4F","arg0":{"w":1,"z":0,"x":0,"y":0}},"samplerMinFilter":{"tag":"Nearest"},"samplerWrapT":{"tag":"Repeat"},"samplerMagFilter":{"tag":"Nearest"},"samplerWrapR":null,"samplerCompareFunc":null,"samplerWrapS":{"tag":"Repeat"},"samplerMinLod":null},"textureType":{"tag":"Texture2D","arg0":{"tag":"IntT","arg0":{"tag":"RGBA"}},"arg1":1},"textureSemantic":{"tag":"Color"}}],"commands":[{"tag":"SetRenderTarget","arg0":0},{"tag":"ClearRenderTarget","arg0":[{"tag":"ClearImage","clearValue":{"tag":"VV4I","arg0":{"w":0,"z":0,"x":0,"y":0}},"imageSemantic":{"tag":"Color"}}]},{"tag":"SetProgram","arg0":0},{"tag":"SetRasterContext","arg0":{"arg3":{"tag":"LastVertex"},"tag":"TriangleCtx","arg0":{"tag":"CullFront","arg0":{"tag":"CCW"}},"arg1":{"tag":"PolygonFill"},"arg2":{"tag":"NoOffset"}}},{"tag":"SetAccumulationContext","arg0":{"accViewportName":null,"tag":"AccumulationContext","accOperations":[{"tag":"ColorOp","arg0":{"tag":"NoBlending"},"arg1":{"tag":"VV4B","arg0":{"w":true,"z":true,"x":true,"y":true}}}]}},{"tag":"RenderSlot","arg0":0}],"slots":[{"tag":"Slot","slotPrimitive":{"tag":"Triangles"},"slotStreams":{"color":{"tag":"V4F"},"id":{"tag":"Int"},"position":{"tag":"V3F"}},"slotName":"objects","slotUniforms":{"viewProj":{"tag":"M44F"}},"slotPrograms":[0]}],"programs":[{"programInTextures":{},"tag":"Program","programOutput":[{"tag":"Parameter","ty":{"tag":"V4I"},"name":"f0"}],"programStreams":{"vi3":{"tag":"Parameter","ty":{"tag":"Int"},"name":"id"},"vi2":{"tag":"Parameter","ty":{"tag":"V4F"},"name":"color"},"vi1":{"tag":"Parameter","ty":{"tag":"V3F"},"name":"position"}},"fragmentShader":"#version 330 core\nvec4 texture2D(sampler2D s,vec2 uv) {\n    return texture(s,uv);\n}\nflat in vec2 vo1;\nflat in ivec4 vo2;\nout ivec4 f0;\nvoid main() {\n    f0 = vo2;\n}","vertexShader":"#version 330 core\nvec4 texture2D(sampler2D s,vec2 uv) {\n    return texture(s,uv);\n}\nuniform mat4 viewProj;\nin vec3 vi1;\nin vec4 vi2;\nin int vi3;\nflat out vec2 vo1;\nflat out ivec4 vo2;\nvoid main() {\n    gl_Position = (viewProj) * (vec4 ((vi1).x,(vi1).y,0.0,1.0));\n    vo1 = vec2 (0.0,0.0);\n    vo2 = ivec4 (0,0,0,vi3);\n}","geometryShader":null,"programUniforms":{"viewProj":{"tag":"M44F"}}}],"samplers":[],"tag":"Pipeline","backend":{"tag":"OpenGL33"},"streams":[],"targets":[{"tag":"RenderTarget","renderTargets":[{"tag":"TargetItem","targetSemantic":{"tag":"Color"},"targetRef":{"tag":"TextureImage","arg0":0,"arg1":0,"arg2":null}}]}],"info":"generated by lambdacube-compiler 0.6.1.0"}
\ No newline at end of file
diff --git a/examples/pickInt.lc b/examples/pickInt.lc
new file mode 100644
index 0000000..a75bc19
--- /dev/null
+++ b/examples/pickInt.lc
@@ -0,0 +1,21 @@
+type FB = FrameBuffer 1 '[ 'Color (Vec 4 Int)]
+
+scene :: String -> FB -> FB
+scene name prevFB =
+  Accumulate    ((ColorOp NoBlending (one :: Vec 4 Bool)))
+  (mapFragments (\(uv, rgba) -> ((rgba)))
+   $ rasterizePrimitives (TriangleCtx CullFront PolygonFill NoOffset LastVertex) (Flat, Flat)
+   $ mapPrimitives
+    (\(pos, color, id)->
+      ( (Uniform "viewProj" :: Mat 4 4 Float) *. (V4 pos%x pos%y 0 1)
+      , V2 0.0 0.0
+      , V4 0 0 0 id))
+    $ fetch name ( Attribute "position"   :: Vec 3 Float
+                 , Attribute "color"      :: Vec 4 Float
+                 , Attribute "id"         :: Int))
+  prevFB
+
+main :: Output
+main = TextureOut (V2 800 600) $
+       scene "objects" $
+       FrameBuffer ((colorImage1 (V4 0 0 0 0)))
diff --git a/examples/pickIntDraw.json b/examples/pickIntDraw.json
new file mode 100644
index 0000000..610caf3
--- /dev/null
+++ b/examples/pickIntDraw.json
@@ -0,0 +1 @@
+{"textures":[],"commands":[{"tag":"SetRenderTarget","arg0":0},{"tag":"ClearRenderTarget","arg0":[{"tag":"ClearImage","clearValue":{"tag":"VV4F","arg0":{"w":0,"z":0,"x":0,"y":0}},"imageSemantic":{"tag":"Color"}}]},{"tag":"SetProgram","arg0":0},{"tag":"SetRasterContext","arg0":{"arg3":{"tag":"LastVertex"},"tag":"TriangleCtx","arg0":{"tag":"CullFront","arg0":{"tag":"CCW"}},"arg1":{"tag":"PolygonFill"},"arg2":{"tag":"NoOffset"}}},{"tag":"SetAccumulationContext","arg0":{"accViewportName":null,"tag":"AccumulationContext","accOperations":[{"tag":"ColorOp","arg0":{"tag":"NoBlending"},"arg1":{"tag":"VV4B","arg0":{"w":true,"z":true,"x":true,"y":true}}}]}},{"tag":"RenderSlot","arg0":0}],"slots":[{"tag":"Slot","slotPrimitive":{"tag":"Triangles"},"slotStreams":{"color":{"tag":"V4F"},"id":{"tag":"Int"},"position":{"tag":"V3F"}},"slotName":"objects","slotUniforms":{"viewProj":{"tag":"M44F"}},"slotPrograms":[0]}],"programs":[{"programInTextures":{},"tag":"Program","programOutput":[{"tag":"Parameter","ty":{"tag":"V4F"},"name":"f0"}],"programStreams":{"vi3":{"tag":"Parameter","ty":{"tag":"Int"},"name":"id"},"vi2":{"tag":"Parameter","ty":{"tag":"V4F"},"name":"color"},"vi1":{"tag":"Parameter","ty":{"tag":"V3F"},"name":"position"}},"fragmentShader":"#version 330 core\nvec4 texture2D(sampler2D s,vec2 uv) {\n    return texture(s,uv);\n}\nflat in vec2 vo1;\nflat in vec4 vo2;\nout vec4 f0;\nvoid main() {\n    f0 = vo2;\n}","vertexShader":"#version 330 core\nvec4 texture2D(sampler2D s,vec2 uv) {\n    return texture(s,uv);\n}\nuniform mat4 viewProj;\nin vec3 vi1;\nin vec4 vi2;\nin int vi3;\nflat out vec2 vo1;\nflat out vec4 vo2;\nvoid main() {\n    gl_Position = (viewProj) * (vec4 ((vi1).x,(vi1).y,0.0,1.0));\n    vo1 = vec2 (0.0,0.0);\n    vo2 = vi2;\n}","geometryShader":null,"programUniforms":{"viewProj":{"tag":"M44F"}}}],"samplers":[],"tag":"Pipeline","backend":{"tag":"OpenGL33"},"streams":[],"targets":[{"tag":"RenderTarget","renderTargets":[{"tag":"TargetItem","targetSemantic":{"tag":"Color"},"targetRef":{"tag":"Framebuffer","arg0":{"tag":"Color"}}}]}],"info":"generated by lambdacube-compiler 0.6.1.0"}
\ No newline at end of file
diff --git a/examples/pickIntDraw.lc b/examples/pickIntDraw.lc
new file mode 100644
index 0000000..fd1a587
--- /dev/null
+++ b/examples/pickIntDraw.lc
@@ -0,0 +1,21 @@
+type FB = FrameBuffer 1 '[ 'Color (Vec 4 Float)]
+
+scene :: String -> FB -> FB
+scene name prevFB =
+  Accumulate    ((ColorOp NoBlending (one :: Vec 4 Bool)))
+  (mapFragments (\(uv, rgba) -> ((rgba)))
+   $ rasterizePrimitives (TriangleCtx CullFront PolygonFill NoOffset LastVertex) (Flat, Flat)
+   $ mapPrimitives
+    (\(pos, color, id)->
+      ( (Uniform "viewProj" :: Mat 4 4 Float) *. (V4 pos%x pos%y 0 1)
+      , V2 0.0 0.0
+      , color))
+    $ fetch name ( Attribute "position"   :: Vec 3 Float
+                 , Attribute "color"      :: Vec 4 Float
+                 , Attribute "id"         :: Int))
+  prevFB
+
+main :: Output
+main = ScreenOut $
+       scene "objects" $
+       FrameBuffer ((colorImage1 (V4 0 0 0 0)))
diff --git a/lambdacube-gl.cabal b/lambdacube-gl.cabal
index d473889..1859262 100644
--- a/lambdacube-gl.cabal
+++ b/lambdacube-gl.cabal
@@ -79,11 +79,34 @@ executable lambdacube-gl-hello
     bytestring >=0.10 && <0.11,
     vector >=0.12 && <0.13,
     JuicyPixels >=3.2 && <3.3,
-    aeson >= 1.1.2 && <1.3,
-    GLFW-b >= 1.4 && <1.5,
+    aeson >= 1.1.2,
+    GLFW-b >= 1.4,
     lambdacube-gl,
     lambdacube-ir == 0.3.*
 
+executable lambdacube-gl-pickint
+  if flag(example)
+    Buildable: True
+  else
+    Buildable: False
+
+  hs-source-dirs:   examples
+  main-is:          pickInt.hs
+  default-language: Haskell2010
+
+  build-depends:
+    GLFW-b >= 1.4,
+    JuicyPixels >=3.2,
+    OpenGLRaw,
+    aeson >= 1.1.2,
+    base,
+    bytestring >=0.10,
+    containers >=0.5,
+    lambdacube-gl,
+    lambdacube-ir,
+    vect,
+    vector >=0.12
+
 executable lambdacube-gl-hello-obj
   if flag(example)
     Buildable: True
@@ -103,8 +126,8 @@ executable lambdacube-gl-hello-obj
     bytestring >=0.10 && <0.11,
     vector >=0.12 && <0.13,
     JuicyPixels >=3.2 && <3.3,
-    aeson >= 1.1.2 && <1.3,
-    GLFW-b >= 1.4 && <1.5,
+    aeson >= 1.1.2,
+    GLFW-b >= 1.4,
     wavefront >= 0.7 && <1,
     lambdacube-gl,
     lambdacube-ir == 0.3.*
@@ -132,10 +155,10 @@ executable lambdacube-gl-test-client
     base64-bytestring >=1 && <1.1,
     vector >=0.12 && <0.13,
     JuicyPixels >=3.2 && <3.3,
-    aeson >= 1.1 && <1.3,
+    aeson >= 1.1.2,
     websockets >= 0.10 && <1,
     network >= 2.6 && <2.7,
     OpenGLRaw >=3.2 && <4,
-    GLFW-b >= 1.4 && <1.5,
+    GLFW-b >= 1.4,
     lambdacube-gl,
     lambdacube-ir == 0.3.*
diff --git a/src/LambdaCube/GL/Backend.hs b/src/LambdaCube/GL/Backend.hs
index 324b3e6..0584a34 100644
--- a/src/LambdaCube/GL/Backend.hs
+++ b/src/LambdaCube/GL/Backend.hs
@@ -126,7 +126,7 @@ setupAccumulationContext (AccumulationContext n ops) = cvt ops
                 glDepthFunc $! comparisonFunctionToGLType df
                 glDepthMask (cvtBool dm)
         cvtC 0 xs
-    cvt xs = do 
+    cvt xs = do
         glDisable GL_DEPTH_TEST
         glDisable GL_STENCIL_TEST
         cvtC 0 xs
@@ -169,8 +169,8 @@ setupAccumulationContext (AccumulationContext n ops) = cvt ops
     cvtBool True  = 1
     cvtBool False = 0
 
-clearRenderTarget :: [ClearImage] -> IO ()
-clearRenderTarget values = do
+clearRenderTarget :: GLRenderTarget -> [ClearImage] -> IO ()
+clearRenderTarget GLRenderTarget{..} values = do
     let setClearValue (m,i) value = case value of
             ClearImage Depth (VFloat v) -> do
                 glDepthMask 1
@@ -180,20 +180,46 @@ clearRenderTarget values = do
                 glClearStencil $ fromIntegral v
                 return (m .|. GL_STENCIL_BUFFER_BIT, i)
             ClearImage Color c -> do
-                let (r,g,b,a) = case c of
-                        VFloat r            -> (realToFrac r, 0, 0, 1)
-                        VV2F (V2 r g)       -> (realToFrac r, realToFrac g, 0, 1)
-                        VV3F (V3 r g b)     -> (realToFrac r, realToFrac g, realToFrac b, 1)
-                        VV4F (V4 r g b a)   -> (realToFrac r, realToFrac g, realToFrac b, realToFrac a)
-                        _                   -> (0,0,0,1)
                 glColorMask 1 1 1 1
-                glClearColor r g b a
-                return (m .|. GL_COLOR_BUFFER_BIT, i+1)
+                if framebufferObject == 0
+                then
+                  clearDefaultFB >>
+                  pure (m .|. GL_COLOR_BUFFER_BIT, i+1)
+                else
+                  clearFBColorAttachment >>
+                  pure (m, i+1)
+                where
+                  clearDefaultFB = do
+                    let (r,g,b,a) = case c of
+                          VFloat r            -> (realToFrac r, 0, 0, 1)
+                          VV2F (V2 r g)       -> (realToFrac r, realToFrac g, 0, 1)
+                          VV3F (V3 r g b)     -> (realToFrac r, realToFrac g, realToFrac b, 1)
+                          VV4F (V4 r g b a)   -> (realToFrac r, realToFrac g, realToFrac b, realToFrac a)
+                          _                   -> (0,0,0,1)
+                    glClearColor r g b a
+                  clearFBColorAttachment = do
+                    let buf = GL_COLOR
+                    case c of -- there must be some clever way to extract the generality here, I'm sure..
+                      VFloat r            -> with (V4 r 0 0 1) $ glClearBufferfv buf i . castPtr
+                      VV2F (V2 r g)       -> with (V4 r g 0 1) $ glClearBufferfv buf i . castPtr
+                      VV3F (V3 r g b)     -> with (V4 r g b 1) $ glClearBufferfv buf i . castPtr
+                      VV4F (V4 r g b a)   -> with (V4 r g b a) $ glClearBufferfv buf i . castPtr
+                  
+                      VInt r              -> with (V4 r 0 0 1) $ glClearBufferiv buf i . castPtr
+                      VV2I (V2 r g)       -> with (V4 r g 0 1) $ glClearBufferiv buf i . castPtr
+                      VV3I (V3 r g b)     -> with (V4 r g b 1) $ glClearBufferiv buf i . castPtr
+                      VV4I (V4 r g b a)   -> with (V4 r g b a) $ glClearBufferiv buf i . castPtr
+                  
+                      VWord r             -> with (V4 r 0 0 1) $ glClearBufferiv buf i . castPtr
+                      VV2U (V2 r g)       -> with (V4 r g 0 1) $ glClearBufferiv buf i . castPtr
+                      VV3U (V3 r g b)     -> with (V4 r g b 1) $ glClearBufferiv buf i . castPtr
+                      VV4U (V4 r g b a)   -> with (V4 r g b a) $ glClearBufferiv buf i . castPtr
+                      _ -> error $ "internal error: unsupported color attachment format: " <> show c
+
             _ -> error "internal error (clearRenderTarget)"
     (mask,_) <- foldM setClearValue (0,0) values
     glClear $ fromIntegral mask
 
-
 printGLStatus = checkGL >>= print
 printFBOStatus = checkFBO >>= print
 
@@ -283,6 +309,15 @@ compileProgram p = do
         , inputStreams          = Map.fromList [(n,(idx, attrName)) | (n,idx) <- Map.toList $ attributes, let attrName = fromMaybe (error $ "missing attribute: " ++ n) $ Map.lookup n lcStreamName]
         }
 
+renderTargetOutputs :: Vector GLTexture -> RenderTarget -> GLRenderTarget -> [GLOutput]
+renderTargetOutputs glTexs (RenderTarget targetItems) (GLRenderTarget fbo bufs) =
+    let isFB (Framebuffer _)    = True
+        isFB _                  = False
+        images = [img | TargetItem _ (Just img) <- V.toList targetItems]
+    in case all isFB images of
+         True  -> fromMaybe [] $ (GLOutputDrawBuffer fbo <$>) <$> bufs
+         False -> (\(TextureImage texIdx _ _)-> GLOutputRenderTexture fbo $ glTexs ! texIdx) <$> images
+
 compileRenderTarget :: Vector TextureDescriptor -> Vector GLTexture -> RenderTarget -> IO GLRenderTarget
 compileRenderTarget texs glTexs (RenderTarget targets) = do
     let isFB (Framebuffer _)    = True
@@ -344,7 +379,7 @@ compileRenderTarget texs glTexs (RenderTarget targets) = do
                             | n > 1             -> attachArray
                             | otherwise         -> attach2D
                         TextureBuffer _         -> fail "internalError (compileRenderTarget/TextureBuffer)!"
-            
+
                 go a (TargetItem Stencil (Just img)) = do
                     fail "Stencil support is not implemented yet!"
                     return a
@@ -453,7 +488,7 @@ createStreamCommands texUnitMap topUnis attrs primitive prg = streamUniCmds ++ s
 
     -- object attribute stream commands
     streamCmds = [attrCmd i s | (i,name) <- Map.elems attrMap, let s = fromMaybe (error $ "missing attribute: " ++ name) $ Map.lookup name attrs]
-      where 
+      where
         attrMap = inputStreams prg
         attrCmd i s = case s of
             Stream ty (Buffer arrs bo) arrIdx start len -> case ty of
@@ -488,16 +523,25 @@ createStreamCommands texUnitMap topUnis attrs primitive prg = streamUniCmds ++ s
             -- constant generic attribute
             constAttr -> GLSetVertexAttrib i constAttr
 
+outputIsRenderTexture :: GLOutput -> Bool
+outputIsRenderTexture GLOutputRenderTexture{..} = True
+outputIsRenderTexture _                         = False
+
 allocRenderer :: Pipeline -> IO GLRenderer
 allocRenderer p = do
     smps <- V.mapM compileSampler $ samplers p
     texs <- V.mapM compileTexture $ textures p
-    trgs <- V.mapM (compileRenderTarget (textures p) texs) $ targets p
+    let cmds                 = V.toList $ commands p
+        finalRenderTargetIdx = head [i | SetRenderTarget i <- reverse $ cmds]
+    trgs <- traverse (compileRenderTarget (textures p) texs) $ targets p
+    let finalRenderTarget   = targets p ! finalRenderTargetIdx
+        finalGLRenderTarget = trgs      ! finalRenderTargetIdx
+        outs                = renderTargetOutputs texs finalRenderTarget finalGLRenderTarget
     prgs <- V.mapM compileProgram $ programs p
     -- texture unit mapping ioref trie
     -- texUnitMapRefs :: Map UniformName (IORef TextureUnit)
     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
+    let st = execState (mapM_ (compileCommand texUnitMapRefs smps texs trgs prgs) cmds) initCGState
     input <- newIORef Nothing
     -- default Vertex Array Object
     vao <- alloca $! \pvao -> glGenVertexArrays 1 pvao >> peek pvao
@@ -515,6 +559,7 @@ allocRenderer p = do
         , glCommands        = reverse $ drawCommands st
         , glSlotPrograms    = V.map (V.toList . slotPrograms) $ IR.slots p
         , glInput           = input
+        , glOutputs         = outs
         , glSlotNames       = V.map slotName $ IR.slots p
         , glVAO             = vao
         , glTexUnitMapping  = texUnitMapRefs
@@ -573,7 +618,7 @@ isSubTrie eqFun universe subset = and [isMember a (Map.lookup n universe) | (n,a
             when (sPrim /= (primitiveToFetchPrimitive prim)) $ throw $ userError $
                 "Primitive mismatch for slot (" ++ show slotName ++ ") expected " ++ show sPrim  ++ " but got " ++ show prim
             let sType = fmap streamToStreamType attribs
-            when (sType /= sAttrs) $ throw $ userError $ unlines $ 
+            when (sType /= sAttrs) $ throw $ userError $ unlines $
                 [ "Attribute stream mismatch for slot (" ++ show slotName ++ ") expected "
                 , show sAttrs
                 , " but got "
@@ -790,7 +835,7 @@ renderFrame GLRenderer{..} = do
         case cmd of
             GLClearRenderTarget rt vals -> do
               setupRenderTarget glInput rt
-              clearRenderTarget vals
+              clearRenderTarget rt vals
               modifyIORef glDrawContextRef $ \ctx -> ctx {glRenderTarget = rt}
 
             GLRenderStream ctx streamIdx progIdx -> do
@@ -895,4 +940,4 @@ compileCommand texUnitMap samplers textures targets programs cmd = case cmd of
                                     case IM.lookup tu tb of
                                         Nothing     -> fail "internal error (GenerateMipMap)!"
                                         Just tex    -> return $ GLGenerateMipMap (GL_TEXTURE0 + fromIntegral tu) (glTextureTarget tex)
--}
\ No newline at end of file
+-}
diff --git a/src/LambdaCube/GL/Type.hs b/src/LambdaCube/GL/Type.hs
index 49491ed..bd3f827 100644
--- a/src/LambdaCube/GL/Type.hs
+++ b/src/LambdaCube/GL/Type.hs
@@ -152,6 +152,7 @@ data GLRenderer
     , glTextures        :: Vector GLTexture
     , glSamplers        :: Vector GLSampler
     , glTargets         :: Vector GLRenderTarget
+    , glOutputs         :: [GLOutput]
     , glCommands        :: [GLCommand]
     , glSlotPrograms    :: Vector [ProgramName] -- programs depend on a slot
     , glInput           :: IORef (Maybe InputConnection)
@@ -177,6 +178,16 @@ data GLRenderTarget
     , framebufferDrawbuffers    :: Maybe [GLenum]
     } deriving Eq
 
+data GLOutput
+    = GLOutputDrawBuffer
+      { glOutputFBO           :: GLuint
+      , glOutputDrawBuffer    :: GLenum
+      }
+    | GLOutputRenderTexture
+      { glOutputFBO           :: GLuint
+      , glOutputRenderTexture :: GLTexture
+      }
+
 type GLTextureUnit = Int
 type GLUniformBinding = GLint
 
diff --git a/src/LambdaCube/GL/Util.hs b/src/LambdaCube/GL/Util.hs
index bba322b..b267c7f 100644
--- a/src/LambdaCube/GL/Util.hs
+++ b/src/LambdaCube/GL/Util.hs
@@ -403,6 +403,8 @@ blendingFactorToGLType a = case a of
     SrcColor                -> GL_SRC_COLOR
     Zero                    -> GL_ZERO
 
+-- XXX: we need to extend IR.TextureDescriptor to carry component bit depth
+--      if we want to avoid making arbitrary decisions here
 textureDataTypeToGLType :: ImageSemantic -> TextureDataType -> GLenum
 textureDataTypeToGLType Color a = case a of
     FloatT Red  -> GL_R32F
@@ -412,8 +414,8 @@ textureDataTypeToGLType Color a = case a of
     IntT   RG   -> GL_RG32I
     WordT  RG   -> GL_RG32UI
     FloatT RGBA -> GL_RGBA32F
-    IntT   RGBA -> GL_RGBA32I
-    WordT  RGBA -> GL_RGBA32UI
+    IntT   RGBA -> GL_RGBA8I
+    WordT  RGBA -> GL_RGBA8UI
     a           -> error $ "FIXME: This texture format is not yet supported" ++ show a
 textureDataTypeToGLType Depth a = case a of
     FloatT Red  -> GL_DEPTH_COMPONENT32F
@@ -425,14 +427,14 @@ textureDataTypeToGLType Stencil a = case a of
 textureDataTypeToGLArityType :: ImageSemantic -> TextureDataType -> GLenum
 textureDataTypeToGLArityType Color a = case a of
     FloatT Red  -> GL_RED
-    IntT   Red  -> GL_RED
-    WordT  Red  -> GL_RED
+    IntT   Red  -> GL_RED_INTEGER
+    WordT  Red  -> GL_RED_INTEGER
     FloatT RG   -> GL_RG
-    IntT   RG   -> GL_RG
-    WordT  RG   -> GL_RG
+    IntT   RG   -> GL_RG_INTEGER
+    WordT  RG   -> GL_RG_INTEGER
     FloatT RGBA -> GL_RGBA
-    IntT   RGBA -> GL_RGBA
-    WordT  RGBA -> GL_RGBA
+    IntT   RGBA -> GL_RGBA_INTEGER
+    WordT  RGBA -> GL_RGBA_INTEGER
     a           -> error $ "FIXME: This texture format is not yet supported" ++ show a
 textureDataTypeToGLArityType Depth a = case a of
     FloatT Red  -> GL_DEPTH_COMPONENT