{-# LANGUAGE QuasiQuotes #-}
module Shaders 
    (setupBasicShader
    ,setupFadeShader
    ,setupShaders
    ,makeTextureShader
    ,makeBasicShader
    ,makeFadeShader
    ,makeCircleShader
    ,makeArcShader
    ,makeBackgroundShader
    )
    where
import Graphics.Rendering.OpenGL
import Control.Monad (when)
import Text.RawString.QQ
import qualified Data.ByteString as BS

setupShaders :: IO [Program]
setupShaders = do
    basicShader <- makeBasicShader
    fadeShader <- makeFadeShader
    textureShader <- makeTextureShader
    return [basicShader,fadeShader,textureShader]

makeBasicShader :: IO Program
makeBasicShader = do
    vsSource <- BS.readFile "shader/basic.vert"
    fsSource <- BS.readFile "shader/basic.frag"

    makeShaderProgram [(VertexShader, vsSource)
                      ,(FragmentShader, fsSource)
                      ]

setupBasicShader :: IO ()
setupBasicShader = do
    shaderProgram <- makeBasicShader
    currentProgram $= (Just shaderProgram)

makeCircleShader :: IO Program
makeCircleShader = do
    vsSource <- BS.readFile "shader/circle.vert"
    gsSource <- BS.readFile "shader/circle.geom"
    fsSource <- BS.readFile "shader/circle.frag"

    makeShaderProgram [(VertexShader,   vsSource )
                      ,(GeometryShader, gsSource )
                      ,(FragmentShader, fsSource )
                      ]

makeArcShader :: IO Program
makeArcShader = do
    vsSource <- BS.readFile "shader/arc.vert"
    gsSource <- BS.readFile "shader/arc.geom"
    fsSource <- BS.readFile "shader/arc.frag"

    makeShaderProgram [(VertexShader,   vsSource )
                      ,(GeometryShader, gsSource )
                      ,(FragmentShader, fsSource )
                      ]

makeFadeShader :: IO Program
makeFadeShader = do
    vsSource <- BS.readFile "shader/fadeCircle.vert"
    gsSource <- BS.readFile "shader/fadeCircle.geom"
    fsSource <- BS.readFile "shader/fadeCircle.frag"

    makeShaderProgram [(VertexShader,   vsSource )
                      ,(GeometryShader, gsSource )
                      ,(FragmentShader, fsSource )
                      ]
makeBackgroundShader :: IO Program
makeBackgroundShader = do
    vsSource <- BS.readFile "shader/background.vert"
    gsSource <- BS.readFile "shader/background.geom"
    fsSource <- BS.readFile "shader/background.frag"

    makeShaderProgram [(VertexShader,   vsSource )
                      ,(GeometryShader, gsSource )
                      ,(FragmentShader, fsSource )
                      ]

setupFadeShader :: IO Program
setupFadeShader = do
    shaderProgram <- makeFadeShader
    currentProgram $= (Just shaderProgram)
    return shaderProgram

makeTextureShader :: IO Program
makeTextureShader = do
    vsSource <- BS.readFile "shader/basicTexture.vert"
    gsSource <- BS.readFile "shader/basicTexture.geom"
    fsSource <- BS.readFile "shader/basicTexture.frag"

    makeShaderProgram [(VertexShader,   vsSource )
                      ,(GeometryShader, gsSource )
                      ,(FragmentShader, fsSource )
                      ]

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

    linkProgram shaderProgram
    linkingSuccess <- linkStatus shaderProgram
    when (not linkingSuccess) $ do
        infoLog <- get (programInfoLog shaderProgram)
        putStrLn $ "Program Linking" ++ infoLog

    return shaderProgram

compileAndCheckShader :: (ShaderType,BS.ByteString) -> IO Shader
compileAndCheckShader (shaderType,sourceCode) = do
    theShader <- createShader shaderType
    shaderSourceBS theShader $= sourceCode
    compileShader theShader
    success <- compileStatus theShader
    when (not success) $ do
        infoLog <- get (shaderInfoLog theShader)
        putStrLn $ "Shader compile: " ++ show shaderType ++ " : " ++ show infoLog
    return theShader