Buggy (but fastish) merge of shadows into shapes

src/Dodge/Render.hs

@@ -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)

src/Preload/Render.hs

@@ -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
+    --setup silhouette edge VAO
-    wsShad <- makeShader "lighting/occlude" [vert,geom,frag] [4] EPoints
+    shEdgeVAOname <- genObjectName
-                >>= addUniforms ["lightPos"]
+    bindVertexArrayObject $= Just shEdgeVAOname
-    lightingCapShad
+    bindBuffer ArrayBuffer $= Just shVBOname
-         <- makeShader "lighting/cap" [vert,geom,frag] [3] ETriangles
+    setupVertexAttribPointer 0 3 7 0
-                >>= addUniforms ["lightPos"]
+    --setup ebo for silhouette edges
-    lightingLineShadowShad
-        <- makeShader "lighting/lineShadow" [vert,geom,frag] [3] ELinesAdjacency
-                >>= addUniforms ["lightPos"]
     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 }

src/Shader/Poke.hs

@@ -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)
+    -> IO (Int,Int,Int)
-pokeShape vptr eptr iptr ieptr = bifoldlM 
+pokeShape vptr iptr ieptr = pokeShapeObjs vptr iptr ieptr (0,0,0) . fst
-    (pokeShapeObjs vptr iptr ieptr) 
-    (pokeShapeEs eptr ieptr) (0,0,0,0)
 
 pokeShapeObjs 
     :: Ptr Float 
     -> Ptr GLushort 
-    -> Ptr GLushort -> (Int,Int,Int,Int) -> [ShapeObj] -> IO (Int, Int,Int,Int)
+    -> Ptr GLushort -> (Int,Int,Int) -> [ShapeObj] -> IO (Int,Int,Int)
-pokeShapeObjs ptr iptr _ count = VS.foldlM' (pokeShapeObj ptr iptr) count . VS.fromList
+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 Float -> Ptr GLushort -> Ptr GLushort 
-pokeShapeObj ptr iptr counts (ShapeObj shType shVerts) = case shType of
+    -> (Int,Int,Int) -> ShapeObj -> IO (Int,Int,Int)
-    TopPrism size -> pokeTopPrism size ptr iptr counts shVerts
+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 :: Int -> Ptr Float -> Ptr GLushort 
-pokeTopPrism size ptr iptr count svs = do
+    -> Ptr GLushort -> (Int,Int,Int) -> [ShapeV] -> IO (Int,Int,Int)
-    count' <- pokeTopPrismIndices size iptr count
+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 :: Int -> Ptr GLushort -> (Int,Int,Int) -> IO (Int,Int,Int)
-pokeTopPrismIndices size iptr (nv,ne,ni,nei) = do
+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 Float -> (Int,Int,Int) -> ShapeV -> IO (Int,Int,Int)
-pokeJustV ptr (nv,ne,ni,nei) sh = do
+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