Make bloom trail last for at most one frame

shader/texture/bloomBlur.frag

@@ -5,8 +5,8 @@ out vec4 fColor;
 uniform vec2 winSize;
 uniform sampler2D screenTexture;
 
-const float hOff = 2.0 / 600;
-const float vOff = 2.0 / 600;
+const float hOff = 1.0 / 300;
+const float vOff = 1.0 / 300;
 const float frac = 1.0 / 9;
 const vec2 off[9] = vec2[]
     ( vec2( vOff,hOff )
@@ -39,14 +39,20 @@ void main()
     {
         sampleTex[i] = vec4(texture(screenTexture, vTexPos + off[i]));
     }
+    vec4 sampleFive[5];
+    for(int i=0; i<5; i++)
+    {
+        sampleFive[i] = vec4(texture(screenTexture, vTexPos + fiveOff[i]));
+    }
     vec4 col = vec4(0,0,0,0);
     for (int i = 0; i < 9; i++)
         col = combinef(col,sampleTex[i]);
         //col += sampleTex[i] * frac;
     float alph = 0.0;
     for (int i = 0; i < 9; i++)
-        alph += sampleTex[i].a;
-    alph = max(sampleTex[4].a, alph/9.0);
+        //alph += sampleTex[i].a;
+        alph = max(alph, 0.5 * sampleTex[i].a);
+    alph = max(sampleTex[4].a, alph);
         //
     //fColor = col;
     fColor = vec4(col.rgb/col.a,alph);

src/Dodge/Render.hs

@@ -82,20 +82,24 @@ doDrawing pdata w = do
     depthMask $= Enabled
     --bindFramebuffer Framebuffer $= (fst3 $ _fbo2 pdata)
     bindFramebuffer Framebuffer $= (fst $ _fboFourth1 pdata)
-    viewport $= (Position 0 0, Size 600 600)
+    viewport $= (Position 0 0, Size 300 300)
     depthFunc $= Just Always
     --blend $= Disabled
     textureBinding Texture2D $= Just (snd $ _fboBloom pdata)
-    textureFilter Texture2D $= ((Linear',Nothing) , Linear')
     --clear [ColorBuffer]
     --blendFunc $= (SrcAlpha,OneMinusSrcAlpha)
     --blendFuncSeparate $= ((Zero,One), (Zero,SrcAlpha))
     --drawShader (_fullscreenAlphaHalveShader pdata) 4
     --blendFunc $= (SrcAlpha,OneMinusSrcAlpha)
     --drawShader (_bloomBlurShader pdata) 4
-    blendFunc $= (One,Zero)
-    drawShader (_fullscreenShader pdata) 4
-    --replicateM_ 5 $ pingPongBetween (_fboFourth1 pdata) (_fboFourth2 pdata) (_bloomBlurShader pdata)
+    --blendFuncSeparate $= ((Zero,One),(Zero,SrcAlpha))
+    blendFunc $= (One,One)
+    blendEquation $= FuncReverseSubtract
+    drawShader (_fullscreenAlphaHalveShader pdata) 4
+    blendFunc $= (SrcAlpha,OneMinusSrcAlpha)
+    blendEquation $= FuncAdd
+    drawShader (_bloomBlurShader pdata) 4
+    replicateM_ 5 $ pingPongBetween (_fboFourth1 pdata) (_fboFourth2 pdata) (_bloomBlurShader pdata)
     --replicateM_ 5 $ pingPongBlur pdata
     --blend $= Enabled
     viewport $= (Position 0 0, Size (round $ fst wins) (round $ snd wins))
@@ -122,8 +126,6 @@ doDrawing pdata w = do
     --drawShader (_fullscreenShader pdata) 4
     --textureBinding Texture2D $= Just (snd3 $ _fbo2 pdata)
     textureBinding Texture2D $= Just (snd $ _fboLighting pdata)
-    textureFilter Texture2D $= ((Linear',Just Linear') , Linear')
-    generateMipmap' Texture2D
     blend $= Enabled
     blendFunc $= (Zero, OneMinusSrcAlpha)
     drawShader (_fullscreenShader pdata) 4

src/Preload/Render.hs

@@ -92,8 +92,8 @@ preloadRender = do
     fboBloomName <- newFramebufferGivenStencil rboBaseBloomName
     fboColorName <- newFramebufferGivenStencil rboBaseBloomName
 
-    fboFourth1Name <- setupTextureFramebuffer 600 600
-    fboFourth2Name <- setupTextureFramebuffer 600 600
+    fboFourth1Name <- setupTextureFramebuffer 300 300
+    fboFourth2Name <- setupTextureFramebuffer 300 300
 
 -- reset to default framebuffer, ready for drawing direct to screen
     bindFramebuffer Framebuffer $= defaultFramebufferObject
@@ -156,8 +156,7 @@ setupFramebufferWithStencil = do
     fboTO <- genObjectName
     textureBinding Texture2D $= Just fboTO
     texImage2D Texture2D NoProxy 0 RGBA8 (TextureSize2D 800 600) 0 (PixelData RGBA UnsignedByte nullPtr)
-    textureFilter Texture2D $= ((Linear',Just Linear') , Linear')
-    generateMipmap' Texture2D
+    textureFilter Texture2D $= minMagFilter
     framebufferTexture2D Framebuffer (ColorAttachment 0) Texture2D fboTO 0
 
     fboRBO <- genObjectName
@@ -188,9 +187,7 @@ newFramebufferGivenStencil rboName = do
     textureBinding Texture2D $= Just toName
     texImage2D Texture2D NoProxy 0 RGBA8 (TextureSize2D 800 600) 0 (PixelData RGBA UnsignedByte nullPtr)
     -- don't need mipmaps
-    textureFilter Texture2D $= ((Linear',Nothing) , Linear')
-    --textureFilter Texture2D $= ((Linear',Just Linear') , Linear')
-    --generateMipmap' Texture2D
+    textureFilter Texture2D $= minMagFilter
     framebufferTexture2D Framebuffer (ColorAttachment 0) Texture2D toName 0
     framebufferRenderbuffer Framebuffer DepthStencilAttachment Renderbuffer rboName
     fboStatus <- framebufferStatus Framebuffer
@@ -208,16 +205,15 @@ setupTextureFramebuffer x y = do
     fboTO <- genObjectName
     textureBinding Texture2D $= Just fboTO
     texImage2D Texture2D NoProxy 0 RGBA8 (TextureSize2D x y) 0 (PixelData RGBA UnsignedByte nullPtr)
-    --textureFilter Texture2D $= ((Linear',Just Linear') , Linear')
-    textureFilter Texture2D $= ((Nearest,Nothing) , Nearest)
-    --textureFilter Texture2D $= ((Linear',Nothing) , Linear')
-    --textureFilter Texture2D $= ((Nearest,Just Nearest) , Nearest)
-    --generateMipmap' Texture2D
+    textureFilter Texture2D $= minMagFilter
     framebufferTexture2D Framebuffer (ColorAttachment 0) Texture2D fboTO 0
     fboStatus <- framebufferStatus Framebuffer
     print fboStatus
     return (fboName, fboTO)
 
+minMagFilter :: ((TextureFilter, Maybe TextureFilter),TextureFilter)
+minMagFilter = ((Nearest,Nothing),Nearest)
+
 cleanUpRenderPreload :: RenderData -> IO ()
 cleanUpRenderPreload pd = do
     mapM_ freeShaderPointers $ _pictureShaders pd

src/Preload/Update.hs

@@ -25,9 +25,6 @@ resizeSpareFBO xsize ysize xfull yfull pdata = do
     bindFramebuffer Framebuffer $= fboName
     textureBinding Texture2D $= Just fboTO
     texImage2D Texture2D NoProxy 0 RGBA8 (TextureSize2D xsize' ysize') 0 (PixelData RGBA UnsignedByte nullPtr)
-    textureFilter Texture2D $= ((Linear',Nothing) , Nearest)
-    --textureFilter Texture2D $= ((Linear',Just Linear') , Nearest)
-    --generateMipmap' Texture2D
     framebufferTexture2D Framebuffer (ColorAttachment 0) Texture2D fboTO 0
 
     bindRenderbuffer Renderbuffer $= fboRBO
@@ -57,9 +54,6 @@ resizeTextureFBO (fboName,fboTO,fboRBO) xsize ysize = do
     bindFramebuffer Framebuffer $= fboName
     textureBinding Texture2D $= Just fboTO
     texImage2D Texture2D NoProxy 0 RGBA8 (TextureSize2D xsize' ysize') 0 (PixelData RGBA UnsignedByte nullPtr)
-    textureFilter Texture2D $= ((Linear',Nothing) , Nearest)
-    --textureFilter Texture2D $= ((Linear',Just Linear') , Nearest)
-    --generateMipmap' Texture2D
     framebufferTexture2D Framebuffer (ColorAttachment 0) Texture2D fboTO 0
 
     bindRenderbuffer Renderbuffer $= fboRBO
@@ -91,9 +85,6 @@ resizeFBOTO (fboName,fboTO) xsize ysize = do
     bindFramebuffer Framebuffer $= fboName
     textureBinding Texture2D $= Just fboTO
     texImage2D Texture2D NoProxy 0 RGBA8 (TextureSize2D xsize' ysize') 0 (PixelData RGBA UnsignedByte nullPtr)
-    textureFilter Texture2D $= ((Linear',Nothing) , Nearest)
-    --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

src/Render.hs

@@ -68,8 +68,6 @@ createLightMap pdata resDiv wallPoints lightPoints fpics scPol = do
     let vsize = divideSize resDiv vpsize
     viewport $= (vppos, vsize)
     textureBinding Texture2D $= Just (snd $ _fboLighting pdata)
-    --textureFilter Texture2D $= ((Linear',Just Linear') , Linear')
-    --generateMipmap' Texture2D
     -- store wall and light positions into buffer
     nWallLights <- F.foldM (pokeShader $ _lightingWallShader pdata) (map Render22 wallPoints)
     bindShaderBuffers [_lightingWallShader pdata] [nWallLights]
@@ -168,14 +166,10 @@ pingPongBlur :: RenderData -> IO ()
 pingPongBlur pdata = do
     bindFramebuffer Framebuffer $= fst3 (_fbo3 pdata)
     textureBinding Texture2D $= Just (snd3 $ _fbo2 pdata)
-    --textureFilter Texture2D $= ((Linear',Just Linear') , Linear')
-    --generateMipmap' Texture2D
     drawShader (_bloomBlurShader pdata) 4
 
     bindFramebuffer Framebuffer $= fst3 (_fbo2 pdata)
     textureBinding Texture2D $= Just (snd3 $ _fbo3 pdata)
-    --textureFilter Texture2D $= ((Linear',Just Linear') , Linear')
-    --generateMipmap' Texture2D
     drawShader (_bloomBlurShader pdata) 4
 
 -- assumes that vertices have already been sent to the shader
@@ -187,14 +181,10 @@ pingPongBetween
 pingPongBetween (fb1,to1) (fb2,to2) fs = do
     bindFramebuffer Framebuffer $= fb2
     textureBinding Texture2D $= Just to1
---    textureFilter Texture2D $= ((Linear',Just Linear') , Linear')
---    generateMipmap' Texture2D
     drawShader fs 4
 
     bindFramebuffer Framebuffer $= fb1
     textureBinding Texture2D $= Just to2
---    textureFilter Texture2D $= ((Linear',Just Linear') , Linear')
---    generateMipmap' Texture2D
     drawShader fs 4
 
 renderShader