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
+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