Move towards attaching a position texture to base framebuffer

src/Framebuffer/Setup.hs

@@ -3,6 +3,7 @@
 module Framebuffer.Setup
     ( setupTextureFramebuffer
     , setupFramebufferGivenStencil
+    , setupFramebuffer2GivenStencil 
     ) where
 import Graphics.Rendering.OpenGL hiding (Point,translate,scale,imageHeight)
 import Graphics.GL.Core43
@@ -37,6 +38,18 @@ setupFramebufferGivenStencil rboName = do
     fboStatus <- framebufferStatus Framebuffer
     print fboStatus
     return (fboName,toName)
+setupFramebuffer2GivenStencil 
+    :: RenderbufferObject 
+    -> IO (FramebufferObject, (TextureObject,TextureObject))
+setupFramebuffer2GivenStencil rboName = do
+    fboName <- genObjectName
+    bindFramebuffer Framebuffer $= fboName
+    toName <- genObjectName
+    toName2 <- genObjectName
+    framebufferRenderbuffer Framebuffer DepthStencilAttachment Renderbuffer rboName
+    fboStatus <- framebufferStatus Framebuffer
+    print fboStatus
+    return (fboName,(toName,toName2))
 
 minMagFilter :: ((TextureFilter, Maybe TextureFilter),TextureFilter)
 minMagFilter = ((Nearest,Nothing),Nearest)

src/Framebuffer/Update.hs

@@ -23,8 +23,9 @@ sizeFBOs
     -> IO RenderData
 sizeFBOs xsize ysize xfull yfull rdata = do
     resizeRBO (_rboBaseBloom rdata) xsize ysize
-    rdata' <- foldM (updateFBOTO xsize ysize minMagFilter GL_RGBA8) rdata 
-        [fboBase, fboColor,fboLighting,fboLightingHigh]
+    rdata' <- updateFBOTO2 xsize ysize minMagFilter GL_RGBA8 GL_RGBA16F rdata fboBase
+        >>= flip (foldM (updateFBOTO xsize ysize minMagFilter GL_RGBA8))
+            [fboColor,fboLighting,fboLightingHigh]
     rdata'' <- foldM (updateFBOTO xsize ysize linMinMagFilter GL_RGBA16F) rdata' 
         [fboBloom, fboPos]
     rdata''' <- foldM (updateFBOTO xfull yfull minMagFilter GL_RGBA8) rdata'' 
@@ -55,6 +56,48 @@ updateFBOTO xsize ysize mmfilt inFormat pdata target = do
     newfbo2 <- resizeFBOTO (pdata ^# target) xsize ysize mmfilt inFormat
     return $ storing target newfbo2 pdata
 
+updateFBOTO2
+    :: Int
+    -> Int
+    -> ((TextureFilter, Maybe TextureFilter),TextureFilter)
+    -> GLenum   -- ^ internal color format texture1
+    -> GLenum   -- ^ internal color format texture2
+    -> RenderData
+    -> ALens' RenderData (FramebufferObject, (TextureObject,TextureObject))
+    -> IO RenderData
+updateFBOTO2 xsize ysize mmfilt inFormat1 inFormat2 pdata target = do
+    newfbo2 <- resizeFBOTO2 (pdata ^# target) xsize ysize mmfilt inFormat1 inFormat2
+    return $ storing target newfbo2 pdata
+
+resizeFBOTO2
+    :: (FramebufferObject , (TextureObject,TextureObject))
+    -> Int
+    -> Int
+    -> ((TextureFilter, Maybe TextureFilter),TextureFilter)
+    -> GLenum   -- ^ internal color format1
+    -> GLenum   -- ^ internal color format2
+    -> IO (FramebufferObject, (TextureObject,TextureObject))
+resizeFBOTO2 (fboName,(toOld1,toOld2)) xsize ysize mmfilt inFormat1 inFormat2 = do
+    bindFramebuffer Framebuffer $= fboName
+    let xsize' = fromIntegral xsize
+        ysize' = fromIntegral ysize
+    deleteObjectName toOld1
+    deleteObjectName toOld2
+    toName1 <- genObjectName
+    textureBinding Texture2D $= Just toName1
+    glTexStorage2D GL_TEXTURE_2D 1 inFormat1 xsize' ysize'
+    textureFilter Texture2D $= mmfilt
+    framebufferTexture2D Framebuffer (ColorAttachment 0) Texture2D toName1 0
+
+    toName2 <- genObjectName
+    textureBinding Texture2D $= Just toName2
+    glTexStorage2D GL_TEXTURE_2D 1 inFormat2 xsize' ysize'
+    textureFilter Texture2D $= mmfilt
+    framebufferTexture2D Framebuffer (ColorAttachment 1) Texture2D toName2 0
+    fboStatus <- framebufferStatus Framebuffer
+    putStrLn $ "after resize, framebuffer status:" ++ show fboStatus
+    return (fboName, (toName1,toName2))
+
 resizeFBOTO
     :: (FramebufferObject , TextureObject)
     -> Int