Separate rendering of background, bloom, lightmap into framebuffers

src/Dodge/Render.hs

@@ -29,7 +29,7 @@ import Foreign
 --import Control.Applicative
 --import Control.Monad.State
 import Control.Lens
---import Control.Monad
+import Control.Monad
 import qualified Control.Foldl as F
 import Data.Tuple.Extra
 --import Data.List
@@ -41,10 +41,98 @@ import Data.Tuple.Extra
 import Graphics.Rendering.OpenGL hiding (color,scale,translate,rotate)
 import qualified SDL
 
-{- | Central drawing function.
-Returns a 'Word32' that should give the number of ticks it took to evaluate.  -}
 doDrawing :: RenderData -> World -> IO Word32
 doDrawing pdata w = do
+    sTicks <- SDL.ticks
+    let rot     = _cameraRot w
+        camzoom    = _cameraZoom w
+        trans = _cameraCenter w
+        wins    = (getWindowX w,getWindowY w)
+        wallPointsCol   = wallsPointsAndCols w
+        --windowPoints    = wallsWindows w
+        lightPoints     = lightsForGloom w
+        --viewFroms@(viewFromx,viewFromy) = _cameraViewFrom w
+        viewFroms = _cameraViewFrom w
+        pic = worldPictures w
+        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)
+    clearColor $= Color4 0 0 0 0
+    clear [ColorBuffer,DepthBuffer]
+    depthFunc $= Just Less
+    if w ^. config . wall_textured
+        then renderTextureWalls pdata wallPointsCol
+        else renderBlankWalls pdata wallPointsCol
+--    _ <- setWallDepth pdata wallPoints (viewFromx,viewFromy)
+    _ <- renderFoldable pdata $ picToLTree (Just 0) (polysToPic $ foregroundPics w)
+    _ <- renderFoldable pdata $ picToLTree (Just 0) pic
+    _ <- renderShader (_textureArrayShader pdata) (_floorTiles w)
+
+    bindFramebuffer Framebuffer $= (fst $ (fst $ _fbos pdata) !! 1)
+    clear [ColorBuffer]
+    blendFunc $= (SrcAlpha,OneMinusSrcAlpha)
+    _ <- renderFoldable pdata $ picToLTree (Just 1) pic
+    depthMask $= Disabled
+    _ <- renderFoldable pdata $ picToLTree (Just 3) pic
+    _ <- renderFoldable pdata $ picToLTree (Just 4) pic
+    _ <- renderFoldable pdata $ picToLTree (Just 5) pic
+    --depthFunc $= Just Always
+    --bindFramebuffer Framebuffer $= fst3 (_fbo2 pdata)
+    --clear [ColorBuffer]
+    --bindShaderBuffers [_boxBlurShader pdata] [4]
+    --textureBinding Texture2D $= Just (snd $ (fst $ _fbos pdata) !! 1)
+    --textureFilter Texture2D $= ((Linear',Just Linear') , Linear')
+    --generateMipmap' Texture2D
+    --drawShader (_boxBlurShader pdata) 4
+    --replicateM_ 3 $ pingPongBlur pdata
+    --bindFramebuffer Framebuffer $= (fst $ (fst $ _fbos pdata) !! 1)
+    --textureBinding Texture2D $= Just (snd3 $ _fbo2 pdata)
+    --blendFunc $= (One,Zero)
+    --drawShader (_boxBlurShader pdata) 4
+    --depthFunc $= Just Less
+
+    depthMask $= Enabled
+
+    bindFramebuffer Framebuffer $= (fst $ (fst $ _fbos pdata) !! 2)
+    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
+    depthFunc $= Just Always
+    textureBinding Texture2D $= Just (snd $ head $ fst $ _fbos pdata)
+    drawShader (_fullscreenShader pdata) 4
+    --textureBinding Texture2D $= Just (snd3 $ _fbo2 pdata)
+    textureBinding Texture2D $= Just (snd $ (fst $ _fbos pdata) !! 2)
+    blend $= Enabled
+    blendFunc $= (Zero, OneMinusSrcAlpha)
+    drawShader (_fullscreenShader pdata) 4
+    blendFunc $= (SrcAlpha, OneMinusSrcAlpha)
+    textureBinding Texture2D $= Just (snd $ (fst $ _fbos pdata) !! 1)
+    drawShader (_fullscreenShader pdata) 4
+
+    -- draw overlay
+    bufferUBO $ isoMatrix 0 1 (0,0) (2,2)
+    --depthFunc $= Just Always
+    depthMask $= Enabled
+    blend $= Enabled
+    blendFunc $= (SrcAlpha,OneMinusSrcAlpha)
+    _ <- renderFoldable pdata (picToLTree Nothing $ fixedCoordPictures w)
+
+    eTicks <- SDL.ticks
+    return (eTicks - sTicks)
+
+{- | Central drawing function.
+Returns a 'Word32' that should give the number of ticks it took to evaluate.  -}
+doDrawing' :: RenderData -> World -> IO Word32
+doDrawing' pdata w = do
     clearColor $= Color4 0 0 0 1
     sTicks <- SDL.ticks
     clear [ColorBuffer,DepthBuffer]

src/Render.hs

@@ -46,10 +46,12 @@ setWallDepth pdata wallPoints (viewFromx,viewFromy) = do
 divideSize :: Int -> Size -> Size
 divideSize i (Size x y) = Size (div x $ fromIntegral i) (div y $ fromIntegral i)
 
+sizeToTexSize :: Size -> TextureSize2D
+sizeToTexSize (Size x y) = TextureSize2D x y
+
 {- | 
 Determine where light is shining in the world.
-Note that this currently (1/5/2021) sets the bound framebuffer to fbo2.
+  -}
-The lightmap itself is rendered into this buffer.  -}
 createLightMap 
     :: RenderData 
     -> Int                  -- Resolution division
@@ -61,9 +63,14 @@ createLightMap
 createLightMap pdata resDiv wallPoints lightPoints fpics scPol = do
     -- get viewport size so we can reset it later
     (vppos,vpsize) <- get viewport
-    -- set the viewport size to that of the render buffer
+    -- set the viewport size to desired fidelity
-    viewport $= (vppos, divideSize resDiv vpsize)
+    let vsize = divideSize resDiv vpsize
-    bindFramebuffer Framebuffer $= _spareFBO pdata
+    viewport $= (vppos, vsize)
+    textureBinding Texture2D $= Just (snd $ (fst $ _fbos pdata) !! 2)
+    texImage2D Texture2D NoProxy 0 RGBA8 (sizeToTexSize vsize) 0 (PixelData RGBA UnsignedByte nullPtr)
+    textureFilter Texture2D $= ((Linear',Just Linear') , Linear')
+    generateMipmap' Texture2D
+--    bindFramebuffer Framebuffer $= _spareFBO pdata
     -- store wall and light positions into buffer
     nWallLights <- F.foldM (pokeShader $ _lightingWallShader pdata) (map Render22 wallPoints)
     bindShaderBuffers [_lightingWallShader pdata] [nWallLights]
@@ -80,6 +87,7 @@ createLightMap pdata resDiv wallPoints lightPoints fpics scPol = do
     bindShaderBuffers [_lightingSurfaceShader pdata] [nsurfVs]
 -- clear buffer to full alpha and furthest depth
 -- clearColor is specified in preloadRender
+    clearColor $= Color4 0 0 0 1
     clear [ColorBuffer,DepthBuffer]
     cullFace $= Just Back
 -- draw walls from your point of view in order to set z buffer
@@ -153,23 +161,6 @@ createLightMap pdata resDiv wallPoints lightPoints fpics scPol = do
     -- set the viewport size to that of the window
     viewport $= (vppos, vpsize)
     -- disable depth testing for blurring
-    depthFunc $= Just Always
-    -- draw the lightmap on a full size fbo
-    bindFramebuffer Framebuffer $= fst3 (_fbo2 pdata)
-    colorMask $= Color4 Disabled Disabled Disabled Enabled
-    bindShaderBuffers [_boxBlurShader pdata] [4]
-    textureBinding Texture2D $= Just (_fboTexture pdata)
-    -- by upscaling the shadowmap texture and using Linear' magnification
-    -- interpolation, we get a poor mans blur, not sure about performance
-    textureFilter Texture2D $= ((Linear',Just Linear') , Linear')
-    generateMipmap' Texture2D
-    drawShader (_boxBlurShader pdata) 4
-    -- ping pong blur between '_fbo2' and '_fbo3' as many times as desired
-    replicateM_ 3 $ pingPongBlur pdata
-    -- reset drawing parameters ready for drawing on top of the light map
-    colorMask $= Color4 Enabled Enabled Enabled Enabled
-    depthMask $= Enabled
-    blend $= Enabled
 {- |
 Blur between two framebuffers.
 Assumes no depth testing is done (depthFunc %= Just Always).