359 lines
13 KiB
Haskell
359 lines
13 KiB
Haskell
-- | Contains the central drawing functions for the dodge loop.
|
|
module Dodge.Render (
|
|
doDrawing,
|
|
) where
|
|
|
|
--import qualified Data.Vector as V
|
|
|
|
import GLHelp
|
|
import Control.Lens
|
|
import Control.Monad
|
|
import qualified Control.Monad.Parallel as MP
|
|
import qualified Data.Map.Strict as M
|
|
import Data.Preload.Render
|
|
import qualified Data.Vector.Unboxed.Mutable as UMV
|
|
import Dodge.Data.Universe
|
|
import Dodge.Render.Lights
|
|
import Dodge.Render.Picture
|
|
import Dodge.Render.Shadow
|
|
import Dodge.Render.ShapePicture
|
|
import Dodge.Render.Walls
|
|
import Foreign
|
|
import Geometry
|
|
import Graphics.GL.Core45
|
|
import MatrixHelper
|
|
import Picture.Base
|
|
import Render
|
|
import qualified SDL
|
|
--import qualified SDL
|
|
import Shader
|
|
import Shader.Bind
|
|
import Shader.Data
|
|
import Shader.ExtraPrimitive
|
|
import Shader.Parameters
|
|
import Shader.Poke
|
|
|
|
doDrawing :: SDL.Window -> RenderData -> Universe -> IO ()
|
|
doDrawing window rdata u
|
|
| SDL.ScancodeT `M.member` (u ^. uvWorld . input . pressedKeys) = doTestDrawing rdata u
|
|
| otherwise = doDrawing' window rdata u
|
|
|
|
doTestDrawing :: RenderData -> Universe -> IO ()
|
|
doTestDrawing _ _ = do
|
|
return ()
|
|
|
|
doDrawing' :: SDL.Window -> RenderData -> Universe -> IO ()
|
|
doDrawing' win pdata u = do
|
|
--sTicks <- SDL.ticks
|
|
checkGLError
|
|
let w = _uvWorld u
|
|
cfig = _uvConfig u
|
|
rot = w ^. cWorld . camPos . camRot
|
|
camzoom = w ^. cWorld . camPos . camZoom
|
|
trans = w ^. cWorld . camPos . camCenter
|
|
wins@(V2 winx winy) = V2 (_windowX cfig) (_windowY cfig)
|
|
resFact = resFactorNum $ cfig ^. graphics_resolution_factor
|
|
(wallPointsCol, windowPoints, wallSPics, wallsToPoke) = wallsToDraw w
|
|
lightPoints = lightsToRender cfig (w ^. cWorld . camPos) (w ^. cWorld . lWorld)
|
|
viewFroms@(V2 vfx vfy) = w ^. cWorld . camPos . camViewFrom
|
|
shadV = _pictureShaders pdata
|
|
nFls = w ^. cWorld . numberFloorVerxs
|
|
-- bind as much data into vbos as feasible at this point
|
|
-- count mutable vectors setup
|
|
layerCounts <- UMV.replicate (numLayers * 6) 0
|
|
-- attempt to poke in parallel
|
|
let (ws, wp) = wallSPics <> worldSPic cfig w
|
|
((nWalls, nWins,trueNWalls), (nShapeVs, nIndices, nSilIndices)) <-
|
|
MP.bindM3
|
|
(\_ a b -> return (a, b))
|
|
( pokeLayVerxs
|
|
shadV
|
|
layerCounts
|
|
wp
|
|
)
|
|
( pokeWallsWindows
|
|
( pdata ^. vboWalls . vboPtr)
|
|
( pdata ^. vboWindows . vboPtr)
|
|
( pdata ^. wallVBO . vboPtr)
|
|
wallPointsCol
|
|
windowPoints
|
|
wallsToPoke
|
|
)
|
|
( pokeShape
|
|
(_vboPtr $ _vboShapes pdata)
|
|
(_eboPtr $ _shapeEBO pdata)
|
|
(_eboPtr $ _silhouetteEBO pdata)
|
|
(0, 0, 0)
|
|
ws
|
|
)
|
|
-- bind wall points, silhouette data, surface geometry
|
|
bindShaderLayers shadV layerCounts
|
|
uncurry (zipWithM_ bufferPokedVBO) $
|
|
unzip
|
|
[ (pdata ^. vboWalls, nWalls)
|
|
, (pdata ^. vboWindows, nWins)
|
|
, (pdata ^. wallVBO, trueNWalls)
|
|
]
|
|
bufferPokedVBO (_vboShapes pdata) nShapeVs
|
|
glNamedBufferSubData
|
|
(_eboName $ _shapeEBO pdata)
|
|
0
|
|
(fromIntegral $ glushortSize * nIndices)
|
|
(_eboPtr $ _shapeEBO pdata)
|
|
glNamedBufferSubData
|
|
(_eboName $ _silhouetteEBO pdata)
|
|
0
|
|
(fromIntegral $ glushortSize * nSilIndices)
|
|
(_eboPtr $ _silhouetteEBO pdata)
|
|
-- set the coordinate uniform ready for drawing elements using world coordinates
|
|
glBindBufferBase GL_UNIFORM_BUFFER 0 (pdata ^. matUBO)
|
|
withArray (perspectiveMatrixb rot camzoom trans wins viewFroms) $ \ptr ->
|
|
glNamedBufferSubData (pdata ^. matUBO) 0 64 ptr
|
|
setViewportSize (round winx `div` resFact) (round winy `div` resFact)
|
|
glBindFramebuffer GL_FRAMEBUFFER (_unFBO (fst (_fboBase pdata)))
|
|
glDepthMask GL_TRUE
|
|
-- the following clear may not be necessary
|
|
withArray [0,0,0,1] $ \ptr -> glClearNamedFramebufferfv
|
|
(pdata ^. fboBase . _1 . unFBO)
|
|
GL_COLOR
|
|
0
|
|
ptr
|
|
with 1 $ \ptr -> glClearNamedFramebufferfv
|
|
(pdata ^. fboBase . _1 . unFBO)
|
|
GL_DEPTH
|
|
0
|
|
ptr
|
|
|
|
glDepthFunc GL_LESS
|
|
-- draw wall occlusions from the camera's point of view
|
|
glUseProgram (pdata ^. lightingWallShadShader . shadName)
|
|
glProgramUniform3f (pdata ^. lightingWallShadShader . shadName)
|
|
0 vfx vfy 20
|
|
glProgramUniform1f (pdata ^. lightingWallShadShader . shadName)
|
|
1 1000
|
|
glBindVertexArray $ pdata ^. lightingWallShadShader . shadVAO . vaoName
|
|
unless (debugOn Remove_LOS cfig) $
|
|
glDrawArrays
|
|
(marshalEPrimitiveMode $ pdata ^. lightingWallShadShader . shadPrim')
|
|
0
|
|
(fromIntegral nWalls)
|
|
-- clear normals
|
|
withArray [0,0,0,0] $ \ptr -> glClearNamedFramebufferfv
|
|
(pdata ^. fboBase . _1 . unFBO)
|
|
GL_COLOR
|
|
2
|
|
ptr
|
|
--draw walls onto base buffer
|
|
glDisable GL_BLEND
|
|
glBindTextureUnit 1 (pdata ^. toNormalMaps . unTO)
|
|
glBindTextureUnit 2 (pdata ^. toDiffuse . unTO)
|
|
-- maybe cull faces? maybe do this before?
|
|
--glEnable GL_CULL_FACE
|
|
--glCullFace GL_BACK
|
|
glUseProgram (pdata ^. wallShader . shadName)
|
|
glBindVertexArray $ pdata ^. wallShader . shadVAO . vaoName
|
|
glDrawArrays
|
|
(marshalEPrimitiveMode $ pdata ^. wallShader . shadPrim')
|
|
0
|
|
(fromIntegral trueNWalls)
|
|
--glDisable GL_CULL_FACE
|
|
-- if cfig ^. graphics_wall_textured
|
|
-- then renderTextureWalls pdata nWalls
|
|
-- else renderBlankWalls pdata nWalls
|
|
--draw object pictures onto base buffer
|
|
renderLayer BottomLayer shadV layerCounts
|
|
--draw object shapes onto base buffer
|
|
let fs = _shapeShader pdata
|
|
glUseProgram (_shadName fs)
|
|
glBindVertexArray $ fs ^. shadVAO . vaoName
|
|
-- glEnable GL_CULL_FACE
|
|
-- glCullFace GL_BACK
|
|
glDrawElements
|
|
(marshalEPrimitiveMode $ _shadPrim' fs)
|
|
(fromIntegral nIndices)
|
|
GL_UNSIGNED_SHORT
|
|
nullPtr
|
|
glDisable GL_CULL_FACE
|
|
--draw floor onto base buffer
|
|
glUseProgram (pdata ^. floorShader . shadName)
|
|
glBindVertexArray $ pdata ^. floorShader . shadVAO . vaoName
|
|
glBindTextureUnit 1 (pdata ^. toNormalMaps . unTO)
|
|
glBindTextureUnit 2 (pdata ^. toDiffuse . unTO)
|
|
glDrawArrays
|
|
(marshalEPrimitiveMode $ pdata ^. floorShader . shadPrim' )
|
|
0
|
|
(fromIntegral $ nFls)
|
|
glEnable GL_BLEND
|
|
--draw lightmap into its own buffer
|
|
createLightMap
|
|
cfig
|
|
pdata
|
|
lightPoints
|
|
nWalls
|
|
nSilIndices
|
|
nIndices
|
|
(u ^. uvConfig . graphics_object_shadows)
|
|
(pdata ^. fboBase . _2 . _2)
|
|
(drawCPUShadows pdata ws)
|
|
glColorMask GL_TRUE GL_TRUE GL_TRUE GL_TRUE
|
|
--apply lightmap to base buffer
|
|
glBindFramebuffer GL_FRAMEBUFFER (pdata ^. fboBase . _1 . unFBO)
|
|
glBindTexture GL_TEXTURE_2D (pdata ^. fboLighting . _2 . unTO)
|
|
glEnable GL_BLEND
|
|
glBlendFunc GL_ZERO GL_ONE_MINUS_SRC_COLOR
|
|
drawShader (fst $ _fullscreenShader pdata) 4
|
|
with GL_COLOR_ATTACHMENT0 $ \ptr ->
|
|
glInvalidateNamedFramebufferData
|
|
(pdata ^. fboLighting . _1 . unFBO)
|
|
1
|
|
ptr
|
|
--draw bloom onto bloom buffer
|
|
glBindFramebuffer GL_FRAMEBUFFER (pdata ^. fboBloom . _1 . unFBO)
|
|
withArray [0,0,0,0] $ \ptr -> glClearNamedFramebufferfv
|
|
(pdata ^. fboBloom . _1 . unFBO)
|
|
GL_COLOR
|
|
0
|
|
ptr
|
|
glDepthFunc GL_LESS
|
|
glBlendFunc GL_SRC_ALPHA GL_ONE_MINUS_SRC_ALPHA
|
|
glDepthMask GL_FALSE
|
|
renderLayer BloomNoZWrite shadV layerCounts
|
|
glDepthMask GL_TRUE
|
|
renderLayer BloomLayer shadV layerCounts
|
|
--setup downscale viewport for blurring bloom
|
|
setViewportSize (round winx `div` (2 * resFact)) (round winy `div` (2 * resFact))
|
|
glBindFramebuffer GL_FRAMEBUFFER (_unFBO (fst (_fboHalf1 pdata)))
|
|
glDepthFunc GL_ALWAYS
|
|
glBindTexture GL_TEXTURE_2D (pdata ^. fboBloom . _2 . unTO)
|
|
glDisable GL_BLEND
|
|
drawShader (_bloomBlurShader pdata) 4
|
|
replicateM_ 9 $ pingPongBetween (_fboHalf1 pdata) (_fboHalf2 pdata) (_bloomBlurShader pdata)
|
|
glEnable GL_BLEND
|
|
setViewportSize (round winx `div` resFact) (round winy `div` resFact)
|
|
--draw clouds onto cloud buffer
|
|
glBindFramebuffer GL_FRAMEBUFFER (_unFBO (fst (_fboCloud pdata)))
|
|
glDepthFunc GL_LEQUAL
|
|
glDepthMask GL_FALSE
|
|
glBlendFuncSeparate GL_SRC_ALPHA GL_ONE_MINUS_SRC_ALPHA GL_ONE GL_ONE_MINUS_SRC_ALPHA
|
|
withArray [GL_COLOR_ATTACHMENT0, GL_NONE] $ \ptr -> glDrawBuffers 2 ptr
|
|
withArray [0.5,0.5,0.5,0] $ \ptr -> glClearNamedFramebufferfv
|
|
(pdata ^. fboCloud . _1 . unFBO)
|
|
GL_COLOR
|
|
0
|
|
ptr
|
|
renderLayer MidLayer shadV layerCounts
|
|
drawShader (_windowShader pdata) nWins
|
|
-- when (_graphics_cloud_shadows cfig) $ do
|
|
-- ----render transparency depths
|
|
-- glDepthMask GL_TRUE
|
|
-- glDisable GL_BLEND
|
|
-- withArray [GL_NONE, GL_COLOR_ATTACHMENT1] $ \ptr -> glDrawBuffers 2 ptr
|
|
-- renderLayer MidLayer shadV layerCounts
|
|
-- drawShader (_windowShader pdata) nWins
|
|
-- ----draw lightmap for cloud buffer
|
|
-- glDepthMask GL_FALSE
|
|
-- glEnable GL_BLEND
|
|
-- glBindFramebuffer GL_FRAMEBUFFER (_unFBO (fst (_fboLighting pdata)))
|
|
-- createLightMap
|
|
-- cfig
|
|
-- pdata
|
|
-- lightPoints
|
|
-- nWalls
|
|
-- nSilIndices
|
|
-- nIndices
|
|
-- (_graphics_object_shadows $ _uvConfig u)
|
|
-- (snd $ snd $ _fboCloud pdata)
|
|
-- (drawCPUShadows pdata ws)
|
|
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] $ \ptr -> glDrawBuffers 2 ptr
|
|
glDepthFunc GL_ALWAYS
|
|
glBindTexture GL_TEXTURE_2D (_unTO . snd $ _fboLighting pdata)
|
|
glEnable GL_BLEND
|
|
glBlendFuncSeparate GL_ZERO GL_ONE_MINUS_SRC_COLOR GL_ZERO GL_ONE
|
|
drawShader (fst $ _fullscreenShader pdata) 4
|
|
glBlendFunc GL_SRC_ALPHA GL_ONE_MINUS_SRC_ALPHA
|
|
-- bind base buffer for drawing bloom then clouds
|
|
glBindFramebuffer GL_FRAMEBUFFER (_unFBO (fst (_fboBase pdata)))
|
|
--Draw blurred bloom onto base buffer
|
|
glEnable GL_BLEND
|
|
glBlendFunc GL_SRC_ALPHA GL_ONE
|
|
glBindTexture GL_TEXTURE_2D (_unTO . snd $ _fboHalf1 pdata)
|
|
drawShader (fst $ _fullscreenShader pdata) 4
|
|
glBlendFunc GL_SRC_ALPHA GL_ONE_MINUS_SRC_ALPHA
|
|
--draw shadowed clouds onto base buffer
|
|
glBindTexture GL_TEXTURE_2D (_unTO . fst . snd $ _fboCloud pdata)
|
|
drawShader (fst $ _fullscreenShader pdata) 4
|
|
--set viewport for radial distortion
|
|
setViewportSize (round winx) (round winy)
|
|
glDepthFunc GL_ALWAYS
|
|
glBlendFunc GL_ONE GL_ZERO
|
|
-- perform any radial distortion
|
|
case w ^. cWorld . lWorld . distortions of
|
|
[] -> do
|
|
bindTO $ pdata ^. fboBase . _2 . _1
|
|
glBindFramebuffer GL_FRAMEBUFFER 0
|
|
drawShader (fst $ _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 bindTO toList)
|
|
glActiveTexture GL_TEXTURE1
|
|
zipWithM_ (>>) bindings $ map bindDrawDist rds
|
|
glActiveTexture GL_TEXTURE1
|
|
glDepthFunc GL_ALWAYS
|
|
glEnable GL_BLEND
|
|
glBlendFunc GL_SRC_ALPHA GL_ONE_MINUS_SRC_ALPHA
|
|
renderLayer DebugLayer shadV layerCounts
|
|
-- draw overlay
|
|
glDepthFunc GL_ALWAYS
|
|
glDepthMask GL_FALSE
|
|
glEnable GL_BLEND
|
|
glBlendFunc GL_SRC_ALPHA GL_ONE_MINUS_SRC_ALPHA
|
|
glBindBufferBase GL_UNIFORM_BUFFER 0 (pdata ^. orthonormalMatUBO)
|
|
renderLayer FixedCoordLayer shadV layerCounts
|
|
renderFoldable shadV $ fixedCoordPictures u
|
|
glDepthMask GL_TRUE
|
|
when (debugOn Show_ms_frame $ _uvConfig u) $
|
|
renderFoldable
|
|
(_pictureShaders pdata)
|
|
( setDepth (-1)
|
|
. translate (-0.5) (-0.8)
|
|
. scale 0.0005 0.0005
|
|
$ fpsText (u ^. uvFrameTicks - u ^. uvLastFrameTicks)
|
|
)
|
|
SDL.glSwapWindow win
|
|
|
|
fpsText :: (Show a, Ord a, Num a) => a -> Picture
|
|
fpsText x = color col $ text $ "ms/frame " ++ show x
|
|
where
|
|
col
|
|
| x < 22 = blue
|
|
| x < 30 = green
|
|
| x < 40 = yellow
|
|
| x < 50 = orange
|
|
| otherwise = red
|
|
|
|
--------------------------------------------------------------------------------
|
|
-- note: currently assume there is only one UBO, we only bind it once at setup
|
|
--bufferUBO :: GLuint -> [Float] -> IO ()
|
|
--bufferUBO ubo mat = withArray mat $ \ptr ->
|
|
-- glNamedBufferSubData ubo 0 64 ptr
|
|
|
|
setViewportSize :: Int -> Int -> IO ()
|
|
setViewportSize x y =
|
|
glViewport 0 0 (fromIntegral x) (fromIntegral y)
|
|
|
|
|
|
--cullFace $= Nothing
|
|
|