{-# LANGUAGE TemplateHaskell #-}
--{-# LANGUAGE Strict #-}
module Picture.Preload
    ( RenderData (..)
    , preloadRender
    , cleanUpRenderPreload
    )
    where

import Picture.Data

import Graphics.Rendering.OpenGL hiding (Point (..),translate,scale,imageHeight,imageWidth)

import Control.Lens

import Foreign
import Shader

import Geometry (Point2,Point3,Point4)

import qualified Control.Foldl as F

data RenderData = RenderData
    { _lightSourceShader :: FullShader (Float,Float,Float,Float)
    , _wallShadowShader  :: FullShader (Point2,Point2,Point2,Point2)
    , _wallLightShader  :: FullShader (Point3)
    , _backgroundShader  :: FullShader (Point2,Point2,Point2,Point2)
    , _fullscreenShader  :: FullShader ()
    , _wallShader :: FullShader (Point3,Point4)
    , _listShaders :: [FullShader RenderType]
    , _dummyVBO :: BufferObject
    , _dummyPtr :: Ptr Float
    , _spareFBO :: FramebufferObject
    , _fboTexture :: TextureObject
    }

makeLenses ''RenderData

preloadRender :: IO RenderData
preloadRender = do
-- compile shader programs
    lsShad <- makeShader "lightmapCircle" [vert,geom,frag] [(0,4)] Points (return . return . flat4)
--    fcs <- makeSourcedShader "lightmapCircle" [VertexShader,GeometryShader,FragmentShader]

    bgShad <- makeTextureShader "background" [vert,geom,frag] [(0,4),(1,2)] Points pokeBGStrat
                                "data/texture/smudgedDirt.png"

    wsShad <- makeShaderCustomUnis "wallShadow" [vert,geom,frag] [(0,4),(1,4)] Points pokeWPStrat
                ["lightPos"]

    wlLightShad <- makeShaderCustomUnis "wallLight" [vert,frag] [(0,3)] TriangleStrip pokeLightWallStrat
                    ["lightPosRadLum"]

    wlShad <- makeShader "wall" [vert,frag] [(0,3),(1,4)] TriangleStrip pokeWlStrat

    bslist <- makeShader "basic"   [vert,frag]      [(0,3),(1,4)]       Triangles pokeTriStrat
    lslist <- makeShader "basic"   [vert,frag]      [(0,3),(1,4)]       Lines     pokeLineStrat
    aslist <- makeShader "arc"     [vert,geom,frag] [(0,3),(1,4),(2,4)] Points    pokeArcStrat
    eslist <- makeShader "ellipse" [vert,geom,frag] [(0,3),(1,4)]       Triangles pokeEllStrat
    cslist <- makeTextureShader "character" [vert,geom,frag] 
                                [(0,3),(1,4),(2,3)] Points pokeCharStrat
                                "data/texture/charMap.png"

    bezierQuadShader
           <- makeShader "bezierQuad" [vert,frag] [(0,3),(1,4),(2,4)]    TriangleStrip pokeBezQStrat

    fsShad <- makeShader "fullscreen" [vert,frag] [(0,2),(1,2)] TriangleStrip 
                                (const [[[-1, 1],[0,1]]
                                       ,[[ 1, 1],[1,1]]
                                       ,[[-1,-1],[0,0]]
                                       ,[[ 1,-1],[1,0]]
                                       ]
                                 )
    n <- F.foldM (pokeShader fsShad) [()]
    putStrLn $ show n

--the following vbo is set up to contain one fixed vertex
    dummyvbo <- genObjectName
    dummyptr <- mallocArray numDrawableElements
    pokeArray dummyptr [0..2000]
    bindBuffer ArrayBuffer $= Just dummyvbo
    bufferData ArrayBuffer $= (fromIntegral floatSize, dummyptr, StaticDraw)

-- input a list of (attribute location, attrib length) pairs
-- these will have buffers and pointers created
    backgroundvao <- setupVAO [(0,4),(1,2)]

    (fbo,fboTO) <- setupFramebuffer

    bindFramebuffer Framebuffer $= defaultFramebufferObject
    
    return $ RenderData
        { _listShaders = [bslist,lslist,cslist,aslist,eslist,bezierQuadShader]
        , _dummyVBO = dummyvbo
        , _dummyPtr = dummyptr
        , _lightSourceShader = lsShad
        , _wallShadowShader  = wsShad
        , _wallLightShader   = wlLightShad
        , _wallShader        = wlShad
        , _backgroundShader  = bgShad
        , _fullscreenShader  = fsShad
        , _spareFBO = fbo
        , _fboTexture = fboTO
        }


--------------------end preloadRender

setupFramebuffer :: IO (FramebufferObject, TextureObject)
setupFramebuffer = 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') , Nearest)
    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
    putStrLn $ show fboStatus

    return (fboName, fboTO)


cleanUpRenderPreload :: RenderData -> IO ()
cleanUpRenderPreload pd = do
    mapM_ freeShaderPointers $ _listShaders pd
    freeShaderPointers $ _lightSourceShader pd
    freeShaderPointers $ _wallShadowShader pd
    freeShaderPointers $ _backgroundShader pd
    free $ _dummyPtr 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 _ = []

{-# INLINE pokeTriStrat #-}
pokeTriStrat :: RenderType -> [[[Float]]]
pokeTriStrat (RenderPoly vs) = fmap (\((x,y,z),(r,g,b,a)) -> [[x,y,z],[r,g,b,a]]) vs
pokeTriStrat _ = []

pokeWlStrat :: (Point3,Point4) -> [[[Float]]]
pokeWlStrat ((x,y,z),(r,g,b,a)) = [[[x,y,z],[r,g,b,a]]]

pokeCharStrat (RenderText vs) = fmap (\(a,b,c) -> flat3 (flat3 a, flat4 b, flat3 c)) vs
pokeCharStrat _ = []

pokeArcStrat (RenderArc (a,b,c)) = [flat3 (flat3 a, flat4 b, flat4 c)]
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 _ = []

bufferOffset :: Integral a => a -> Ptr b
bufferOffset = plusPtr nullPtr . fromIntegral

vert = VertexShader
geom = GeometryShader
frag = FragmentShader

pokeWPStrat :: (Point2,Point2,Point2,Point2) -> [[[Float]]]
pokeWPStrat ((x,y),(z,w),(a,b),(c,d)) = [[[x,y,z,w],[a,b,c,d]]]

pokeLightWallStrat :: Point3 -> [[[Float]]]
pokeLightWallStrat (x,y,z) = [[[x,y,z]]]

pokeBGStrat :: a -> [[[Float]]]
pokeBGStrat = const []