Commit before attempting to change cloud shading

src/Shader/Compile.hs

@@ -1,7 +1,7 @@
 module Shader.Compile (
     setupVBO,
-    setupVBO',
-    makeShaderVAOEBO,
+    setupVBOStatic,
+    makeShaderEBO,
     makeShader,
     makeShader4,
     makeByteStringShaderUsingVAO,
@@ -47,7 +47,7 @@ makeShader s shaderlist sizes pm = do
             }
             , vbo)
 
-makeShaderVAOEBO ::
+makeShaderEBO ::
     -- | First part of the name of the shader
     String ->
     -- | shader types
@@ -58,14 +58,13 @@ makeShaderVAOEBO ::
     Int ->
     GLenum ->
     VBO ->
-    IO (Shader, VAO, EBO)
-makeShaderVAOEBO s shaderlist sizes strd pm vbo = do
+    IO (Shader, EBO)
+makeShaderEBO s shaderlist sizes strd pm vbo = do
     prog <- makeSourcedShader s shaderlist
     vao <- setupVAOvbo sizes strd vbo
     ebo <- setupEBO vao
     return
-        ( Shader prog pm
-        , vao
+        ( Shader prog pm vao
         , ebo
         )
 
@@ -102,8 +101,8 @@ setupVBO vertexsize = do
         GL_STREAM_DRAW
     return VBO {_vboName = vboname, _vboPtr = thePtr, _vboVertexSize = vertexsize}
 
-setupVBO' :: Int -> IO VBO
-setupVBO' vertexsize = do
+setupVBOStatic :: Int -> IO VBO
+setupVBOStatic vertexsize = do
     vboname <- mglCreate glCreateBuffers
     thePtr <- mallocArray (vertexsize * numDrawableElements)
     -- Allocate space

src/Shader/Data.hs

@@ -13,6 +13,7 @@ module Shader.Data
     , vaoName
     , shaderUINT
     , shaderPrimitive
+    , shaderVAO
 
     , textureObject
 
@@ -45,6 +46,7 @@ data FullShader = FullShader
 data Shader = Shader
     { _shaderUINT :: GLuint -- should be shaderID
     , _shaderPrimitive :: GLenum
+    , _shaderVAO :: VAO
     }
 {- | Vertex array object: contains the reference to the object,
 and its buffer targets.  -}

src/Shader/Poke/Cloud.hs

@@ -0,0 +1,33 @@
+module Shader.Poke.Cloud (
+    pokeCloud,
+) where
+
+import qualified Data.Vector.Unboxed as UV
+import Dodge.Data.Cloud
+import Foreign
+import Geometry
+import Graphics.GL.Core45
+
+pokeCloud :: Ptr Float -> Ptr GLushort -> (Int, Int) -> Cloud -> IO (Int, Int)
+pokeCloud vptr iptr (nv,ni) cl = do
+    UV.imapM_ (pokeCloudVerx vptr cl nv) $ UV.fromList [(1, 1), (1, -1), (-1, -1), (-1, 1)]
+    UV.imapM_ (pokeCloudIndex iptr nv ni) $ UV.fromList [0, 1, 2, 2, 1, 3]
+    return (nv + 4, ni + 6)
+
+pokeCloudVerx :: Ptr Float -> Cloud -> Int -> Int -> (Float, Float) -> IO ()
+pokeCloudVerx ptr cl nv i (dx, dy) =
+    UV.imapM_ (pokeCloudFloat ptr (nv + i)) $ UV.fromList 
+        [x, y, cz, 1, r, g, b, a, cx, cy, cz, rad, dx, dy, 0, 0]
+  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
+
+pokeCloudFloat :: Ptr Float -> Int -> Int -> Float -> IO ()
+pokeCloudFloat ptr nv i = pokeElemOff ptr (nv * 16 + i)
+
+pokeCloudIndex :: Ptr GLushort -> Int -> Int -> Int -> Int -> IO ()
+pokeCloudIndex ptr nv ni ioff voff = pokeElemOff ptr (ni + ioff) (fromIntegral $ nv + voff)