Use glTexStorage when resizing framebuffers

src/Preload/Update.hs

@@ -1,11 +1,16 @@
+{-# LANGUAGE NoMonomorphismRestriction #-}
 module Preload.Update
     ( resizeSpareFBO
     )
 where
 import Data.Preload
 import Data.Preload.Render
+
 import Graphics.Rendering.OpenGL
+import Graphics.GL.Core43
 import Foreign
+import Control.Lens
+import Control.Monad
 
 resizeSpareFBO 
     :: Int  -- ^ Lightmap width
@@ -17,31 +22,18 @@ resizeSpareFBO
 resizeSpareFBO xsize ysize xfull yfull pdata = do
 -- I am unsure how much of this needs to be bound...
     let rdata   = _renderData pdata
-        fboName = _spareFBO rdata
-        fboTO   = _fboTexture rdata
-        fboRBO  = _fboRenderbufferObject rdata
-        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)
-    framebufferTexture2D Framebuffer (ColorAttachment 0) Texture2D fboTO 0
-
-    bindRenderbuffer Renderbuffer $= fboRBO
-    renderbufferStorage Renderbuffer Depth24Stencil8 (RenderbufferSize xsize' ysize')
-    framebufferRenderbuffer Framebuffer DepthStencilAttachment Renderbuffer fboRBO
-    fboStatus <- framebufferStatus Framebuffer
-    putStrLn $ "after resize, framebuffer status:" ++ show fboStatus
-    resizeFBOTO (_fbo2 rdata) xfull yfull
-    resizeFBOTO (_fbo3 rdata) xfull yfull
+    --resizeFBOTO (_fbo3 rdata) xfull yfull
     resizeRBO (_rboBaseBloom rdata) xfull yfull
-    resizeFBOTO (_fboBase rdata) xfull yfull
-    resizeFBOTO (_fboBloom rdata) xfull yfull
-    resizeFBOTO (_fboColor rdata) xfull yfull
+    --resizeFBOTO (_fboBase rdata) xfull yfull
+    --resizeFBOTO (_fboBloom rdata) xfull yfull
+    --resizeFBOTO (_fboColor rdata) xfull yfull
     resizeRBO (_rboLighting rdata)   xsize ysize
-    resizeFBOTO (_fboLighting rdata) xsize ysize
-    
-    return pdata
+    --resizeFBOTO (_fboLighting rdata) xsize ysize
+    pdata' <- foldM (resizeFBOTO'' xfull yfull) pdata [fbo2, fbo3, fboBase, fboBloom, fboColor]
+    resizeFBOTO'' xsize ysize pdata' fboLighting
+    --foldM (resizeFBOTO'' xsize ysize) pdata [fbo2, fbo3, fboBase, fboBloom, fboColor]
+    --resizeFBOTO (_fboLighting rdata) xsize ysize
+    --return $ pdata & renderData . fbo2 .~ newfbo2
 
 resizeRBO
     :: RenderbufferObject
@@ -54,6 +46,38 @@ resizeRBO rboName xsize ysize = do
     bindRenderbuffer Renderbuffer $= rboName
     renderbufferStorage Renderbuffer Depth24Stencil8 (RenderbufferSize xsize' ysize')
 
+resizeFBOTO''
+    :: Int
+    -> Int
+    -> PreloadData a
+    -> ALens' RenderData (FramebufferObject, TextureObject)
+    -> IO (PreloadData a)
+resizeFBOTO'' xsize ysize pdata target = do
+    newfbo2 <- resizeFBOTO' (pdata ^# renderData . target) xsize ysize
+    return $ storing (renderData . target) newfbo2 pdata
+
+resizeFBOTO'
+    :: (FramebufferObject , TextureObject)
+    -> Int
+    -> Int
+    -> IO (FramebufferObject, TextureObject)
+resizeFBOTO' (fboName,toOld) xsize ysize = do
+    bindFramebuffer Framebuffer $= fboName
+    let xsize' = fromIntegral xsize
+        ysize' = fromIntegral ysize
+    deleteObjectName toOld
+    toName <- genObjectName
+    textureBinding Texture2D $= Just toName
+    glTexStorage2D GL_TEXTURE_2D 1 GL_RGBA8 xsize' ysize'
+    textureFilter Texture2D $= minMagFilter
+    framebufferTexture2D Framebuffer (ColorAttachment 0) Texture2D toName 0
+    fboStatus <- framebufferStatus Framebuffer
+    putStrLn $ "after resize, framebuffer status:" ++ show fboStatus
+    return (fboName, toName)
+
+minMagFilter :: ((TextureFilter, Maybe TextureFilter),TextureFilter)
+minMagFilter = ((Nearest,Nothing),Nearest)
+
 resizeFBOTO
     :: (FramebufferObject , TextureObject)
     -> Int