module Render ( createLightMap, renderFoldable, renderLayer, pingPongBetween, bindTO, bindFBO, ) where import Control.Lens import Control.Monad 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 Dodge.WindowSize 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 NoShadows -> do let 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 lightmap itself glDepthFunc GL_ALWAYS -- bind world position texture bindTO toPos glColorMask GL_TRUE GL_TRUE GL_TRUE GL_TRUE glStencilFunc GL_EQUAL 0 255 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 NoLighting -> do glBindFramebuffer GL_FRAMEBUFFER (_unFBO (fst (_fboLighting pdata))) glClearColor 0 0 0 1 -- glClearDepth 0 glBlendFunc GL_ZERO GL_ONE_MINUS_SRC_COLOR glClear $ GL_COLOR_BUFFER_BIT + GL_DEPTH_BUFFER_BIT -- glClearDepth 1 glDisable GL_CULL_FACE bindTO toPos glDepthFunc GL_ALWAYS glDepthMask GL_FALSE _ -> 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 glDepthFunc GL_ALWAYS -- bind world position texture bindTO toPos glColorMask GL_TRUE GL_TRUE GL_TRUE GL_TRUE glStencilFunc GL_EQUAL 0 255 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] 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 lcapShad = _shadowCapShader 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 $ pdata ^. fboShadow . _1 . unFBO glDepthMask GL_FALSE glClearColor 0 0 0 0 glClear $ GL_COLOR_BUFFER_BIT + GL_STENCIL_BUFFER_BIT -- stencil out the shadows from each light's point of view -- setup stencil glEnable GL_STENCIL_TEST glStencilOpSeparate GL_FRONT GL_KEEP GL_KEEP GL_INCR_WRAP glStencilOpSeparate GL_BACK GL_KEEP GL_KEEP GL_DECR_WRAP glDepthFunc GL_LESS glColorMask GL_FALSE GL_FALSE GL_FALSE GL_FALSE glDisable GL_BLEND glDisable GL_CULL_FACE glStencilFunc GL_ALWAYS 0 255 --draw wall shadows glUseProgram $ pdata ^. shadowWallShader . shadProg' glBindVertexArray $ pdata ^. shadowWallShader . shadVAO' . vaoName -- Just (_vao $ _shadVAO lwallShad) glDrawArrays (marshalEPrimitiveMode $ pdata ^. shadowWallShader . shadPrim') 0 (fromIntegral nWalls) --draw silhouette shadows glUseProgram $ pdata ^. shadowEdgeShader . shadProg' glBindVertexArray $ pdata ^. shadowEdgeShader . shadVAO' . vaoName glDrawElements (marshalEPrimitiveMode $ pdata ^. shadowEdgeShader . shadPrim') (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 glDrawElements (marshalEPrimitiveMode $ _shadPrim' lcapShad) (fromIntegral nCaps) GL_UNSIGNED_SHORT nullPtr --draw lightmap itself 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 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 withArray [GL_COLOR_ATTACHMENT0, GL_DEPTH_STENCIL_ATTACHMENT] $ \ptr -> glInvalidateNamedFramebufferData (pdata ^. fboShadow . _1 . unFBO) 2 ptr -- 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)