loop/src/Preload/Render.hs

--{-# LANGUAGE TemplateHaskell #-}
--{-# OPTIONS_GHC -Wno-unused-top-binds #-}
module Preload.Render
    ( preloadRender
    , cleanUpRenderPreload
    )
    where
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
import qualified Data.Vector.Mutable as MV

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, _vboPtr = wpVBOptr, _vboAttribSizes = [4,4], _vboStride = 8}
    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
                >>= addUniforms ["lightPos"]
    wlLightShad 
         <- makeShaderUsingShaderVAO "lighting/wall" [vert,geom,frag] EPoints wsShad
                >>= addUniforms ["lightPos","radLum"]
    lightingSurfaceShad
         <- makeShader "lighting/surface" [vert,frag] [3] ETriangles
                >>= addUniforms ["lightPos","radLum"]
    lightingLineShadowShad
        <- makeShader "lighting/lineShadow" [vert,geom,frag] [3] ELinesAdjacency
                >>= addUniforms ["lightPos"]
-- 2D draw shaders
    bslist <- makeShader "twoD/basic"   [vert,frag] [3,4]   ETriangles 
    aslist <- makeShader "twoD/arc"     [vert,frag] [3,4,3] ETriangles 
    eslist <- makeShader "twoD/ellipse" [vert,geom,frag] [3,4]   ETriangles 
    bezierQuadShader <- makeShader "twoD/bezierQuad" [vert,frag] [3,4,4]  ETriangleStrip
    cslist <- makeShader "twoD/character" [vert,frag] [3,4,2] ETriangles 
                  >>= vaddTextureNoFilter "data/texture/charMap.png"
                    -- this should really be a 2d texture array
    basicTweakZShad <- makeShader "twoD/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
    pokeArray (shadVBOptr 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
-- blank wallShader
    wlBlank <- makeShader "wall/blank" [vert,geom,frag] [4,4] EPoints
-- textured wallShader
    wlTexture <- makeShader "wall/texture" [vert,geom,frag] [4,4] EPoints 
                >>= addTexture "data/texture/grayscaleDirt.png"
---- texture array shader
    textArrayShad <- makeShader "texture/array" [vert,frag] [3,3] ETriangles
        >>= 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

    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
        , _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
    -- TODO fix this
    --mapM_ freeShaderPointers $ _pictureShaders pd
    freeShaderPointers $ _lightingOccludeShader pd
    freeShaderPointers $ _fullscreenShader pd