Files
loop/src/Dodge/Render.hs
T

450 lines
18 KiB
Haskell

-- | Contains the central drawing functions for the dodge loop.
module Dodge.Render (
doDrawing,
getWindowSize,
) where
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.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
-- SDL.glSwapWindow win
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' <- -- foldM (pokeCloud $ pdata ^. cloudVBO . vboPtr) 0 (w ^. cWorld . lWorld . clouds)
V.foldM'
(pokeCloud (pdata ^. cloudVBO . vboPtr))
0
(V.fromList $ w ^. cWorld . lWorld . clouds)
nCloudVs <-
V.foldM'
(pokeDust (pdata ^. cloudVBO . vboPtr))
nCloudVs'
(V.fromList $ w ^. cWorld . lWorld . dusts)
-- bind wall points, silhouette data, surface geometry
bufferShaderLayers pokeCounts shadV
bufferPokedVBO (_vboShapes pdata) nShapeVs
bufferPokedVBO (pdata ^. winVBO) nWins
bufferPokedVBO (pdata ^. wallVBO) trueNWalls
bufferPokedVBO (pdata ^. cloudVBO) nCloudVs
bufferEBO (_shapeEBO pdata) nIndices
bufferEBO (pdata ^. silhouetteEBO) nSilIndices
-- set the coordinate uniform ready for drawing elements using world coordinates
bufferPerspectiveMatrixUBO cfig (w ^. wCam) (pdata ^. matUBO)
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
unless (debugOn Remove_LOS cfig) $ do
glUseProgram (pdata ^. ceilingStencilShader)
glEnable GL_DEPTH_CLAMP
glDrawArrays GL_TRIANGLES 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
-- glNamedFramebufferDrawBuffers set in preloadRender
--draw walls onto base buffer
glUseProgram (pdata ^. pullWallShader)
glDrawArrays GL_TRIANGLES 0 (fromIntegral trueNWalls * 6)
--draw object shapes onto base buffer
let fs = _shapeShader pdata
glUseProgram fs
glDrawArrays GL_TRIANGLES 0 (fromIntegral nIndices)
-- draw chasm shader blocking floor
glUseProgram (pdata ^. chasmShader)
glDepthMask GL_FALSE
glStencilOp GL_KEEP GL_KEEP GL_INCR
with 0 $ glClearNamedFramebufferiv (pdata ^. fboBase . _1 . unFBO) GL_STENCIL 0
-- need to set the drawbuffer to none
glDrawBuffer GL_NONE
glDrawArrays GL_TRIANGLES 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)
glStencilFunc GL_EQUAL 0 255
glDrawArrays GL_TRIANGLES 0 (fromIntegral nFls)
glEnable GL_BLEND
--draw lightmap into its own buffer
createLightMap
False
(w ^. wCam)
cfig
(cfig ^. gr_shadow_rendering)
(fromIntegral trueNWalls)
nSilIndices
nIndices
(pdata ^. fboBase . _2 . _2)
(pdata ^. fboBase . _2 . _3)
lightPoints
pdata
-- -- no longer need base positions/normals
-- withArray [GL_COLOR_ATTACHMENT1,GL_COLOR_ATTACHMENT2] $
-- glInvalidateNamedFramebufferData (pdata ^. fboBase . _1 . unFBO) 2
glColorMask GL_TRUE GL_TRUE GL_TRUE GL_TRUE
--apply lightmap to base buffer
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
glUseProgram (pdata ^. fullscreenShader)
--glDrawArrays GL_TRIANGLES 0 6
glDrawArrays GL_TRIANGLES 0 3
-- no longer need lighting texture
-- 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_LEQUAL
--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
glBlendColor 0 0 0 0.05 -- using this and GL_CONSTANT_ALPHA below
-- can allow for extra 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)
glDrawArrays GL_TRIANGLES 0 (fromIntegral nCloudVs * 6)
--setup downscale viewport for blurring bloom
setViewport _gr_downsize_res cfig
glBindFramebuffer GL_FRAMEBUFFER $ pdata ^. fboHalf . _1 . unFBO
glDepthFunc GL_ALWAYS
glGenerateTextureMipmap (pdata ^. fboBloom . _2 . unTO)
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
glUseProgram (_bloomBlurShader pdata)
--glDrawArrays GL_TRIANGLES 0 6
glDrawArrays GL_TRIANGLES 0 3
glBindFramebuffer GL_FRAMEBUFFER $ pdata ^. fboQuarter . _1 . unFBO
glGenerateTextureMipmap (pdata ^. fboHalf . _2 . unTO)
glBindTextureUnit 0 (pdata ^. fboHalf . _2 . unTO)
setViewport (const SixteenthRes) cfig
glDrawArrays GL_TRIANGLES 0 3
glEnable GL_BLEND
-- when (cfig ^. gr_bloom) $ do
-- replicateM_ 1 $
-- 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] $
withArray [GL_COLOR_ATTACHMENT0] $
glNamedFramebufferDrawBuffers (pdata ^. fboCloud . _1 . unFBO) 1
withArray [0.5, 0.5, 0.5, 0] $
glClearNamedFramebufferfv
(pdata ^. fboCloud . _1 . unFBO)
GL_COLOR
0
glUseProgram (pdata ^. cloudShader)
glDrawArrays GL_TRIANGLES 0 (fromIntegral nCloudVs * 6)
when (_gr_cloud_shadows cfig) $ do
----render transparency depths
-- glDepthMask GL_TRUE
glDepthMask GL_TRUE
glDepthFunc GL_ALWAYS
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
-- we divide by the alpha later
-- and sum the normals weighted by alpha
glBlendFunci 2 GL_SRC_ALPHA GL_ONE
glUseProgram (pdata ^. cloudShader)
glDrawArrays GL_TRIANGLES 0 (fromIntegral nCloudVs * 6)
glBindFramebuffer GL_FRAMEBUFFER (pdata ^. fboPos . _1 . unFBO)
withArray [0, 0, 0, 0] $
glClearNamedFramebufferfv (pdata ^. fboPos . _1 . unFBO) GL_COLOR 0
glBindTextureUnit 0 (pdata ^. fboCloud . _2 . _2 . unTO)
glDepthMask GL_FALSE
glUseProgram (pdata ^. alphaDivideShader)
--glDrawArrays GL_TRIANGLES 0 6
glDrawArrays GL_TRIANGLES 0 3
----draw lightmap for cloud buffer
glDepthMask GL_TRUE
glDepthFunc GL_LESS
glEnable GL_BLEND
glBindFramebuffer GL_FRAMEBUFFER $ pdata ^. fboLighting . _1 . unFBO
createLightMap
True
(w ^. wCam)
cfig
(cfig ^. gr_shadows_on_clouds)
(fromIntegral trueNWalls)
nSilIndices
nIndices
(pdata ^. fboPos . _2)
(pdata ^. fboCloud . _2 . _3)
lightPoints
pdata
-- no longer need cloud normals
withArray [GL_COLOR_ATTACHMENT1] $
glInvalidateNamedFramebufferData (pdata ^. fboCloud . _1 . unFBO) 1
-- no longer need shape data
glInvalidateBufferData (pdata ^. vboShapes . vboName)
--draw windows into window textures
glBindFramebuffer GL_FRAMEBUFFER (pdata ^. fboWindow . _1 . unFBO)
glBindTextureUnit 3 (pdata ^. fboPos . _2 . unTO)
-- glNamedFramebufferDrawBuffers should be set in preloadRender
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
glDepthMask GL_FALSE
glEnable GL_BLEND
--glBlendFunc GL_SRC_ALPHA GL_ONE
glBindTextureUnit 3 (pdata ^. fboPos . _2 . unTO)
-- with all source alphas 0.25, alpha -> 0.5
glBlendFunc GL_ONE_MINUS_DST_ALPHA GL_ONE_MINUS_SRC_ALPHA
glUseProgram $ pdata ^. windowPullShader
glDrawArrays GL_TRIANGLES 0 (fromIntegral nWins * 12)
-- don't need cloud postions any more
withArray [GL_COLOR_ATTACHMENT0] $
glInvalidateNamedFramebufferData (pdata ^. fboPos . _1 . unFBO) 1
glEnable GL_CULL_FACE
glDisable GL_DEPTH_CLAMP
--apply lightmap to cloud buffer
glBindFramebuffer GL_FRAMEBUFFER $ pdata ^. fboCloud . _1 . unFBO
glDepthMask GL_FALSE
withArray [GL_COLOR_ATTACHMENT0, GL_NONE] $
glNamedFramebufferDrawBuffers (pdata ^. fboCloud . _1 . unFBO) 2
glDepthFunc GL_ALWAYS
glBindTextureUnit 0 (pdata ^. fboLighting . _2 . unTO)
glEnable GL_BLEND
glBlendFuncSeparate GL_ZERO GL_ONE_MINUS_SRC_COLOR GL_ZERO GL_ONE
glUseProgram (pdata ^. fullscreenShader)
--glDrawArrays GL_TRIANGLES 0 6
glDrawArrays GL_TRIANGLES 0 3
glBlendFunc GL_SRC_ALPHA GL_ONE_MINUS_SRC_ALPHA
-- bind base buffer for drawing clouds and bloom
--glBindFramebuffer GL_FRAMEBUFFER (pdata ^. fboBase . _1 . unFBO)
glBindFramebuffer GL_FRAMEBUFFER (pdata ^. fboFullscreen . _1 . unFBO)
setViewport (const FullRes) cfig
glUseProgram (pdata ^. fullscreenShader)
glBindTextureUnit 0 (pdata ^. fboBase . _2 . _1 . unTO)
glDisable GL_BLEND
glDrawArrays GL_TRIANGLES 0 3
glEnable GL_BLEND
glBindTextureUnit 0 (pdata ^. fboWindow . _2 . _2 . unTO)
glBlendFunc GL_DST_COLOR GL_ONE_MINUS_SRC_ALPHA
--glDrawArrays GL_TRIANGLES 0 6
glDrawArrays GL_TRIANGLES 0 3
glBindTextureUnit 0 (pdata ^. fboCloud . _2 . _1 . unTO)
glUseProgram (pdata ^. upscaleCloudShader)
glUniform2f 0 (windowXFloat cfig) (windowYFloat cfig)
glBlendFunc GL_SRC_ALPHA GL_ONE_MINUS_SRC_ALPHA
glDrawArrays GL_TRIANGLES 0 3
glUseProgram (pdata ^. fullscreenShader)
glBindTextureUnit 0 (pdata ^. fboWindow . _2 . _1 . unTO)
glBlendFunc GL_DST_COLOR GL_ONE_MINUS_SRC_ALPHA
glDrawArrays GL_TRIANGLES 0 3
--Draw blurred bloom onto base buffer
glEnable GL_BLEND
glBlendFunc GL_SRC_ALPHA GL_ONE
--glBlendFunc GL_ONE GL_ONE
glBindTextureUnit 0 (_unTO . snd $ _fboQuarter pdata)
glUseProgram (pdata ^. fullscreenShader)
--glDrawArrays GL_TRIANGLES 0 6
glDrawArrays GL_TRIANGLES 0 3
glBindTextureUnit 0 (_unTO . snd $ _fboHalf pdata)
glUseProgram (pdata ^. fullscreenShader)
--glDrawArrays GL_TRIANGLES 0 6
glDrawArrays GL_TRIANGLES 0 3
glBindTextureUnit 0 (_unTO . snd $ _fboBloom pdata)
glUseProgram (pdata ^. fullscreenShader)
--glDrawArrays GL_TRIANGLES 0 6
glDrawArrays GL_TRIANGLES 0 3
--set viewport for radial distortion
--setViewportSize (round winx) (round winy)
setViewport (const FullRes) cfig
glDepthFunc GL_ALWAYS
glBlendFunc GL_ONE GL_ZERO
-- perform distortions
case getDistortions cfig w of
[] -> do
-- glBindTextureUnit 0 $ pdata ^. fboBase . _2 . _1 . unTO
glBindTextureUnit 0 $ pdata ^. fboFullscreen . _2 . unTO
glBindFramebuffer GL_FRAMEBUFFER 0
if cfig ^. gr_upscale_filter then do
glUseProgram (pdata ^. textureAntiaShader)
glGenerateTextureMipmap (pdata ^. fboBase . _2 . _1 . unTO)
glUniform2f 0 (windowXFloat cfig) (windowYFloat cfig)
else glUseProgram (pdata ^. fullscreenShader)
--glDrawArrays GL_TRIANGLES 0 6
glDrawArrays GL_TRIANGLES 0 3
rs' -> do
let rs = take 15 rs'
glBindFramebuffer GL_FRAMEBUFFER 0
withArray (concatMap rdToVec2s rs) $
glNamedBufferSubData (pdata ^. barrelShader . _2 . vboName) 0
(24 * fromIntegral (length rs * sizeOf (0 :: Float)))
-- glBindTextureUnit 1 $ pdata ^. fboBase . _2 . _1 . unTO
glBindTextureUnit 1 $ pdata ^. fboFullscreen . _2 . unTO
glUseProgram (pdata ^. barrelShader . _1)
glUniform1i 0 (fromIntegral (length rs))
--glDrawArrays GL_TRIANGLES 0 6
glDrawArrays GL_TRIANGLES 0 6
glBlendFunc GL_SRC_ALPHA GL_ONE_MINUS_SRC_ALPHA
-- draw the overlay
glDepthFunc GL_LEQUAL
--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
glDisable GL_CULL_FACE
renderLayer DebugLayer shadV pokeCounts
withArray (scaleMatrix (2 / windowXFloat cfig) (2 / windowYFloat cfig)) $
glNamedBufferSubData (pdata ^. matUBO) 0 64
glDepthMask GL_TRUE
with 1 $ glClearNamedFramebufferfv 0 GL_DEPTH 0
renderLayer FixedCoordLayer shadV pokeCounts
glEnable GL_CULL_FACE
checkGLError "during doDrawing'"
SDL.glSwapWindow win
rdToVec2s :: Distortion -> [Point2]
rdToVec2s (RadialDistortion a b c d e f _) = [a,b,c] <> t d <> t e <> t f
where
t (V3 x y z) = [x,y,z]
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 = uncurryV (glViewport 0 0) . getWindowSize f