Files
loop/src/Preload/Render.hs
T
2023-03-09 14:58:38 +00:00

271 lines
11 KiB
Haskell

--{-# LANGUAGE TemplateHaskell #-}
--{-# OPTIONS_GHC -Wno-unused-top-binds #-}
module Preload.Render (
preloadRender,
cleanUpRenderPreload,
) where
import GLHelp
import Control.Lens
import Control.Monad
import Data.Preload.Render
import qualified Data.Vector.Mutable as MV
import Foreign
import Framebuffer.Setup
import Graphics.Rendering.OpenGL hiding (Point, imageHeight, scale, translate)
import Shader
import Shader.AuxAddition
import Shader.Bind
import Shader.Compile
import Shader.Data
import Shader.Parameters
import Graphics.GL.Core45
numDrawableWalls :: Int
numDrawableWalls = 5000
preloadRender :: IO RenderData
preloadRender = do
-- set up uniform buffer object
theUBO <- mglCreateSingle glCreateBuffers
glNamedBufferData theUBO 64 nullPtr GL_STREAM_DRAW
glBindBufferBase GL_UNIFORM_BUFFER 0 theUBO
-- setup wall points VBO, VAOs and shaders
wpVBOname <- mglCreateSingle glCreateBuffers
wpVBOptr <- mallocArray (8 * numDrawableWalls)
glNamedBufferData wpVBOname
( fromIntegral $ floatSize * numDrawableWalls * 8)
nullPtr
GL_STREAM_DRAW
let wpVBO = VBO{_vboName = wpVBOname, _vboPtr = wpVBOptr, _vboAttribSizes = [4, 4], _vboStride = 8}
-- wpVAOname <- genObjectName
-- bindVertexArrayObject $= Just wpVAOname
wpVAOname <- mglCreateSingle glCreateVertexArrays
glBindVertexArray wpVAOname
setupVertexAttribPointer wpVAOname wpVBOname 0 4 8 0
--wpColVAOname <- genObjectName
--bindVertexArrayObject $= Just wpColVAOname
wpColVAOname <- mglCreateSingle glCreateVertexArrays
glBindVertexArray wpColVAOname
setupVertexAttribPointer wpColVAOname wpVBOname 0 4 8 0
setupVertexAttribPointer wpColVAOname wpVBOname 1 4 8 4
let wpVAO = VAO{_vaoName = wpVAOname, _vaoVBO = wpVBO}
wpColVAO = VAO{_vaoName = wpColVAOname, _vaoVBO = wpVBO}
-- setup window points VBO, VAOs and shaders
winVBOname <- mglCreateSingle glCreateBuffers
winVBOptr <- mallocArray (8 * numDrawableWalls)
glNamedBufferData wpVBOname
( fromIntegral $ floatSize * numDrawableWalls * 8)
nullPtr
GL_STREAM_DRAW
let winVBO = VBO{_vboName = winVBOname, _vboPtr = winVBOptr, _vboAttribSizes = [4, 4], _vboStride = 8}
--winColVAOname <- genObjectName
--bindVertexArrayObject $= Just winColVAOname
winColVAOname <- mglCreateSingle glCreateVertexArrays
glBindVertexArray winColVAOname
setupVertexAttribPointer winColVAOname winVBOname 0 4 8 0
setupVertexAttribPointer winColVAOname winVBOname 1 4 8 4
let winColVAO = VAO{_vaoName = winColVAOname, _vaoVBO = winVBO}
-- setup shape geometry/cap VBO and two VAOs
shEBOptr <- mallocArray numDrawableElements
shEBOname <- mglCreateSingle glCreateBuffers
glNamedBufferData
shEBOname
( fromIntegral $ glushortSize * numDrawableElements)
nullPtr
GL_STREAM_DRAW
let shEBO = EBO{_eboName = shEBOname, _eboPtr = shEBOptr}
shVBOname <- mglCreateSingle glCreateBuffers
shVBOptr <- mallocArray (7 * numDrawableElements)
glNamedBufferData shVBOname
( fromIntegral $ floatSize * numDrawableElements * 7)
nullPtr
GL_STREAM_DRAW
let shVBO = VBO{_vboName = shVBOname, _vboPtr = shVBOptr, _vboAttribSizes = [4, 4], _vboStride = 8}
--shPosColVAOname <- genObjectName
--bindVertexArrayObject $= Just shPosColVAOname
shPosColVAOname <- mglCreateSingle glCreateVertexArrays
glBindVertexArray shPosColVAOname
setupVertexAttribPointer shPosColVAOname shVBOname 0 3 7 0
setupVertexAttribPointer shPosColVAOname shVBOname 1 4 7 3
--bindBuffer ElementArrayBuffer $= Just shEBOname
glVertexArrayElementBuffer shPosColVAOname shEBOname
--shPosVAOname <- genObjectName
--bindVertexArrayObject $= Just shPosVAOname
shPosVAOname <- mglCreateSingle glCreateVertexArrays
glBindVertexArray shPosVAOname
setupVertexAttribPointer shPosVAOname shVBOname 0 3 7 0
--bindBuffer ElementArrayBuffer $= Just shEBOname
glVertexArrayElementBuffer shPosVAOname shEBOname
let shPosColVAO = VAO{_vaoName = shPosColVAOname, _vaoVBO = shVBO}
shPosVAO = VAO{_vaoName = shPosVAOname, _vaoVBO = shVBO}
--setup silhouette edge VAO
--shEdgeVAOname <- genObjectName
--bindVertexArrayObject $= Just shEdgeVAOname
shEdgeVAOname <- mglCreateSingle glCreateVertexArrays
glBindVertexArray shEdgeVAOname
setupVertexAttribPointer shEdgeVAOname shVBOname 0 3 7 0
--setup ebo for silhouette edges
silEBOname <- mglCreateSingle glCreateBuffers
silEBOptr <- mallocArray numDrawableElements
-- it may be important to bind this while the correct VAO is bound
glVertexArrayElementBuffer shEdgeVAOname silEBOname
--bindBuffer ElementArrayBuffer $= Just silEBOname
glNamedBufferData
silEBOname
( fromIntegral $ glushortSize * numDrawableElements)
nullPtr
GL_STREAM_DRAW
let silEBO = EBO{_eboName = silEBOname, _eboPtr = silEBOptr}
shEdgeVAO = VAO{_vaoName = shEdgeVAOname, _vaoVBO = shVBO}
-- lighting shaders
lightingWallShadShad <-
makeShaderUsingVAO "lighting/wallShadow" [vert', geom', frag'] EPoints wpVAO
>>= addUniforms ["lightPos"]
lightingCapShad <-
makeShaderUsingVAO "lighting/cap" [vert', geom', frag'] ETriangles shPosVAO
>>= addUniforms ["lightPos"]
lightingLineShadowShad <-
makeShaderUsingVAO "lighting/lineShadow" [vert', geom', frag'] ELinesAdjacency shEdgeVAO
>>= addUniforms ["lightPos", "radiusUniform"]
-- positional shader
positionalBlankShad <- makeShader "positional/blank" [vert', frag'] [3] ETriangles
-- 2D draw shaders
bslist <- makeShader "dualTwoD/basic" [vert', frag'] [3, 4] ETriangles
bslista <- makeShader "dualTwoD/basic" [vert', frag'] [3, 4] ETriangles
aslist <- makeShader "dualTwoD/arc" [vert', frag'] [3, 4, 3] ETriangles
eslist <- makeShader "dualTwoD/ellipse" [vert', geom', frag'] [3, 4] ETriangles
bezierQuadShader <- makeShader "dualTwoD/bezierQuad" [vert', frag'] [3, 4, 4] ETriangleStrip
cslist <-
makeShader "dualTwoD/character" [vert', frag'] [3, 4, 2] ETriangles
>>= vaddTextureNoFilter "data/texture/charMap.png"
-- this should really be a 2d texture array
basicTweakZShad <- makeShader "dualTwoD/basicTweakZ" [vert', frag'] [4, 4] ETriangles
-- fullscreen shaders
--fullscreenAlphaHalveShad <- makeShaderSized "fullscreen/alphaHalve" [vert,frag] [2] 4 ETriangleStrip
--pokeArray (shadVBOptr fullscreenAlphaHalveShad) $ concat cornerListNoCoord
-- texture shaders, no textures attached
fsShad <- makeShaderSized "texture/simple" [vert', frag'] [2, 2] 4 ETriangleStrip
-- note we directly poke the shader vertex data here
-- could possibly use an indirect draw call
pokeArray (shadVBOptr' fsShad) $ concat cornerList
let fsshadvao = fsShad ^. shadVAO'
bloomBlurShad <- makeShaderUsingVAO "texture/bloomBlur" [vert', frag'] ETriangleStrip fsshadvao
colorBlurShad <- makeShaderUsingVAO "texture/colorBlur" [vert', frag'] ETriangleStrip fsshadvao
grayscaleShad <- makeShaderUsingVAO "texture/grayscale" [vert', frag'] ETriangleStrip fsshadvao
lightingTextureShad <-
makeShaderUsingVAO "lighting/texture" [vert', frag'] ETriangleStrip fsshadvao
>>= addUniforms ["lightPos", "lumRad"]
barrelShad <- makeShader "texture/barrel" [vert', geom', frag'] [2, 2, 2, 1] EPoints
-- blank wallShader
wallBlankShad <- makeShaderUsingVAO "wall/blank" [vert', geom', frag'] EPoints wpColVAO
-- textured wallShader
wallTextureShad <-
makeShaderUsingVAO "wall/texture" [vert', geom', frag'] EPoints wpColVAO
>>= addTexture "data/texture/grayscaleDirt.png"
---- texture array shader
textArrayShad <-
makeShader "texture/arrayPos" [vert', frag'] [3, 3] ETriangles
>>= addTextureArray "data/texture/ayene_wooden_floor_transformed.png"
-- >>= addTextureArray "data/texture/ayene_wooden_floor.png"
-- bind fixed vertex data
bindShaderBuffers' [fsShad] [4, 4]
framebuf2 <- setupTextureFramebuffer 800 600
framebuf3 <- setupTextureFramebuffer 800 600
rboBaseBloomName <- mglCreateSingle glCreateRenderbuffers
--bindRenderbuffer Renderbuffer $= rboBaseBloomName
--renderbufferStorage Renderbuffer Depth24Stencil8 (RenderbufferSize 800 600)
glNamedRenderbufferStorage
rboBaseBloomName
GL_DEPTH24_STENCIL8
800
600
fboBaseName <- setupFramebuffer2GivenStencil rboBaseBloomName
fboCloudName <- setupFramebuffer2GivenStencil rboBaseBloomName
fboBloomName <- setupFramebufferGivenStencil rboBaseBloomName
fboColorName <- setupFramebufferGivenStencil rboBaseBloomName
fboPosName <- setupFramebufferGivenStencil rboBaseBloomName
fboLightingName <- setupFramebufferGivenStencil rboBaseBloomName
fboLightingHighName <- setupFramebufferGivenStencil rboBaseBloomName
fboShadowName <- setupShadowFramebuffer
fboHalf1Name <- setupTextureFramebuffer 300 300
fboHalf2Name <- setupTextureFramebuffer 300 300
fboHalf3Name <- setupTextureFramebuffer 300 300
-- reset to default framebuffer, ready for drawing direct to screen
bindFramebuffer Framebuffer $= defaultFramebufferObject
-- set the clearColor to have 1 alpha
clearColor $= Color4 0 0 0 1
shadV <- MV.new 6
zipWithM_
(MV.write shadV)
[0 .. 5]
[ bslist -- note the ordering is very important
, basicTweakZShad -- ShadNum
, bezierQuadShader
, cslist
, aslist
, eslist
]
return $
RenderData
{ _pictureShaders = shadV
, _shapeShader = bslista{_shadVAO' = shPosColVAO}
, _shapeEBO = shEBO
, _silhouetteEBO = silEBO
, _lightingCapShader = lightingCapShad
, _lightingLineShadowShader = lightingLineShadowShad
, _positionalBlankShader = positionalBlankShad
, _lightingWallShadShader = lightingWallShadShad
, _wallBlankShader = wallBlankShad
, _wallTextureShader = wallTextureShad
, _windowShader = wallBlankShad{_shadVAO' = winColVAO}
, _textureArrayShader = textArrayShad
, _fullscreenShader = fsShad
, _lightingTextureShader = lightingTextureShad
, _bloomBlurShader = bloomBlurShad
, _colorBlurShader = colorBlurShad
, _barrelShader = barrelShad
, _grayscaleShader = grayscaleShad
, _fbo2 = framebuf2
, _fbo3 = framebuf3
, _fboHalf1 = fboHalf1Name
, _fboHalf2 = fboHalf2Name
, _fboHalf3 = fboHalf3Name
, _fboLighting = fboLightingName
, _fboLightingHigh = fboLightingHighName
, _fboShadow = fboShadowName
, _fboBase = fboBaseName
, _fboCloud = fboCloudName
, _fboBloom = fboBloomName
, _fboColor = fboColorName
, _fboPos = fboPosName
, _rboBaseBloom = rboBaseBloomName
, _matUBO = theUBO
}
--------------------end preloadRender
cornerList :: [[Float]]
cornerList =
[ [-1, 1, 0, 1]
, [-1, -1, 0, 0]
, [1, 1, 1, 1]
, [1, -1, 1, 0]
]
cleanUpRenderPreload :: RenderData -> IO ()
cleanUpRenderPreload pd = do
-- TODO fix this
--mapM_ freeShaderPointers $ _pictureShaders pd
freeShaderPointers' $ _lightingWallShadShader pd
freeShaderPointers' $ _fullscreenShader pd