Work on distortion shader

shader/lighting/lineShadow.vert

@@ -34,7 +34,7 @@ vec4 shiftNear(vec4 pos)
   return (sp.z > 100 ? projNear(pos) : sp);
 }               
 // Output 6 vertices for 4 data inputs
-int ks[6] = //        Inputdata:  n1a   Shadow:
+const int ks[6] = //        Inputdata:  n1a   Shadow:
     {0,1,2  //  2--3              /       p2--p3
     ,2,1,3  //  |  |       p0---p1        /    |
     };      //  0--1      /              /     |

shader/texture/barrel.frag

@@ -1,20 +1,10 @@
 #version 450 core
 in vec2 texPos;
-in vec2 texDist;
-in float gfactor;
-in vec2 vcpos;
+in vec2 distmask;
 out vec4 fColor;
 layout (binding = 1) uniform sampler2D screenTexture;
-float f ( float x) {
- if (x>1) {return 1;} else {return (1-gfactor)*x + gfactor;}
-}
+float x = min(1, dot(distmask,distmask));
 void main()
 {
-    float t = f(length(texDist));
-    float r = texture(screenTexture , (t*texPos - vcpos)).r ;
-    vec2 gb = texture(screenTexture 
-                , 0.5+0.5 *( vcpos + t * (texPos - vcpos))
-                ).gb 
-                ;
-    fColor = vec4(r,gb,1);
+    fColor = mix(texture(screenTexture, texPos),vec4(1,0,0,1),x);
 }

shader/texture/barrel.vert

@@ -1,18 +1,27 @@
 #version 450 core
-layout (location = 0) in vec2 pos;
-layout (location = 1) in vec2 rad1;
-layout (location = 2) in vec2 rad2;
-layout (location = 3) in float factor;
+struct DataS { vec2 pos; vec2 rad1; vec2 rad2; };
+layout (std430, binding = 9) readonly buffer Data { DataS data[]; };
 layout (std140, binding = 0) uniform TheMat { mat4 theMat; } ;
-out vec2 vCen;
-out vec2 vRad1;
-out vec2 vRad2;
-out float vFactor;
+out vec2 texPos;
+out vec2 distmask;
+const int ks[6] =   
+    {0,1,2          //  2--3
+    ,2,1,3          //  |  |
+    };              //  0--1
+const vec2 cs[4] =
+    { vec2 (-1,-1)
+    , vec2 ( 1,-1)
+    , vec2 (-1, 1)
+    , vec2 ( 1, 1)
+    };
 void main()
 {
-  gl_Position = vec4(0,0,0,1);
-  vCen = (theMat * vec4(pos,0,1)).xy;
-  vRad1 = (theMat * vec4(rad1,0,1)).xy;
-  vRad2 = (theMat * vec4(rad2,0,1)).xy;
-  vFactor = factor;
+  int k = ks[gl_VertexID];
+  vec4 off = (theMat * vec4(data[gl_VertexID/6].pos, 0,1));
+  float r = distance
+        ((theMat * vec4(data[gl_VertexID/6].rad1, 0,1)).xy
+        ,(theMat * vec4(0,0, 0,1)).xy);
+  distmask = (cs[k] - off.xy)/r;
+  texPos = 0.5 * (cs[k]+vec2(1,1));
+  gl_Position = vec4 (cs[k],0,1);
 }

src/Data/Preload/Render.hs

@@ -22,7 +22,7 @@ data RenderData = RenderData
     , _fullscreenShader :: GLuint
     , _transparencyCompShader :: GLuint
     , _bloomBlurShader :: GLuint
-    , _barrelShader :: (Shader,VBO)
+    , _barrelShader :: (GLuint,VBO)
     , _shapeShader :: GLuint
     , _shapeEBO :: UintBO
     , _silhouetteEBO :: UintBO

src/Dodge/Event/Test.hs

@@ -10,5 +10,5 @@ testEvent :: World -> World
 testEvent w = fromMaybe w $ do
     cpos <- w ^? cWorld . lWorld . creatures . ix 0 . crPos . _xy
     let distR = 50
-        distortionBulge = RadialDistortion cpos (cpos + V2 distR 0) (cpos + V2 0 distR) 1.9
+        distortionBulge = RadialDistortion cpos (V2 distR 0) (cpos + V2 0 distR) 1.9
     return $ w & cWorld . lWorld . distortions .~ [distortionBulge]

src/Dodge/Render.hs

@@ -25,7 +25,6 @@ import Graphics.GL.Core45
 import MatrixHelper
 import Render
 import qualified SDL
-import Shader
 import Shader.Bind
 import Shader.Data
 import Shader.Poke
@@ -369,10 +368,13 @@ doDrawing' win pdata u = do
             glDrawArrays GL_TRIANGLES 0 6
         (RadialDistortion (V2 a b) (V2 c d) (V2 e f) g:_) -> do
             glBindFramebuffer GL_FRAMEBUFFER (pdata ^. fbo2 . _1 . unFBO)
-            pokeArray (shadVBOptr $ _barrelShader pdata) [a, b, c, d, e, f, g]
-            bufferPokedVBO (snd $ _barrelShader pdata) 1
+            pokeArray (pdata ^. barrelShader . _2 . vboPtr) [a, b, c, d, e, f]
+            withArray [a, b, c, d, e, f, g] $ 
+                glNamedBufferSubData (pdata ^. barrelShader . _2 . vboName) 0 
+                    (6 * fromIntegral (sizeOf (0 :: Float)))
             glBindTextureUnit 1 $ pdata ^. fboBase . _2 . _1 . unTO
-            drawShader (fst $ _barrelShader pdata) 1
+            glUseProgram (pdata ^. barrelShader . _1)
+            glDrawArrays GL_TRIANGLES 0 6
             glBindTextureUnit 0 $ pdata ^. fbo2 . _2 . unTO
             glBindFramebuffer GL_FRAMEBUFFER 0
             glUseProgram (pdata ^. fullscreenShader)

src/Preload/Render.hs

@@ -127,7 +127,14 @@ preloadRender = do
     transcompshader <- makeSourcedShader "fullscreen/transparencyComp" [vert, frag]
     bloomBlurShad <- makeSourcedShader "texture/bloomBlur" [vert, frag]
     lightingTextureShad <- makeSourcedShader "lighting/texture" [vert, frag]
-    barrelShad <- makeShaderVBO "texture/barrel" [vert, geom, frag] (toFloatVAs [2, 2, 2, 1]) pmPoints
+
+    distbo <- mglCreate glCreateBuffers
+    let distbosize = sizeOf (0 :: Float) * 6 * 1024
+    glNamedBufferStorage distbo (fromIntegral distbosize) nullPtr GL_DYNAMIC_STORAGE_BIT
+    glBindBufferBase GL_SHADER_STORAGE_BUFFER 9 distbo
+    distptr <- mallocBytes distbosize
+    let distvbo = VBO distbo distptr (sizeOf (0::Float) * 6)
+    barrelShad <- makeSourcedShader "texture/barrel" [vert,frag]
 
     putStrLn "Setup floor VBO, shader"
     flvbo <- mglCreate glCreateBuffers
@@ -183,7 +190,7 @@ preloadRender = do
             , _alphaDivideShader = alphadivideshader
             , _lightingTextureShader = lightingTextureShad
             , _bloomBlurShader = bloomBlurShad
-            , _barrelShader = barrelShad
+            , _barrelShader = (barrelShad,distvbo)
             , _fbo2 = framebuf2
             , _fboHalf1 = fboHalf1Name
             , _fboHalf2 = fboHalf2Name

src/Shader.hs

@@ -1,13 +1,8 @@
-module Shader (
-    drawShaderLay,
-    shadVBOptr,
-    drawShader,
-) where
+module Shader (drawShaderLay) where
 
 import Control.Lens
 import Control.Monad.Primitive
 import qualified Data.Vector.Unboxed.Mutable as UMV
-import Foreign
 import Graphics.GL.Core45
 import Shader.Data
 import Shader.Parameters
@@ -22,17 +17,3 @@ drawShaderLay l countsVector shadIn fs = do
         (_unPrimitiveMode $ _shaderPrimitive $ fst fs)
         (fromIntegral $ l * numSubElements)
         (fromIntegral i)
-
-drawShader :: Shader -> Int -> IO ()
-{-# INLINE drawShader #-}
-drawShader fs i = do
-    glUseProgram (_shaderUINT fs)
-    glBindVertexArray $ fs ^. shaderVAO . unVAO
-    glDrawArrays
-        (_unPrimitiveMode $ _shaderPrimitive fs)
-        0
-        (fromIntegral i)
-
-shadVBOptr :: (Shader, VBO) -> Ptr Float
-{-# INLINE shadVBOptr #-}
-shadVBOptr = _vboPtr . snd