module Gelatin.GL.TH where
import Control.Exception (assert)
import Data.Proxy (Proxy (..))
import Foreign.C.String (withCString)
import GHC.TypeLits (KnownSymbol, symbolVal)
import Graphics.GL
import Language.Haskell.TH
import Gelatin.Shaders
genUniform :: TypeQ
-> ExpQ
-> DecsQ
genUniform typ func =
[d|
instance KnownSymbol name => HasGenFunc (Uniform name $typ) where
type GenFunc (Uniform name $typ) = GLuint -> $typ -> IO ()
genFunction _ program val = do
let ident = symbolVal (Proxy :: Proxy name)
loc <- withCString ident $ glGetUniformLocation program
$func loc val
glGetError >>= \case
0 -> return ()
e -> do
putStrLn $ unwords [ "Could not update uniform"
, ident
, "with value"
, show val
, ", encountered error (" ++ show e ++ ")"
, show (GL_INVALID_OPERATION, "invalid operation")
, show (GL_INVALID_VALUE, "invalid value")
]
assert False $ return ()
|]