265 lines
10 KiB
Haskell
265 lines
10 KiB
Haskell
--{-# LANGUAGE TemplateHaskell #-}
|
|
--{-# OPTIONS_GHC -Wno-unused-top-binds #-}
|
|
module Preload.Render
|
|
( preloadRender
|
|
, cleanUpRenderPreload
|
|
)
|
|
where
|
|
import Picture.Data
|
|
import Shader
|
|
import Shader.Data
|
|
import Shader.Compile
|
|
import Shader.AuxAddition
|
|
import Shader.Parameters
|
|
import Data.Preload.Render
|
|
|
|
import Graphics.Rendering.OpenGL hiding (Point,translate,scale,imageHeight)
|
|
import Graphics.GL.Core43
|
|
--import Control.Lens
|
|
--import Control.Monad
|
|
import Foreign
|
|
|
|
numDrawableWalls :: Int
|
|
numDrawableWalls = 5000
|
|
|
|
preloadRender :: IO RenderData
|
|
preloadRender = do
|
|
-- set up uniform buffer object
|
|
theUBO <- genObjectName
|
|
bindBuffer UniformBuffer $= Just theUBO
|
|
bufferData UniformBuffer $= (64, nullPtr, DynamicDraw)
|
|
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
|
|
, DynamicDraw
|
|
)
|
|
let wpVBO = VBO {_vbo = wpVBOname, _vboPointer = wpVBOptr, _vboAttribSizes = [4,4]}
|
|
wpVAOname <- genObjectName
|
|
bindVertexArrayObject $= Just wpVAOname
|
|
bindBuffer ArrayBuffer $= Just wpVBOname
|
|
setupVertexAttribPointer 0 4 8 0
|
|
wpColVAOname <- genObjectName
|
|
bindVertexArrayObject $= Just wpColVAOname
|
|
setupVertexAttribPointer 0 4 8 0
|
|
setupVertexAttribPointer 1 4 8 4
|
|
let wpVAO = VAO {_vao = wpVAOname, _vaoVBO = wpVBO}
|
|
wpColVAO = VAO {_vao = wpColVAOname, _vaoVBO = wpVBO}
|
|
|
|
-- lighting shaders
|
|
wsShad <- makeShader "lighting/occlude" [vert,geom,frag] [4] EPoints pokeWPStrat
|
|
>>= addUniforms ["lightPos"]
|
|
wlLightShad
|
|
<- makeShaderUsingShaderVAO "lighting/wall" [vert,geom,frag] EPoints wsShad
|
|
>>= addUniforms ["lightPos","radLum"]
|
|
lightingSurfaceShad
|
|
<- makeShader "lighting/surface" [vert,frag] [3] ETriangles poke3
|
|
>>= addUniforms ["lightPos","radLum"]
|
|
lightingLineShadowShad
|
|
<- makeShader "lighting/lineShadow" [vert,geom,frag] [3] ELinesAdjacency poke3
|
|
>>= addUniforms ["lightPos"]
|
|
-- 2D draw shaders
|
|
bslist <- makeShader "twoD/basic" [vert,frag] [3,4] ETriangles pokeTriStrat
|
|
aslist <- makeShader "twoD/arc" [vert,frag] [3,4,3] ETriangles pokeArcStrat
|
|
eslist <- makeShader "twoD/ellipse" [vert,geom,frag] [3,4] ETriangles pokeEllStrat
|
|
bezierQuadShader <- makeShader "twoD/bezierQuad" [vert,frag] [3,4,4] ETriangleStrip pokeBezQStrat
|
|
cslist <- makeShader "twoD/character" [vert,frag] [3,4,2] ETriangles pokeCharStrat
|
|
>>= addTextureNoFilter "data/texture/charMap.png"
|
|
-- this should really be a 2d texture array
|
|
basicTweakZShad <- makeShader "twoD/basicTweakZ" [vert,frag] [4,4] ETriangles pokeTriTweakZ
|
|
-- fullscreen shaders
|
|
fullscreenAlphaHalveShad <- makeShaderSized "fullscreen/alphaHalve" [vert,frag] [2] 4 ETriangleStrip $
|
|
const cornerListNoCoord
|
|
pokeArray (_vboPointer $ _vaoVBO $ _shaderVAO fullscreenAlphaHalveShad) $ concat cornerListNoCoord
|
|
-- texture shaders, no textures attached
|
|
fsShad <- makeShaderSized "texture/simple" [vert,frag] [2,2] 4 ETriangleStrip $ const cornerList
|
|
-- note we directly poke the shader vertex data here
|
|
pokeArray (_vboPointer $ _vaoVBO $ _shaderVAO fsShad) $ concat cornerList
|
|
bloomBlurShad <- makeShaderUsingShaderVAO "texture/bloomBlur" [vert,frag] ETriangleStrip fsShad
|
|
colorBlurShad <- makeShaderUsingShaderVAO "texture/colorBlur" [vert,frag] ETriangleStrip fsShad
|
|
grayscaleShad <- makeShaderUsingShaderVAO "texture/grayscale" [vert,frag] ETriangleStrip fsShad
|
|
barrelShad <- makeShader "texture/barrel" [vert,geom,frag] [2,2,2,1] EPoints pokeRadDist
|
|
-- blank wallShader
|
|
wlBlank <- makeShader "wall/blank" [vert,geom,frag] [4,4] EPoints pokeWPColStrat
|
|
-- textured wallShader
|
|
wlTexture <- makeShader "wall/texture" [vert,geom,frag] [4,4] EPoints pokeWPColStrat
|
|
>>= addTexture "data/texture/grayscaleDirt.png"
|
|
---- texture array shader
|
|
textArrayShad <- makeShader "texture/array" [vert,frag] [3,3] ETriangles poke33
|
|
>>= addTextureArray "data/texture/ayene_wooden_floor.png"
|
|
-- bind fixed vertex data
|
|
bindShaderBuffers [fsShad,fullscreenAlphaHalveShad] [4,4]
|
|
framebuf2 <- setupTextureFramebuffer 800 600
|
|
framebuf3 <- setupTextureFramebuffer 800 600
|
|
|
|
rboLightingName <- genObjectName
|
|
bindRenderbuffer Renderbuffer $= rboLightingName
|
|
renderbufferStorage Renderbuffer Depth24Stencil8 (RenderbufferSize 800 600)
|
|
fboLightingName <- newFramebufferGivenStencilAlpha rboLightingName
|
|
|
|
rboBaseBloomName <- genObjectName
|
|
bindRenderbuffer Renderbuffer $= rboBaseBloomName
|
|
renderbufferStorage Renderbuffer Depth24Stencil8 (RenderbufferSize 800 600)
|
|
|
|
fboBaseName <- newFramebufferGivenStencil rboBaseBloomName
|
|
fboBloomName <- newFramebufferGivenStencil rboBaseBloomName
|
|
fboColorName <- newFramebufferGivenStencil rboBaseBloomName
|
|
|
|
fboFourth1Name <- setupTextureFramebuffer 300 300
|
|
fboFourth2Name <- 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
|
|
|
|
return $ RenderData
|
|
{ _pictureShaders =
|
|
[bslist,cslist,aslist,eslist,bezierQuadShader,basicTweakZShad]
|
|
, _lightingSurfaceShader = lightingSurfaceShad
|
|
, _lightingLineShadowShader = lightingLineShadowShad
|
|
, _lightingOccludeShader = wsShad {_shaderVAO = wpVAO}
|
|
, _lightingWallShader = wlLightShad {_shaderVAO = wpVAO}
|
|
, _wallBlankShader = wlBlank { _shaderVAO = wpColVAO }
|
|
, _wallTextureShader = wlTexture { _shaderVAO = wpColVAO }
|
|
, _textureArrayShader = textArrayShad
|
|
, _fullscreenShader = fsShad
|
|
, _fullscreenAlphaHalveShader = fullscreenAlphaHalveShad
|
|
, _bloomBlurShader = bloomBlurShad
|
|
, _colorBlurShader = colorBlurShad
|
|
, _barrelShader = barrelShad
|
|
, _grayscaleShader = grayscaleShad
|
|
, _fbo2 = framebuf2
|
|
, _fbo3 = framebuf3
|
|
, _fboFourth1 = fboFourth1Name
|
|
, _fboFourth2 = fboFourth2Name
|
|
, _fboLighting = fboLightingName
|
|
, _rboLighting = rboLightingName
|
|
, _fboBase = fboBaseName
|
|
, _fboBloom = fboBloomName
|
|
, _fboColor = fboColorName
|
|
, _rboBaseBloom = rboBaseBloomName
|
|
, _matUBO = theUBO
|
|
}
|
|
cornerList :: [[Float]]
|
|
cornerList =
|
|
[[-1, 1,0,1]
|
|
,[ 1, 1,1,1]
|
|
,[-1,-1,0,0]
|
|
,[ 1,-1,1,0]
|
|
]
|
|
cornerListNoCoord :: [[Float]]
|
|
cornerListNoCoord =
|
|
[[-1, 1]
|
|
,[ 1, 1]
|
|
,[-1,-1]
|
|
,[ 1,-1]
|
|
]
|
|
--------------------end preloadRender
|
|
|
|
newFramebufferGivenStencil
|
|
:: RenderbufferObject
|
|
-> IO (FramebufferObject, TextureObject)
|
|
newFramebufferGivenStencil rboName = do
|
|
fboName <- genObjectName
|
|
bindFramebuffer Framebuffer $= fboName
|
|
toName <- genObjectName
|
|
framebufferRenderbuffer Framebuffer DepthStencilAttachment Renderbuffer rboName
|
|
fboStatus <- framebufferStatus Framebuffer
|
|
print fboStatus
|
|
return (fboName,toName)
|
|
|
|
newFramebufferGivenStencilAlpha
|
|
:: RenderbufferObject
|
|
-> IO (FramebufferObject, TextureObject)
|
|
newFramebufferGivenStencilAlpha rboName = do
|
|
fboName <- genObjectName
|
|
bindFramebuffer Framebuffer $= fboName
|
|
toName <- genObjectName
|
|
framebufferRenderbuffer Framebuffer DepthStencilAttachment Renderbuffer rboName
|
|
fboStatus <- framebufferStatus Framebuffer
|
|
print fboStatus
|
|
return (fboName,toName)
|
|
|
|
setupTextureFramebuffer
|
|
:: GLsizei
|
|
-> GLsizei
|
|
-> IO (FramebufferObject, TextureObject)
|
|
setupTextureFramebuffer x y = do
|
|
fboName <- genObjectName
|
|
bindFramebuffer Framebuffer $= fboName
|
|
|
|
fboTO <- genObjectName
|
|
textureBinding Texture2D $= Just fboTO
|
|
glTexStorage2D GL_TEXTURE_2D 1 GL_RGBA8 x y
|
|
textureFilter Texture2D $= minMagFilter
|
|
framebufferTexture2D Framebuffer (ColorAttachment 0) Texture2D fboTO 0
|
|
fboStatus <- framebufferStatus Framebuffer
|
|
print fboStatus
|
|
return (fboName, fboTO)
|
|
|
|
minMagFilter :: ((TextureFilter, Maybe TextureFilter),TextureFilter)
|
|
minMagFilter = ((Nearest,Nothing),Nearest)
|
|
|
|
cleanUpRenderPreload :: RenderData -> IO ()
|
|
cleanUpRenderPreload pd = do
|
|
mapM_ freeShaderPointers $ _pictureShaders pd
|
|
freeShaderPointers $ _lightingOccludeShader pd
|
|
freeShaderPointers $ _fullscreenShader pd
|
|
|
|
--{-# INLINE pokeBezQStrat #-}
|
|
pokeBezQStrat :: RenderType -> [[Float]]
|
|
pokeBezQStrat (RenderBezQ vs) = fmap
|
|
(\((x,y,z),(r,g,b,a),(s,t,u,v)) -> [x,y,z,r,g,b,a,s,t,u,v])
|
|
vs
|
|
pokeBezQStrat _ = []
|
|
|
|
|
|
pokeTriTweakZ :: RenderType -> [[Float]]
|
|
pokeTriTweakZ (RenderPolyZ vs) = fmap (\(p,co,z) -> flat3 p ++ [z] ++ flat4 co) vs
|
|
pokeTriTweakZ _ = []
|
|
|
|
--{-# INLINE pokeTriStrat #-}
|
|
pokeTriStrat,pokeCharStrat,pokeArcStrat,pokeEllStrat :: RenderType -> [[Float]]
|
|
pokeTriStrat (RenderPoly vs) = fmap (\(p,co) -> flat3 p ++ flat4 co) vs
|
|
pokeTriStrat _ = []
|
|
|
|
pokeCharStrat (RenderText vs) = fmap (\(a,b,c) -> concat [flat3 a, flat4 b, flat2 c]) vs
|
|
pokeCharStrat _ = []
|
|
|
|
pokeArcStrat (RenderArc vs) = fmap (\(a,b,c) -> concat [flat3 a, flat4 b, flat3 c]) vs
|
|
pokeArcStrat _ = []
|
|
|
|
pokeEllStrat (RenderEllipse vs) = fmap (\((x,y,z),(r,g,b,a)) -> [x,y,z,r,g,b,a]) vs
|
|
pokeEllStrat _ = []
|
|
|
|
vert, geom, frag :: ShaderType
|
|
vert = VertexShader
|
|
geom = GeometryShader
|
|
frag = FragmentShader
|
|
|
|
poke3 :: RenderType -> [[Float]]
|
|
poke3 (Render3 vs) = map flat3 vs
|
|
poke3 _ = undefined
|
|
|
|
pokeWPStrat :: RenderType -> [[Float]]
|
|
pokeWPStrat Render22{_unRender22 = ((x,y),(z,w))} = [[x,y,z,w]]
|
|
pokeWPStrat _ = undefined
|
|
|
|
pokeRadDist :: RenderType -> [[Float]]
|
|
pokeRadDist Render2221{_unRender2221 = ((a,b),(c,d),(e,f),g)} = [[a,b,c,d,e,f,g]]
|
|
pokeRadDist _ = undefined
|
|
|
|
pokeWPColStrat :: RenderType -> [[Float]]
|
|
pokeWPColStrat Render22x4{_unRender22x4=(((x,y),(z,w)),(r,g,b,a))} = [[x,y,z,w,r,g,b,a]]
|
|
pokeWPColStrat _ = undefined
|
|
|
|
poke33 :: RenderType -> [[Float]]
|
|
poke33 Render3x3{_unRender3x3=((x,y,z),(a,b,c))} = [[x,y,z,a,b,c]]
|
|
poke33 _ = undefined
|