module Shader
    ( bindArrayBuffers
    , bindShaderBuffers
    , drawShader
    , drawShaders
    , setShaderUniforms
    , resetShaderUniforms
    , extractProgAndUnis 
    , freeShaderPointers
    , setPerpMatUniform
    ) where
import Geometry.Data
import Shader.Data
import Shader.Parameters
import MatrixHelper

import Foreign
import Control.Monad
import Graphics.Rendering.OpenGL hiding (Point,translate,scale,imageHeight)
--import Text.RawString.QQ
import Linear.Matrix
import Linear.V4

extractProgAndUnis :: FullShader -> (Program,UniformLocation)
extractProgAndUnis s = (_shaderProgram s, _shaderMatrixUniform s)

bindArrayBuffers :: Int -> VBO -> IO ()
bindArrayBuffers numVs theVBO = do
    bindBuffer ArrayBuffer $= Just (_vbo theVBO)
    bufferData ArrayBuffer $= 
        (fromIntegral $ floatSize * numVs * sum (_vboAttribSizes theVBO), _vboPointer theVBO, DynamicDraw)

bindShaderBuffers :: [FullShader] -> [Int] -> IO ()
bindShaderBuffers = zipWithM_ f
  where 
    f fs i = bindArrayBuffers i $ _vaoVBO $ _shaderVAO fs

drawShaders :: [FullShader] -> [Int] -> IO ()
drawShaders = zipWithM_ drawShader

drawShader :: FullShader -> Int -> IO ()
{-# INLINE drawShader #-}
drawShader fs i = do 
    currentProgram $= Just (_shaderProgram fs)
    bindVertexArrayObject $= Just (_vao $ _shaderVAO fs)
    case _shaderTexture fs of 
        Just ShaderTexture{_textureObject = txo}
            -> textureBinding Texture2D $= Just txo
        _   -> return ()
    drawArrays (_shaderDrawPrimitive fs) 0 (fromIntegral i)

resetShaderUniforms :: [(Program, UniformLocation)] -> IO ()
{-# INLINE resetShaderUniforms #-}
resetShaderUniforms = setShaderUniforms 0 1 (0,0) (2,2)

setShaderUniforms :: Float -> Float -> Point2 -> Point2 -> [(Program,UniformLocation)] -> IO ()
{-# INLINE setShaderUniforms #-}
setShaderUniforms rot czoom (tranx,trany) (winx,winy) fss = do
    let scalMat = Linear.Matrix.transpose $
            V4 (V4 (2*czoom/winx) 0             0 (0::GLfloat))
                (V4 0             (2*czoom/winy) 0 0)
                (V4 0             0             1 0)
                (V4 0             0             0 1)
    let rotMat = Linear.Matrix.transpose $
            V4 (V4 (cos rot) (sin (-rot)) 0 0)
                (V4 (sin rot) (cos rot)    0 0)
                (V4 0             0        1 0)
                (V4 0             0        0 1)
    let tranMat = Linear.Matrix.transpose $
            V4 (V4 1        0        0 0)
                (V4 0        1        0 0)
                (V4 0        0        1 0)
                (V4 (-tranx) (-trany) 0 1)
    let wmat = scalMat !*! rotMat !*! tranMat
        vToL (V4 a b c d) = [a,b,c,d]
    wmata <- (newMatrix RowMajor $ concatMap vToL $ vToL wmat) :: IO (GLmatrix GLfloat)
-- set common uniforms
    forM_ fss $ \shad -> do
        currentProgram $= Just (fst shad)
        uniform (snd shad) $= wmata

setPerpMatUniform 
    :: Float -- ^ rotation
    -> Float -- ^ zoom
    -> Point2 -- ^ translation
    -> Point2 -- ^ window size
    -> Point2 -- ^ viewfrom point
    -> FullShader
    -> IO ()
setPerpMatUniform rot czoom trans wins vFrom shad = do
    pmat <- (newMatrix RowMajor $ perspectiveMatrix rot czoom trans wins vFrom) :: IO (GLmatrix GLfloat)
    currentProgram $= Just (_shaderProgram shad)
    uniform (_shaderMatrixUniform shad) $= pmat
    return ()

freeShaderPointers :: FullShader -> IO ()
freeShaderPointers fs = free $ _vboPointer $ _vaoVBO $ _shaderVAO fs