27 lines
1,014 B
Haskell
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
|