Use glTexStorage when resizing framebuffers

src/Data/Preload/Render.hs

@@ -13,7 +13,6 @@ data RenderData = RenderData
     , _lightingLineShadowShader :: FullShader
     , _wallBlankShader          :: FullShader
     , _wallTextureShader        :: FullShader
-    , _textureShader            :: FullShader
     , _textureArrayShader       :: FullShader
     , _fullscreenShader         :: FullShader
     , _fullscreenAlphaHalveShader         :: FullShader
@@ -23,9 +22,6 @@ data RenderData = RenderData
     , _barrelShader             :: FullShader
     , _grayscaleShader          :: FullShader
     , _pictureShaders           :: [FullShader]
-    , _spareFBO                 :: FramebufferObject
-    , _fboTexture               :: TextureObject
-    , _fboRenderbufferObject    :: RenderbufferObject
     , _fbo2                     :: (FramebufferObject, TextureObject)
     , _fbo3                     :: (FramebufferObject, TextureObject)
     , _fboFourth1 :: (FramebufferObject, TextureObject)

src/Preload/Render.hs

@@ -85,16 +85,11 @@ preloadRender = do
 -- textured wallShader
     wlTexture <- makeShader "wall/texture" [vert,geom,frag] [4,4] EPoints pokeWPColStrat
                 >>= addTexture "data/texture/grayscaleDirt.png"
----- texture shader
-    textShad <- makeShader "texture/simpleWorld" [vert,frag] [3,2] ETriangles poke32
-        >>= addTexture "data/texture/ayene_wooden_floor.png"
 ---- texture array shader
     textArrayShad <- makeShader "texture/array" [vert,frag] [3,3] ETriangles poke33
         >>= addTextureArray "data/texture/ayene_wooden_floor.png"
     -- bind fixed vertex data
     bindShaderBuffers [fsShad,fullscreenAlphaHalveShad] [4,4]
--- framebuffer for lighting
-    (fbo,fboTO,fboRBO) <- setupFramebufferWithStencil
     framebuf2 <- setupTextureFramebuffer 600 600
     framebuf3 <- setupTextureFramebuffer 600 600
 
@@ -129,7 +124,6 @@ preloadRender = do
         , _lightingWallShader       = wlLightShad   {_shaderVAO = wpVAO}
         , _wallBlankShader          = wlBlank { _shaderVAO = wpColVAO }
         , _wallTextureShader        = wlTexture { _shaderVAO = wpColVAO }
-        , _textureShader            = textShad
         , _textureArrayShader       = textArrayShad
         , _fullscreenShader         = fsShad
         , _fullscreenAlphaHalveShader = fullscreenAlphaHalveShad
@@ -137,9 +131,6 @@ preloadRender = do
         , _colorBlurShader            = colorBlurShad
         , _barrelShader            = barrelShad
         , _grayscaleShader          = grayscaleShad
-        , _spareFBO                 = fbo
-        , _fboTexture               = fboTO
-        , _fboRenderbufferObject    = fboRBO
         , _fbo2                     = framebuf2
         , _fbo3                     = framebuf3
         , _fboFourth1 = fboFourth1Name

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
+    --resizeFBOTO (_fbo3 rdata) xfull yfull
-        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
     resizeRBO (_rboBaseBloom rdata) xfull yfull
-    resizeFBOTO (_fboBase rdata) xfull yfull
+    --resizeFBOTO (_fboBase rdata) xfull yfull
-    resizeFBOTO (_fboBloom rdata) xfull yfull
+    --resizeFBOTO (_fboBloom rdata) xfull yfull
-    resizeFBOTO (_fboColor rdata) xfull yfull
+    --resizeFBOTO (_fboColor rdata) xfull yfull
     resizeRBO (_rboLighting rdata)   xsize ysize
-    resizeFBOTO (_fboLighting rdata) xsize ysize
+    --resizeFBOTO (_fboLighting rdata) xsize ysize
-    
+    pdata' <- foldM (resizeFBOTO'' xfull yfull) pdata [fbo2, fbo3, fboBase, fboBloom, fboColor]
-    return pdata
+    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

src/Render.hs

@@ -58,8 +58,6 @@ createLightMap pdata lightPoints nWalls nSils nsurfVs = do
     depthFunc $= Just Lequal
     forM_ lightPoints $ \((x,y,z),r,lum) -> do
         -- stencil out shadows
-        --depthFunc $= Just Less
-        --depthFunc $= Just Lequal
         colorMask $= Color4 Disabled Disabled Disabled Disabled
         clear [StencilBuffer]
         cullFace $= Just Back

src/Shader/AuxAddition.hs

@@ -11,6 +11,8 @@ import Codec.Picture
 import qualified Data.Vector.Storable as V
 import Control.Lens
 import Graphics.Rendering.OpenGL hiding (Point,translate,scale,imageHeight)
+import Graphics.GL.Core43
+--import Graphics.GL.Groups
 --import Text.RawString.QQ
     
 -- I am not sure if this assumes that the shader is constructed directly before
@@ -39,11 +41,9 @@ addTextureArray texturePath shad = do
     textureBinding Texture2DArray $= Just textureOb
     let texData = tilesToLine 128 8 . 
             V.toList $ imageData tex
-        --wtex = fromIntegral $ imageWidth  tex
+    glTexStorage3D GL_TEXTURE_2D_ARRAY 3 GL_RGBA8 32 32 64
-        --htex = fromIntegral $ imageHeight tex
     withArray texData $ \ptr -> do
-        texImage3D Texture2DArray NoProxy 0 RGBA8 (TextureSize3D 32 32 64) 0 
+        glTexSubImage3D GL_TEXTURE_2D_ARRAY 0 0 0 0 32 32 64 GL_RGBA GL_UNSIGNED_BYTE ptr
-                        (PixelData RGBA UnsignedByte ptr)
     textureFilter Texture2DArray $= ((Linear',Just Linear') , Linear')
     generateMipmap' Texture2DArray
     return $ shad & shaderTexture ?~ ShaderTexture {_textureObject = textureOb}