From c627961aaceeff6e2a58a867e8122dd1b90707f3 Mon Sep 17 00:00:00 2001
From: jgk <justin.g.kruger@gmail.com>
Date: Sun, 4 Jul 2021 14:41:46 +0200
Subject: [PATCH] Add framebuffers with shared renderbufferobject

---
 src/Data/Preload/Render.hs |  1 +
 src/Preload/Render.hs      | 41 ++++++++++++++++++++++++++++----------
 src/Preload/Update.hs      | 32 +++++++++++++++++++++++++++++
 3 files changed, 63 insertions(+), 11 deletions(-)

diff --git a/src/Data/Preload/Render.hs b/src/Data/Preload/Render.hs
index 8dc0b72c4..169a2cd74 100644
--- a/src/Data/Preload/Render.hs
+++ b/src/Data/Preload/Render.hs
@@ -24,6 +24,7 @@ data RenderData = RenderData
     , _fboRenderbufferObject    :: RenderbufferObject
     , _fbo2                     :: (FramebufferObject, TextureObject, RenderbufferObject)
     , _fbo3                     :: (FramebufferObject, TextureObject, RenderbufferObject)
+    , _fbos :: ( [(FramebufferObject, TextureObject) ] , RenderbufferObject )
     , _matUBO                   :: BufferObject
     }
 makeLenses ''RenderData
diff --git a/src/Preload/Render.hs b/src/Preload/Render.hs
index 5079868f3..48ed4c991 100644
--- a/src/Preload/Render.hs
+++ b/src/Preload/Render.hs
@@ -14,6 +14,7 @@ import Data.Preload.Render
 
 import Graphics.Rendering.OpenGL hiding (Point,translate,scale,imageHeight)
 --import Control.Lens
+import Control.Monad
 import Foreign
 
 preloadRender :: IO RenderData
@@ -69,6 +70,9 @@ preloadRender = do
     (fbo,fboTO,fboRBO) <- setupFramebufferWithStencil
     framebuf2 <- setupFramebufferWithStencil
     framebuf3 <- setupFramebufferWithStencil
+
+    frameBufs <- setupFramebuffersSharedStencil 6
+
 -- reset to default framebuffer, ready for drawing direct to screen
     bindFramebuffer Framebuffer $= defaultFramebufferObject
 
@@ -94,6 +98,7 @@ preloadRender = do
         , _fboRenderbufferObject    = fboRBO
         , _fbo2                     = framebuf2
         , _fbo3                     = framebuf3
+        , _fbos = frameBufs
         , _matUBO = theUBO
         }
 cornerList :: [[Float]]
@@ -127,17 +132,31 @@ setupFramebufferWithStencil = do
 
     return (fboName, fboTO, fboRBO)
 
-setupFramebuffersSharedStencil :: IO 
-    (   ( (FramebufferObject, TextureObject)
-        , (FramebufferObject, TextureObject)
-        , (FramebufferObject, TextureObject)
-        , (FramebufferObject, TextureObject)
-        , (FramebufferObject, TextureObject)
-        , (FramebufferObject, TextureObject)
-        )
-    , RenderbufferObject
-    )
-setupFramebuffersSharedStencil = undefined
+setupFramebuffersSharedStencil :: Int -> IO ( [(FramebufferObject,TextureObject)] , RenderbufferObject)
+setupFramebuffersSharedStencil n = do
+    rboName <- genObjectName
+    bindRenderbuffer Renderbuffer $= rboName
+    renderbufferStorage Renderbuffer Depth24Stencil8 (RenderbufferSize 800 600)
+    fbs <- replicateM n (newFramebufferGivenStencil rboName)
+    return (fbs,rboName)
+
+newFramebufferGivenStencil 
+    :: RenderbufferObject 
+    -> IO (FramebufferObject, TextureObject)
+newFramebufferGivenStencil rboName = do
+    fboName <- genObjectName
+    bindFramebuffer Framebuffer $= fboName
+    toName <- genObjectName
+    textureBinding Texture2D $= Just toName
+    texImage2D Texture2D NoProxy 0 RGBA8 (TextureSize2D 800 600) 0 (PixelData RGBA UnsignedByte nullPtr)
+    textureFilter Texture2D $= ((Linear',Just Linear') , Linear')
+    generateMipmap' Texture2D
+    framebufferTexture2D Framebuffer (ColorAttachment 0) Texture2D toName 0
+    framebufferRenderbuffer Framebuffer DepthStencilAttachment Renderbuffer rboName
+    fboStatus <- framebufferStatus Framebuffer
+    print fboStatus
+    return (fboName,toName)
+    
 
 setupFramebuffer :: IO (FramebufferObject, TextureObject)
 setupFramebuffer = do
diff --git a/src/Preload/Update.hs b/src/Preload/Update.hs
index e2ff1a4ab..38fbbce32 100644
--- a/src/Preload/Update.hs
+++ b/src/Preload/Update.hs
@@ -38,6 +38,9 @@ resizeSpareFBO xsize ysize xfull yfull pdata = do
 
     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)
     
     return pdata
 
@@ -62,3 +65,32 @@ resizeTextureFBO (fboName,fboTO,fboRBO) xsize ysize = do
 
     fboStatus <- framebufferStatus Framebuffer
     putStrLn $ "after resize, framebuffer status:" ++ show fboStatus
+
+resizeRBO
+    :: RenderbufferObject
+    -> Int
+    -> Int
+    -> IO ()
+resizeRBO rboName xsize ysize = do
+    let xsize' = fromIntegral xsize
+        ysize' = fromIntegral ysize
+    bindRenderbuffer Renderbuffer $= rboName
+    renderbufferStorage Renderbuffer Depth24Stencil8 (RenderbufferSize xsize' ysize')
+
+resizeFBOTO
+    :: (FramebufferObject , TextureObject)
+    -> Int
+    -> Int
+    -> IO ()
+resizeFBOTO (fboName,fboTO) xsize ysize = do
+    let xsize' = fromIntegral xsize
+        ysize' = fromIntegral ysize
+    bindFramebuffer Framebuffer $= fboName
+    textureBinding Texture2D $= Just fboTO
+    texImage2D Texture2D NoProxy 0 RGBA8 (TextureSize2D xsize' ysize') 0 (PixelData RGBA UnsignedByte nullPtr)
+    textureFilter Texture2D $= ((Linear',Just Linear') , Nearest)
+    generateMipmap' Texture2D
+    framebufferTexture2D Framebuffer (ColorAttachment 0) Texture2D fboTO 0
+    fboStatus <- framebufferStatus Framebuffer
+    putStrLn $ "after resize, framebuffer status:" ++ show fboStatus
+