Separate rendering of background, bloom, lightmap into framebuffers

2021-07-04 19:14:16 +02:00
parent c627961aac
commit e6f95b0480
2 changed files with 104 additions and 25 deletions
@@ -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]