--{-# 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 Shader.Bind
import Framebuffer.Setup
import Data.Preload.Render

import Graphics.Rendering.OpenGL hiding (Point,translate,scale,imageHeight)
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, 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
    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}
    -- 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
    setupVertexAttribPointer 0 4 8 0
    setupVertexAttribPointer 1 4 8 4
    let winColVAO = VAO {_vao = winColVAOname, _vaoVBO = winVBO}
    -- setup shape geometry/cap VBO and two VAOs
    shEBOname <- genObjectName
    shEBOptr <- mallocArray numDrawableElements
    bindBuffer ElementArrayBuffer $= Just shEBOname
    bufferData ElementArrayBuffer $=
        ( fromIntegral $ glushortSize * numDrawableElements
        , nullPtr
        , StreamDraw
        )
    let shEBO = EBO {_ebo = 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
    bindBuffer ArrayBuffer $= Just shVBOname
    setupVertexAttribPointer 0 3 7 0
    setupVertexAttribPointer 1 4 7 3
    bindBuffer ElementArrayBuffer $= Just shEBOname
    shPosVAOname <- genObjectName
    bindVertexArrayObject $= Just shPosVAOname
    bindBuffer ArrayBuffer $= Just shVBOname
    setupVertexAttribPointer 0 3 7 0
    bindBuffer ElementArrayBuffer $= Just shEBOname
    let shPosColVAO = VAO { _vao = shPosColVAOname, _vaoVBO = shVBO }
        shPosVAO    = VAO { _vao = shPosVAOname,    _vaoVBO = shVBO }
    --setup silhouette edge VAO
    shEdgeVAOname <- genObjectName
    bindVertexArrayObject $= Just shEdgeVAOname
    bindBuffer ArrayBuffer $= Just shVBOname
    setupVertexAttribPointer 0 3 7 0
    --setup ebo for silhouette edges
    silEBOname <- genObjectName
    silEBOptr <- mallocArray numDrawableElements
    -- it may be important to bind this while the correct VAO is bound
    bindBuffer ElementArrayBuffer $= Just silEBOname
    bufferData ElementArrayBuffer $=
        ( fromIntegral $ glushortSize * numDrawableElements
        , nullPtr
        , StreamDraw
        )
    let silEBO = EBO {_ebo = silEBOname, _eboPtr = silEBOptr}
        shEdgeVAO = VAO { _vao = 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"]
-- 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
    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
    lightingTextureShad <- makeShaderUsingShaderVAO "lighting/texture" [vert,frag] ETriangleStrip fsShad
                >>= 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

    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
        , _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
        , _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
