Tweak rendering

src/Data/Preload/Render.hs

@@ -25,6 +25,11 @@ data RenderData = RenderData
     , _fbo2                     :: (FramebufferObject, TextureObject, RenderbufferObject)
     , _fbo3                     :: (FramebufferObject, TextureObject, RenderbufferObject)
     , _fbos :: ( [(FramebufferObject, TextureObject) ] , RenderbufferObject )
+    , _fboBase                  :: (FramebufferObject, TextureObject)
+    , _fboBloom                 :: (FramebufferObject, TextureObject)
+    , _rboBaseBloom             :: RenderbufferObject
+    , _fboLighting              :: (FramebufferObject, TextureObject)
+    , _rboLighting              :: RenderbufferObject
     , _matUBO                   :: BufferObject
     }
 makeLenses ''RenderData

src/Dodge/Render.hs

@@ -57,7 +57,7 @@ doDrawing pdata w = do
         wallPoints = map fst wallPointsCol
     -- set the coordinate uniform ready for drawing elements using world coordinates
     bufferUBO $ perspectiveMatrixb rot camzoom trans wins viewFroms
-    bindFramebuffer Framebuffer $= (fst $ head $ fst $ _fbos pdata)
+    bindFramebuffer Framebuffer $= (fst $ _fboBase pdata)
     clearColor $= Color4 0 0 0 0
     clear [ColorBuffer,DepthBuffer]
     depthFunc $= Just Less
@@ -69,7 +69,7 @@ doDrawing pdata w = do
     _ <- renderFoldable pdata $ picToLTree (Just 0) pic
     _ <- renderShader (_textureArrayShader pdata) (_floorTiles w)
 
-    bindFramebuffer Framebuffer $= (fst $ (fst $ _fbos pdata) !! 1)
+    bindFramebuffer Framebuffer $= (fst $ _fboBloom pdata)
     clear [ColorBuffer]
     blendFunc $= (SrcAlpha,OneMinusSrcAlpha)
     _ <- renderFoldable pdata $ picToLTree (Just 1) pic
@@ -80,43 +80,43 @@ doDrawing pdata w = do
 
     depthMask $= Enabled
 
-    bindFramebuffer Framebuffer $= (fst $ (fst $ _fbos pdata) !! 2)
+    bindFramebuffer Framebuffer $= (fst $ _fboLighting pdata)
     let scPol = screenPolygon w
     createLightMap pdata (w ^. config . shadow_resolution) wallPoints lightPoints
         (foregroundPics w) scPol
     colorMask $= Color4 Enabled Enabled Enabled Enabled
-    depthMask $= Enabled
     clearColor $= Color4 0 0 0 0
 
     bindShaderBuffers [_fullscreenShader pdata] [4]
 
     --bindFramebuffer Framebuffer $= defaultFramebufferObject
     blend $= Disabled
+    depthMask $= Disabled
     depthFunc $= Just Always
     --textureBinding Texture2D $= Just (snd $ head $ fst $ _fbos pdata)
     --drawShader (_fullscreenShader pdata) 4
 
-    bindFramebuffer Framebuffer $= (fst $ head $ fst $ _fbos pdata)
+    bindFramebuffer Framebuffer $= (fst $ _fboBase pdata)
     --drawShader (_fullscreenShader pdata) 4
     --textureBinding Texture2D $= Just (snd3 $ _fbo2 pdata)
-    textureBinding Texture2D $= Just (snd $ (fst $ _fbos pdata) !! 2)
+    textureBinding Texture2D $= Just (snd $ _fboLighting pdata)
     textureFilter Texture2D $= ((Linear',Just Linear') , Linear')
     generateMipmap' Texture2D
     blend $= Enabled
     blendFunc $= (Zero, OneMinusSrcAlpha)
     drawShader (_fullscreenShader pdata) 4
     blendFunc $= (SrcAlpha, OneMinusSrcAlpha)
-    textureBinding Texture2D $= Just (snd $ (fst $ _fbos pdata) !! 1)
+    textureBinding Texture2D $= Just (snd $ _fboBloom pdata)
     drawShader (_fullscreenShader pdata) 4
 
-    depthFunc $= Just Less
+    depthFunc $= Just Lequal
-    --_ <- renderFoldable pdata $ picToLTree (Just 2) pic
+    _ <- renderFoldable pdata $ picToLTree (Just 2) pic
     renderBlankWalls pdata windowPoints
 
     depthFunc $= Just Always
     bindFramebuffer Framebuffer $= defaultFramebufferObject
     clear [ColorBuffer]
-    textureBinding Texture2D $= Just (snd $ head $ fst $ _fbos pdata)
+    textureBinding Texture2D $= Just (snd $ _fboBase pdata)
     drawShader (_fullscreenShader pdata) 4
 
     -- draw overlay

src/Preload/Render.hs

@@ -73,6 +73,18 @@ preloadRender = do
 
     frameBufs <- setupFramebuffersSharedStencil 6
 
+    rboLightingName <- genObjectName
+    bindRenderbuffer Renderbuffer $= rboLightingName
+    renderbufferStorage Renderbuffer Depth24Stencil8 (RenderbufferSize 800 600)
+    fboLightingName <- newFramebufferGivenStencil rboLightingName
+
+    rboBaseBloomName <- genObjectName
+    bindRenderbuffer Renderbuffer $= rboBaseBloomName
+    renderbufferStorage Renderbuffer Depth24Stencil8 (RenderbufferSize 800 600)
+
+    fboBaseName <- newFramebufferGivenStencil rboBaseBloomName
+    fboBloomName <- newFramebufferGivenStencil rboBaseBloomName
+
 -- reset to default framebuffer, ready for drawing direct to screen
     bindFramebuffer Framebuffer $= defaultFramebufferObject
 
@@ -99,6 +111,11 @@ preloadRender = do
         , _fbo2                     = framebuf2
         , _fbo3                     = framebuf3
         , _fbos = frameBufs
+        , _fboLighting = fboLightingName
+        , _rboLighting = rboLightingName
+        , _fboBase = fboBaseName
+        , _fboBloom = fboBloomName
+        , _rboBaseBloom = rboBaseBloomName
         , _matUBO = theUBO
         }
 cornerList :: [[Float]]

src/Preload/Update.hs

@@ -32,15 +32,17 @@ resizeSpareFBO xsize ysize xfull yfull pdata = do
     bindRenderbuffer Renderbuffer $= fboRBO
     renderbufferStorage Renderbuffer Depth24Stencil8 (RenderbufferSize xsize' ysize')
     framebufferRenderbuffer Framebuffer DepthStencilAttachment Renderbuffer fboRBO
-
     fboStatus <- framebufferStatus Framebuffer
     putStrLn $ "after resize, framebuffer status:" ++ show fboStatus
-
     resizeTextureFBO (_fbo2 rdata) xfull yfull
     resizeTextureFBO (_fbo3 rdata) xfull yfull
-
     resizeRBO (snd $ _fbos rdata) xfull yfull
     mapM_ (\p -> resizeFBOTO p xfull yfull) (fst $ _fbos rdata)
+    resizeRBO (_rboBaseBloom rdata) xfull yfull
+    resizeFBOTO (_fboBase rdata) xfull yfull
+    resizeFBOTO (_fboBloom rdata) xfull yfull
+    resizeRBO (_rboLighting rdata)   xsize ysize
+    resizeFBOTO (_fboLighting rdata) xsize ysize
     
     return pdata
 

src/Render.hs

@@ -66,9 +66,9 @@ createLightMap pdata resDiv wallPoints lightPoints fpics scPol = do
     -- set the viewport size to desired fidelity
     let vsize = divideSize resDiv vpsize
     viewport $= (vppos, vsize)
-    textureBinding Texture2D $= Just (snd $ (fst $ _fbos pdata) !! 2)
+    textureBinding Texture2D $= Just (snd $ _fboLighting pdata)
     -- this is a problem! it should be resized once on screen/parameter resize
-    texImage2D Texture2D NoProxy 0 RGBA8 (sizeToTexSize vsize) 0 (PixelData RGBA UnsignedByte nullPtr)
+    --texImage2D Texture2D NoProxy 0 RGBA8 (sizeToTexSize vsize) 0 (PixelData RGBA UnsignedByte nullPtr)
     textureFilter Texture2D $= ((Linear',Just Linear') , Linear')
     generateMipmap' Texture2D
 --    bindFramebuffer Framebuffer $= _spareFBO pdata