Use immutable storage for fullscreen vbo

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
-    V4 r g b a = case _clPict cl of
-        CloudColor _ _ col -> col
-        DrawGasCloud col -> col
+    CloudColor rad' fadet col = _clPict cl
+    (rad,V4 r g b a') = (rad'*_clRad cl, col)
+    a = a' * min 1 (fromIntegral (_clTimer cl) / fadet)
 
 pokeCloudFloat :: Ptr Float -> Int -> Int -> Float -> IO ()
 pokeCloudFloat ptr nv i = pokeElemOff ptr (nv * 16 + i)