Use immutable storage for fullscreen vbo

shader/cloud/basic.frag

@@ -8,14 +8,27 @@ layout (location=1) out vec4 fPos;
 layout (location=2) out vec4 fNorm;
 void main()
 {
+    // there are quite a few intricate controls concerning the normals
+    // we want normals to be bigger towards the center, so that when two clouds
+    // are blended central normals predominate
+    // similarly, we want normals to be bigger the further up the cloud is
+    // finally, we want normals to allow for shadows at the edge of a cloud
+    // when a light is direcly above the cloud
     float d = dot(vControls,vControls);
     if (d > 1) {discard;}
     //fCol = vCol;
     fCol = vec4(vCol.xyz,vCol.w*(1-d));
-    fPos = vec4(vPosID.xy, vPosID.z + (1-d) * vCenterSize.w, 0.5);
+    //float rad = vCenterSize.w;
-    vec3 fn1 = (1-d)*vec3(vCenterSize.xyz - fPos.xyz);
+    float rad = vCenterSize.w*0.5;
+    float h = (1-d) * rad;
+    fPos = vec4(vPosID.xy, vPosID.z + h, 1);
+    float h1 = float (1 - 0.01*fPos.z);
+    //vec3 fn1 = fPos.z*(1-d)*normalize(vec3(vCenterSize.xyz - fPos.xyz));
+    //vec3 fn1 = fPos.z*normalize(vec3(vCenterSize.xyz - fPos.xyz));
     //vec3 fn1 = vec3(vCenterSize.xyz - fPos.xyz);
+    vec3 fn1 = fPos.z*(1-d)*normalize(vec3(vCenterSize.xyz - (fPos.xyz + vec3(0,0,0.5*h))));
     //fNorm = vec4(0.5*fn1.xy,fn1.z, 0.5);
-    fNorm = vec4(fn1.xyz, 0.5);
+    //fNorm = vec4(fn1.xyz, fCol.w);
+    fNorm = vec4(fn1,1);
     //fNorm = vec4(0,0,1, 1);
 }

src/Data/Preload/Render.hs

@@ -29,7 +29,7 @@ data RenderData = RenderData
     , _windowShader :: FullShader
     , _wallTextureShader :: FullShader
 --    , _textureArrayShader :: (FullShader,VBO)
-    , _fullscreenShader :: (FullShader,VBO)
+    , _fullscreenShader :: FullShader
     , _bloomBlurShader :: FullShader
     , _colorBlurShader :: FullShader
     , _barrelShader :: (FullShader,VBO)
@@ -65,6 +65,7 @@ data RenderData = RenderData
     , _cloudVBO :: VBO
     , _cloudShader :: Shader
     , _cloudEBO :: EBO
+    , _screenTextureVAO :: VAO
     }
 
 makeLenses ''RenderData

src/Dodge/Cloud/Draw.hs

@@ -6,8 +6,8 @@ import Picture
 drawCloud :: CloudDraw -> Cloud -> Picture
 drawCloud cd = case cd of
     CloudColor radmult fadet col -> drawCloudWith radmult fadet col
-    DrawGasCloud col -> const . setLayer MidLayer . setDepth 30 $ color (withAlpha 0.05 col) 
+--    DrawGasCloud col -> const . setLayer MidLayer . setDepth 30 $ color (withAlpha 0.05 col) 
-                                          $ circleSolid 20
+--                                          $ circleSolid 20
 
 drawCloudWith :: Float -> Float -> Color -> Cloud -> Picture
 drawCloudWith radMult fadet col cl = setLayer MidLayer 

src/Dodge/Data/Cloud.hs

@@ -13,7 +13,6 @@ import Geometry
 
 data CloudDraw
     = CloudColor Float Float Color -- radius-multiply fade-time color
-    | DrawGasCloud Color
     deriving (Eq, Ord, Show, Read) --Generic, Flat)
 
 data Cloud = Cloud

src/Dodge/Placement/Instance/Wall.hs

@@ -88,7 +88,8 @@ baseBlockPane =
     defaultWall
         { _wlLine = (V2 0 0, V2 50 0)
         , _wlID = 0
-        , _wlColor = greyN 0.5
+        --, _wlColor = greyN 0.5
+        , _wlColor = orange
         , _wlOpacity = Opaque 10
         , _wlUnshadowed = True
         , _wlFireThrough = True

src/Dodge/Projectile/Update.hs

@@ -107,8 +107,11 @@ doThrust pj w =
         & cWorld . lWorld . projectiles . ix i . prjVel %~ (\v -> accel +.+ frict *.* v)
         & soundContinue (ShellSound i) newPos missileLaunchS (Just 1)
         & makeFlamelet (oldPos -.- vel) 0 (vel +.+ rotateV (pi + sparkD) accel) 3 10
-        & shellTrailCloud (addZ 20 (oldPos +.+ r1 +.+ 30 *.* normalizeV (oldPos -.- newPos)))
+        & shellTrailCloud' trailage trailfadetime 
+            (addZ 20 (oldPos +.+ r1 +.+ 30 *.* normalizeV (oldPos -.- newPos)))
   where
+    trailage = fst . randomR (300, 500) $ _randGen w
+    trailfadetime = fst . randomR (100, 300) $ _randGen w
     accel = _prjAcc pj
     i = _prjID pj
     oldPos = _prjPos pj

src/Dodge/Render.hs

@@ -5,6 +5,7 @@ module Dodge.Render (
 
 --import qualified Data.Vector as V
 
+import Data.List (sortOn)
 import Shader.Poke.Cloud
 import GLHelp
 import Control.Lens
@@ -96,7 +97,7 @@ doDrawing' win pdata u = do
             ]
     bufferPokedVBO (_vboShapes pdata) nShapeVs
     (nCloudVs,nCloudIs) <- foldM (pokeCloud (pdata ^. cloudVBO . vboPtr) (pdata ^. cloudEBO . eboPtr))
-        (0,0) (w ^. cWorld . lWorld . clouds)
+        (0,0) (sortOn (^. clPos . _3) $ w ^. cWorld . lWorld . clouds)
     bufferPokedVBO (pdata ^. cloudVBO) nCloudVs
     glNamedBufferSubData
         (_eboName $ _cloudEBO pdata)
@@ -208,7 +209,8 @@ doDrawing' win pdata u = do
     glBindTexture GL_TEXTURE_2D (pdata ^. fboLighting . _2 . unTO)
     glEnable GL_BLEND
     glBlendFunc GL_ZERO GL_ONE_MINUS_SRC_COLOR
-    drawShader (fst $ _fullscreenShader pdata) 4
+    drawShader (_fullscreenShader pdata) 4
+    --drawShader (fst $ _fullscreenShader pdata) 4
     with GL_COLOR_ATTACHMENT0 $ \ptr ->
         glInvalidateNamedFramebufferData 
             (pdata ^. fboLighting . _1 . unFBO)
@@ -241,7 +243,14 @@ doDrawing' win pdata u = do
     glBindFramebuffer GL_FRAMEBUFFER (_unFBO (fst (_fboCloud pdata)))
     glDepthFunc GL_LEQUAL
     glDepthMask GL_FALSE
-    glBlendFuncSeparate GL_SRC_ALPHA GL_ONE_MINUS_SRC_ALPHA GL_ONE GL_ONE_MINUS_SRC_ALPHA
+    --blendFunc $= (SrcAlphaSaturate,One)
+    --blendColor $= Color4 0.5 0.5 0.5 0.5
+    --blendFuncSeparate $= ((SrcAlphaSaturate,One) , (One,OneMinusSrcAlpha))
+    --blendFuncSeparate $= ((SrcAlpha, OneMinusSrcAlpha), (One, OneMinusSrcAlpha))
+    --glBlendFuncSeparate GL_SRC_ALPHA GL_ONE_MINUS_SRC_ALPHA GL_ONE GL_ONE_MINUS_SRC_ALPHA
+    glBlendFuncSeparate GL_SRC_ALPHA GL_ONE_MINUS_SRC_ALPHA GL_ONE_MINUS_DST_ALPHA GL_ONE
+    --glBlendFuncSeparate GL_SRC_ALPHA_SATURATE GL_ONE_MINUS_SRC_ALPHA GL_ONE GL_ONE_MINUS_SRC_ALPHA
+    --glBlendFunc GL_SRC_ALPHA GL_ONE_MINUS_SRC_ALPHA
     withArray [GL_COLOR_ATTACHMENT0, GL_NONE] $ \ptr -> glDrawBuffers 2 ptr
     withArray [0.5,0.5,0.5,0] $ \ptr -> glClearNamedFramebufferfv
         (pdata ^. fboCloud . _1 . unFBO)
@@ -274,10 +283,15 @@ doDrawing' win pdata u = do
             2
             ptr
         glEnable GL_BLEND
+        --glDisable GL_BLEND
         -- the idea is to (roughly) get the average position
-        glBlendFunci 1 GL_ONE_MINUS_DST_ALPHA GL_DST_ALPHA
+        --glBlendFunci 1 GL_ONE_MINUS_DST_ALPHA GL_DST_ALPHA
-        -- and to sum the normals
+        -- or, if we order the clouds, just get the top pos
-        glBlendFunci 2 GL_ONE GL_ONE
+        glBlendFunci 1 GL_ONE GL_ZERO
+        -- and to sum the normals (based on the alpha)
+        glBlendFunci 2 GL_SRC_ALPHA GL_ONE
+        -- just get the top normal
+        -- glBlendFunci 2 GL_ONE GL_ZERO
         glUseProgram (pdata ^. cloudShader . shaderUINT)
         glBindVertexArray $ pdata ^. cloudShader . shaderVAO . vaoName
         glDrawElements
@@ -286,6 +300,7 @@ doDrawing' win pdata u = do
             GL_UNSIGNED_SHORT
             nullPtr
         drawShader (_windowShader pdata) nWins
+        glEnable GL_BLEND
         ----draw lightmap for cloud buffer
         glDepthMask GL_FALSE
         glDepthFunc GL_LEQUAL
@@ -310,7 +325,7 @@ doDrawing' win pdata u = do
     glBindTexture GL_TEXTURE_2D (_unTO . snd $ _fboLighting pdata)
     glEnable GL_BLEND
     glBlendFuncSeparate GL_ZERO GL_ONE_MINUS_SRC_COLOR GL_ZERO GL_ONE
-    drawShader (fst $ _fullscreenShader pdata) 4
+    drawShader (_fullscreenShader pdata) 4
     glBlendFunc GL_SRC_ALPHA GL_ONE_MINUS_SRC_ALPHA
     -- bind base buffer for drawing bloom then clouds
     glBindFramebuffer GL_FRAMEBUFFER (_unFBO (fst (_fboBase pdata)))
@@ -318,11 +333,11 @@ doDrawing' win pdata u = do
     glEnable GL_BLEND
     glBlendFunc GL_SRC_ALPHA GL_ONE
     glBindTexture GL_TEXTURE_2D (_unTO . snd $ _fboHalf1 pdata)
-    drawShader (fst $ _fullscreenShader pdata) 4
+    drawShader (_fullscreenShader pdata) 4
     glBlendFunc GL_SRC_ALPHA GL_ONE_MINUS_SRC_ALPHA
     --draw shadowed clouds onto base buffer
     glBindTexture GL_TEXTURE_2D (pdata ^. fboCloud . _2 . _1 . unTO)
-    drawShader (fst $ _fullscreenShader pdata) 4
+    drawShader (_fullscreenShader pdata) 4
     --set viewport for radial distortion
     setViewportSize (round winx) (round winy)
     glDepthFunc GL_ALWAYS
@@ -332,7 +347,7 @@ doDrawing' win pdata u = do
         [] -> do
             bindTO $ pdata ^. fboBase . _2 . _1
             glBindFramebuffer GL_FRAMEBUFFER 0
-            drawShader (fst $ _fullscreenShader pdata) 4
+            drawShader (_fullscreenShader pdata) 4
         rds -> do
             let bindDrawDist :: Distortion -> IO ()
                 bindDrawDist (RadialDistortion (V2 a b) (V2 c d) (V2 e f) g) = do

src/Dodge/WorldEvent/Cloud.hs

@@ -3,7 +3,7 @@ module Dodge.WorldEvent.Cloud (
     smokeCloudAt,
     makeThinSmokeAt,
     makeThickSmokeAt,
-    shellTrailCloud,
+    shellTrailCloud',
     spawnSmokeAtCursor,
     makeStartCloudAt,
 ) where
@@ -60,10 +60,13 @@ makeThinSmokeAt = makeCloudAt (CloudColor 4 400 (withAlpha 0.05 black)) 5 400 50
 
 makeStartCloudAt :: Point3 -> World -> World
 --makeStartCloudAt = makeCloudAt (CloudColor 2 800 white) 10 400 5
-makeStartCloudAt = makeCloudAt (CloudColor 2 800 white) 10 400 50
+makeStartCloudAt = makeCloudAt (CloudColor 2 200 white) 10 400 50
 
 shellTrailCloud :: Point3 -> World -> World
-shellTrailCloud = makeCloudAt (CloudColor (4 / 3) 800 (greyN 0.5)) 15 400 40
+shellTrailCloud = makeCloudAt (CloudColor (3/2) 100 (greyN 0.5)) 15 400 80
+
+shellTrailCloud' :: Int -> Float -> Point3 -> World -> World
+shellTrailCloud' age fadet = makeCloudAt (CloudColor (3/2) fadet (greyN 0.5)) 15 age 80
 
 makeFlamerSmokeAt :: Point3 -> World -> World
 makeFlamerSmokeAt p w = makeCloudAt (CloudColor 4 300 (greyN x)) 6 200 40 p w

src/Dodge/WorldEvent/SpawnParticle.hs

@@ -93,7 +93,7 @@ makeGasCloud pos vel w =
         Cloud
             { _clPos = addZ 20 pos
             , _clVel = addZ 0 vel
-            , _clPict = DrawGasCloud col
+            , _clPict = CloudColor 3 50 (withAlpha 0.05 col)
             , _clRad = 10
             , _clAlt = 25
             , _clTimer = 400

src/Preload/Render.hs

@@ -136,18 +136,28 @@ preloadRender = do
     -- this should really be a 2d texture array
     basicTweakZShad <- makeShader "dualTwoD/basicTweakZ" [vert, frag] [4, 4] ETriangles
     -- texture shaders, no textures attached
-    fsShad <- makeShaderSized "texture/simple" [vert, frag] [2, 2] 4 ETriangleStrip
-    -- note we directly poke the shader vertex data here
-    -- could possibly use an indirect draw call
-    pokeArray (shadVBOptr fsShad) $ concat cornerList
 
-    let fsshadvao = fsShad ^. _1 . shadVAO
+    screentexturevbo <- mglCreate glCreateBuffers
+    withArray (concat cornerList) $ \ptr ->
+        glNamedBufferStorage
+            screentexturevbo
+            (fromIntegral $ floatSize * length (concat cornerList))
+            ptr
+            0
+    screentexturevao <- setupVAOvbo' [2,2] 4 screentexturevbo
 
-    bloomBlurShad <- makeShaderUsingVAO "texture/bloomBlur" [vert, frag] ETriangleStrip fsshadvao
+--    fsShad <- makeShaderSized "texture/simple" [vert, frag] [2, 2] 4 ETriangleStrip
-    colorBlurShad <- makeShaderUsingVAO "texture/colorBlur" [vert, frag] ETriangleStrip fsshadvao
+--    -- note we directly poke the shader vertex data here
-    grayscaleShad <- makeShaderUsingVAO "texture/grayscale" [vert, frag] ETriangleStrip fsshadvao
+--    -- could possibly use an indirect draw call
+--    pokeArray (shadVBOptr fsShad) $ concat cornerList
+
+    fsShad <- makeShaderUsingVAO "texture/simple" [vert, frag] ETriangleStrip screentexturevao
+
+    bloomBlurShad <- makeShaderUsingVAO "texture/bloomBlur" [vert, frag] ETriangleStrip screentexturevao
+    colorBlurShad <- makeShaderUsingVAO "texture/colorBlur" [vert, frag] ETriangleStrip screentexturevao
+    grayscaleShad <- makeShaderUsingVAO "texture/grayscale" [vert, frag] ETriangleStrip screentexturevao
     lightingTextureShad <-
-        makeShaderUsingVAO "lighting/texture" [vert, frag] ETriangleStrip fsshadvao
+        makeShaderUsingVAO "lighting/texture" [vert, frag] ETriangleStrip screentexturevao
     barrelShad <- makeShader "texture/barrel" [vert, geom, frag] [2, 2, 2, 1] EPoints
     -- blank wallShader
     wallBlankShad <- makeShaderUsingVAO "wall/blank" [vert, geom, frag] EPoints wpColVAO
@@ -168,8 +178,8 @@ preloadRender = do
     (cloudshader, cloudebo)
         <- makeShaderEBO "cloud/basic" [vert, frag] cloudverxsizes (sum cloudverxsizes) 
             GL_TRIANGLES cloudvbo
-    -- bind fixed vertex data
+--    -- bind fixed vertex data
-    bufferPokedVBO (snd fsShad) 4
+--    bufferPokedVBO (snd fsShad) 4
     framebuf2 <- setupTextureFramebuffer 800 600
     framebuf3 <- setupTextureFramebuffer 800 600
 
@@ -259,6 +269,7 @@ preloadRender = do
             , _cloudVBO = cloudvbo
             , _cloudShader = cloudshader
             , _cloudEBO = cloudebo
+            , _screenTextureVAO = screentexturevao
             }
 
 --------------------end preloadRender

src/Preload/Update.hs

@@ -52,5 +52,5 @@ renderDataResizeUpdate xsize ysize xfull yfull rdata = do
             "bloomBlur"
             [(vert, bbVert), (frag, bbFrag')]
             ETriangleStrip
-            (rdata ^. fullscreenShader . _1 . shadVAO)
+            (rdata ^. screenTextureVAO)
     return (rdata'{_bloomBlurShader = bbShad})

src/Shader/Compile.hs

@@ -8,6 +8,8 @@ module Shader.Compile (
     makeShaderSized,
     makeShaderUsingVAO,
     setupVAO,
+    setupVAOvbo,
+    setupVAOvbo',
     setupEBO,
     setupVertexAttribPointer,
 ) where
@@ -195,6 +197,16 @@ shaderTypeExt' _ = undefined
 setupVAO :: [Int] -> IO (VAO,VBO)
 setupVAO = setupVAOSized numDrawableElements
 
+setupVAOvbo' :: [Int] -> Int -> GLuint -> IO VAO
+setupVAOvbo' sizes strd vbo = do
+    vaoname <- mglCreate glCreateVertexArrays
+    glBindVertexArray vaoname
+    setupVertexAttribs' vbo vaoname sizes strd
+    return $ VAO
+            { _vaoName = vaoname
+            }
+
+
 setupVAOvbo :: [Int] -> Int -> VBO -> IO VAO
 setupVAOvbo sizes strd vbo = do
     vaoname <- mglCreate glCreateVertexArrays
@@ -252,7 +264,15 @@ setupVBOSized ndraw vao sizes = do
 
 setupVertexAttribs :: VBO -> GLuint -> [Int] -> Int -> IO ()
 setupVertexAttribs vbo vao sizes strd = do
-    glVertexArrayVertexBuffer vao 0 (vbo ^. vboName) 0 (fromIntegral $ floatSize * strd) 
+    glVertexArrayVertexBuffer vao 0 (_vboName vbo) 0 (fromIntegral $ floatSize * strd) 
+    forM_ (zip3 [0 ..] sizes offs) $ \(loc, siz, off) -> do
+        setupVertexAttribPointer vao loc siz off
+  where
+    offs = scanl (+) 0 sizes
+
+setupVertexAttribs' :: GLuint -> GLuint -> [Int] -> Int -> IO ()
+setupVertexAttribs' vbo vao sizes strd = do
+    glVertexArrayVertexBuffer vao 0 vbo 0 (fromIntegral $ floatSize * strd) 
     forM_ (zip3 [0 ..] sizes offs) $ \(loc, siz, off) -> do
         setupVertexAttribPointer vao loc siz off
   where

src/Shader/Poke/Cloud.hs

@@ -21,10 +21,9 @@ pokeCloudVerx ptr cl nv i (dx, dy) =
   where
     V3 cx cy cz = _clPos cl
     V2 x y = V2 cx cy - rad *.* V2 dx dy
-    rad = _clRad cl
+    CloudColor rad' fadet col = _clPict cl
-    V4 r g b a = case _clPict cl of
+    (rad,V4 r g b a') = (rad'*_clRad cl, col)
-        CloudColor _ _ col -> col
+    a = a' * min 1 (fromIntegral (_clTimer cl) / fadet)
-        DrawGasCloud col -> col
 
 pokeCloudFloat :: Ptr Float -> Int -> Int -> Float -> IO ()
 pokeCloudFloat ptr nv i = pokeElemOff ptr (nv * 16 + i)