From 7f1a365cac32ea94f0d5ab91a6a8753a0528113b Mon Sep 17 00:00:00 2001 From: justin Date: Tue, 21 Sep 2021 00:43:45 +0100 Subject: [PATCH] Draw shape shadows using index buffer --- src/Data/Preload/Render.hs | 1 + src/Dodge/Creature/Picture.hs | 16 ++++++- src/Dodge/Layout.hs | 2 +- src/Dodge/Render.hs | 31 +++++++----- src/Preload/Render.hs | 12 +++++ src/Render.hs | 24 ++++++++-- src/Shader/Poke.hs | 89 ++++++++++++++++++++++++++++------- src/Shape.hs | 18 +++++-- src/Shape/Data.hs | 15 +++++- 9 files changed, 167 insertions(+), 41 deletions(-) diff --git a/src/Data/Preload/Render.hs b/src/Data/Preload/Render.hs index f27bff2a0..863b0c4f5 100644 --- a/src/Data/Preload/Render.hs +++ b/src/Data/Preload/Render.hs @@ -30,6 +30,7 @@ data RenderData = RenderData , _grayscaleShader :: FullShader , _shapeShader :: FullShader , _shapeEBO :: EBO + , _silhouetteEBO :: EBO , _pictureShaders :: MV.MVector (PrimState IO) FullShader , _fbo2 :: (FramebufferObject, TextureObject) , _fbo3 :: (FramebufferObject, TextureObject) diff --git a/src/Dodge/Creature/Picture.hs b/src/Dodge/Creature/Picture.hs index 9532ab16e..6360f7639 100644 --- a/src/Dodge/Creature/Picture.hs +++ b/src/Dodge/Creature/Picture.hs @@ -1,3 +1,4 @@ +{-# LANGUAGE TupleSections #-} {- | Drawing of creatures. Takes into account damage etc. -} @@ -173,9 +174,22 @@ scalp cr | oneH cr = rotateSH 0.5 $ translateSHf (0.25 * crad) 0 fhead | otherwise = translateSHf (0.25 * crad) 0 fhead where - fhead = colorSH (greyN 0.9) . upperPrismPoly 5 . polyCirc 3 $ crad * 0.5 + --fhead = colorSH (greyN 0.9) . upperPrismPoly 5 . polyCirc 3 $ crad * 0.5 + fhead = ([ShapeObj TopHexahedron $ map (flip ShapeV (greyN 0.9)) aBox] , mempty) crad = _crRad cr +aBox :: [Point3] +aBox = + [ V3 0 0 5 + , V3 5 0 5 + , V3 5 5 5 + , V3 0 5 5 + , V3 0 0 0 + , V3 5 0 0 + , V3 5 5 0 + , V3 0 5 0 + ] + oneH :: Creature -> Bool oneH cr = crIsAiming' cr && crIt ^? itAimStance == Just OneHand where diff --git a/src/Dodge/Layout.hs b/src/Dodge/Layout.hs index 3e606fd62..e0e78669e 100644 --- a/src/Dodge/Layout.hs +++ b/src/Dodge/Layout.hs @@ -79,7 +79,7 @@ setupWorldBounds w = w setupForegroundEdgeVerxs :: World -> World setupForegroundEdgeVerxs w = w & foregroundEdgeVerx .~ polyhedrasToEdges (_foregroundDecorations w) - & foregroundShape .~ (vs,es) + & foregroundShape .~ ([ShapeObj ListV vs],es) where vs = shVfromList $ map pairToSV $ concatMap polyToTris $ concatMap _pyFaces $ _foregroundDecorations w es = shEfromList $ polyhedrasToEdges (_foregroundDecorations w) diff --git a/src/Dodge/Render.hs b/src/Dodge/Render.hs index 808c1c8ac..5ada0586b 100644 --- a/src/Dodge/Render.hs +++ b/src/Dodge/Render.hs @@ -57,10 +57,11 @@ 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) <- pokeShape + (numShapeVs,nSils,nIndices,nSilIndices) <- pokeShape (_vboPtr $ _vaoVBO $ _shadVAO $ _shapeShader pdata) (shadVBOptr $ _lightingLineShadowShader pdata) (_eboPtr $ _shapeEBO pdata) + (_eboPtr $ _silhouetteEBO pdata) $ worldShape w -- bind wall points, silhouette data, surface geometry uncurry bindShaderBuffers $ unzip @@ -68,6 +69,20 @@ doDrawing pdata w = do , (_lightingLineShadowShader pdata, nSils) , (_shapeShader pdata, numShapeVs) ] + bindBuffer ElementArrayBuffer $= Just (_ebo $ _shapeEBO pdata) + bufferSubData + ElementArrayBuffer + WriteToBuffer + 0 + (fromIntegral $ glushortSize * nIndices) + (_eboPtr $ _shapeEBO pdata) + bindBuffer ElementArrayBuffer $= Just (_ebo $ _silhouetteEBO pdata) + bufferSubData + ElementArrayBuffer + WriteToBuffer + 0 + (fromIntegral $ glushortSize * nIndices) + (_eboPtr $ _silhouetteEBO pdata) -- set the coordinate uniform ready for drawing elements using world coordinates bufferUBO $ perspectiveMatrixb rot camzoom trans wins viewFroms setViewportSize (round winx `div` resFact) (round winy `div` resFact) @@ -90,20 +105,12 @@ doDrawing pdata w = do pokeBindFoldableLayer shadV layerCounts $ worldPictures w renderLayer 0 shadV layerCounts --- drawShader (_shapeShader pdata) numShapeVs let fs = _shapeShader pdata currentProgram $= Just (_shadProg fs) bindVertexArrayObject $= Just (_vao $ _shadVAO fs) - bindBuffer ElementArrayBuffer $= Just (_ebo $ _shapeEBO pdata) - bufferSubData - ElementArrayBuffer - WriteToBuffer - 0 - (fromIntegral $ glushortSize * numShapeVs) - (_eboPtr $ _shapeEBO pdata) glDrawElements (marshalEPrimitiveMode $ _shadPrim fs) - (fromIntegral numShapeVs) + (fromIntegral nIndices) (GL_UNSIGNED_SHORT) nullPtr @@ -113,8 +120,8 @@ doDrawing pdata w = do drawShader (_textureArrayShader pdata) nTextArrayVs --draw lightmap for base buffer bindFramebuffer Framebuffer $= fst (_fboLighting pdata) - --createLightMap pdata lightPoints nWalls nSils numShapeVs (snd $ snd $ _fboBase pdata) - createLightMap pdata lightPoints nWalls 0 0 (snd $ snd $ _fboBase pdata) + createLightMap pdata lightPoints nWalls nSils numShapeVs (snd $ snd $ _fboBase pdata) + --createLightMap pdata lightPoints nWalls 0 0 (snd $ snd $ _fboBase pdata) colorMask $= Color4 Enabled Enabled Enabled Enabled clearColor $= Color4 0 0 0 0 --apply lightmap to base buffer diff --git a/src/Preload/Render.hs b/src/Preload/Render.hs index b228314b6..a4aca757c 100644 --- a/src/Preload/Render.hs +++ b/src/Preload/Render.hs @@ -96,6 +96,7 @@ preloadRender = do bindVertexArrayObject $= Just shPosVAOname bindBuffer ArrayBuffer $= Just shVBOname setupVertexAttribPointer 0 3 7 0 + bindBuffer ElementArrayBuffer $= Just shEBOname let shPosColVAO = VAO { _vao = shPosColVAOname, _vaoVBO = shVBO } shPosVAO = VAO { _vao = shPosVAOname, _vaoVBO = shVBO } -- lighting shaders @@ -107,6 +108,16 @@ preloadRender = do 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 + bindBuffer ElementArrayBuffer $= Just silEBOname + bufferData ElementArrayBuffer $= + ( fromIntegral $ glushortSize * numDrawableElements + , nullPtr + , StreamDraw + ) + let silEBO = EBO {_ebo = silEBOname, _eboPtr = silEBOptr} -- 2D draw shaders bslist <- makeShader "dualTwoD/basic" [vert,frag] [3,4] ETriangles bslista <- makeShader "dualTwoD/basic" [vert,frag] [3,4] ETriangles @@ -181,6 +192,7 @@ preloadRender = do { _pictureShaders = shadV , _shapeShader = bslista {_shadVAO = shPosColVAO } , _shapeEBO = shEBO + , _silhouetteEBO = silEBO , _lightingCapShader = lightingCapShad { _shadVAO = shPosVAO } , _lightingLineShadowShader = lightingLineShadowShad , _lightingOccludeShader = wsShad {_shadVAO = wpVAO} diff --git a/src/Render.hs b/src/Render.hs index 3ae91beb4..170f75b61 100644 --- a/src/Render.hs +++ b/src/Render.hs @@ -9,6 +9,7 @@ module Render ) where import Shader +import Shader.ExtraPrimitive import Shader.Data --import Shader.Poke import Data.Preload.Render @@ -16,13 +17,14 @@ import Picture.Data import Geometry.Data --import Data.Foldable ---import Foreign hiding (rotate) +import Foreign hiding (rotate) import Graphics.Rendering.OpenGL hiding (Line,translate,scale,imageHeight,Polygon,Color,T) --import qualified SDL import qualified Data.Vector.Unboxed.Mutable as UMV import qualified Data.Vector.Mutable as MV import Control.Monad.Primitive import qualified Data.Vector.Fusion.Stream.Monadic as VS +import Graphics.GL.Core43 divideSize :: Int -> Size -> Size divideSize i (Size x y) = Size (div x $ fromIntegral i) (div y $ fromIntegral i) @@ -66,16 +68,32 @@ createLightMap pdata lightPoints nWalls nSils nCaps toPos = do $= Vector3 x y z drawShader (_lightingOccludeShader pdata) nWalls --draw silhouette shadows + let llss = _lightingLineShadowShader pdata currentProgram $= Just (_shadProg $ _lightingLineShadowShader pdata) uniform (head $ _shadUnis $ _lightingLineShadowShader pdata) $= Vector3 x y z - drawShader (_lightingLineShadowShader pdata) nSils + -- drawShader (_lightingLineShadowShader pdata) nSils + bindVertexArrayObject $= Just (_vao $ _shadVAO llss) + glDrawElements + (marshalEPrimitiveMode $ _shadPrim llss) + (fromIntegral nSils) + (GL_UNSIGNED_SHORT) + nullPtr cullFace $= Just Back + --draw caps on the near plane as required currentProgram $= Just (_shadProg $ _lightingCapShader pdata) uniform (head $ _shadUnis $ _lightingCapShader pdata) $= Vector3 x y z - drawShader (_lightingCapShader pdata) nCaps + -- TODO clean this up + let fs = _lightingCapShader pdata + bindVertexArrayObject $= Just (_vao $ _shadVAO fs) + glDrawElements + (marshalEPrimitiveMode $ _shadPrim fs) + (fromIntegral nCaps) + (GL_UNSIGNED_SHORT) + nullPtr + --drawShader (_lightingCapShader pdata) nCaps --draw lightmap itself depthFunc $= Just Always --cullFace $= Nothing diff --git a/src/Shader/Poke.hs b/src/Shader/Poke.hs index 6993562da..fa17b7187 100644 --- a/src/Shader/Poke.hs +++ b/src/Shader/Poke.hs @@ -21,6 +21,7 @@ import qualified Data.Vector.Unboxed.Mutable as UMV import qualified Data.Vector.Mutable as MV import qualified Data.Vector.Fusion.Stream.Monadic as VS import Control.Monad.Primitive +import Control.Monad import Data.Bifoldable --import qualified Data.DList as DL @@ -42,25 +43,64 @@ pokeVerx vbos offsets Verx{_vxPos=thePos,_vxCol=theCol,_vxExt=ext,_vxShadNum=the where sn = _unShadNum theShadNum -pokeShape :: Ptr Float -> Ptr Float -> Ptr GLushort -> Shape -> IO (Int,Int) -pokeShape vptr eptr iptr = bifoldlM (pokeShapeVs' vptr iptr) (pokeShapeEs' eptr) (0,0) +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) -pokeShapeVs' :: Ptr Float -> Ptr GLushort -> (Int,Int) -> [ShapeV] -> IO (Int, Int) -pokeShapeVs' ptr iptr count = VS.foldlM' (pokeShapeV' ptr iptr) count . VS.fromList +pokeShapeObjs + :: Ptr Float + -> Ptr GLushort + -> Ptr GLushort -> (Int,Int,Int,Int) -> [ShapeObj] -> IO (Int, Int,Int,Int) +pokeShapeObjs ptr iptr ieptr count = VS.foldlM' (pokeShapeObj ptr iptr) count . VS.fromList -pokeShapeEs' :: Ptr Float -> (Int,Int) -> [Point3] -> IO (Int, Int) -pokeShapeEs' ptr count = VS.foldlM' (pokeShapeE' ptr) 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 + ListV -> pokeShapeVs ptr iptr counts shVerts + TopHexahedron -> pokeTopHexahedron ptr iptr counts shVerts -pokeShapeE' :: Ptr Float -> (Int,Int) -> Point3 -> IO (Int,Int) -pokeShapeE' ptr (nv,n) (V3 a b c) = do - pokeElemOff ptr (n * 3) a - pokeElemOff ptr (n * 3 + 1) b - pokeElemOff ptr (n * 3 + 2) c - return $ (nv,n + 1) +pokeShapeVs :: Ptr Float -> Ptr GLushort -> (Int,Int,Int,Int) -> [ShapeV] -> IO (Int, Int,Int,Int) +pokeShapeVs ptr iptr count = VS.foldlM' (pokeShapeV ptr iptr) count . VS.fromList -pokeShapeV' :: Ptr Float -> Ptr GLushort -> (Int,Int) -> ShapeV -> IO (Int,Int) -pokeShapeV' ptr iptr (n,ne) sh = do +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 nei) + return $ (nv,n + 1,ni,nei+1) + +pokeTopHexahedron :: Ptr Float -> Ptr GLushort -> (Int,Int,Int,Int) -> [ShapeV] -> IO (Int,Int,Int,Int) +pokeTopHexahedron ptr iptr count svs = do + count' <- pokeHexahedronIndices iptr count + VS.foldlM' (pokeJustV ptr) count' (VS.fromList svs) + +pokeHexahedronIndices :: Ptr GLushort -> (Int,Int,Int,Int) -> IO (Int,Int,Int,Int) +pokeHexahedronIndices iptr (nv,ne,ni,nei) = do + ni' <- foldM (pokeHexhedronIndex nv iptr) ni hexIndices + return (nv,ne,ni',nei) + +pokeHexhedronIndex :: Int -> Ptr GLushort -> Int -> Int -> IO Int +pokeHexhedronIndex nv iptr ni ioff = do + pokeElemOff iptr ni (fromIntegral $ nv + ioff) + return (ni + 1) + +hexIndices :: [Int] +hexIndices = [0,1,2,0,2,3,0,4,5,0,5,1,1,5,6,1,6,2,2,6,7,2,7,8,3,7,4,3,4,0] + +pokeJustV :: Ptr Float -> (Int,Int,Int,Int) -> ShapeV -> IO (Int,Int,Int,Int) +pokeJustV ptr (nv,ne,ni,nei) sh = do pokeElemOff ptr (off 0) a pokeElemOff ptr (off 1) b pokeElemOff ptr (off 2) c @@ -68,10 +108,25 @@ pokeShapeV' ptr iptr (n,ne) sh = do pokeElemOff ptr (off 4) e pokeElemOff ptr (off 5) f pokeElemOff ptr (off 6) g - pokeElemOff iptr n (fromIntegral n) - return (n+1,ne) + return (nv+1,ne,ni,nei) where - off i = n*7 + i + off i = nv*7 + i + V3 a b c = _svPos sh + V4 d e f g = _svCol sh + +pokeShapeV :: Ptr Float -> Ptr GLushort -> (Int,Int,Int,Int) -> ShapeV -> IO (Int,Int,Int,Int) +pokeShapeV ptr iptr (nv,ne,ni,nei) sh = do + pokeElemOff ptr (off 0) a + pokeElemOff ptr (off 1) b + pokeElemOff ptr (off 2) c + pokeElemOff ptr (off 3) d + pokeElemOff ptr (off 4) e + pokeElemOff ptr (off 5) f + pokeElemOff ptr (off 6) g + pokeElemOff iptr ni (fromIntegral nv) + return (nv+1,ne,ni+1,nei) + where + off i = nv*7 + i V3 a b c = _svPos sh V4 d e f g = _svCol sh diff --git a/src/Shape.hs b/src/Shape.hs index 665b71cbe..965531c22 100644 --- a/src/Shape.hs +++ b/src/Shape.hs @@ -40,7 +40,7 @@ upperPrismPoly -> Shape {-# INLINE upperPrismPoly #-} upperPrismPoly h ps = - ( topFace <> sideFaces + ( [ShapeObj ListV (topFace <> sideFaces)] , topEdges <> bottomEdges <> sideEdges ) where @@ -64,7 +64,7 @@ prismPoly -> Shape {-# INLINE prismPoly #-} prismPoly h ps = - ( topFace <> bottomFace <> sideFaces + ( [ShapeObj ListV (topFace <> bottomFace <> sideFaces)] , topEdges <> bottomEdges <> sideEdges ) where @@ -86,7 +86,7 @@ prismPoly h ps = flatPoly :: [Point2] -> Shape flatPoly ps = - ( shVfromList $ polyToTris $ map f ps + ( [ShapeObj ListV $ shVfromList $ polyToTris $ map f ps] , shEfromList $ concat $ zipWith g ps (tail ps ++ [head ps]) ) where @@ -106,11 +106,11 @@ colorSH col = overCol $ const col overCol :: (Point4 -> Point4) -> Shape -> Shape {-# INLINE overCol #-} -overCol f = first (fmap $ overColVertex f) +overCol f = first (fmap $ overColObj f) overPos :: (Point3 -> Point3) -> Shape -> Shape {-# INLINE overPos #-} -overPos f = bimap (fmap $ overPosVertex f) (fmap f) +overPos f = bimap (fmap $ overPosObj f) (fmap f) translateSH :: Point3 -> Shape -> Shape {-# INLINE translateSH #-} @@ -132,10 +132,18 @@ scaleSH :: Point3 -> Shape -> Shape {-# INLINE scaleSH #-} scaleSH !(V3 a b c) = overPos (\(V3 x y z) -> V3 (x*a) (y*b) (z*c)) +overColObj :: (Point4 -> Point4) -> ShapeObj -> ShapeObj +{-# INLINE overColObj #-} +overColObj f (ShapeObj st vs) = ShapeObj st (map (overColVertex f) vs) + overColVertex :: (Point4 -> Point4) -> ShapeV -> ShapeV {-# INLINE overColVertex #-} overColVertex f (ShapeV a b) = ShapeV a (f b) +overPosObj :: (Point3 -> Point3) -> ShapeObj -> ShapeObj +{-# INLINE overPosObj #-} +overPosObj f (ShapeObj st vs) = ShapeObj st $ map (overPosVertex f) vs + overPosVertex :: (Point3 -> Point3) -> ShapeV -> ShapeV {-# INLINE overPosVertex #-} overPosVertex f (ShapeV a b) = ShapeV (f a) b diff --git a/src/Shape/Data.hs b/src/Shape/Data.hs index d05de5beb..bd2cd5ccd 100644 --- a/src/Shape/Data.hs +++ b/src/Shape/Data.hs @@ -8,10 +8,11 @@ module Shape.Data import Geometry.Data --import qualified Data.DList as DL -type Shape = ([ShapeV], [Point3]) +type Shape = ([ShapeObj], [Point3]) + _shVertices :: Shape -> [ShapeV] {-# INLINE _shVertices #-} -_shVertices = fst +_shVertices = concatMap _shVs . fst _shEdges :: Shape -> [Point3] {-# INLINE _shEdges #-} _shEdges = snd @@ -32,6 +33,16 @@ shVfromList = id shEfromList = id --shEfromList = DL.fromList +data ShapeObj = ShapeObj + { _shType :: ShapeType + , _shVs :: [ShapeV] + } + +data ShapeType + = ListV + | TopHexahedron -- ^ assumed convex, eight vertices + | TopPrism Int + -- edges are given by four consecutive points data ShapeV = ShapeV {_svPos :: Point3