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

data RenderData = RenderData
    { _lightSourceShader :: FullShader (Float,Float,Float,Float)
    , _wallShadowShader  :: FullShader (Point2,Point2,Point2,Point2)
    , _backgroundShader  :: FullShader (Point2,Point2,Point2,Point2)
    , _listShaders :: [FullShader RenderType]
    , _dummyVBO :: BufferObject
    , _dummyPtr :: Ptr Float
    }

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"]

    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,geom,frag] [(0,3),(1,4),(2,3)]    Triangles pokeBezQStrat

--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)]
    
    return $ RenderData
        { _listShaders = [bslist,lslist,cslist,aslist,eslist,bezierQuadShader]
        , _dummyVBO = dummyvbo
        , _dummyPtr = dummyptr
        , _lightSourceShader = lsShad
        , _wallShadowShader  = wsShad
        , _backgroundShader  = bgShad
        }


--------------------end preloadRender
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,v)) -> [[x,y,z],[r,g,b,a],[s,t,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 _ = []

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]]]

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