Files
loop/src/Dodge/Render.hs
T

485 lines
19 KiB
Haskell

-- | Contains the central drawing functions for the dodge loop.
module Dodge.Render (
doDrawing,
getWindowSize,
) where
import Shape.Parameters
import Control.Lens
import Control.Monad
import qualified Control.Monad.Parallel as MP
--import Data.List (sortOn)
import qualified Data.Map.Strict as M
import Data.Preload.Render
import qualified Data.Vector as V
import qualified Data.Vector.Unboxed.Mutable as UMV
import Dodge.Data.Universe
import Dodge.Render.Lights
import Dodge.Render.ShapePicture
import Dodge.Render.Walls
import Dodge.Shadows
import Dodge.WindowSize
import Foreign
import GLHelp
import Geometry
import Graphics.GL.Core45
import MatrixHelper
import Render
import qualified SDL
import Shader
import Shader.Bind
import Shader.Data
import Shader.Poke
import Shader.Poke.Cloud
doDrawing :: SDL.Window -> Universe -> IO ()
doDrawing window u
| SDL.ScancodeY `M.member` (u ^. uvWorld . input . pressedKeys) = doTestDrawing rdata u
| otherwise = doDrawing' window rdata u
where
rdata = u ^. preloadData . renderData
doTestDrawing :: RenderData -> Universe -> IO ()
doTestDrawing _ _ = do
return ()
doDrawing' :: SDL.Window -> RenderData -> Universe -> IO ()
doDrawing' win pdata u = do
--sTicks <- SDL.ticks
checkGLError "during drawing"
let w = _uvWorld u
cfig = _uvConfig u
(windowPoints, wallSPics, wallsToPoke) = wallsToDraw w
lightPoints = lightsToRender cfig (w ^. wCam) (w ^. cWorld . lWorld)
shadV = _pictureShaders pdata
nFls = w ^. cWorld . numberFloorVerxs
nchs = w ^. cWorld . numberChasmVerxs
-- bind as much data into vbos as feasible at this point
-- count mutable vectors setup
pokeCounts <- UMV.replicate (numLayers * numShads) 0
-- attempt to poke in parallel
let wswp = wallSPics <> worldSPic cfig u
ws = wswp ^. _1
wp = wswp ^. _2
((nWins, trueNWalls), (nShapeVs, nIndices, nSilIndices)) <-
MP.liftM3
(\_ a b -> (a, b))
( pokeLayVerxs
shadV
pokeCounts
wp
)
( pokeWallsWindows
(pdata ^. winVBO . vboPtr)
(pdata ^. wallVBO . vboPtr)
windowPoints
wallsToPoke
)
( pokeShape
(drawShadowsByImportance $ cfig ^. gr_shadow_size)
(_vboPtr $ _vboShapes pdata)
(_uiboPtr $ _shapeEBO pdata)
(_uiboPtr $ _silhouetteEBO pdata)
(0, 0, 0)
ws
)
(nCloudVs', nCloudIs') <-
-- Might want to sort the clouds based on z depth, not sure
V.foldM'
(pokeCloud (pdata ^. cloudVBO . vboPtr) (pdata ^. cloudEBO . uiboPtr))
(0, 0)
(V.fromList $ w ^. cWorld . lWorld . clouds)
(nCloudVs, nCloudIs) <-
V.foldM'
(pokeDust (pdata ^. cloudVBO . vboPtr) (pdata ^. cloudEBO . uiboPtr))
(nCloudVs', nCloudIs')
(V.fromList $ w ^. cWorld . lWorld . dusts)
-- bind wall points, silhouette data, surface geometry
bufferShaderLayers shadV pokeCounts
mapM_
(uncurry bufferPokedVBO)
[ (_vboShapes pdata, nShapeVs)
, (pdata ^. cloudVBO, nCloudVs)
]
mapM_
(uncurry bufferEBO)
[ (_cloudEBO pdata, nCloudIs)
, (_shapeEBO pdata, nIndices)
]
-- set the coordinate uniform ready for drawing elements using world coordinates
bufferPerspectiveMatrixUBO cfig (w ^. wCam) (pdata ^. matUBO)
glNamedBufferSubData (pdata ^. winVBO . vboName) 0
(fromIntegral $ nWins * sizeOf (0::Float) * 8)
(pdata ^. winVBO . vboPtr)
-- bufferFloatBO function
glNamedBufferSubData (pdata ^. wallVBO . vboName) 0
(fromIntegral $ trueNWalls * sizeOf (0::Float) * 8)
(pdata ^. wallVBO . vboPtr)
glNamedBufferSubData (pdata ^. vboShapes . vboName) 0
(fromIntegral $ nShapeVs * shapeVerxSize)
(pdata ^. vboShapes . vboPtr)
glNamedBufferSubData (pdata ^. shapeEBO . uiboName) 0
(fromIntegral $ nIndices * (sizeOf (0::GLuint)))
(pdata ^. shapeEBO . uiboPtr)
bufferEBO (pdata ^. silhouetteEBO) nSilIndices
setViewport _gr_world_res cfig
glBindFramebuffer GL_FRAMEBUFFER (pdata ^. fboBase . _1 . unFBO)
glDepthMask GL_TRUE
glDisable GL_BLEND
glDepthFunc GL_LESS
-- clear depth and stencil buffers
glStencilMask 255 -- to alter the entire stencil
glClearNamedFramebufferfi
(pdata ^. fboBase . _1 . unFBO)
GL_DEPTH_STENCIL
0
1
0
-- draw wall occlusions from the camera's point of view
glStencilFunc GL_NOTEQUAL 128 255
glStencilOp GL_KEEP GL_KEEP GL_REPLACE
glEnable GL_CULL_FACE
glCullFace GL_BACK
unless (debugOn Remove_LOS cfig) $ do
glUseProgram (pdata ^. ceilingStencilShader . shaderUINT)
-- glBindVertexArray $ pdata ^. ceilingStencilShader . shaderVAO . vaoName
glBindVertexArray $ pdata ^. dummyVAO . vaoName
glEnable GL_DEPTH_CLAMP
glDrawArrays
(_unPrimitiveMode $ pdata ^. ceilingStencilShader . shaderPrimitive)
0
(fromIntegral (trueNWalls * 6))
glDisable GL_DEPTH_CLAMP
glStencilMask 127 -- to alter last seven bits
glStencilOp GL_KEEP GL_KEEP GL_KEEP
-- clear color and normals
withArray [0, 0, 0, 1] $
glClearNamedFramebufferfv (pdata ^. fboBase . _1 . unFBO) GL_COLOR 0
withArray [0, 0, 0, 0] $
glClearNamedFramebufferfv (pdata ^. fboBase . _1 . unFBO) GL_COLOR 2
withArray [GL_COLOR_ATTACHMENT0, GL_COLOR_ATTACHMENT1, GL_COLOR_ATTACHMENT2] $
glNamedFramebufferDrawBuffers (pdata ^. fboBase . _1 . unFBO) 3
--draw walls onto base buffer
glEnable GL_CULL_FACE
glCullFace GL_BACK
-- glUseProgram (pdata ^. wallShader . shaderUINT)
-- glBindVertexArray $ pdata ^. wallShader . shaderVAO . vaoName
-- glDrawArrays
-- (_unPrimitiveMode $ pdata ^. wallShader . shaderPrimitive)
-- 0
-- (fromIntegral trueNWalls)
glUseProgram (pdata ^. pullWallShader . shaderUINT)
glBindVertexArray $ pdata ^. dummyVAO . vaoName
glDrawArrays
GL_TRIANGLES
0
(fromIntegral trueNWalls * 6)
--draw object shapes onto base buffer
let fs = _shapeShader pdata
glUseProgram (_shaderUINT fs)
glDrawArrays GL_TRIANGLES 0 (fromIntegral nIndices)
-- draw chasm shader blocking floor
glUseProgram (pdata ^. chasmShader . shaderUINT)
glBindVertexArray $ pdata ^. chasmShader . shaderVAO . vaoName
glDepthMask GL_FALSE
glDrawBuffer GL_NONE
glStencilOp GL_KEEP GL_KEEP GL_INCR
with 0 $
glClearNamedFramebufferiv
(pdata ^. fboBase . _1 . unFBO)
GL_STENCIL
0
glDrawArrays
(_unPrimitiveMode $ pdata ^. chasmShader . shaderPrimitive)
0
(fromIntegral nchs)
withArray [GL_COLOR_ATTACHMENT0, GL_COLOR_ATTACHMENT1, GL_COLOR_ATTACHMENT2] $
glNamedFramebufferDrawBuffers (pdata ^. fboBase . _1 . unFBO) 3
glDepthMask GL_TRUE
--draw floor onto base buffer
glUseProgram (pdata ^. floorShader . shaderUINT)
glBindVertexArray $ pdata ^. floorShader . shaderVAO . vaoName
glStencilFunc GL_EQUAL 0 255
glDrawArrays
(_unPrimitiveMode $ pdata ^. floorShader . shaderPrimitive)
0
(fromIntegral nFls)
--glDisable GL_STENCIL_TEST
glDisable GL_CULL_FACE
glEnable GL_BLEND
--draw lightmap into its own buffer
createLightMap
cfig
(fromIntegral trueNWalls)
nSilIndices
nIndices
(pdata ^. fboBase . _2 . _2)
(pdata ^. fboBase . _2 . _3)
lightPoints
pdata
glColorMask GL_TRUE GL_TRUE GL_TRUE GL_TRUE
--apply lightmap to base buffer
glDisable GL_CULL_FACE
glDepthFunc GL_ALWAYS
glDepthMask GL_FALSE
glBindFramebuffer GL_FRAMEBUFFER (pdata ^. fboBase . _1 . unFBO)
glBindTextureUnit 0 (pdata ^. fboLighting . _2 . unTO)
glEnable GL_BLEND
glBlendFunc GL_ZERO GL_ONE_MINUS_SRC_COLOR
drawShader (_fullscreenShader pdata) 4
with GL_COLOR_ATTACHMENT0 $
glInvalidateNamedFramebufferData (pdata ^. fboLighting . _1 . unFBO) 1
--draw bloom onto bloom buffer
glBindFramebuffer GL_FRAMEBUFFER (pdata ^. fboBloom . _1 . unFBO)
withArray [0, 0, 0, 0] $
glClearNamedFramebufferfv (pdata ^. fboBloom . _1 . unFBO) GL_COLOR 0
glDepthFunc GL_LESS
--glBlendFunc GL_SRC_ALPHA GL_ONE_MINUS_SRC_ALPHA
--glBlendFunc GL_ONE GL_ONE_MINUS_SRC_ALPHA
glBlendFunc GL_ONE GL_ONE
glDepthMask GL_FALSE
renderLayer BloomNoZWrite shadV pokeCounts
glDepthMask GL_TRUE
renderLayer BloomLayer shadV pokeCounts
-- draw clouds to block bloom particles, transparency blocks some alpha
glDepthMask GL_FALSE
glBlendColor 0 0 0 0.1 -- using this and GL_CONSTANT_ALPHA below
-- can allow for some bloom to bleed through underneath the clouds
-- note that BloomNoZWrite will always be under the clouds, this should be
-- rethought, either do another pass and write just the depth or even remove
-- the layer entirely
glBlendFuncSeparate GL_ZERO GL_ONE GL_CONSTANT_ALPHA GL_ONE_MINUS_SRC_ALPHA
glUseProgram (pdata ^. cloudShader . shaderUINT)
glBindVertexArray $ pdata ^. cloudShader . shaderVAO . vaoName
glDrawElements
(pdata ^. cloudShader . shaderPrimitive . unPrimitiveMode)
(fromIntegral nCloudIs)
GL_UNSIGNED_INT
nullPtr
glDepthMask GL_TRUE
--setup downscale viewport for blurring bloom
--setViewportSize (round winx `div` (2 * resFact)) (round winy `div` (2 * resFact))
setViewport _gr_downsize_res cfig
glBindFramebuffer GL_FRAMEBUFFER (_unFBO (fst (_fboHalf1 pdata)))
glDepthFunc GL_ALWAYS
glBindTextureUnit 0 (pdata ^. fboBloom . _2 . unTO)
glDisable GL_BLEND
-- this all needs more tuning + more thought
-- a fade effect would be cool, so not to fully reset last frames bloom
-- buffers...
-- withArray [0, 0, 0, 0] $
-- glClearNamedFramebufferfv (pdata ^. fboHalf1 . _1 . unFBO) GL_COLOR 0
-- withArray [0, 0, 0, 0] $
-- glClearNamedFramebufferfv (pdata ^. fboHalf2 . _1 . unFBO) GL_COLOR 0
-- glBlendFunc GL_ONE GL_ONE_MINUS_SRC_ALPHA
drawShader (_bloomBlurShader pdata) 4
when (cfig ^. gr_bloom) $ do
replicateM_ 2 $ pingPongBetween
(_fboHalf1 pdata) (_fboHalf2 pdata) (_bloomBlurShader pdata)
glEnable GL_BLEND
setViewport _gr_world_res cfig
--draw clouds onto cloud buffer
glBindFramebuffer GL_FRAMEBUFFER (pdata ^. fboCloud . _1 . unFBO)
glDepthFunc GL_LEQUAL
glDepthMask GL_FALSE
glBlendFuncSeparatei 0 GL_SRC_ALPHA GL_ONE_MINUS_SRC_ALPHA GL_ONE_MINUS_DST_ALPHA GL_ONE
--glBlendFunci 0 GL_ONE GL_ONE_MINUS_SRC_ALPHA
--withArray [GL_COLOR_ATTACHMENT0, GL_NONE] $
withArray [GL_COLOR_ATTACHMENT0, GL_COLOR_ATTACHMENT1] $
glNamedFramebufferDrawBuffers (pdata ^. fboCloud . _1 . unFBO) 2
withArray [0.5, 0.5, 0.5, 0] $
glClearNamedFramebufferfv
(pdata ^. fboCloud . _1 . unFBO)
GL_COLOR
0
glUseProgram (pdata ^. cloudShader . shaderUINT)
glBindVertexArray $ pdata ^. cloudShader . shaderVAO . vaoName
glDrawElements
(pdata ^. cloudShader . shaderPrimitive . unPrimitiveMode)
(fromIntegral nCloudIs)
GL_UNSIGNED_INT
nullPtr
-- glEnable GL_CULL_FACE
-- glEnable GL_DEPTH_CLAMP
-- glCullFace GL_BACK
---- drawShader (_windowShader pdata) nWins
-- glDisable GL_DEPTH_CLAMP
-- glDisable GL_CULL_FACE
when (_gr_cloud_shadows cfig) $ do
----render transparency depths
-- glDepthMask GL_TRUE
glDepthFunc GL_ALWAYS
glDisable GL_BLEND
withArray [GL_NONE, GL_COLOR_ATTACHMENT1, GL_COLOR_ATTACHMENT2] $
glNamedFramebufferDrawBuffers (pdata ^. fboCloud . _1 . unFBO) 3
withArray [0, 0, 0, 0] $
glClearNamedFramebufferfv (pdata ^. fboCloud . _1 . unFBO) GL_COLOR 1
withArray [0, 0, 0, 0] $
glClearNamedFramebufferfv (pdata ^. fboCloud . _1 . unFBO) GL_COLOR 2
glEnable GL_BLEND
-- we sum the positions weighted by alpha, and sum the alpha
glBlendFuncSeparatei 1 GL_SRC_ALPHA GL_ONE GL_ONE GL_ONE
--glBlendFuncSeparatei 1 GL_ONE GL_ZERO GL_ONE GL_ZERO
-- and sum the normals weighted by alpha
--glBlendFunci 2 GL_SRC_ALPHA GL_ONE
glBlendFunci 2 GL_SRC_ALPHA GL_ONE
glUseProgram (pdata ^. cloudShader . shaderUINT)
glBindVertexArray $ pdata ^. cloudShader . shaderVAO . vaoName
-- glDepthMask GL_TRUE
glDrawElements
(pdata ^. cloudShader . shaderPrimitive . unPrimitiveMode)
(fromIntegral nCloudIs)
GL_UNSIGNED_INT
nullPtr
---
-- glEnable GL_CULL_FACE
-- glEnable GL_DEPTH_CLAMP
-- glCullFace GL_BACK
---- drawShader (_windowShader pdata) nWins
-- glDisable GL_DEPTH_CLAMP
-- glDisable GL_CULL_FACE
-- drawShader (_windowShader pdata) nWins
glBindFramebuffer GL_FRAMEBUFFER (pdata ^. fboPos . _1 . unFBO)
withArray [0, 0, 0, 0] $ \ptr ->
glClearNamedFramebufferfv
(pdata ^. fboPos . _1 . unFBO)
GL_COLOR
0
ptr
glBindTextureUnit 0 (pdata ^. fboCloud . _2 . _2 . unTO)
glDepthMask GL_FALSE
drawShader (pdata ^. alphaDivideShader) 4
----draw lightmap for cloud buffer
glDepthMask GL_TRUE
glDepthFunc GL_LESS
glEnable GL_BLEND
glBindFramebuffer GL_FRAMEBUFFER (_unFBO (fst (_fboLighting pdata)))
createLightMap
cfig
(fromIntegral trueNWalls)
nSilIndices
nIndices
(pdata ^. fboPos . _2)
(pdata ^. fboCloud . _2 . _3)
lightPoints
pdata
--draw windows onto window buffer
glBindFramebuffer GL_FRAMEBUFFER (pdata ^. fboWindow . _1 . unFBO)
withArray [GL_COLOR_ATTACHMENT0, GL_COLOR_ATTACHMENT1] $
glNamedFramebufferDrawBuffers (pdata ^. fboWindow . _1 . unFBO) 2
withArray [0, 0, 0, 0] $
glClearNamedFramebufferfv (pdata ^. fboWindow . _1 . unFBO) GL_COLOR 0
withArray [0, 0, 0, 0] $
glClearNamedFramebufferfv (pdata ^. fboWindow . _1 . unFBO) GL_COLOR 1
glEnable GL_CULL_FACE
glEnable GL_DEPTH_CLAMP
glDepthFunc GL_LEQUAL
glCullFace GL_BACK
glDisable GL_BLEND
-- glDepthFunc GL_ALWAYS
-- glDisable GL_CULL_FACE
glUseProgram $ pdata ^. windowPullShader . shaderUINT
glBindVertexArray $ pdata ^. dummyVAO . vaoName
glDrawArrays GL_TRIANGLES 0 (fromIntegral nWins * 6)
--drawShader (_windowShader pdata) nWins
glDisable GL_DEPTH_CLAMP
glDisable GL_CULL_FACE
glInvalidateBufferData (pdata ^. vboShapes . vboName)
--apply lightmap to cloud buffer
glBindFramebuffer GL_FRAMEBUFFER (_unFBO (fst (_fboCloud pdata)))
glDepthMask GL_FALSE
withArray [GL_COLOR_ATTACHMENT0, GL_NONE] $
glNamedFramebufferDrawBuffers (pdata ^. fboCloud . _1 . unFBO) 2
-- $ \ptr -> glDrawBuffers 2 ptr
glDepthFunc GL_ALWAYS
glBindTextureUnit 0 (_unTO . snd $ _fboLighting pdata)
glEnable GL_BLEND
glBlendFuncSeparate GL_ZERO GL_ONE_MINUS_SRC_COLOR GL_ZERO GL_ONE
drawShader (_fullscreenShader pdata) 4
glBlendFunc GL_SRC_ALPHA GL_ONE_MINUS_SRC_ALPHA
-- bind base buffer for drawing clouds and bloom
--glBindFramebuffer GL_FRAMEBUFFER (_unFBO (fst (_fboBase pdata)))
glBindFramebuffer GL_FRAMEBUFFER (pdata ^. fboBase . _1 . unFBO)
-- --draw shadowed clouds onto base buffer
-- glBindTextureUnit 0 (pdata ^. fboCloud . _2 . _1 . unTO)
-- drawShader (_fullscreenShader pdata) 4
glBlendFunc GL_SRC_ALPHA GL_ONE_MINUS_SRC_ALPHA
-- --draw windows onto base buffer
glBlendFunc GL_SRC_ALPHA GL_ONE_MINUS_SRC_ALPHA
glBindTextureUnit 0 (pdata ^. fboWindow . _2 . _1 . unTO)
glBindTextureUnit 1 (pdata ^. fboWindow . _2 . _2 . unTO)
glBindTextureUnit 2 (pdata ^. fboCloud . _2 . _1 . unTO)
--glBindTextureUnit 3 (pdata ^. fboCloud . _2 . _2 . unTO)
glBindTextureUnit 3 (pdata ^. fboPos . _2 . unTO)
drawShader (_transparencyCompShader pdata) 4
--Draw blurred bloom onto base buffer
glEnable GL_BLEND
glBlendFunc GL_SRC_ALPHA GL_ONE
--glBlendFunc GL_ONE GL_ONE
glBindTextureUnit 0 (_unTO . snd $ _fboHalf1 pdata)
drawShader (_fullscreenShader pdata) 4
-- glBlendFunc GL_SRC_ALPHA GL_ONE_MINUS_SRC_ALPHA
--set viewport for radial distortion
--setViewportSize (round winx) (round winy)
setViewport (const FullRes) cfig
glDepthFunc GL_ALWAYS
glBlendFunc GL_ONE GL_ZERO
-- perform any radial distortion
-- this is hideous
case (getDistortions cfig w, cfig ^. gr_distortions) of
(rds, x) | null rds || not x -> do
glBindTextureUnit 0 $ pdata ^. fboBase . _2 . _1 . unTO
glBindFramebuffer GL_FRAMEBUFFER 0
drawShader (_fullscreenShader pdata) 4
(rds, _) -> do
let bindDrawDist :: Distortion -> IO ()
bindDrawDist (RadialDistortion (V2 a b) (V2 c d) (V2 e f) g) = do
pokeArray (shadVBOptr $ _barrelShader pdata) [a, b, c, d, e, f, g]
bufferPokedVBO (snd $ _barrelShader pdata) 1
drawShader (fst $ _barrelShader pdata) 1
fboList =
take (length rds - 1) (concat (repeat [fst $ _fbo2 pdata, fst $ _fbo3 pdata]))
++ [FBO 0]
toList = (pdata ^. fboBase . _2 . _1) : concat (repeat [snd $ _fbo2 pdata, snd $ _fbo3 pdata])
bindings = zipWith (>>) (map bindFBO fboList) (map (glBindTextureUnit 1 . _unTO) toList)
zipWithM_ (>>) bindings $ map bindDrawDist rds
glBlendFunc GL_SRC_ALPHA GL_ONE_MINUS_SRC_ALPHA
-- draw the overlay
--glBindFramebuffer GL_FRAMEBUFFER (pdata ^. fboOverlay ._1 . unFBO)
glDepthFunc GL_ALWAYS
glDepthMask GL_FALSE
glEnable GL_BLEND
--glBlendFunc GL_SRC_ALPHA GL_ONE_MINUS_SRC_ALPHA
glBlendFunc GL_ONE GL_ONE_MINUS_SRC_ALPHA -- assume premultiplied alpha
renderLayer DebugLayer shadV pokeCounts
glBindBufferBase GL_UNIFORM_BUFFER 0 (pdata ^. matUBO)
withArray (scaleMatrix (2 / windowXFloat cfig) (2 / windowYFloat cfig)) $
glNamedBufferSubData (pdata ^. matUBO) 0 64
glDepthFunc GL_GEQUAL
glDepthMask GL_TRUE
with (-1) $ glClearNamedFramebufferfv 0 GL_DEPTH 0
renderLayer FixedCoordLayer shadV pokeCounts
SDL.glSwapWindow win
bufferPerspectiveMatrixUBO :: Config -> Camera -> GLuint -> IO ()
bufferPerspectiveMatrixUBO cfig cam uboid = withArray
(perspectiveMatrixb (cam ^. camRot) (cam ^. camZoom) (cam ^. camCenter)
(V2 (windowXFloat cfig) (windowYFloat cfig)) (cam ^. camViewFrom))
$ glNamedBufferSubData uboid 0 64
getDistortions :: Config -> World -> [Distortion]
getDistortions cfig w
| cfig ^. gr_distortions = w ^. cWorld . lWorld . distortions
| otherwise = []
setViewport :: (Config -> ResFactor) -> Config -> IO ()
setViewport f = uncurry (glViewport 0 0) . getWindowSize f