diff --git a/src/Dodge/Render.hs b/src/Dodge/Render.hs index 65d028e12..c7ee9c02a 100644 --- a/src/Dodge/Render.hs +++ b/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) diff --git a/src/Preload/Render.hs b/src/Preload/Render.hs index a4aca757c..7bc2d2f71 100644 --- a/src/Preload/Render.hs +++ b/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 - 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 } diff --git a/src/Shader/Poke.hs b/src/Shader/Poke.hs index b275d536b..a8873f730 100644 --- a/src/Shader/Poke.hs +++ b/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) -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