Implement (not fully working) alternate shadow volumes

This commit is contained in:
2023-02-24 19:51:41 +00:00
parent ed9a46a18d
commit bf1bd5bb0b
9 changed files with 136 additions and 116 deletions
+19 -12
View File
@@ -3,6 +3,8 @@ module Dodge.Render (
doDrawing,
) where
import qualified Data.Vector as V
import Dodge.Render.Shadow
import Control.Lens
import Control.Monad
import qualified Control.Monad.Parallel as MP
@@ -105,14 +107,14 @@ doDrawing pdata u = do
, (_windowShader pdata, nWins)
, (_textureArrayShader pdata, nFls)
]
bindBuffer ElementArrayBuffer $= Just (_ebo $ _shapeEBO pdata)
bindBuffer ElementArrayBuffer $= pdata ^? shapeEBO . ebo --Just (_ebo $ _shapeEBO pdata)
bufferSubData
ElementArrayBuffer
WriteToBuffer
0
(fromIntegral $ glushortSize * nIndices)
(_eboPtr $ _shapeEBO pdata)
bindBuffer ElementArrayBuffer $= Just (_ebo $ _silhouetteEBO pdata)
bindBuffer ElementArrayBuffer $= pdata ^? silhouetteEBO . ebo --Just (_ebo $ _silhouetteEBO pdata)
bufferSubData
ElementArrayBuffer
WriteToBuffer
@@ -127,9 +129,9 @@ doDrawing pdata u = do
clear [ColorBuffer, DepthBuffer]
depthFunc $= Just Less
-- draw wall occlusions from the camera's point of view
currentProgram $= Just (_shadProg lwShad)
uniform (head $ _shadUnis lwShad) $= viewFrom3d
bindVertexArrayObject $= Just (_vao $ _shadVAO lwShad)
currentProgram $= lwShad ^? shadProg -- Just (_shadProg lwShad)
uniform (_shadUnis lwShad V.! 0) $= viewFrom3d
bindVertexArrayObject $= lwShad ^? shadVAO . vao -- Just (_vao $ _shadVAO lwShad)
unless (debugOn Remove_LOS cfig) $
glDrawArrays
(marshalEPrimitiveMode $ _shadPrim lwShad)
@@ -144,7 +146,7 @@ doDrawing pdata u = do
--draw object shapes onto base buffer
let fs = _shapeShader pdata
currentProgram $= Just (_shadProg fs)
bindVertexArrayObject $= Just (_vao $ _shadVAO fs)
bindVertexArrayObject $= fs ^? shadVAO . vao -- Just (_vao $ _shadVAO fs)
glDrawElements
(marshalEPrimitiveMode $ _shadPrim fs)
(fromIntegral nIndices)
@@ -161,18 +163,21 @@ doDrawing pdata u = do
nWalls
nSilIndices
nIndices
(_graphics_object_shadows $ _uvConfig u)
(snd $ snd $ _fboBase pdata)
--(_graphics_object_shadows $ _uvConfig u)
(u ^. uvConfig . graphics_object_shadows)
(snd $ snd $ pdata ^. fboBase)
(drawCPUShadows pdata ws)
colorMask $= Color4 Enabled Enabled Enabled Enabled
clearColor $= Color4 0 0 0 0
--apply lightmap to base buffer
bindFramebuffer Framebuffer $= fst (_fboBase pdata)
textureBinding Texture2D $= Just (snd $ _fboLighting pdata)
bindFramebuffer Framebuffer $= pdata ^. fboBase . _1 --fst (_fboBase pdata)
--textureBinding Texture2D $= Just (snd $ _fboLighting pdata)
textureBinding Texture2D $= pdata ^? fboLighting . _2 -- Just (snd $ _fboLighting pdata)
blend $= Enabled
blendFunc $= (Zero, OneMinusSrcColor)
drawShader (_fullscreenShader pdata) 4
--draw bloom onto bloom buffer
bindFramebuffer Framebuffer $= fst (_fboBloom pdata)
bindFramebuffer Framebuffer $= pdata ^. fboBloom . _1 --fst (_fboBloom pdata)
clear [ColorBuffer]
depthFunc $= Just Less
blendFunc $= (SrcAlpha, OneMinusSrcAlpha)
@@ -185,7 +190,7 @@ doDrawing pdata u = do
setViewportSize (round winx `div` (2 * resFact)) (round winy `div` (2 * resFact))
bindFramebuffer Framebuffer $= fst (_fboHalf1 pdata)
depthFunc $= Just Always
textureBinding Texture2D $= Just (snd $ _fboBloom pdata)
textureBinding Texture2D $= pdata ^? fboBloom . _2 -- Just (snd $ _fboBloom pdata)
blend $= Disabled
drawShader (_bloomBlurShader pdata) 4
replicateM_ 9 $ pingPongBetween (_fboHalf1 pdata) (_fboHalf2 pdata) (_bloomBlurShader pdata)
@@ -224,6 +229,7 @@ doDrawing pdata u = do
nIndices
(_graphics_object_shadows $ _uvConfig u)
(snd $ snd $ _fboCloud pdata)
(drawCPUShadows pdata ws)
colorMask $= Color4 Enabled Enabled Enabled Enabled
clearColor $= Color4 0 0 0 0
--apply lightmap to cloud buffer
@@ -322,3 +328,4 @@ renderTextureWalls pdata nWalls = do
cullFace $= Just Back
drawShader (_wallTextureShader pdata) nWalls
cullFace $= Nothing
+2 -3
View File
@@ -121,10 +121,9 @@ preloadRender = do
>>= addUniforms ["lightPos"]
lightingLineShadowShad
<- makeShaderUsingVAO "lighting/lineShadow" [vert,geom,frag] ELinesAdjacency shEdgeVAO
>>= addUniforms ["lightPos","lumRad"]
>>= addUniforms ["lightPos","radiusUniform"]
-- positional shader
positionalBlankShad <- makeShader "positional/blank" [vert,frag] [3] ETriangles
positionalBlankShad <- makeShader "positional/blank" [vert,frag] [3] ETriangles
-- 2D draw shaders
bslist <- makeShader "dualTwoD/basic" [vert,frag] [3,4] ETriangles
bslista <- makeShader "dualTwoD/basic" [vert,frag] [3,4] ETriangles
+91 -85
View File
@@ -1,130 +1,136 @@
module Render
( createLightMap
, divideSize
, renderFoldable
, renderLayer
, pingPongBetween
, bindTO
, bindFBO
) where
import Dodge.Data.Config
import Shader
import Shader.ExtraPrimitive
import Shader.Data
import Data.Preload.Render
import Picture.Data
import Geometry.Data
module Render (
createLightMap,
divideSize,
renderFoldable,
renderLayer,
pingPongBetween,
bindTO,
bindFBO,
) where
import Foreign hiding (rotate)
import Graphics.Rendering.OpenGL hiding (Line,translate,scale,imageHeight,Polygon,Color,T)
import qualified Data.Vector.Unboxed.Mutable as UMV
import qualified Data.Vector.Mutable as MV
import Control.Lens
import Control.Monad.Primitive
import Graphics.GL.Core43
import Data.Preload.Render
import qualified Data.Vector as V
--import Control.Monad
import qualified Data.Vector.Fusion.Stream.Monadic as VFSM
import qualified Data.Vector.Mutable as MV
import qualified Data.Vector.Unboxed.Mutable as UMV
import Dodge.Data.Config
import Foreign hiding (rotate)
import Geometry.Data
import Graphics.GL.Core43
import Graphics.Rendering.OpenGL hiding (Color, Line, Polygon, T, imageHeight, scale, translate)
import Picture.Data
import Shader
import Shader.Data
import Shader.ExtraPrimitive
divideSize :: Int -> Size -> Size
divideSize i (Size x y) = Size (div x $ fromIntegral i) (div y $ fromIntegral i)
{- | Determine where light is shining in the world. -}
createLightMap
:: RenderData
-> [(Point3,Float,Point3)] -- Lights
-> Int -- ^ number of walls
-> Int -- ^ number of silhoutte lines to draw
-> Int -- ^ number of "caps" to attempt to draw
-> ObjectShadows -- ^ whether to draw object shadows or not
-> TextureObject -- ^ the texture object giving positions
-> IO ()
createLightMap pdata lightPoints nWalls nSils nCaps drawObjShads toPos = do
let llsShad = _lightingLineShadowShader pdata
let lcShad = _lightingCapShader pdata
let lwShad = _lightingWallShadShader pdata
let ltShad = _lightingTextureShader pdata
-- | Determine where light is shining in the world.
createLightMap ::
RenderData ->
[(Point3, Float, Point3)] -> -- Lights
-- | number of walls
Int ->
-- | number of silhoutte lines to draw
Int ->
-- | number of "caps" to attempt to draw
Int ->
-- | whether to draw object shadows or not
ObjectShadows ->
-- | the texture object giving positions
TextureObject ->
(Point3 -> Float -> IO ()) -> -- attempt at drawing shadow not using geo shader
IO ()
createLightMap pdata lightPoints nWalls nSils nCaps drawObjShads toPos drawCPUShadows = do
let llinesShad = _lightingLineShadowShader pdata
lcapShad = _lightingCapShader pdata
lwallShad = _lightingWallShadShader pdata
ltextShad = _lightingTextureShader pdata
-- we assume that the renderbuffer's depth has been correctly set elsewhere
-- we will not be changing that here
depthMask $= Disabled
-- clearColor is specified differently in preloadRender
clearColor $= Color4 1 1 1 1
clear [ColorBuffer]
-- for each of the lights:
-- 1. stencil out the walls from this light's point of view
-- for each of the lights:
-- 1. stencil out the shadows from this light's point of view
-- 2. calculate lighting based on each fragment's position
-- to consider: adding normals/a "material" for each fragment
blendFunc $= (Zero, OneMinusSrcColor)
stencilTest $= Enabled
flip VFSM.mapM_ (VFSM.fromList lightPoints) $ \(V3 x y z,rad,V3 r g b) -> do
flip VFSM.mapM_ (VFSM.fromList lightPoints) $ \(V3 x y z, rad, V3 r g b) -> do
depthFunc $= Just Less
-- setup stencil
colorMask $= Color4 Disabled Disabled Disabled Disabled
clear [StencilBuffer]
cullFace $= Nothing
stencilOpSeparate Front $= (OpKeep,OpKeep,OpIncrWrap)
stencilOpSeparate Back $= (OpKeep,OpKeep,OpDecrWrap)
stencilOpSeparate Front $= (OpKeep, OpKeep, OpIncrWrap)
stencilOpSeparate Back $= (OpKeep, OpKeep, OpDecrWrap)
stencilFunc $= (Always, 0, 255)
--draw wall shadows
currentProgram $= Just (_shadProg lwShad)
uniform (head $ _shadUnis lwShad)
currentProgram $= Just (_shadProg lwallShad)
uniform (_shadUnis lwallShad V.! 0)
$= Vector3 x y z
bindVertexArrayObject $= Just (_vao $ _shadVAO lwShad)
glDrawArrays
(marshalEPrimitiveMode $ _shadPrim lwShad)
0
bindVertexArrayObject $= lwallShad ^? shadVAO . vao -- Just (_vao $ _shadVAO lwallShad)
glDrawArrays
(marshalEPrimitiveMode $ _shadPrim lwallShad)
0
(fromIntegral nWalls)
case drawObjShads of
GeoObjShads -> do
--draw silhouette shadows
currentProgram $= Just (_shadProg llsShad)
uniform (head $ _shadUnis $ _lightingLineShadowShader pdata)
$= Vector3 x y z
uniform (_shadUnis ltShad !! 1)
$= Vector4 r g b rad
bindVertexArrayObject $= Just (_vao $ _shadVAO llsShad)
currentProgram $= Just (_shadProg llinesShad)
uniform (_shadUnis llinesShad V.! 0) $= Vector3 x y z
uniform (_shadUnis llinesShad V.! 1) $= rad
bindVertexArrayObject $= Just (_vao $ _shadVAO llinesShad)
glDrawElements
(marshalEPrimitiveMode $ _shadPrim llsShad)
(marshalEPrimitiveMode $ _shadPrim llinesShad)
(fromIntegral nSils)
GL_UNSIGNED_SHORT
nullPtr
--draw caps on the near plane as required
cullFace $= Just Back
currentProgram $= Just (_shadProg lcShad)
uniform (head $ _shadUnis lcShad)
$= Vector3 x y z
bindVertexArrayObject $= Just (_vao $ _shadVAO lcShad)
currentProgram $= Just (_shadProg lcapShad)
uniform (_shadUnis lcapShad V.! 0) $= Vector3 x y z
bindVertexArrayObject $= lcapShad ^? shadVAO . vao --Just (_vao $ _shadVAO lcapShad)
glDrawElements
(marshalEPrimitiveMode $ _shadPrim lcShad)
(marshalEPrimitiveMode $ _shadPrim lcapShad)
(fromIntegral nCaps)
GL_UNSIGNED_SHORT
nullPtr
CPUObjShads -> drawCPUShadows (V3 x y z) rad
_ -> return ()
--draw lightmap itself
depthFunc $= Just Always
-- bind world position texture
bindTO toPos
colorMask $= Color4 Enabled Enabled Enabled Enabled
stencilOp $= (OpKeep,OpKeep,OpKeep)
stencilOp $= (OpKeep, OpKeep, OpKeep)
stencilFunc $= (Equal, 0, 255)
currentProgram $= Just (_shadProg ltShad)
uniform (head $ _shadUnis ltShad)
$= Vector3 x y z
uniform (_shadUnis ltShad !! 1)
$= Vector4 r g b rad
bindVertexArrayObject $= Just (_vao $ _shadVAO ltShad)
glDrawArrays
(marshalEPrimitiveMode (_shadPrim ltShad))
0
(fromIntegral (4::Int))
currentProgram $= ltextShad ^? shadProg --Just (_shadProg ltextShad)
uniform (_shadUnis ltextShad V.! 0) $= Vector3 x y z
uniform (_shadUnis ltextShad V.! 1) $= Vector4 r g b rad
bindVertexArrayObject $= ltextShad ^? shadVAO . vao -- Just (_vao $ _shadVAO ltextShad)
glDrawArrays
(marshalEPrimitiveMode (_shadPrim ltextShad))
0
(fromIntegral (4 :: Int))
--cleanup: may not be necessary, depending on what comes after...
cullFace $= Nothing
stencilTest $= Disabled
-- assumes that vertices have already been sent to the shader
pingPongBetween
:: (FramebufferObject,TextureObject)
-> (FramebufferObject,TextureObject)
-> FullShader
-> IO ()
pingPongBetween (fb1,to1) (fb2,to2) fs = do
pingPongBetween ::
(FramebufferObject, TextureObject) ->
(FramebufferObject, TextureObject) ->
FullShader ->
IO ()
pingPongBetween (fb1, to1) (fb2, to2) fs = do
bindFramebuffer Framebuffer $= fb2
textureBinding Texture2D $= Just to1
drawShader fs 4
@@ -132,21 +138,21 @@ pingPongBetween (fb1,to1) (fb2,to2) fs = do
textureBinding Texture2D $= Just to2
drawShader fs 4
renderFoldable
:: MV.MVector (PrimState IO) FullShader
-> Picture
-> IO ()
renderFoldable ::
MV.MVector (PrimState IO) FullShader ->
Picture ->
IO ()
renderFoldable shadV struct = do
counts <- UMV.replicate 6 0
pokeBindFoldable shadV counts struct
MV.imapM_ (drawShaderLay 0 counts) shadV
------------------------------end renderFoldable
renderLayer
:: Layer
-> MV.MVector (PrimState IO) FullShader
-> UMV.MVector (PrimState IO) Int
-> IO ()
renderLayer ::
Layer ->
MV.MVector (PrimState IO) FullShader ->
UMV.MVector (PrimState IO) Int ->
IO ()
renderLayer layer shads counts = do
let layerCounts = UMV.slice (ln * numLayers) 6 counts
MV.imapM_ (drawShaderLay ln layerCounts) shads
+7 -6
View File
@@ -8,9 +8,10 @@ module Shader.AuxAddition
) where
import Shader.Data
import qualified Data.Vector as V
import Data.List.Extra
import Codec.Picture
import qualified Data.Vector.Storable as V
import qualified Data.Vector.Storable as VS
import Control.Lens
import Graphics.Rendering.OpenGL hiding (Point,translate,scale,imageHeight)
import Graphics.GL.Core43
@@ -26,7 +27,7 @@ addTexture texturePath shad = do
let wtex = fromIntegral $ imageWidth tex
htex = fromIntegral $ imageHeight tex
glTexStorage2D GL_TEXTURE_2D 3 GL_RGBA8 wtex htex
V.unsafeWith (imageData tex) $ \ptr -> do
VS.unsafeWith (imageData tex) $ \ptr -> do
glTexSubImage2D GL_TEXTURE_2D 0 0 0 wtex htex GL_RGBA GL_UNSIGNED_BYTE ptr
textureFilter Texture2DArray $= ((Linear',Just Linear') , Linear')
generateMipmap' Texture2D
@@ -42,7 +43,7 @@ vaddTextureNoFilter texturePath shad = do
let wtex = fromIntegral $ imageWidth tex
htex = fromIntegral $ imageHeight tex
glTexStorage2D GL_TEXTURE_2D 1 GL_RGBA8 wtex htex
V.unsafeWith (imageData tex) $ \ptr -> do
VS.unsafeWith (imageData tex) $ \ptr -> do
glTexSubImage2D GL_TEXTURE_2D 0 0 0 wtex htex GL_RGBA GL_UNSIGNED_BYTE ptr
return $ shad & shadTex ?~ ShaderTexture {_textureObject = textureOb}
@@ -56,7 +57,7 @@ addTextureNoFilter texturePath shad = do
let wtex = fromIntegral $ imageWidth tex
htex = fromIntegral $ imageHeight tex
glTexStorage2D GL_TEXTURE_2D 1 GL_RGBA8 wtex htex
V.unsafeWith (imageData tex) $ \ptr -> do
VS.unsafeWith (imageData tex) $ \ptr -> do
glTexSubImage2D GL_TEXTURE_2D 0 0 0 wtex htex GL_RGBA GL_UNSIGNED_BYTE ptr
return $ shad & shadTex ?~ ShaderTexture {_textureObject = textureOb}
@@ -75,7 +76,7 @@ addTextureArray texturePath shad = do
glTexStorage3D GL_TEXTURE_2D_ARRAY 3 GL_RGBA8 32 32 64
--writePng "atest.png" ((Image 256 256 (V.fromList texData)) :: Image PixelRGBA8)
--withArray texData $ \ptr -> do
V.unsafeWith (imageData tex) $ \ptr -> do
VS.unsafeWith (imageData tex) $ \ptr -> do
--glTexSubImage3D GL_TEXTURE_2D_ARRAY 0 0 0 0 32 32 64 GL_RGBA GL_UNSIGNED_BYTE ptr
glTexSubImage3D GL_TEXTURE_2D_ARRAY 0 0 0 0 32 32 64 GL_RGBA GL_UNSIGNED_BYTE ptr
textureFilter Texture2DArray $= ((Linear',Just Linear') , Linear')
@@ -93,4 +94,4 @@ tilesToLine n w = concat . concat . transpose . chunksOf n . chunksOf w
addUniforms :: [String] -> FullShader -> IO FullShader
addUniforms uniStrings shad = do
uniLocs <- mapM (uniformLocation $ _shadProg shad) uniStrings
return $ shad & shadUnis %~ (++ uniLocs)
return $ shad & shadUnis %~ (V.++ V.fromList uniLocs)
+6 -6
View File
@@ -35,7 +35,7 @@ makeShader s shaderlist sizes pm = do
, _shadVAO = vaob
, _shadPrim = pm
, _shadTex = Nothing
, _shadUnis = []
, _shadUnis = mempty
}
makeByteStringShader
:: String -- ^ (Arbitrary) name of the shader
@@ -51,7 +51,7 @@ makeByteStringShader s shaderlist sizes pm = do
, _shadVAO = vaob
, _shadPrim = pm
, _shadTex = Nothing
, _shadUnis = []
, _shadUnis = mempty
}
makeByteStringShaderUsingVAO
:: String -- ^ (Arbitrary) name of the shader
@@ -65,7 +65,7 @@ makeByteStringShaderUsingVAO s shaderlist pm fs = do
{ _shadProg = prog
, _shadPrim = pm
, _shadTex = Nothing
, _shadUnis = []
, _shadUnis = mempty
}
-- | Takes the VAO from elsewhere
@@ -82,7 +82,7 @@ makeShaderUsingVAO s shaderlist pm theVAO = do
, _shadVAO = theVAO
, _shadPrim = pm
, _shadTex = Nothing
, _shadUnis = []
, _shadUnis = mempty
}
-- | Takes the VAO from another shader
@@ -98,7 +98,7 @@ makeShaderUsingShaderVAO s shaderlist pm fs = do
{ _shadProg = prog
, _shadPrim = pm
, _shadTex = Nothing
, _shadUnis = []
, _shadUnis = mempty
}
{- |
Compiles a full shader found within the shader directory.
@@ -119,7 +119,7 @@ makeShaderSized s shaderlist sizes ndraw pm = do
, _shadVAO = vaob
, _shadPrim = pm
, _shadTex = Nothing
, _shadUnis = []
, _shadUnis = mempty
}
-- | Compile shader and get its uniform locations.
+2 -1
View File
@@ -27,6 +27,7 @@ module Shader.Data
, geom
, frag
) where
import Data.Vector (Vector)
import Graphics.Rendering.OpenGL
import Foreign
import Control.Lens
@@ -36,7 +37,7 @@ data FullShader = FullShader
, _shadVAO :: VAO
, _shadPrim :: EPrimitiveMode
, _shadTex :: Maybe ShaderTexture
, _shadUnis :: [UniformLocation]
, _shadUnis :: Vector UniformLocation
}
{- | Vertex array object: contains the reference to the object,
and its buffer targets. -}
+1
View File
@@ -4,6 +4,7 @@ module Shader.Poke
, pokeArrayOff
, pokeShape
, pokeWallsWindowsFloor
, memoTopPrismEdgeIndices
) where
import Shader.Data
import Shader.Parameters
+2 -1
View File
@@ -18,7 +18,7 @@ shVfromList = id
{-# INLINE shEfromList #-}
shEfromList = id
newtype ShapeType = TopPrism Int
newtype ShapeType = TopPrism { _prismSize :: Int }
deriving newtype (Eq, Ord, Show, Read)
--deriving stock Generic
--deriving anyclass Flat
@@ -43,6 +43,7 @@ pairToSV = uncurry ShapeV
makeLenses ''ShapeV
makeLenses ''ShapeObj
makeLenses ''ShapeType
--type Shape' = Stream (Of ShapeObj) IO ()
type Shape = [ShapeObj]