--{-# 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