canvas/app/Types/CanvasShader.hs
2020-05-13 05:42:32 +02:00

27 lines
1,014 B
Haskell

module Types.CanvasShader where
import Data.List as L
import Data.Map.Strict
import Graphics.Rendering.OpenGL (get)
import qualified Graphics.Rendering.OpenGL as GL
data CanvasShader = CanvasShader
{ shaderAttribs :: Map String (GL.AttribLocation, GL.VariableType)
, shaderUniforms :: Map String (GL.UniformLocation, GL.VariableType)
, shaderProgram :: GL.Program
}
makeCanvasShader :: GL.Program -> IO CanvasShader
makeCanvasShader p = CanvasShader
<$> (fromList <$> ((get (GL.activeAttribs p) >>= mapM (aux (GL.attribLocation p)))))
<*> (fromList <$> ((get (GL.activeUniforms p)
>>= mapM (aux (GL.uniformLocation p) . on3 trimArray))))
<*> (pure p)
where aux f (_,t,name) = get (f name) >>= \l -> return (name, (l, t))
on3 f (a,b,c) = (a, b, f c)
-- An array uniform, foo, is sometimes given the name "foo" and
-- sometimes the name "foo[0]". We strip off the "[0]" if present.
trimArray n = if "[0]" `isSuffixOf` n then L.take (length n - 3) n else n