Fix resize bug, resize RenderbufferObject of ping pong framebuffers

src/Dodge/Base/Zone.hs

@@ -12,7 +12,7 @@ import Data.Bifunctor
 import qualified Data.IntMap.Strict as IM
 import qualified Data.IntSet as IS
 zoneSize :: Float
-zoneSize = 50
+zoneSize = 25
 --zoneSize = 100
           
 floorHun :: Float -> Int

src/Dodge/Creature/ChooseTarget.hs

@@ -8,6 +8,7 @@ import Control.Lens
 import qualified Data.IntMap.Strict as IM
 
 targetYouLOS :: Creature -> World -> Maybe Creature
+{-# INLINE targetYouLOS #-}
 targetYouLOS cr w 
     | hasLOS (_crPos cr) (_crPos $ you w) w = Just $ you w
     | otherwise = Nothing

src/Dodge/Creature/SwarmCrit.hs

@@ -38,3 +38,5 @@ swarmCrit = defaultCreature
     , _crFaction = ColorFaction yellow
     , _crMeleeCooldown = Just 0
     }
+
+

src/Dodge/Floor.hs

@@ -52,7 +52,7 @@ roomTreex = do
             [[StartRoom]
             ,[Corridor]
             ,[SpecificRoom . pure . pure . Right $ roomGlassOctogon 400 
-                & rmPS %~ ([swarmPS 0 (x,y) 0 swarmCrit | x <- [-20,-19.5.. 20] , y <- [200,200.5..202] ]++)
+                & rmPS %~ ([swarmPS 0 (x,y) 0 swarmCrit | x <- [-20,-19.5.. 20] , y <- [200,201] ]++)
              ]
             ,[Corridor]
             ,[Corridor]

src/Dodge/Render.hs

@@ -23,6 +23,7 @@ import Control.Applicative
 import Control.Monad.State
 import Control.Lens
 import qualified Control.Foldl as F
+import Data.Tuple.Extra
 import Data.Maybe
 import Data.List
 import Data.Bifunctor
@@ -95,7 +96,7 @@ doDrawing pdata w = do
     -- we probably do not want to blend during this step
     blend $= Disabled
     depthFunc $= Just Always
-    textureBinding Texture2D $= Just (snd $ _fbo2 pdata)
+    textureBinding Texture2D $= Just (snd3 $ _fbo2 pdata)
 --    textureFilter Texture2D $= ((Linear',Just Linear') , Linear')
 --    generateMipmap' Texture2D
     if _crHP (you w) > 0 

src/Picture/Preload.hs

@@ -31,8 +31,8 @@ data RenderData = RenderData
     , _spareFBO                 :: FramebufferObject
     , _fboTexture               :: TextureObject
     , _fboRenderbufferObject    :: RenderbufferObject
-    , _fbo2                     :: (FramebufferObject, TextureObject)
+    , _fbo2                     :: (FramebufferObject, TextureObject, RenderbufferObject)
-    , _fbo3                     :: (FramebufferObject, TextureObject)
+    , _fbo3                     :: (FramebufferObject, TextureObject, RenderbufferObject)
     }
 
 makeLenses ''RenderData
@@ -47,7 +47,6 @@ preloadRender = do
     wlLightShad 
          <- makeShader "lighting/wall" [vert,geom,frag] [(0,4)] Points pokeWPStrat
                 >>= addUniforms ["lightPos","perpMat","radLum"]
-
 -- 2D draw shaders
     bslist <- makeShader "twoD/basic"   [vert,frag]      [(0,3),(1,4)]       Triangles pokeTriStrat
     lslist <- makeShader "twoD/basic"   [vert,frag]      [(0,3),(1,4)]       Lines     pokeLineStrat
@@ -58,7 +57,6 @@ preloadRender = do
     cslist <- makeShader "twoD/character" [vert,geom,frag] 
                                 [(0,3),(1,4),(2,3)] Points pokeCharStrat
                   >>= addTexture "data/texture/charMap.png"
-
 -- texture shaders, no textures attached
     fsShad <- makeShader "texture/simple" [vert,frag] [(0,2),(1,2)] TriangleStrip $ const
         [[[-1, 1],[0,1]]
@@ -81,12 +79,9 @@ preloadRender = do
         ,[[ 1,-1],[1,0]]
         ]
     _ <- F.foldM (pokeShader grayscaleShad) [()] -- fix fullscreen vertex positions now
-
-
 -- background shader
     bgShad <- makeShader "background" [vert,geom,frag] [(0,4),(1,2)] Points pokeBGStrat
                 >>= addTexture "data/texture/smudgedDirt.png"
-
 -- blank wallShader
     wlBlank <- makeShader "wall/blank" [vert,geom,frag] [(0,4),(1,4)] Points pokeWPColStrat
 --                >>= addTexture "data/texture/grayscaleDirt.png"
@@ -95,16 +90,12 @@ preloadRender = do
     wlTexture <- makeShader "wall/texture" [vert,geom,frag] [(0,4),(1,4)] Points pokeWPColStrat
                 >>= addTexture "data/texture/grayscaleDirt.png"
                 >>= addUniforms ["perpMat"]
-
 -- framebuffer for lighting
     (fbo,fboTO,fboRBO) <- setupFramebufferWithStencil
-
+    framebuf2 <- setupFramebufferWithStencil
-    framebuf2 <- setupFramebuffer
+    framebuf3 <- setupFramebufferWithStencil
-    framebuf3 <- setupFramebuffer
-
 -- reset to default framebuffer, ready for drawing direct to screen
     bindFramebuffer Framebuffer $= defaultFramebufferObject
-    
     return $ RenderData
         { _pictureShaders           = [bslist,lslist,cslist,aslist,eslist,bezierQuadShader]
         , _lightingFloorShader      = lsShad

src/Picture/Render.hs

@@ -21,6 +21,7 @@ import qualified Control.Foldl as F
 import Foreign hiding (rotate)
 import Graphics.Rendering.OpenGL hiding (Line,translate,scale,imageHeight,imageWidth,Polygon,Color,T)
 import Data.Foldable
+import Data.Tuple.Extra
 import Data.Maybe (fromJust)
 import qualified Data.IntMap.Strict as IM
 import qualified SDL
@@ -145,7 +146,7 @@ createLightMap pdata resDiv wallPoints lightPoints (viewFromx,viewFromy) pmat =
 -- disable depth testing for blurring
     depthFunc $= Just Always
 -- draw the lightmap on a full size fbo
-    bindFramebuffer Framebuffer $= fst (_fbo2 pdata)
+    bindFramebuffer Framebuffer $= fst3 (_fbo2 pdata)
     colorMask $= Color4 Disabled Disabled Disabled Enabled
     bindShaderBuffers [_boxBlurShader pdata] [4]
     textureBinding Texture2D $= Just (_fboTexture pdata)
@@ -169,14 +170,14 @@ Assumes no depth testing is done (depthFunc %= Just Always).
  -}
 pingPongBlur :: RenderData -> IO ()
 pingPongBlur pdata = do
-    bindFramebuffer Framebuffer $= fst (_fbo3 pdata)
+    bindFramebuffer Framebuffer $= fst3 (_fbo3 pdata)
-    textureBinding Texture2D $= Just (snd $ _fbo2 pdata)
+    textureBinding Texture2D $= Just (snd3 $ _fbo2 pdata)
     textureFilter Texture2D $= ((Linear',Just Linear') , Linear')
     generateMipmap' Texture2D
     drawShader (_boxBlurShader pdata) 4
 
-    bindFramebuffer Framebuffer $= fst (_fbo2 pdata)
+    bindFramebuffer Framebuffer $= fst3 (_fbo2 pdata)
-    textureBinding Texture2D $= Just (snd $ _fbo3 pdata)
+    textureBinding Texture2D $= Just (snd3 $ _fbo3 pdata)
     textureFilter Texture2D $= ((Linear',Just Linear') , Linear')
     generateMipmap' Texture2D
     drawShader (_boxBlurShader pdata) 4

src/Preload/Update.hs

@@ -42,11 +42,11 @@ resizeSpareFBO xsize ysize xfull yfull pdata = do
     return pdata
 
 resizeTextureFBO 
-    :: (FramebufferObject , TextureObject)
+    :: (FramebufferObject , TextureObject, RenderbufferObject)
     -> Int
     -> Int
     -> IO ()
-resizeTextureFBO (fboName,fboTO) xsize ysize = do
+resizeTextureFBO (fboName,fboTO,fboRBO) xsize ysize = do
     let xsize' = fromIntegral xsize
         ysize' = fromIntegral ysize
     bindFramebuffer Framebuffer $= fboName
@@ -55,5 +55,10 @@ resizeTextureFBO (fboName,fboTO) xsize ysize = do
     textureFilter Texture2D $= ((Linear',Just Linear') , Nearest)
     generateMipmap' Texture2D
     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