Files
loop/src/Preload/Render.hs
T
2023-03-09 13:06:55 +00:00

284 lines
12 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 <- genObjectName
bindBuffer UniformBuffer $= Just theUBO
bufferData UniformBuffer $= (64, nullPtr, StreamDraw)
bindBufferBase IndexedUniformBuffer 0 $= Just theUBO
-- setup wall points VBO, VAOs and shaders
wpVBOname <- genObjectName
wpVBOptr <- mallocArray (8 * numDrawableWalls)
bindBuffer ArrayBuffer $= Just wpVBOname
bufferData ArrayBuffer
$= ( fromIntegral $ floatSize * numDrawableWalls * 8
, nullPtr
, StreamDraw
)
let wpVBO = VBO{_vbo = wpVBOname, _vboPtr = wpVBOptr, _vboAttribSizes = [4, 4], _vboStride = 8}
-- wpVAOname <- genObjectName
-- bindVertexArrayObject $= Just wpVAOname
wpVAOname <- mglCreateSingle glCreateVertexArrays
glBindVertexArray wpVAOname
bindBuffer ArrayBuffer $= Just wpVBOname
setupVertexAttribPointer 0 4 8 0
--wpColVAOname <- genObjectName
--bindVertexArrayObject $= Just wpColVAOname
wpColVAOname <- mglCreateSingle glCreateVertexArrays
glBindVertexArray wpColVAOname
setupVertexAttribPointer 0 4 8 0
setupVertexAttribPointer 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 <- genObjectName
winVBOptr <- mallocArray (8 * numDrawableWalls)
bindBuffer ArrayBuffer $= Just winVBOname
bufferData ArrayBuffer
$= ( fromIntegral $ floatSize * numDrawableWalls * 8
, nullPtr
, StreamDraw
)
let winVBO = VBO{_vbo = winVBOname, _vboPtr = winVBOptr, _vboAttribSizes = [4, 4], _vboStride = 8}
--winColVAOname <- genObjectName
--bindVertexArrayObject $= Just winColVAOname
winColVAOname <- mglCreateSingle glCreateVertexArrays
glBindVertexArray winColVAOname
setupVertexAttribPointer 0 4 8 0
setupVertexAttribPointer 1 4 8 4
let winColVAO = VAO{_vaoName = winColVAOname, _vaoVBO = winVBO}
-- setup shape geometry/cap VBO and two VAOs
--shEBOname <- genObjectName
shEBOptr <- mallocArray numDrawableElements
shEBOname <- mglCreateSingle glCreateBuffers
--bindBuffer ElementArrayBuffer $= Just shEBOname
--bufferData ElementArrayBuffer
-- $= ( fromIntegral $ glushortSize * numDrawableElements
-- , nullPtr
-- , StreamDraw
-- )
glNamedBufferData
shEBOname
( fromIntegral $ glushortSize * numDrawableElements)
nullPtr
GL_STREAM_DRAW
let shEBO = EBO{_eboName = shEBOname, _eboPtr = shEBOptr}
shVBOname <- genObjectName
shVBOptr <- mallocArray (7 * numDrawableElements)
bindBuffer ArrayBuffer $= Just shVBOname
bufferData ArrayBuffer
$= ( fromIntegral $ floatSize * numDrawableElements * 7
, nullPtr
, StreamDraw
)
let shVBO = VBO{_vbo = shVBOname, _vboPtr = shVBOptr, _vboAttribSizes = [4, 4], _vboStride = 8}
--shPosColVAOname <- genObjectName
--bindVertexArrayObject $= Just shPosColVAOname
shPosColVAOname <- mglCreateSingle glCreateVertexArrays
glBindVertexArray shPosColVAOname
bindBuffer ArrayBuffer $= Just shVBOname
setupVertexAttribPointer 0 3 7 0
setupVertexAttribPointer 1 4 7 3
--bindBuffer ElementArrayBuffer $= Just shEBOname
glBindBuffer GL_ELEMENT_ARRAY_BUFFER shEBOname
--shPosVAOname <- genObjectName
--bindVertexArrayObject $= Just shPosVAOname
shPosVAOname <- mglCreateSingle glCreateVertexArrays
glBindVertexArray shPosVAOname
bindBuffer ArrayBuffer $= Just shVBOname
setupVertexAttribPointer 0 3 7 0
--bindBuffer ElementArrayBuffer $= Just shEBOname
glBindBuffer GL_ELEMENT_ARRAY_BUFFER 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
bindBuffer ArrayBuffer $= Just shVBOname
setupVertexAttribPointer 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
glBindBuffer GL_ELEMENT_ARRAY_BUFFER silEBOname --bindBuffer ElementArrayBuffer $= Just 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 <- genObjectName
bindRenderbuffer Renderbuffer $= rboBaseBloomName
renderbufferStorage Renderbuffer Depth24Stencil8 (RenderbufferSize 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