Files
loop/src/Preload/Render.hs
T
2023-03-23 00:27:09 +00:00

294 lines
12 KiB
Haskell

--{-# LANGUAGE TemplateHaskell #-}
--{-# OPTIONS_GHC -Wno-unused-top-binds #-}
module Preload.Render (
preloadRender,
cleanUpRenderPreload,
) where
import Shader.AuxAddition
import Shape.Data
import Geometry.Data
import MatrixHelper
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 Shader
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 <- mglCreate glCreateBuffers
glNamedBufferData theUBO 64 nullPtr GL_STREAM_DRAW
glBindBufferBase GL_UNIFORM_BUFFER 0 theUBO
orthonormalUBO <- mglCreate glCreateBuffers
withArray (isoMatrix 0 1 (V2 0 0) (V2 2 2)) $ \ptr ->
glNamedBufferStorage orthonormalUBO 64 ptr 0
lightsubo <- mglCreate glCreateBuffers
glNamedBufferData lightsubo 640 nullPtr GL_STREAM_DRAW
glBindBufferBase GL_UNIFORM_BUFFER 1 lightsubo
-- setup wall points VBO, VAOs and shaders
wpVBOname <- mglCreate glCreateBuffers
wpVBOptr <- mallocArray (8 * numDrawableWalls)
glNamedBufferData wpVBOname
( fromIntegral $ floatSize * numDrawableWalls * 8)
nullPtr
GL_STREAM_DRAW
let wpVBO = VBO{_vboName = wpVBOname, _vboPtr = wpVBOptr, _vboVertexSize = 8}
wpVAOname <- mglCreate glCreateVertexArrays
glBindVertexArray wpVAOname
glVertexArrayVertexBuffer wpVAOname 0 wpVBOname 0 (fromIntegral $ floatSize * 8)
setupVertexAttribPointer wpVAOname 0 4 0
wpColVAOname <- mglCreate glCreateVertexArrays
glBindVertexArray wpColVAOname
glVertexArrayVertexBuffer wpColVAOname 0 wpVBOname 0 (fromIntegral $ floatSize * 8)
setupVertexAttribPointer wpColVAOname 0 4 0
setupVertexAttribPointer wpColVAOname 1 4 4
let wpVAO = VAO{_vaoName = wpVAOname}
wpColVAO = VAO{_vaoName = wpColVAOname}
-- setup window points VBO, VAOs and shaders
winVBOname <- mglCreate glCreateBuffers
winVBOptr <- mallocArray (8 * numDrawableWalls)
glNamedBufferData wpVBOname
( fromIntegral $ floatSize * numDrawableWalls * 8)
nullPtr
GL_STREAM_DRAW
let winVBO = VBO{_vboName = winVBOname, _vboPtr = winVBOptr, _vboVertexSize = 8}
winColVAOname <- mglCreate glCreateVertexArrays
glBindVertexArray winColVAOname
glVertexArrayVertexBuffer winColVAOname 0 winVBOname 0 (fromIntegral $ floatSize * 8)
setupVertexAttribPointer winColVAOname 0 4 0
setupVertexAttribPointer winColVAOname 1 4 4
let winColVAO = VAO
{_vaoName = winColVAOname}
-- setup shape geometry/cap VBO and two VAOs
shVBO <- setupVBO nShapeVerxComp
shPosVAOname <- mglCreate glCreateVertexArrays
glBindVertexArray shPosVAOname
glVertexArrayVertexBuffer shPosVAOname 0 (shVBO ^. vboName) 0 (fromIntegral $ floatSize * nShapeVerxComp)
setupVertexAttribPointer shPosVAOname 0 4 0
let shPosVAO = VAO{_vaoName = shPosVAOname}
--setup silhouette edge VAO
shEBO' <- setupEBO shPosVAO
shEdgeVAOname <- mglCreate glCreateVertexArrays
glBindVertexArray shEdgeVAOname
glVertexArrayVertexBuffer shEdgeVAOname 0 (shVBO ^. vboName) 0 (fromIntegral $ floatSize * nShapeVerxComp)
setupVertexAttribPointer shEdgeVAOname 0 4 0
--setup ebo for silhouette edges
silEBOname <- mglCreate glCreateBuffers
silEBOptr <- mallocArray numDrawableElements
glVertexArrayElementBuffer shEdgeVAOname silEBOname
glNamedBufferData
silEBOname
( fromIntegral $ glushortSize * numDrawableElements)
nullPtr
GL_STREAM_DRAW
let silEBO = EBO{_eboName = silEBOname, _eboPtr = silEBOptr}
shEdgeVAO = VAO{_vaoName = shEdgeVAOname}
-- shEdgeVAO is unecessary?
-- lighting shaders
lightingWallShadShad <-
makeShaderUsingVAO "lighting/wallShadow" [vert, geom, frag] pmPoints wpVAO
lightingCapShad <-
makeShaderUsingVAO "lighting/cap" [vert, geom] pmTriangles shPosVAO
lightingLineShadowShad <-
makeShaderUsingVAO "lighting/lineShadow" [vert, geom] pmLinesAdjacency shEdgeVAO
shadowedgeshader <-
makeShaderUsingVAO "shadow/edge" [vert, geom] pmLinesAdjacency shEdgeVAO
shadowcapshader <-
makeShaderUsingVAO "shadow/cap" [vert, geom] pmTriangles shPosVAO
shadowwallshader <-
makeShaderUsingVAO "shadow/wallShadow" [vert, geom] pmPoints wpVAO
shadowlightshader <- makeShaderSized "shadow/light" [vert, geom, frag]
[1] 1
pmPoints
shadowcombineshader <- makeShaderSized "shadow/combine" [vert,geom,frag] [1] 1 pmPoints
poke (shadVBOptr shadowlightshader) 1
-- positional shader
positionalBlankShad <- makeShader "positional/blank" [vert, frag] [3] pmTriangles
-- 2D draw shaders
bslist <- makeShader "dualTwoD/basic" [vert, frag] [3, 4] pmTriangles
bslista <- makeShader4 "shape/basic" [vert, frag] shapeVerxSizes nShapeVerxComp pmTriangles shVBO
glVertexArrayElementBuffer (bslista ^. shaderVAO . vaoName) (shEBO' ^. eboName)
--glVertexArrayElementBuffer (bslista ^. shaderVAO . vaoName) shEBOname
aslist <- makeShader "dualTwoD/arc" [vert, frag] [3, 4, 3] pmTriangles
eslist <- makeShader "dualTwoD/ellipse" [vert, geom, frag] [3, 4] pmTriangles
bezierQuadShader <- makeShader "dualTwoD/bezierQuad" [vert, frag] [3, 4, 4] pmTriangleStrip
cslist <-
makeShader "dualTwoD/character" [vert, frag] [3, 4, 2] pmTriangles
>>= _1 (vaddTextureNoFilter "data/texture/charMap.png")
-- this should really be a 2d texture array
screentexturevbo <- mglCreate glCreateBuffers
withArray (concat cornerList) $ \ptr ->
glNamedBufferStorage
screentexturevbo
(fromIntegral $ floatSize * length (concat cornerList))
ptr
0
screentexturevao <- setupVAOvbo' [2,2] 4 screentexturevbo
alphadivideshader <- makeShader4UsingVAO "texture2D/alphaDivide" [vert,frag] pmTriangleStrip screentexturevao
fsShad <- makeShader4UsingVAO "texture/simple" [vert, frag] pmTriangleStrip screentexturevao
bloomBlurShad <- makeShaderUsingVAO "texture/bloomBlur" [vert, frag] pmTriangleStrip screentexturevao
colorBlurShad <- makeShaderUsingVAO "texture/colorBlur" [vert, frag] pmTriangleStrip screentexturevao
grayscaleShad <- makeShaderUsingVAO "texture/grayscale" [vert, frag] pmTriangleStrip screentexturevao
lightingTextureShad <-
makeShaderUsingVAO "lighting/texture" [vert, frag] pmTriangleStrip screentexturevao
barrelShad <- makeShader "texture/barrel" [vert, geom, frag] [2, 2, 2, 1] pmPoints
-- blank wallShader
wallBlankShad <- makeShaderUsingVAO "wall/blank" [vert, geom, frag] pmPoints wpColVAO
-- textured wallShader
wallTextureShad <-
makeShaderUsingVAO "wall/texture" [vert, geom, frag] pmPoints wpColVAO
let wallverxstrd = 8
wallvbo <- setupVBO wallverxstrd
wallshader <- makeShader4 "wall/basic" [vert,geom,frag] [4,4] wallverxstrd pmPoints wallvbo
let floorverxstrd = 8
floorvbo <- setupVBOStatic floorverxstrd
floorshader <- makeShader4 "floor/arrayPos" [vert, frag] [4,4] floorverxstrd pmTriangles floorvbo
tonormalmap <- initTexture2DArray 3 GL_LINEAR_MIPMAP_LINEAR GL_LINEAR "data/normalMaps/normalArray.png"
todiffusemap <- initTexture2DArray 3 GL_LINEAR_MIPMAP_LINEAR GL_LINEAR "data/normalMaps/diffuseArray.png"
let cloudverxsizes = [4,4,4,4]
cloudvbo <- setupVBO (sum cloudverxsizes)
(cloudshader, cloudebo)
<- makeShaderEBO "cloud/basic" [vert, frag] cloudverxsizes (sum cloudverxsizes)
pmTriangles cloudvbo
framebuf2 <- setupTextureFramebuffer 800 600
framebuf3 <- setupTextureFramebuffer 800 600
rboBaseBloomName <- mglCreate glCreateRenderbuffers
glNamedRenderbufferStorage
rboBaseBloomName
GL_DEPTH24_STENCIL8
800
600
fboBaseName <- setupFramebuffer3GivenStencil rboBaseBloomName
fboCloudName <- setupFramebuffer3GivenStencil rboBaseBloomName
fboBloomName <- setupFramebufferGivenStencil rboBaseBloomName
fboPosName <- setupFramebufferGivenStencil rboBaseBloomName
fboLightingName <- 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
glBindFramebuffer GL_FRAMEBUFFER 0
shadV <- MV.new 5
zipWithM_
(MV.write shadV)
[0 .. 4]
[ bslist -- note the ordering is very important
, bezierQuadShader
, cslist
, aslist
, eslist
]
initializeGLState
return $
RenderData
{ _pictureShaders = shadV
, _shapeShader = bslista -- & shaderVAO' .~ shPosColVAO
, _shapeEBO = shEBO'
, _silhouetteEBO = silEBO
, _lightingCapShader = lightingCapShad
, _lightingLineShadowShader = lightingLineShadowShad
, _lightingWallShadShader = lightingWallShadShad
, _shadowEdgeShader = shadowedgeshader
, _shadowCapShader = shadowcapshader
, _shadowWallShader = shadowwallshader
, _shadowLightShader = shadowlightshader
, _shadowCombineShader = shadowcombineshader
, _positionalBlankShader = positionalBlankShad
, _wallBlankShader = wallBlankShad
, _wallTextureShader = wallTextureShad
, _windowShader = wallBlankShad{_shaderVAO = winColVAO}
-- , _textureArrayShader = textArrayShad
, _fullscreenShader = fsShad
, _alphaDivideShader = alphadivideshader
, _lightingTextureShader = lightingTextureShad
, _bloomBlurShader = bloomBlurShad
, _colorBlurShader = colorBlurShad
, _barrelShader = barrelShad
, _grayscaleShader = grayscaleShad
, _fbo2 = framebuf2
, _fbo3 = framebuf3
, _fboHalf1 = fboHalf1Name
, _fboHalf2 = fboHalf2Name
, _fboHalf3 = fboHalf3Name
, _fboLighting = fboLightingName
, _fboShadow = fboShadowName
, _fboBase = fboBaseName
, _fboCloud = fboCloudName
, _fboBloom = fboBloomName
, _fboPos = fboPosName
, _rboBaseBloom = rboBaseBloomName
, _matUBO = theUBO
, _orthonormalMatUBO = orthonormalUBO
, _lightsUBO = lightsubo
, _vboWalls = wpVBO
, _vboWindows = winVBO
, _vboShapes = shVBO
, _floorVBO = floorvbo
, _floorShader = floorshader
, _toNormalMaps = tonormalmap
, _toDiffuse = todiffusemap
, _wallVBO = wallvbo
, _wallShader = wallshader
, _cloudVBO = cloudvbo
, _cloudShader = cloudshader
, _cloudEBO = cloudebo
, _screenTextureVAO = screentexturevao
}
--------------------end preloadRender
cornerList :: [[Float]]
cornerList =
[ [-1, 1, 0, 1]
, [-1, -1, 0, 0]
, [1, 1, 1, 1]
, [1, -1, 1, 0]
]
--cornerListForTriangles :: [[Float]]
--cornerListForTriangles =
-- [ [-1, 1, 0, 1]
-- , [-1, -1, 0, 0]
-- , [1, 1, 1, 1]
-- , [-1, -1, 0, 0]
-- , [1, 1, 1, 1]
-- , [1, -1, 1, 0]
-- ]
initializeGLState :: IO ()
initializeGLState = do
glEnable GL_DEPTH_TEST
cleanUpRenderPreload :: RenderData -> IO ()
cleanUpRenderPreload _ = return ()
--cleanUpRenderPreload pd = do
-- TODO fix this
--mapM_ freeShaderPointers $ _pictureShaders pd
--freeShaderPointers' $ _lightingWallShadShader pd
--freeShaderPointers' $ _fullscreenShader pd