Buggy (but fastish) merge of shadows into shapes

2021-09-21 10:09:40 +01:00
parent e98ada22fd
commit 8854b195cc
3 changed files with 54 additions and 45 deletions
@@ -56,16 +56,15 @@ doDrawing pdata w = do
    -- bind as much data into vbos as feasible at this point
    -- poke wall points and colors
    nWalls <- poke224s (shadVBOptr $ _wallTextureShader pdata) wallPointsCol
-    (numShapeVs,nSils,nIndices,nSilIndices) <- pokeShape
+    (numShapeVs,nIndices,nSilIndices) <- pokeShape
        (_vboPtr $ _vaoVBO $ _shadVAO $ _shapeShader pdata)
-        (shadVBOptr $ _lightingLineShadowShader pdata) 
+--        (shadVBOptr $ _lightingLineShadowShader pdata) 
        (_eboPtr $ _shapeEBO pdata)
        (_eboPtr $ _silhouetteEBO pdata)
        $ worldShape w
    -- bind wall points, silhouette data, surface geometry
    uncurry bindShaderBuffers $ unzip
        [ ( _wallTextureShader pdata, nWalls)
-        , (_lightingLineShadowShader pdata, nSils)
        , (_shapeShader pdata, numShapeVs)
        ]
    bindBuffer ElementArrayBuffer $= Just (_ebo $ _shapeEBO pdata)
@@ -99,15 +99,12 @@ preloadRender = do
    bindBuffer ElementArrayBuffer $= Just shEBOname
    let shPosColVAO = VAO { _vao = shPosColVAOname, _vaoVBO = shVBO }
        shPosVAO    = VAO { _vao = shPosVAOname,    _vaoVBO = shVBO }
-    -- lighting shaders
-    wsShad <- makeShader "lighting/occlude" [vert,geom,frag] [4] EPoints
-                >>= addUniforms ["lightPos"]
-    lightingCapShad
-         <- makeShader "lighting/cap" [vert,geom,frag] [3] ETriangles
-                >>= addUniforms ["lightPos"]
-    lightingLineShadowShad
-        <- makeShader "lighting/lineShadow" [vert,geom,frag] [3] ELinesAdjacency
-                >>= addUniforms ["lightPos"]
+    --setup silhouette edge VAO
+    shEdgeVAOname <- genObjectName
+    bindVertexArrayObject $= Just shEdgeVAOname
+    bindBuffer ArrayBuffer $= Just shVBOname
+    setupVertexAttribPointer 0 3 7 0
+    --setup ebo for silhouette edges
    silEBOname <- genObjectName
    silEBOptr <- mallocArray numDrawableElements
    -- it may be important to bind this while the correct VAO is bound
@@ -118,6 +115,16 @@ preloadRender = do
        , StreamDraw
        )
    let silEBO = EBO {_ebo = silEBOname, _eboPtr = silEBOptr}
+        shEdgeVAO = VAO { _vao = shEdgeVAOname, _vaoVBO = shVBO }
+    -- lighting shaders
+    wsShad <- makeShader "lighting/occlude" [vert,geom,frag] [4] EPoints
+                >>= addUniforms ["lightPos"]
+    lightingCapShad
+         <- makeShader "lighting/cap" [vert,geom,frag] [3] ETriangles
+                >>= addUniforms ["lightPos"]
+    lightingLineShadowShad
+        <- makeShader "lighting/lineShadow" [vert,geom,frag] [3] ELinesAdjacency
+                >>= addUniforms ["lightPos"]
 -- 2D draw shaders
    bslist <- makeShader "dualTwoD/basic"   [vert,frag] [3,4]   ETriangles 
    bslista <- makeShader "dualTwoD/basic"   [vert,frag] [3,4]   ETriangles 
@@ -194,7 +201,7 @@ preloadRender = do
        , _shapeEBO = shEBO
        , _silhouetteEBO = silEBO
        , _lightingCapShader        = lightingCapShad { _shadVAO = shPosVAO }
-        , _lightingLineShadowShader = lightingLineShadowShad
+        , _lightingLineShadowShader = lightingLineShadowShad {_shadVAO = shEdgeVAO}
        , _lightingOccludeShader    = wsShad    {_shadVAO = wpVAO}
        , _wallBlankShader          = wlBlank   { _shadVAO = wpColVAO }
        , _wallTextureShader        = wlTexture { _shadVAO = wpColVAO }
@@ -45,54 +45,57 @@ pokeVerx vbos offsets Verx{_vxPos=thePos,_vxCol=theCol,_vxExt=ext,_vxShadNum=the

 pokeShape 
    :: Ptr Float    -- ^ vertex data pointer
-    -> Ptr Float    -- ^ edge data pointer
    -> Ptr GLushort -- ^ vertex indices pointer
    -> Ptr GLushort -- ^ edge indices pointer
    -> Shape 
-    -> IO (Int,Int,Int,Int)
-pokeShape vptr eptr iptr ieptr = bifoldlM 
-    (pokeShapeObjs vptr iptr ieptr) 
-    (pokeShapeEs eptr ieptr) (0,0,0,0)
+    -> IO (Int,Int,Int)
+pokeShape vptr iptr ieptr = pokeShapeObjs vptr iptr ieptr (0,0,0) . fst

 pokeShapeObjs 
    :: Ptr Float 
    -> Ptr GLushort 
-    -> Ptr GLushort -> (Int,Int,Int,Int) -> [ShapeObj] -> IO (Int, Int,Int,Int)
-pokeShapeObjs ptr iptr _ count = VS.foldlM' (pokeShapeObj ptr iptr) count . VS.fromList
+    -> Ptr GLushort -> (Int,Int,Int) -> [ShapeObj] -> IO (Int,Int,Int)
+pokeShapeObjs ptr iptr ieptr count = VS.foldlM' (pokeShapeObj ptr iptr ieptr) count . VS.fromList

-pokeShapeObj :: Ptr Float -> Ptr GLushort -> (Int,Int,Int,Int) -> ShapeObj -> IO (Int,Int,Int,Int)
-pokeShapeObj ptr iptr counts (ShapeObj shType shVerts) = case shType of
-    TopPrism size -> pokeTopPrism size ptr iptr counts shVerts
+pokeShapeObj :: Ptr Float -> Ptr GLushort -> Ptr GLushort 
+    -> (Int,Int,Int) -> ShapeObj -> IO (Int,Int,Int)
+pokeShapeObj ptr iptr ieptr counts (ShapeObj shType shVerts) = case shType of
+    TopPrism size -> pokeTopPrism size ptr iptr ieptr counts shVerts

-pokeTopPrism :: Int -> Ptr Float -> Ptr GLushort -> (Int,Int,Int,Int) -> [ShapeV] -> IO (Int,Int,Int,Int)
-pokeTopPrism size ptr iptr count svs = do
-    count' <- pokeTopPrismIndices size iptr count
+pokeTopPrism :: Int -> Ptr Float -> Ptr GLushort 
+    -> Ptr GLushort -> (Int,Int,Int) -> [ShapeV] -> IO (Int,Int,Int)
+pokeTopPrism size ptr iptr ieptr count svs = do
+    count' <- pokeTopPrismIndices size iptr count >>= pokeTopPrismEdgeIndices size ieptr
    VS.foldlM' (pokeJustV ptr) count' (VS.fromList svs)

-pokeTopPrismIndices :: Int -> Ptr GLushort -> (Int,Int,Int,Int) -> IO (Int,Int,Int,Int)
-pokeTopPrismIndices size iptr (nv,ne,ni,nei) = do
+pokeTopPrismIndices :: Int -> Ptr GLushort -> (Int,Int,Int) -> IO (Int,Int,Int)
+pokeTopPrismIndices size iptr (nv,ni,nei) = do
    ni' <- foldM (pokeTopPrismIndex nv iptr) ni (topPrismIndices size)
-    return (nv,ne,ni',nei)
+    return (nv,ni',nei)
+
+pokeTopPrismEdgeIndices :: Int -> Ptr GLushort -> (Int,Int,Int) -> IO (Int,Int,Int)
+pokeTopPrismEdgeIndices size ieptr (nv,ni,nei) = do
+    nei' <- foldM (pokeTopPrismEdgeIndex nv ieptr) nei (topPrismEdgeIndices size)
+    return (nv,ni,nei')
+
+pokeTopPrismEdgeIndex :: Int -> Ptr GLushort -> Int -> Int -> IO Int
+pokeTopPrismEdgeIndex nv iptr ni ioff = do
+    pokeElemOff iptr ni (fromIntegral $ nv + ioff)
+    return (ni + 1)

 pokeTopPrismIndex :: Int -> Ptr GLushort -> Int -> Int -> IO Int
 pokeTopPrismIndex nv iptr ni ioff = do
    pokeElemOff iptr ni (fromIntegral $ nv + ioff)
    return (ni + 1)

-pokeShapeEs :: Ptr Float -> Ptr GLushort -> (Int,Int,Int,Int) -> [Point3] -> IO (Int,Int,Int,Int)
-pokeShapeEs ptr ieptr count = VS.foldlM' (pokeShapeE ptr ieptr) count . VS.fromList
-
-
-pokeShapeE :: Ptr Float -> Ptr GLushort -> (Int,Int,Int,Int) -> Point3 -> IO (Int,Int,Int,Int)
-pokeShapeE eptr ieptr (nv,n,ni,nei) (V3 a b c) = do
-    pokeElemOff eptr (n * 3) a
-    pokeElemOff eptr (n * 3 + 1) b
-    pokeElemOff eptr (n * 3 + 2) c
-    pokeElemOff ieptr nei (fromIntegral n)
-    return $ (nv,n + 1,ni,nei+1)
-
 topPrismEdgeIndices :: Int -> [Int]
-topPrismEdgeIndices n = undefined
+topPrismEdgeIndices n = concatMap f [0..n-1]
+  where
+    f i = 
+        [ i, (i+2) `mod` n, i+1, (i+4) `mod` n
+        , i, i+1, (i+4) `mod` n, (i+3) `mod` n
+        , i+1, (i+5) `mod` n, i, (i+3) `mod` n
+        ]

 topPrismIndices :: Int -> [Int]
 topPrismIndices n = concatMap f [1..n-2]    -- triangles on top face
@@ -104,8 +107,8 @@ topPrismIndices n = concatMap f [1..n-2]    -- triangles on top face
    g x = [2*x,2*x+1,2*x+3
            ,2*x,2*x+3,2*x+2]

-pokeJustV :: Ptr Float -> (Int,Int,Int,Int) -> ShapeV -> IO (Int,Int,Int,Int)
-pokeJustV ptr (nv,ne,ni,nei) sh = do
+pokeJustV :: Ptr Float -> (Int,Int,Int) -> ShapeV -> IO (Int,Int,Int)
+pokeJustV ptr (nv,ni,nei) sh = do
    pokeElemOff ptr (off 0) a
    pokeElemOff ptr (off 1) b
    pokeElemOff ptr (off 2) c
@@ -113,7 +116,7 @@ pokeJustV ptr (nv,ne,ni,nei) sh = do
    pokeElemOff ptr (off 4) e
    pokeElemOff ptr (off 5) f
    pokeElemOff ptr (off 6) g
-    return (nv+1,ne,ni,nei)
+    return (nv+1,ni,nei)
  where
    off i = nv*7 + i
    V3 a b c    = _svPos sh