Move towards attaching a position texture to base framebuffer

src/Data/Preload/Render.hs

@@ -32,7 +32,7 @@ data RenderData = RenderData
     , _fbo3                     :: (FramebufferObject, TextureObject)
     , _fboFourth1 :: (FramebufferObject, TextureObject)
     , _fboFourth2 :: (FramebufferObject, TextureObject)
-    , _fboBase                  :: (FramebufferObject, TextureObject)
+    , _fboBase                  :: (FramebufferObject, (TextureObject, TextureObject))
     , _fboBloom                 :: (FramebufferObject, TextureObject)
     , _fboColor                 :: (FramebufferObject, TextureObject)
     , _fboPos                   :: (FramebufferObject, TextureObject)

src/Dodge/Render.hs

@@ -19,6 +19,7 @@ import Shader.Data
 import MatrixHelper
 --import Polyhedra.Data
 import Polyhedra
+import Tuple
 
 import Foreign
 --import Control.Applicative
@@ -59,8 +60,9 @@ doDrawing pdata w = do
     -- poke foreground geometry and floor
     let addC (V2 xx yy) = V3 xx yy 0
     nsurfVs <- pokePoint3s (shadVBOptr $ _lightingSurfaceShader pdata)
-        $ youBox w
+        $ 
-        ++ concatMap polyToGeoRender (foregroundPics w)
+        --youBox w ++ 
+        concatMap polyToGeoRender (foregroundPics w)
         ++ polyToTris (map addC $ screenPolygon w)
     -- bind wall points, silhouette data, surface geometry
     uncurry bindShaderBuffers $ unzip
@@ -187,7 +189,7 @@ doDrawing pdata w = do
     -- perform any radial distortion
     case _radDistortion w of
         [] -> do
-            bindTO $ snd $ _fboBase pdata
+            bindTO $ fst $ snd $ _fboBase pdata
             bindFramebuffer Framebuffer $= defaultFramebufferObject
             --bufferUBO $ perspectiveMatrixb rot camzoom trans wins viewFroms
             drawShader (_fullscreenShader pdata) 4
@@ -200,7 +202,7 @@ doDrawing pdata w = do
                     drawShader (_barrelShader pdata) 1
                 fboList = take (length rds - 1) (concat (repeat [fst $ _fbo2 pdata,fst $ _fbo3 pdata]))
                         ++ [defaultFramebufferObject]
-                toList = snd (_fboBase pdata) : concat (repeat [snd $ _fbo2 pdata,snd $ _fbo3 pdata])
+                toList = fst (snd (_fboBase pdata)) : concat (repeat [snd $ _fbo2 pdata,snd $ _fbo3 pdata])
                 bindings = zipWith (>>) (map bindFBO fboList) (map bindTO toList)
             activeTexture $= TextureUnit 1
             zipWithM_ (>>) bindings $ map bindDrawDist rds

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 
+    rdata' <- updateFBOTO2 xsize ysize minMagFilter GL_RGBA8 GL_RGBA16F rdata fboBase
-        [fboBase, fboColor,fboLighting,fboLightingHigh]
+        >>= 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

src/Preload/Render.hs

@@ -101,16 +101,16 @@ preloadRender = do
     framebuf2 <- setupTextureFramebuffer 800 600
     framebuf3 <- setupTextureFramebuffer 800 600
 
-    rboLightingName <- genObjectName
+    --rboLightingName <- genObjectName
-    bindRenderbuffer Renderbuffer $= rboLightingName
+    --bindRenderbuffer Renderbuffer $= rboLightingName
-    renderbufferStorage Renderbuffer Depth24Stencil8 (RenderbufferSize 800 600)
+    --renderbufferStorage Renderbuffer Depth24Stencil8 (RenderbufferSize 800 600)
     --fboLightingName <- setupFramebufferGivenStencil rboLightingName
 
     rboBaseBloomName <- genObjectName
     bindRenderbuffer Renderbuffer $= rboBaseBloomName
     renderbufferStorage Renderbuffer Depth24Stencil8 (RenderbufferSize 800 600)
 
-    fboBaseName  <- setupFramebufferGivenStencil rboBaseBloomName
+    fboBaseName  <- setupFramebuffer2GivenStencil rboBaseBloomName
     fboBloomName <- setupFramebufferGivenStencil rboBaseBloomName
     fboColorName <- setupFramebufferGivenStencil rboBaseBloomName
     fboPosName   <- setupFramebufferGivenStencil rboBaseBloomName