Files
loop/src/Dodge/Render.hs
T
2025-11-14 11:27:16 +00:00

418 lines
16 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
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' <-
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 shadV pokeCounts
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)
glBindVertexArray $ pdata ^. dummyVAO
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
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
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
glDrawBuffer GL_NONE
glStencilOp GL_KEEP GL_KEEP GL_INCR
with 0 $ glClearNamedFramebufferiv (pdata ^. fboBase . _1 . unFBO) GL_STENCIL 0
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
glDisable GL_CULL_FACE
--draw floor onto base buffer
glUseProgram (pdata ^. floorShader)
glStencilFunc GL_EQUAL 0 255
glDrawArrays GL_TRIANGLES 0 (fromIntegral nFls)
--glDisable GL_STENCIL_TEST
glEnable GL_BLEND
--draw lightmap into its own buffer
createLightMap
(w ^. wCam)
cfig
(cfig ^. gr_shadow_rendering)
(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
glUseProgram (pdata ^. fullscreenShader)
glDrawArrays GL_TRIANGLES 0 6
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
--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
glUseProgram (_bloomBlurShader pdata)
glDrawArrays GL_TRIANGLES 0 6
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
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] $ \ptr ->
glClearNamedFramebufferfv
(pdata ^. fboPos . _1 . unFBO)
GL_COLOR
0
ptr
glBindTextureUnit 0 (pdata ^. fboCloud . _2 . _2 . unTO)
glDepthMask GL_FALSE
glUseProgram (pdata ^. alphaDivideShader)
glDrawArrays GL_TRIANGLES 0 6
----draw lightmap for cloud buffer
glDepthMask GL_TRUE
glDepthFunc GL_LESS
glEnable GL_BLEND
glBindFramebuffer GL_FRAMEBUFFER (_unFBO (fst (_fboLighting pdata)))
createLightMap
(w ^. wCam)
cfig
(cfig ^. gr_shadows_on_clouds)
(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)
glBindTextureUnit 3 (pdata ^. fboPos . _2 . unTO)
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
glDepthMask GL_FALSE
glEnable GL_BLEND
glBlendFunc GL_SRC_ALPHA GL_ONE
glUseProgram $ pdata ^. windowPullShader
glBindVertexArray $ pdata ^. dummyVAO
glDrawArrays GL_TRIANGLES 0 (fromIntegral nWins * 6)
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
glDepthFunc GL_ALWAYS
glBindTextureUnit 0 (_unTO . snd $ _fboLighting pdata)
glEnable GL_BLEND
glBlendFuncSeparate GL_ZERO GL_ONE_MINUS_SRC_COLOR GL_ZERO GL_ONE
glUseProgram (pdata ^. fullscreenShader)
glDrawArrays GL_TRIANGLES 0 6
glBlendFunc GL_SRC_ALPHA GL_ONE_MINUS_SRC_ALPHA
-- bind base buffer for drawing clouds and bloom
glBindFramebuffer GL_FRAMEBUFFER (pdata ^. fboBase . _1 . unFBO)
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 ^. fboPos . _2 . unTO)
--drawShader (_transparencyCompShader pdata) 4
glUseProgram (pdata ^. transparencyCompShader)
glDrawArrays GL_TRIANGLES 0 6
--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)
glUseProgram (pdata ^. fullscreenShader)
glDrawArrays GL_TRIANGLES 0 6
-- 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
glUseProgram (pdata ^. fullscreenShader)
glDrawArrays GL_TRIANGLES 0 6
(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 = uncurryV (glViewport 0 0) . getWindowSize f