justin/loop
1
0
Fork 0
Code Issues Pull Requests 1 Packages Projects Releases Wiki Activity

Draw shape shadows using index buffer

Browse Source
This commit is contained in:
justin
2021-09-21 00:43:45 +01:00
parent 5cbcbec101
commit 7f1a365cac
9 changed files with 167 additions and 41 deletions
Download Patch File Download Diff File Expand all files Collapse all files
src/Data/Preload/Render.hs
+1
View File
@@ -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)
src/Dodge/Creature/Picture.hs
+15 -1
View File
@@ -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
src/Dodge/Layout.hs
+1 -1
View File
@@ -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)
src/Dodge/Render.hs
+19 -12
View File
@@ -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
src/Preload/Render.hs
+12
View File
@@ -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}
src/Render.hs
+21 -3
View File
@@ -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
src/Shader/Poke.hs
+72 -17
View File
@@ -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
src/Shape.hs
+13 -5
View File
@@ -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
src/Shape/Data.hs
+13 -2
View File
@@ -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