302 lines
11 KiB
Haskell
302 lines
11 KiB
Haskell
module Render (
|
|
createLightMap,
|
|
renderFoldable,
|
|
renderLayer,
|
|
pingPongBetween,
|
|
bindTO,
|
|
bindFBO,
|
|
) where
|
|
|
|
import Control.Monad
|
|
import Dodge.WindowSize
|
|
import Control.Lens
|
|
import Control.Monad.Primitive
|
|
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.Core45
|
|
import Picture.Data
|
|
import Shader
|
|
import Shader.Data
|
|
import Shader.ExtraPrimitive
|
|
|
|
-- | Determine where light is shining in the world.
|
|
-- think of the produced texture as showing what RGB values should be "taken
|
|
-- away" from the shape colors.
|
|
createLightMap ::
|
|
Configuration ->
|
|
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
|
|
TO ->
|
|
(Point3 -> Float -> IO ()) -> -- attempt at drawing shadow not using geo shader
|
|
IO ()
|
|
createLightMap cfig pdata lightPoints nWalls nSils nCaps shadsdrawtype toPos drawCPUShadows = case shadsdrawtype of
|
|
InstancingShads -> instanceLightMap cfig pdata lightPoints nWalls nSils nCaps toPos
|
|
_ -> 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
|
|
glDepthMask GL_FALSE
|
|
-- clearColor is specified differently in preloadRender
|
|
-- the colors are inverted
|
|
glClearColor 1 1 1 1
|
|
glClear GL_COLOR_BUFFER_BIT
|
|
-- 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
|
|
glBlendFunc GL_ZERO GL_ONE_MINUS_SRC_COLOR
|
|
glEnable GL_STENCIL_TEST
|
|
--stencilTest $= Enabled
|
|
glStencilOpSeparate GL_FRONT GL_KEEP GL_KEEP GL_INCR_WRAP
|
|
--stencilOpSeparate Front $= (OpKeep, OpKeep, OpIncrWrap)
|
|
--stencilOpSeparate Back $= (OpKeep, OpKeep, OpDecrWrap)
|
|
glStencilOpSeparate GL_BACK GL_KEEP GL_KEEP GL_DECR_WRAP
|
|
flip VFSM.mapM_ (VFSM.fromList lightPoints) $ \(V3 x y z, rad, V3 r g b) -> do
|
|
glDepthFunc GL_LESS
|
|
-- setup stencil
|
|
glColorMask GL_FALSE GL_FALSE GL_FALSE GL_FALSE
|
|
glClear GL_STENCIL_BUFFER_BIT
|
|
glDisable GL_CULL_FACE
|
|
--cullFace $= Nothing
|
|
glStencilFunc GL_ALWAYS 0 255
|
|
--draw wall shadows
|
|
--currentProgram $= Just (_shadProg lwallShad)
|
|
glUseProgram (_shadProg' lwallShad)
|
|
--uniform (_shadUnis lwallShad V.! 0)
|
|
-- $= Vector3 x y z
|
|
glUniform3f (_shadUnis' lwallShad V.! 0) x y z
|
|
--bindVertexArrayObject $= lwallShad ^? shadVAO' . vaoName -- Just (_vao $ _shadVAO lwallShad)
|
|
glBindVertexArray $ lwallShad ^. shadVAO' . vaoName -- Just (_vao $ _shadVAO lwallShad)
|
|
glDrawArrays
|
|
(marshalEPrimitiveMode $ _shadPrim' lwallShad)
|
|
0
|
|
(fromIntegral nWalls)
|
|
case shadsdrawtype of
|
|
GeoObjShads -> do
|
|
--draw silhouette shadows
|
|
glUseProgram (_shadProg' llinesShad)
|
|
glUniform3f (_shadUnis' llinesShad V.! 0) x y z
|
|
glUniform1f (_shadUnis' llinesShad V.! 1) rad
|
|
glBindVertexArray (_vaoName $ _shadVAO' llinesShad)
|
|
glDrawElements
|
|
(marshalEPrimitiveMode $ _shadPrim' llinesShad)
|
|
(fromIntegral nSils)
|
|
GL_UNSIGNED_SHORT
|
|
nullPtr
|
|
--draw caps on the near plane as required
|
|
glEnable GL_CULL_FACE
|
|
glCullFace GL_BACK
|
|
glUseProgram (_shadProg' lcapShad)
|
|
glUniform3f (_shadUnis' lcapShad V.! 0) x y z
|
|
glBindVertexArray $ lcapShad ^. shadVAO' . vaoName --Just (_vao $ _shadVAO lcapShad)
|
|
glDrawElements
|
|
(marshalEPrimitiveMode $ _shadPrim' lcapShad)
|
|
(fromIntegral nCaps)
|
|
GL_UNSIGNED_SHORT
|
|
nullPtr
|
|
CPUObjShads -> drawCPUShadows (V3 x y z) rad
|
|
NoObjShads -> return ()
|
|
--draw lightmap itself
|
|
glEnable GL_DEPTH_TEST
|
|
glDepthFunc GL_ALWAYS
|
|
--depthFunc $= Just Always
|
|
-- bind world position texture
|
|
bindTO toPos
|
|
glColorMask GL_TRUE GL_TRUE GL_TRUE GL_TRUE
|
|
--stencilOp $= (OpKeep, OpKeep, OpKeep)
|
|
glStencilFunc GL_EQUAL 0 255
|
|
--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
|
|
glUseProgram (ltextShad ^. shadProg') --Just (_shadProg ltextShad)
|
|
glUniform3f (_shadUnis' ltextShad V.! 0) x y z
|
|
glUniform4f (_shadUnis' ltextShad V.! 1) r g b rad
|
|
--bindVertexArrayObject $= ltextShad ^? shadVAO' . vaoName -- Just (_vao $ _shadVAO ltextShad)
|
|
glBindVertexArray $ ltextShad ^. shadVAO' . vaoName -- Just (_vao $ _shadVAO ltextShad)
|
|
glDrawArrays
|
|
(marshalEPrimitiveMode (_shadPrim' ltextShad))
|
|
0
|
|
(fromIntegral (4 :: Int))
|
|
--cleanup: may not be necessary, depending on what comes after...
|
|
glDisable GL_CULL_FACE
|
|
glDisable GL_STENCIL_TEST
|
|
|
|
lightsToArray :: [(Point3,Float,Point3)] -> [Float]
|
|
lightsToArray xs = concat (take 20 $ map t xs ++ repeat [0,0,0,0])
|
|
++ concat (take 20 $ map s xs ++ repeat [0,0,0,0])
|
|
where
|
|
t (V3 a b c,_,_) = [a,b,c,1]
|
|
s (_,d,V3 e f g) = [e,f,g,d]
|
|
--t (V3 a b c,d,V3 e f g) = [a,b,c,1]
|
|
|
|
instanceLightMap ::
|
|
Configuration ->
|
|
RenderData ->
|
|
[(Point3, Float, Point3)] -> -- Lights
|
|
-- | number of walls
|
|
Int ->
|
|
-- | number of silhoutte lines to draw
|
|
Int ->
|
|
-- | number of "caps" to attempt to draw
|
|
Int ->
|
|
-- | the texture object giving positions
|
|
TO ->
|
|
IO ()
|
|
instanceLightMap cfig pdata lightPoints nWalls nSils nCaps toPos = do
|
|
let llinesShad = _shadowEdgeShader pdata
|
|
lcapShad = _shadowCapShader pdata
|
|
lwallShad = _shadowWallShader pdata
|
|
(xsize,ysize) = getWindowSize cfig
|
|
withArray (lightsToArray lightPoints) $ \ptr ->
|
|
glNamedBufferSubData (pdata ^. lightsUBO) 0 620 ptr
|
|
|
|
forM_ [0..19] $ \i -> glCopyImageSubData
|
|
(pdata ^. rboBaseBloom)
|
|
GL_RENDERBUFFER
|
|
0
|
|
0 0 0
|
|
(pdata ^. fboShadow . _2 . _2 . unTO)
|
|
GL_TEXTURE_2D_ARRAY 0 0 0 i (fromIntegral xsize) (fromIntegral ysize)
|
|
1
|
|
glBindFramebuffer GL_FRAMEBUFFER (_unFBO (fst (_fboShadow pdata)))
|
|
glDepthMask GL_FALSE
|
|
-- clearColor is specified differently in preloadRender
|
|
-- the colors are inverted
|
|
glClearColor 0 0 0 0
|
|
glClear $ GL_COLOR_BUFFER_BIT + GL_STENCIL_BUFFER_BIT
|
|
-- 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
|
|
glEnable GL_STENCIL_TEST
|
|
glStencilOpSeparate GL_FRONT GL_KEEP GL_KEEP GL_INCR_WRAP
|
|
glStencilOpSeparate GL_BACK GL_KEEP GL_KEEP GL_DECR_WRAP
|
|
-- this was a loop
|
|
glDepthFunc GL_LESS
|
|
-- setup stencil
|
|
glColorMask GL_FALSE GL_FALSE GL_FALSE GL_FALSE
|
|
glDisable GL_CULL_FACE
|
|
glStencilFunc GL_ALWAYS 0 255
|
|
--draw wall shadows
|
|
glUseProgram (_shadProg' lwallShad)
|
|
glBindVertexArray $ lwallShad ^. shadVAO' . vaoName -- Just (_vao $ _shadVAO lwallShad)
|
|
glDrawArrays
|
|
(marshalEPrimitiveMode $ _shadPrim' lwallShad)
|
|
0
|
|
(fromIntegral nWalls)
|
|
--draw silhouette shadows
|
|
glUseProgram (_shadProg' llinesShad)
|
|
glBindVertexArray (_vaoName $ _shadVAO' llinesShad)
|
|
glDrawElements
|
|
(marshalEPrimitiveMode $ _shadPrim' llinesShad)
|
|
(fromIntegral nSils)
|
|
GL_UNSIGNED_SHORT
|
|
nullPtr
|
|
--draw caps on the near plane as required
|
|
glEnable GL_CULL_FACE
|
|
glCullFace GL_BACK
|
|
glUseProgram (_shadProg' lcapShad)
|
|
glBindVertexArray $ lcapShad ^. shadVAO' . vaoName --Just (_vao $ _shadVAO lcapShad)
|
|
glDrawElements
|
|
(marshalEPrimitiveMode $ _shadPrim' lcapShad)
|
|
(fromIntegral nCaps)
|
|
GL_UNSIGNED_SHORT
|
|
nullPtr
|
|
--draw lightmap itself
|
|
glEnable GL_DEPTH_TEST
|
|
glDepthFunc GL_ALWAYS
|
|
glColorMask GL_TRUE GL_TRUE GL_TRUE GL_TRUE
|
|
glStencilFunc GL_EQUAL 0 255
|
|
glUseProgram (pdata ^. shadowLightShader . shadProg')
|
|
-- bind world position texture
|
|
bindTO toPos
|
|
glDisable GL_BLEND
|
|
glBindVertexArray $ pdata ^. shadowLightShader . shadVAO' . vaoName
|
|
glDrawArrays
|
|
(marshalEPrimitiveMode $ pdata ^. shadowLightShader . shadPrim')
|
|
0
|
|
1
|
|
|
|
-- this was the end of the loop
|
|
glDisable GL_CULL_FACE
|
|
glDisable GL_STENCIL_TEST
|
|
|
|
--draw to the lighting framebuffer here
|
|
glBindFramebuffer GL_FRAMEBUFFER (_unFBO (fst (_fboLighting pdata)))
|
|
glClearColor 1 1 1 1
|
|
glClear GL_COLOR_BUFFER_BIT
|
|
glBindTexture GL_TEXTURE_2D_ARRAY (pdata ^. fboShadow . _2 . _1 . unTO)
|
|
glEnable GL_BLEND
|
|
glBlendFunc GL_ZERO GL_ONE_MINUS_SRC_COLOR
|
|
glUseProgram (pdata ^. shadowCombineShader . shadProg') --Just (_shadProg ltextShad)
|
|
glDrawArrays
|
|
(marshalEPrimitiveMode EPoints)
|
|
0
|
|
1
|
|
|
|
-- assumes that vertices have already been sent to the shader
|
|
pingPongBetween ::
|
|
(FBO, TO) ->
|
|
(FBO, TO) ->
|
|
FullShader ->
|
|
IO ()
|
|
pingPongBetween (fb1, to1) (fb2, to2) fs = do
|
|
--bindFramebuffer Framebuffer $= fb2
|
|
glBindFramebuffer GL_FRAMEBUFFER (_unFBO fb2)
|
|
--textureBinding Texture2D $= Just to1
|
|
glBindTexture GL_TEXTURE_2D (_unTO to1)
|
|
drawShader fs 4
|
|
--bindFramebuffer Framebuffer $= fb1
|
|
glBindFramebuffer GL_FRAMEBUFFER (_unFBO fb1)
|
|
--textureBinding Texture2D $= Just to2
|
|
glBindTexture GL_TEXTURE_2D (_unTO to2)
|
|
drawShader fs 4
|
|
|
|
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 shads counts = do
|
|
let layerCounts = UMV.slice (ln * numLayers) 6 counts
|
|
MV.imapM_ (drawShaderLay ln layerCounts) shads
|
|
where
|
|
ln = layerNum layer
|
|
|
|
bindTO :: TO -> IO ()
|
|
bindTO t = glBindTexture GL_TEXTURE_2D (_unTO t)
|
|
--textureBinding Texture2D $= Just t
|
|
|
|
bindFBO :: FBO -> IO ()
|
|
bindFBO fb = --bindFramebuffer Framebuffer $= fb
|
|
glBindFramebuffer GL_FRAMEBUFFER (_unFBO fb)
|