Implement multiple radial distortion rendering

shader/texture/barrel.frag

@@ -6,10 +6,7 @@ in vec2 vcpos;
 out vec4 fColor;
 layout (binding = 1) uniform sampler2D screenTexture;
 float f ( float x) {
- //return max (1, 1 / (2 * x + 0.5)) ;
- //return min (1, x) ;
  if (x>1) {return 1;} else {return (1-gfactor)*x + gfactor;}
- //if (x>1) {return 1;} else {return 0.5;}
 }
 void main()
 {
@@ -18,8 +15,4 @@ void main()
                 , 0.5+0.5 *( vcpos + t * (texPos - vcpos))
                 ) 
                 );
-    //vec4 tColor = vec4(texture(screenTexture , cpos + (texPos - cpos)) );
-    //float t = distance(cenPos,texPos);
-    //fColor = vec4(tColor.xy,t,tColor.w);
-    //fColor = tColor;
 }

shader/texture/barrel.geom

@@ -9,7 +9,6 @@ out vec2 vcpos;
 out vec2 texPos;
 out vec2 texDist;
 out float gfactor;
-
 vec2 g(float x,float y, vec2 v, vec2 r1, vec2 r2)
     { return vec2 
         (dot(normalize(r1-v),vec2(x,y)-v) / length(r1-v)
@@ -18,7 +17,6 @@ vec2 g(float x,float y, vec2 v, vec2 r1, vec2 r2)
     }
 void main() {
   vec2 cpos = vCen[0];
-  //vcpos = 2*cpos - vec2(1,1);
   vcpos = cpos;
   vec2 grad1 = vRad1[0];
   vec2 grad2 = vRad2[0];

shader/texture/barrel.vert

@@ -12,10 +12,7 @@ void main()
 {
   gl_Position = vec4(0,0,0,1);
   vCen = (theMat * vec4(pos,0,1)).xy;
-  //vCen = (theMat * vec4(0,0,0,1)).xy;
   vRad1 = (theMat * vec4(rad1,0,1)).xy;
-  //vRad1 = (theMat * vec4(0,200,0,1)).xy;
   vRad2 = (theMat * vec4(rad2,0,1)).xy;
-  //vRad2 = (theMat * vec4(200,0,0,1)).xy;
   vFactor = factor;
 }

src/Dodge/Creature/Action.hs

@@ -59,10 +59,12 @@ blinkAction
     -> World 
     -> World
 blinkAction cr w = soundOnce teleSound 
+    . set radDistortion distortionBulge
     . set (creatures . ix cid . crPos) p3
     . blinkShockwave cid p3
     $ inverseShockwaveAt cpos 40 2 2 2 w
   where
+    distortionBulge = [(p3,p3 +.+ (40,0), p3 +.+ (0,40),0.5)]
     cid  = _crID cr
     p1 = mouseWorldPos w
     cpos = _crPos cr

src/Dodge/Default/World.hs

@@ -78,7 +78,7 @@ defaultWorld = World
     , _inventoryMode = TopInventory
     , _lClickHammer = HammerUp
     , _foregroundDecorations = []
-    , _radDistortion = [((-20,120),(60,120),(-20,40),0.5)]
+    , _radDistortion = []
     }
 defaultDebugFlags :: DebugFlags
 defaultDebugFlags = DebugFlags

src/Dodge/Render.hs

@@ -142,15 +142,45 @@ doDrawing pdata w = do
     renderBlankWalls pdata windowPoints
 
     depthFunc $= Just Always
-    bindFramebuffer Framebuffer $= defaultFramebufferObject
+    blendFunc $= (One,Zero)
-    clear [ColorBuffer]
+
-    activeTexture $= TextureUnit 1
+    case _radDistortion w of
-    textureBinding Texture2D $= Just (snd $ _fboBase pdata)
+        [] -> do
-    bufferUBO $ perspectiveMatrixb rot camzoom trans wins viewFroms
+            bindTO $ snd $ _fboBase pdata
-    nraddist <- F.foldM (pokeShader $ _barrelShader pdata) (map Render2221 $ _radDistortion w)
+            bindFramebuffer Framebuffer $= defaultFramebufferObject
-    bindShaderBuffers [_barrelShader pdata] [nraddist]
+            --bufferUBO $ perspectiveMatrixb rot camzoom trans wins viewFroms
-    drawShader (_barrelShader pdata) nraddist
+            drawShader (_fullscreenShader pdata) 4
-    activeTexture $= TextureUnit 0
+        rds -> do
+            let bindDrawDist :: (Point2,Point2,Point2,Float) -> IO ()
+                bindDrawDist distParam = do
+                    _ <- F.foldM (pokeShader $ _barrelShader pdata) [Render2221 distParam]
+                    bindShaderBuffers [_barrelShader pdata] [1]
+                    drawShader (_barrelShader pdata) 1
+                fboList = take (length rds - 1) (concat (repeat [fst3 $ _fbo2 pdata,fst3 $ _fbo3 pdata]))
+                        ++ [defaultFramebufferObject]
+                toList = snd (_fboBase pdata) : concat (repeat [snd3 $ _fbo2 pdata,snd3 $ _fbo3 pdata])
+                bindings = zipWith (>>) (map bindFBO fboList) (map bindTO toList)
+            activeTexture $= TextureUnit 1
+            sequence_ $ zipWith (>>) bindings $ map bindDrawDist rds
+            activeTexture $= TextureUnit 0
+    --activeTexture $= TextureUnit 1
+    --bindTO $ snd $ _fboBase pdata
+
+    --let fbolist = 
+
+    --let bindDrawDist :: (Point2,Point2,Point2,Float) -> IO ()
+    --    bindDrawDist distParam = do
+    --        _ <- F.foldM (pokeShader $ _barrelShader pdata) [Render2221 distParam]
+    --        bindShaderBuffers [_barrelShader pdata] [1]
+    --        drawShader (_barrelShader pdata) 1
+    --sequence_ $ zipWith (>>) 
+    --    (map bindFBO $ concat $ repeat [fst3 $ _fbo2 pdata, fst3 $ _fbo3 pdata])
+    --    $ zipWith (>>) 
+    --        (map bindDrawDist (_radDistortion w) ++ [activeTexture $= TextureUnit 0])
+    --        (map bindTO $ concat $ repeat [snd3 $ _fbo2 pdata, snd3 $ _fbo3 pdata]) 
+    --bindFramebuffer Framebuffer $= defaultFramebufferObject
+    ----bufferUBO $ perspectiveMatrixb rot camzoom trans wins viewFroms
+    --drawShader (_fullscreenShader pdata) 4
 
     -- draw overlay
     bufferUBO $ isoMatrix 0 1 (0,0) (2,2)
@@ -163,6 +193,17 @@ doDrawing pdata w = do
     eTicks <- SDL.ticks
     return (eTicks - sTicks)
 
+bindTO :: TextureObject -> IO ()
+bindTO t = textureBinding Texture2D $= Just t
+
+bindFBO :: FramebufferObject -> IO ()
+bindFBO fb = bindFramebuffer Framebuffer $= fb
+
+fst3 :: (a,b,c) -> a
+fst3 (x,_,_) = x
+snd3 :: (a,b,c) -> b
+snd3 (_,x,_) = x
+
 --------------------------------------------------------------------------------
 -- note: currently assume there is only one UBO, we only bind it once at setup
 bufferUBO :: [Float] -> IO ()

src/Dodge/Update.hs

@@ -53,6 +53,7 @@ update' w = case _menuLayers w of
         w
     (_ : _) -> w
     []  -> checkEndGame 
+        . updateRadialDistortions
         . updateTriggers
         . ppEvents 
         . updateCamera
@@ -89,6 +90,17 @@ updateCreatureGroups :: World -> World
 updateCreatureGroups w = w & creatureGroups %~ 
     IM.mapMaybe (\cgp -> _crGroupUpdate cgp w cgp)
 
+updateRadialDistortions :: World -> World
+updateRadialDistortions = radDistortion %~ mapMaybe decreaseBulge
+
+decreaseBulge 
+    :: (Point2,Point2,Point2,Float) 
+    -> Maybe (Point2,Point2,Point2,Float)
+decreaseBulge (a,b,c,v)
+    | v > 1 = Just (a,b,c,max 1 (v - 0.05) )
+    | v < 1 = Just (a,b,c,min 1 (v + 0.05) )
+    | otherwise = Nothing
+
 updateTriggers :: World -> World
 updateTriggers w 
     | ResetLevel 1 `S.member` _worldTriggers w = generateLevelFromRoomList levx $ initialWorld 

src/Render.hs

@@ -187,6 +187,16 @@ pingPongBetween (fb1,to1) (fb2,to2) fs = do
     textureBinding Texture2D $= Just to2
     drawShader fs 4
 
+drawTextureOnFramebuffer
+    :: FullShader
+    -> FramebufferObject
+    -> TextureObject
+    -> IO ()
+drawTextureOnFramebuffer fs fbo to = do
+    bindFramebuffer Framebuffer $= fbo
+    textureBinding Texture2D $= Just to
+    drawShader fs 4
+
 renderShader
     :: Foldable f
     => FullShader