module Shader.Compile
    ( makeShader
    , makeSourcedShader
    , setupVAO
    ) where
import Shader.Data
import Shader.Parameters
import Picture.Data

import Foreign
import qualified Data.ByteString as BS
import Control.Monad
--import Control.Lens
import Graphics.Rendering.OpenGL hiding (Point,translate,scale,imageHeight)

{- | 
Compiles a full shader found within the shader directory.
The shader is made up of files begining with the inputted string with extensions .vert, .geom etc.
-}
makeShader 
    :: String       -- ^ First part of the name of the shader
    -> [ShaderType] -- ^ Filetype extensions
    -> [Int]   -- ^ The input vertex sizes
    -> PrimitiveMode
    -> (RenderType -> [[Float]])   -- ^ Poke strategy: method for creating a list of vertex data to be bound
    -> IO FullShader
makeShader s shaderlist sizes pm renStrat = do
    prog <- makeSourcedShader s shaderlist
    vaob <- setupVAO sizes
    return $ FullShader 
        { _shaderProgram = prog
        , _shaderVAO = vaob
        , _shaderPokeStrategy = renStrat
        , _shaderDrawPrimitive = pm
        , _shaderTexture = Nothing
        , _shaderCustomUnis = []
        }

-- | Compile shader and get its uniform locations.
-- supposes the shader code is in the shader folder, with the string names
-- followed by .vert/.geom/.frag.
makeSourcedShader :: String -> [ShaderType] -> IO Program
makeSourcedShader s sts = do
    sources <- forM sts $ \st -> BS.readFile ("shader/" ++ s ++ shaderTypeExt st)
    makeShaderProgram s $ zip sts sources

shaderTypeExt :: ShaderType -> String
shaderTypeExt VertexShader   = ".vert"
shaderTypeExt GeometryShader = ".geom"
shaderTypeExt FragmentShader = ".frag"
shaderTypeExt _ = undefined

setupVAO :: [Int] -> IO VAO
setupVAO sizes = do
    theVAO <- genObjectName
    bindVertexArrayObject $= Just theVAO
    theVBO <- setupVBO sizes
    return $ VAO 
        { _vao = theVAO
        , _vaoVBO = theVBO
        }

setupVBO :: [Int] -> IO VBO
setupVBO sizes = do
    vboName <- genObjectName
    bindBuffer ArrayBuffer $= Just vboName
    forM_ (zip3 [0..] sizes offs) $ \(loc,siz,off) -> do
        setupVertexAttribPointer loc siz strd off
    thePtr <- mallocArray (strd * numDrawableElements)
    -- Allocate space
    bufferData ArrayBuffer $=
        (fromIntegral $ floatSize * numDrawableElements * strd
        , nullPtr
        , DynamicDraw
        )
    return $ VBO
        { _vbo = vboName
        , _vboPointer = thePtr
        , _vboAttribSizes = sizes
        }
  where
    strd = sum sizes
    offs = scanl (+) 0 sizes
    
{- | Assumes the correct VBO is bound -}
setupVertexAttribPointer 
    :: Int  -- ^ Atrib location
    -> Int  -- ^ Size
    -> Int  -- ^ Stride 
    -> Int  -- ^ Offset
    -> IO ()
setupVertexAttribPointer loc siz strd off = do
    vertexAttribPointer (AttribLocation (fi loc)) $=
        (ToFloat, VertexArrayDescriptor (fi' siz) Float (fi'' $ floatSize * strd) (bufferOffset off))
    vertexAttribArray (AttribLocation (fi loc)) $= Enabled
  where
    fi = fromIntegral
    fi' = fromIntegral
    fi'' = fromIntegral

makeShaderProgram :: String -> [(ShaderType,BS.ByteString)] -> IO Program
makeShaderProgram str sources = do
    theShaderProgram <- createProgram
    shaders <- mapM (compileAndCheckShader str) sources
    mapM_ (attachShader theShaderProgram) shaders

    linkProgram theShaderProgram
    linkingSuccess <- linkStatus theShaderProgram
    unless linkingSuccess $ do
        infoLog <- get (programInfoLog theShaderProgram)
        putStrLn $ str ++ ": Program Linking" ++ infoLog
    return theShaderProgram

compileAndCheckShader :: String -> (ShaderType,BS.ByteString) -> IO Shader
compileAndCheckShader str (theShaderType,sourceCode) = do
    theShader <- createShader theShaderType
    shaderSourceBS theShader $= sourceCode
    compileShader theShader
    success <- compileStatus theShader
    unless success $ do
        infoLog <- get (shaderInfoLog theShader)
        putStrLn $ str ++ ": Shader compile: " ++ show theShaderType ++ " :\n" ++ infoLog
    return theShader

bufferOffset :: Integral a => a -> Ptr b
bufferOffset = plusPtr nullPtr . (* floatSize) . fromIntegral