Work on distortion shader

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