Attach EBOs to VAOs using DSA

2023-03-09 13:55:52 +00:00
parent f14d9bef60
commit 3e2b51b5e9
3 changed files with 101 additions and 93 deletions
@@ -1,41 +1,35 @@
 module Dodge.Render.Shadow where

-import Shader.Parameters
-import Shader.ExtraPrimitive
-import Graphics.Rendering.OpenGL ( ($=),  bindBuffer
-    , BufferTarget (..), bufferSubData, TransferDirection (..)
-    )
-import Graphics.GL.Core43
-import Geometry
-import Linear.V3 (cross)
 --import Data.Vector.Unboxed as UV
-import qualified Data.Vector as V
-import Shader.Data
-import Foreign
-import Shape.Data
-import Data.Preload.Render
+
 --import Dodge.Data.Universe
 import Control.Lens
+import Data.Preload.Render
+import qualified Data.Vector as V
 import qualified Data.Vector.Fusion.Stream.Monadic as VFSM
+import Foreign
+import Geometry
+import Graphics.GL.Core45
+import Linear.V3 (cross)
+import Shader.Data
+import Shader.ExtraPrimitive
+import Shader.Parameters
+import Shape.Data

 drawCPUShadows :: RenderData -> Shape -> Point3 -> Float -> IO ()
 drawCPUShadows pdata s pos rad = do
-    let theshad = pdata ^. positionalBlankShader  
+    let theshad = pdata ^. positionalBlankShader
        theptr = _vboPtr $ _vaoVBO $ _shadVAO' theshad
    i <- VFSM.foldlM' (pokeShapeShad pos rad theptr) 0 $ VFSM.fromList s
-    glBindBuffer GL_ARRAY_BUFFER (theshad ^. shadVAO' . vaoVBO . vboName)
-    bufferSubData
-        ArrayBuffer
-        WriteToBuffer
+    glBufferSubData 
+        (theshad ^. shadVAO' . vaoVBO . vboName)
        0
        (fromIntegral $ floatSize * i)
        (theshad ^. shadVAO' . vaoVBO . vboPtr)
-    --currentProgram $= theshad ^? shadProg
    glUseProgram (theshad ^. shadProg')
-    --bindVertexArrayObject $= Just (_vaoName $ _shadVAO' theshad)
    glBindVertexArray . _vaoName $ _shadVAO' theshad
    glDrawArrays
-        (marshalEPrimitiveMode $ _shadPrim' theshad) 
+        (marshalEPrimitiveMode $ _shadPrim' theshad)
        0
        (fromIntegral i)
    return ()
@@ -46,33 +40,42 @@ pokeShapeShad pos r theptr i so = do
        is = memoTopPrismEdges V.! (so ^. shType . prismSize - 2)
    V.foldM' (pokeShadEdge pos r theptr vs) i is

-pokeShadEdge :: Point3 -> Float -> Ptr Float -> V.Vector Point3 
-    -> Int -> (Int,Int,Int,Int) -> IO Int
-pokeShadEdge pos _ ptr vxs i (a,b,x,y) = do
+pokeShadEdge ::
+    Point3 ->
+    Float ->
+    Ptr Float ->
+    V.Vector Point3 ->
+    Int ->
+    (Int, Int, Int, Int) ->
+    IO Int
+pokeShadEdge pos _ ptr vxs i (a, b, x, y) = do
    let p0 = vxs V.! a
        p1 = vxs V.! b
        --mid = 0.5 * (p0 + p1)
        n0a = vxs V.! x
-        n1a = vxs V.! y             -- this should almost certainly be done with backpermute
+        n1a = vxs V.! y -- this should almost certainly be done with backpermute
        n0 = cross (p1 - p0) (n0a - p0)
        n1 = cross (p0 - p1) (n1a - p1)
        lightdir = p0 - pos
        shift' p = p + (10000 *.*.* (p - pos))
--        projNear p = 
--        shiftNear p = 
-    if dotV3 n0 lightdir * dotV3 n1 lightdir <=0 
-    then do
-        let p2 = shift' p0
-            p3 = shift' p1
-        if dotV3 n0 lightdir > 0
-            then
-                pokeV3 ptr p0 i >>= pokeV3 ptr p1 >>= pokeV3 ptr p2
-                    >>= pokeV3 ptr p0 >>= pokeV3 ptr p2 >>= pokeV3 ptr p3
-            else
-                pokeV3 ptr p1 i >>= pokeV3 ptr p0 >>= pokeV3 ptr p3 
-                    >>= pokeV3 ptr p1 >>= pokeV3 ptr p3 >>= pokeV3 ptr p2
-    else
-        return i
+    --        projNear p =
+    --        shiftNear p =
+    if dotV3 n0 lightdir * dotV3 n1 lightdir <= 0
+        then do
+            let p2 = shift' p0
+                p3 = shift' p1
+            if dotV3 n0 lightdir > 0
+                then
+                    pokeV3 ptr p0 i >>= pokeV3 ptr p1 >>= pokeV3 ptr p2
+                        >>= pokeV3 ptr p0
+                        >>= pokeV3 ptr p2
+                        >>= pokeV3 ptr p3
+                else
+                    pokeV3 ptr p1 i >>= pokeV3 ptr p0 >>= pokeV3 ptr p3
+                        >>= pokeV3 ptr p1
+                        >>= pokeV3 ptr p3
+                        >>= pokeV3 ptr p2
+        else return i

 pokeV3 :: Ptr Float -> Point3 -> Int -> IO Int
 pokeV3 ptr (V3 x y z) i = do
@@ -81,18 +84,21 @@ pokeV3 ptr (V3 x y z) i = do
    pokeElemOff ptr (3 * i + 2) z
    return (i + 1)

-memoTopPrismEdges :: V.Vector (V.Vector (Int,Int,Int,Int))
-memoTopPrismEdges = V.generate 10 
-    $ V.fromList . topPrismEdges . (+ 2)
+memoTopPrismEdges :: V.Vector (V.Vector (Int, Int, Int, Int))
+memoTopPrismEdges =
+    V.generate 10 $
+        V.fromList . topPrismEdges . (+ 2)

-topPrismEdges :: Int -> [(Int,Int,Int,Int)]
-topPrismEdges n = concatMap f [0..n-1]
+topPrismEdges :: Int -> [(Int, Int, Int, Int)]
+topPrismEdges n = concatMap f [0 .. n -1]
  where
-    f i = map h
-        [ (0 , 2 , 1 , 4)
-        , (0 , 1 ,-2 , 3)
-        , (1 , 3 ,-1 , 2)
-        ]
+    f i =
+        map
+            h
+            [ (0, 2, 1, 4)
+            , (0, 1, -2, 3)
+            , (1, 3, -1, 2)
+            ]
      where
-        h (a,b,c,d) = (g a,g b,g c, g d)
-        g j = (2 * i + j) `mod` (2*n)
+        h (a, b, c, d) = (g a, g b, g c, g d)
+        g j = (2 * i + j) `mod` (2 * n)
@@ -35,24 +35,23 @@ preloadRender = do
    wpVBOname <- mglCreateSingle glCreateBuffers
    wpVBOptr <- mallocArray (8 * numDrawableWalls)
    glBindBuffer GL_ARRAY_BUFFER wpVBOname
-    bufferData ArrayBuffer
-        $= ( fromIntegral $ floatSize * numDrawableWalls * 8
-           , nullPtr
-           , StreamDraw
-           )
+    glNamedBufferData wpVBOname
+        ( fromIntegral $ floatSize * numDrawableWalls * 8)
+         nullPtr
+        GL_STREAM_DRAW
    let wpVBO = VBO{_vboName = wpVBOname, _vboPtr = wpVBOptr, _vboAttribSizes = [4, 4], _vboStride = 8}
 --    wpVAOname <- genObjectName
 --    bindVertexArrayObject $= Just wpVAOname
    wpVAOname <- mglCreateSingle glCreateVertexArrays
    glBindVertexArray wpVAOname
    glBindBuffer GL_ARRAY_BUFFER wpVBOname
-    setupVertexAttribPointer 0 4 8 0
+    setupVertexAttribPointer wpVAOname wpVBOname 0 4 8 0
    --wpColVAOname <- genObjectName
    --bindVertexArrayObject $= Just wpColVAOname
    wpColVAOname <- mglCreateSingle glCreateVertexArrays
    glBindVertexArray wpColVAOname
-    setupVertexAttribPointer 0 4 8 0
-    setupVertexAttribPointer 1 4 8 4
+    setupVertexAttribPointer wpColVAOname wpVBOname 0 4 8 0
+    setupVertexAttribPointer wpColVAOname wpVBOname 1 4 8 4
    let wpVAO = VAO{_vaoName = wpVAOname, _vaoVBO = wpVBO}
        wpColVAO = VAO{_vaoName = wpColVAOname, _vaoVBO = wpVBO}
    -- setup window points VBO, VAOs and shaders
@@ -69,19 +68,12 @@ preloadRender = do
    --bindVertexArrayObject $= Just winColVAOname
    winColVAOname <- mglCreateSingle glCreateVertexArrays
    glBindVertexArray winColVAOname
-    setupVertexAttribPointer 0 4 8 0
-    setupVertexAttribPointer 1 4 8 4
+    setupVertexAttribPointer winColVAOname winVBOname 0 4 8 0
+    setupVertexAttribPointer winColVAOname winVBOname 1 4 8 4
    let winColVAO = VAO{_vaoName = winColVAOname, _vaoVBO = winVBO}
    -- setup shape geometry/cap VBO and two VAOs
-    --shEBOname <- genObjectName
    shEBOptr <- mallocArray numDrawableElements
    shEBOname <- mglCreateSingle glCreateBuffers
-    --bindBuffer ElementArrayBuffer $= Just shEBOname
-    --bufferData ElementArrayBuffer
-    --    $= ( fromIntegral $ glushortSize * numDrawableElements
-    --       , nullPtr
-    --       , StreamDraw
-    --       )
    glNamedBufferData 
        shEBOname
        ( fromIntegral $ glushortSize * numDrawableElements)
@@ -91,29 +83,30 @@ preloadRender = do
    shVBOname <- mglCreateSingle glCreateBuffers
    shVBOptr <- mallocArray (7 * numDrawableElements)
    glBindBuffer GL_ARRAY_BUFFER shVBOname
-    bufferData ArrayBuffer
-        $= ( fromIntegral $ floatSize * numDrawableElements * 7
-           , nullPtr
-           , StreamDraw
-           )
+    glNamedBufferData shVBOname
+        ( fromIntegral $ floatSize * numDrawableElements * 7)
+            nullPtr
+           GL_STREAM_DRAW
    let shVBO = VBO{_vboName = shVBOname, _vboPtr = shVBOptr, _vboAttribSizes = [4, 4], _vboStride = 8}
    --shPosColVAOname <- genObjectName
    --bindVertexArrayObject $= Just shPosColVAOname
    shPosColVAOname <- mglCreateSingle glCreateVertexArrays
    glBindVertexArray shPosColVAOname
    glBindBuffer GL_ARRAY_BUFFER shVBOname
-    setupVertexAttribPointer 0 3 7 0
-    setupVertexAttribPointer 1 4 7 3
+    setupVertexAttribPointer shPosColVAOname shVBOname 0 3 7 0
+    setupVertexAttribPointer shPosColVAOname shVBOname 1 4 7 3
    --bindBuffer ElementArrayBuffer $= Just shEBOname
-    glBindBuffer GL_ELEMENT_ARRAY_BUFFER shEBOname
+    --glBindBuffer GL_ELEMENT_ARRAY_BUFFER shEBOname
+    glVertexArrayElementBuffer shPosColVAOname shEBOname
    --shPosVAOname <- genObjectName
    --bindVertexArrayObject $= Just shPosVAOname
    shPosVAOname  <- mglCreateSingle glCreateVertexArrays
    glBindVertexArray shPosVAOname
    glBindBuffer GL_ARRAY_BUFFER shVBOname
-    setupVertexAttribPointer 0 3 7 0
+    setupVertexAttribPointer shPosVAOname shVBOname 0 3 7 0
    --bindBuffer ElementArrayBuffer $= Just shEBOname
-    glBindBuffer GL_ELEMENT_ARRAY_BUFFER shEBOname
+    --glBindBuffer GL_ELEMENT_ARRAY_BUFFER shEBOname
+    glVertexArrayElementBuffer shPosVAOname shEBOname
    let shPosColVAO = VAO{_vaoName = shPosColVAOname, _vaoVBO = shVBO}
        shPosVAO = VAO{_vaoName = shPosVAOname, _vaoVBO = shVBO}
    --setup silhouette edge VAO
@@ -122,12 +115,13 @@ preloadRender = do
    shEdgeVAOname  <- mglCreateSingle glCreateVertexArrays
    glBindVertexArray shEdgeVAOname
    glBindBuffer GL_ARRAY_BUFFER shVBOname
-    setupVertexAttribPointer 0 3 7 0
+    setupVertexAttribPointer shEdgeVAOname shVBOname 0 3 7 0
    --setup ebo for silhouette edges
    silEBOname <- mglCreateSingle glCreateBuffers
    silEBOptr <- mallocArray numDrawableElements
    -- it may be important to bind this while the correct VAO is bound
-    glBindBuffer GL_ELEMENT_ARRAY_BUFFER silEBOname --bindBuffer ElementArrayBuffer $= Just silEBOname
+    --glBindBuffer GL_ELEMENT_ARRAY_BUFFER silEBOname --bindBuffer ElementArrayBuffer $= Just silEBOname
+    glVertexArrayElementBuffer shEdgeVAOname silEBOname
    --bindBuffer ElementArrayBuffer $= Just silEBOname
    glNamedBufferData
        silEBOname
@@ -14,7 +14,13 @@ import Foreign
 import Foreign.C.String
 import GLHelp
 import Graphics.GL.Core45
-import Graphics.Rendering.OpenGL hiding (Point, imageHeight, scale, translate)
+import Graphics.Rendering.OpenGL (vertexAttribPointer, AttribLocation (..), ($=)
+    , IntegerHandling (..)
+    , VertexArrayDescriptor (..)
+    , DataType (..)
+    , vertexAttribArray
+    , Capability (..)
+    )
 import Shader.Data
 import Shader.Parameters

@@ -132,28 +138,27 @@ setupVAOSized :: Int -> [Int] -> IO VAO
 setupVAOSized ndraw sizes = do
    vaoname <- mglCreateSingle glCreateVertexArrays
    glBindVertexArray vaoname
-    theVBO <- setupVBOSized ndraw sizes
+    theVBO <- setupVBOSized ndraw vaoname sizes
    return $
        VAO
            { _vaoName = vaoname
            , _vaoVBO = theVBO
            }

-setupVBOSized :: Int -> [Int] -> IO VBO
-setupVBOSized ndraw sizes = do
+setupVBOSized :: Int -> GLuint -> [Int] -> IO VBO
+setupVBOSized ndraw vao sizes = do
    --vboName <- genObjectName
    --bindBuffer ArrayBuffer $= Just vboName
    vboname <- mglCreateSingle glCreateBuffers
    glBindBuffer GL_ARRAY_BUFFER vboname
    forM_ (zip3 [0 ..] sizes offs) $ \(loc, siz, off) -> do
-        setupVertexAttribPointer loc siz strd off
+        setupVertexAttribPointer vao vboname loc siz strd off
    thePtr <- mallocArray (strd * ndraw)
    -- Allocate space
-    bufferData ArrayBuffer
-        $= ( fromIntegral $ floatSize * ndraw * strd
-           , nullPtr
-           , StreamDraw
-           )
+    glNamedBufferData vboname
+        ( fromIntegral $ floatSize * ndraw * strd)
+            nullPtr
+        GL_STREAM_DRAW
    return $
        VBO
            { _vboName = vboname
@@ -167,7 +172,10 @@ setupVBOSized ndraw sizes = do

 -- | Assumes the correct VBO is bound
 setupVertexAttribPointer ::
-    -- | Atrib location
+    GLuint ->
+    -- | vao name
+    GLuint ->
+    -- | vbo name
    Int ->
    -- | Size
    Int ->
@@ -176,7 +184,7 @@ setupVertexAttribPointer ::
    -- | Offset
    Int ->
    IO ()
-setupVertexAttribPointer loc siz strd off = do
+setupVertexAttribPointer vao vbo loc siz strd off = do
    vertexAttribPointer (AttribLocation (fi loc))
        $= (ToFloat, VertexArrayDescriptor (fi' siz) Float (fi'' $ floatSize * strd) (bufferOffset off))
    vertexAttribArray (AttribLocation (fi loc)) $= Enabled