Partially implement a framebuffer object for bluring shadows

src/Picture/Preload.hs

@@ -18,13 +18,18 @@ import Shader
 
 import Geometry (Point2)
 
+import qualified Control.Foldl as F
+
 data RenderData = RenderData
     { _lightSourceShader :: FullShader (Float,Float,Float,Float)
     , _wallShadowShader  :: FullShader (Point2,Point2,Point2,Point2)
     , _backgroundShader  :: FullShader (Point2,Point2,Point2,Point2)
+    , _fullscreenShader  :: FullShader ()
     , _listShaders :: [FullShader RenderType]
     , _dummyVBO :: BufferObject
     , _dummyPtr :: Ptr Float
+    , _spareFBO :: FramebufferObject
+    , _fboTexture :: TextureObject
     }
 
 makeLenses ''RenderData
@@ -52,6 +57,16 @@ preloadRender = do
     bezierQuadShader
            <- makeShader "bezierQuad" [vert,frag] [(0,3),(1,4),(2,4)]    TriangleStrip pokeBezQStrat
 
+    fsShad <- makeShader "fullscreen" [vert,frag] [(0,2),(1,2)] TriangleStrip 
+                                (const [[[-1, 1],[0,1]]
+                                       ,[[ 1, 1],[1,1]]
+                                       ,[[-1,-1],[0,0]]
+                                       ,[[ 1,-1],[1,0]]
+                                       ]
+                                 )
+    n <- F.foldM (pokeShader fsShad) [()]
+    putStrLn $ show n
+
 --the following vbo is set up to contain one fixed vertex
     dummyvbo <- genObjectName
     dummyptr <- mallocArray numDrawableElements
@@ -62,6 +77,10 @@ preloadRender = do
 -- input a list of (attribute location, attrib length) pairs
 -- these will have buffers and pointers created
     backgroundvao <- setupVAO [(0,4),(1,2)]
+
+    (fbo,fboTO) <- setupFramebuffer
+
+    bindFramebuffer Framebuffer $= defaultFramebufferObject
     
     return $ RenderData
         { _listShaders = [bslist,lslist,cslist,aslist,eslist,bezierQuadShader]
@@ -70,10 +89,37 @@ preloadRender = do
         , _lightSourceShader = lsShad
         , _wallShadowShader  = wsShad
         , _backgroundShader  = bgShad
+        , _fullscreenShader  = fsShad
+        , _spareFBO = fbo
+        , _fboTexture = fboTO
         }
 
 
 --------------------end preloadRender
+
+setupFramebuffer :: IO (FramebufferObject, TextureObject)
+setupFramebuffer = do
+    fboName <- genObjectName
+    bindFramebuffer Framebuffer $= fboName
+
+    fboTO <- genObjectName
+    textureBinding Texture2D $= Just fboTO
+    texImage2D Texture2D NoProxy 0 RGBA8 (TextureSize2D 800 600) 0 (PixelData RGBA UnsignedByte nullPtr)
+    textureFilter Texture2D $= ((Linear',Just Linear') , Nearest)
+    generateMipmap' Texture2D
+    framebufferTexture2D Framebuffer (ColorAttachment 0) Texture2D fboTO 0
+
+    fboRBO <- genObjectName
+    bindRenderbuffer Renderbuffer $= fboRBO
+    renderbufferStorage Renderbuffer Depth24Stencil8 (RenderbufferSize 800 600)
+                                    -- not sure if the stencil is needed
+
+    fboStatus <- framebufferStatus Framebuffer
+    putStrLn $ show fboStatus
+
+    return (fboName, fboTO)
+
+
 cleanUpRenderPreload :: RenderData -> IO ()
 cleanUpRenderPreload pd = do
     mapM_ freeShaderPointers $ _listShaders pd

src/Picture/Render.hs

@@ -49,6 +49,12 @@ renderPicture' pdata rot zoom (tranx,trany) (winx,winy) wallPoints lightPoints p
         )
 
 -- draw lightmap
+
+    bindFramebuffer Framebuffer $= (_spareFBO pdata)
+    clearColor $= Color4 0 0.5 0 1
+    clearDepth $= (200)
+    clear [ColorBuffer]
+
     nWalls <- F.foldM (pokeShader (_wallShadowShader pdata)) wallPoints
     bindShaderBuffers [_wallShadowShader pdata] [nWalls]
 
@@ -78,10 +84,24 @@ renderPicture' pdata rot zoom (tranx,trany) (winx,winy) wallPoints lightPoints p
     ticksS <- SDL.ticks
     ticksAfterL <- SDL.ticks
 
+    blend $= Disabled
+
+--    blendFunc $= (Zero,One)
+    bindFramebuffer Framebuffer $= defaultFramebufferObject
+--
+--    blendFunc $= (SrcAlpha, OneMinusSrcAlpha)
+    bindShaderBuffers [_fullscreenShader pdata] [4]
+    textureBinding Texture2D $= Just (_fboTexture pdata)
+--    blendFunc $= (One, Zero)
+    drawShader (_fullscreenShader pdata) 4
+
+    blend $= Enabled
+
 -- draw picture on top of light/shadow map
 -- set drawing for on top
     blendFuncSeparate    $= ((SrcAlphaSaturate, OneMinusSrcAlpha), (Zero,One))
     clear [DepthBuffer]
+
 -- draw background
     bindArrayBuffers 1 $ _vaoBufferTargets $ _shaderVAO $ _backgroundShader pdata
     depthFunc $= Just Less