--{-# 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 Data.Preload.Render import Graphics.Rendering.OpenGL hiding (Point,translate,scale,imageHeight) --import Control.Lens import Control.Monad import Foreign 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 -- lighting shaders wsShad <- makeShader "lighting/occlude" [vert,geom,frag] [4] EPoints pokeWPStrat >>= addUniforms ["lightPos"] wlLightShad <- makeShader "lighting/wall" [vert,geom,frag] [4] EPoints pokeWPStrat >>= 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 lslist <- makeShader "twoD/basic" [vert,frag] [3,4] ELines pokeLineStrat 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 >>= addTexture "data/texture/charMap.png" basicTweakZShad <- makeShader "twoD/basicTweakZ" [vert,frag] [4,4] ETriangles pokeTriTweakZ -- fullscreen shaders fullscreenAlphaHalveShad <- makeShader "fullscreen/alphaHalve" [vert,frag] [2] ETriangleStrip $ const cornerListNoCoord pokeArray (_vboPointer $ _vaoVBO $ _shaderVAO fullscreenAlphaHalveShad) $ concat cornerListNoCoord -- texture shaders, no textures attached fsShad <- makeShader "texture/simple" [vert,frag] [2,2] ETriangleStrip $ const cornerList -- note we directly poke the shader vertex data here pokeArray (_vboPointer $ _vaoVBO $ _shaderVAO fsShad) $ concat cornerList bloomBlurShad <- makeShader "texture/bloomBlur" [vert,frag] [2,2] ETriangleStrip $ const cornerList pokeArray (_vboPointer $ _vaoVBO $ _shaderVAO bloomBlurShad) $ concat cornerList colorBlurShad <- makeShader "texture/colorBlur" [vert,frag] [2,2] ETriangleStrip $ const cornerList pokeArray (_vboPointer $ _vaoVBO $ _shaderVAO colorBlurShad) $ concat cornerList grayscaleShad <- makeShader "texture/grayscale" [vert,frag] [2,2] ETriangleStrip $ const cornerList pokeArray (_vboPointer $ _vaoVBO $ _shaderVAO grayscaleShad) $ concat cornerList -- 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 shader textShad <- makeShader "texture/simpleWorld" [vert,frag] [3,2] ETriangles poke32 >>= addTexture "data/texture/ayene_wooden_floor.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 [bloomBlurShad,colorBlurShad,fullscreenAlphaHalveShad ] [4,4,4] -- framebuffer for lighting (fbo,fboTO,fboRBO) <- setupFramebufferWithStencil framebuf2 <- setupFramebufferWithStencil framebuf3 <- setupFramebufferWithStencil rboLightingName <- genObjectName bindRenderbuffer Renderbuffer $= rboLightingName renderbufferStorage Renderbuffer Depth24Stencil8 (RenderbufferSize 800 600) fboLightingName <- newFramebufferGivenStencil rboLightingName rboBaseBloomName <- genObjectName bindRenderbuffer Renderbuffer $= rboBaseBloomName renderbufferStorage Renderbuffer Depth24Stencil8 (RenderbufferSize 800 600) fboBaseName <- newFramebufferGivenStencil rboBaseBloomName fboBloomName <- newFramebufferGivenStencil rboBaseBloomName fboColorName <- newFramebufferGivenStencil rboBaseBloomName fboFourth1Name <- setupTextureFramebuffer 600 600 fboFourth2Name <- setupTextureFramebuffer 600 600 -- 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,lslist,cslist,aslist,eslist,bezierQuadShader,basicTweakZShad] , _lightingSurfaceShader = lightingSurfaceShad , _lightingLineShadowShader = lightingLineShadowShad , _lightingOccludeShader = wsShad , _lightingWallShader = wlLightShad , _wallBlankShader = wlBlank , _wallTextureShader = wlTexture , _textureShader = textShad , _textureArrayShader = textArrayShad , _fullscreenShader = fsShad , _fullscreenAlphaHalveShader = fullscreenAlphaHalveShad , _bloomBlurShader = bloomBlurShad , _colorBlurShader = colorBlurShad , _grayscaleShader = grayscaleShad , _spareFBO = fbo , _fboTexture = fboTO , _fboRenderbufferObject = fboRBO , _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 setupFramebufferWithStencil :: IO (FramebufferObject, TextureObject,RenderbufferObject) setupFramebufferWithStencil = do fboName <- genObjectName bindFramebuffer Framebuffer $= fboName fboTO <- genObjectName textureBinding Texture2D $= Just fboTO texImage2D Texture2D NoProxy 0 RGBA8 (TextureSize2D 800 600) 0 (PixelData RGBA UnsignedByte nullPtr) textureFilter Texture2D $= ((Linear',Just Linear') , Linear') generateMipmap' Texture2D framebufferTexture2D Framebuffer (ColorAttachment 0) Texture2D fboTO 0 fboRBO <- genObjectName bindRenderbuffer Renderbuffer $= fboRBO renderbufferStorage Renderbuffer Depth24Stencil8 (RenderbufferSize 800 600) framebufferRenderbuffer Framebuffer DepthStencilAttachment Renderbuffer fboRBO fboStatus <- framebufferStatus Framebuffer print fboStatus return (fboName, fboTO, fboRBO) setupFramebuffersSharedStencil :: Int -> IO ( [(FramebufferObject,TextureObject)] , RenderbufferObject) setupFramebuffersSharedStencil n = do rboName <- genObjectName bindRenderbuffer Renderbuffer $= rboName renderbufferStorage Renderbuffer Depth24Stencil8 (RenderbufferSize 800 600) fbs <- replicateM n (newFramebufferGivenStencil rboName) return (fbs,rboName) newFramebufferGivenStencil :: RenderbufferObject -> IO (FramebufferObject, TextureObject) newFramebufferGivenStencil rboName = do fboName <- genObjectName bindFramebuffer Framebuffer $= fboName toName <- genObjectName textureBinding Texture2D $= Just toName texImage2D Texture2D NoProxy 0 RGBA8 (TextureSize2D 800 600) 0 (PixelData RGBA UnsignedByte nullPtr) textureFilter Texture2D $= ((Linear',Just Linear') , Linear') generateMipmap' Texture2D framebufferTexture2D Framebuffer (ColorAttachment 0) Texture2D toName 0 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 texImage2D Texture2D NoProxy 0 RGBA8 (TextureSize2D x y) 0 (PixelData RGBA UnsignedByte nullPtr) --textureFilter Texture2D $= ((Linear',Just Linear') , Linear') --textureFilter Texture2D $= ((Linear',Nothing) , Linear') textureFilter Texture2D $= ((Linear',Nothing) , Nearest) --textureFilter Texture2D $= ((Nearest,Just Nearest) , Nearest) --generateMipmap' Texture2D framebufferTexture2D Framebuffer (ColorAttachment 0) Texture2D fboTO 0 fboStatus <- framebufferStatus Framebuffer print fboStatus return (fboName, fboTO) 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,pokeLineStrat,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 _ = [] pokeLineStrat (RenderLine vs) = fmap (\((x,y,z),(r,g,b,a)) -> [x,y,z,r,g,b,a]) vs pokeLineStrat _ = [] 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 pokeWPColStrat :: RenderType -> [[Float]] pokeWPColStrat Render22x4{_unRender22x4=(((x,y),(z,w)),(r,g,b,a))} = [[x,y,z,w,r,g,b,a]] pokeWPColStrat _ = undefined poke32 :: RenderType -> [[Float]] poke32 Render3x2{_unRender3x2=((x,y,z),(a,b))} = [[x,y,z,a,b]] poke32 _ = undefined poke33 :: RenderType -> [[Float]] poke33 Render3x3{_unRender3x3=((x,y,z),(a,b,c))} = [[x,y,z,a,b,c]] poke33 _ = undefined