1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
|
module Graphics.Glyph.Shaders where
import Graphics.Rendering.OpenGL
import qualified Data.ByteString as BS
import qualified Data.ByteString.Lazy as BSL
import Control.Monad
import Data.Maybe
import Data.List as List
import Graphics.Glyph.Util
{- Load a shader from a file giving the type of the shader
- to load.
- This function returns the shader log as a string and
- a shader as a maybe. Nothing if the shader didn't complie
- and Just if the shader did compile
-}
class IsShaderSource a where
loadShader :: ShaderType -> a -> IO (String, Maybe Shader)
instance IsShaderSource FilePath where
loadShader typ path = loadShader typ =<< BS.readFile path
instance IsShaderSource BS.ByteString where
loadShader typ src = do
shader <- createShader typ
shaderSourceBS shader $= src
compileShader shader
ok <- get (compileStatus shader)
infoLog <- get (shaderInfoLog shader)
unless ok $
deleteObjectNames [shader]
return ( infoLog, if not ok then Nothing else Just shader );
instance IsShaderSource BSL.ByteString where
loadShader typ = loadShader typ . toStrict
where toStrict = BS.concat . BSL.toChunks
{- Load multiple shaders -}
loadShaders :: (IsShaderSource a) => [(ShaderType,a)] -> IO [(String, Maybe Shader)]
loadShaders = mapM ( uncurry loadShader )
{- Return the sucessfully complied shaders
- as a new array of working shaders -}
workingShaders :: [(a, Maybe Shader)] -> [Shader]
workingShaders = mapMaybe snd
{- Create a program from a list of working shaders -}
createShaderProgram :: [Shader] -> IO (String, Maybe Program)
createShaderProgram shaders = do
p <- createProgram
mapM_ (attachShader p) shaders
linkProgram p
ok <- get $ linkStatus p
info <- get $ programInfoLog p
unless ok $
deleteObjectNames [p]
return ( info, not ok ? Nothing $ Just p )
{- Creates a shader program, but will only build the program if all the
- shaders compiled correctly -}
createShaderProgramSafe :: [(String,Maybe Shader)] -> IO (String, Maybe Program)
createShaderProgramSafe shaders =
not (List.all (isJust.snd) shaders) ?
return (concatMap fst shaders, Nothing) $
createShaderProgram $ workingShaders shaders
{- Get the uniform form a program. -}
getUniform :: Uniform a => String -> IO (Maybe (StateVar a))
getUniform name =
get currentProgram >>= (\pr -> case pr of
Just p -> liftM (Just . uniform) (get $ uniformLocation p name)
Nothing -> return Nothing )
getUniformForProgram :: Uniform a => String -> Program -> IO (StateVar a)
getUniformForProgram name prog =
liftM uniform (get $ uniformLocation prog name)
getUniformLocation :: String -> IO (Maybe UniformLocation)
getUniformLocation name =
get currentProgram >>= maybe (return Nothing) (\prog ->
liftM Just (get $ uniformLocation prog name) )
loadProgramSafe ::
(IsShaderSource a,
IsShaderSource b,
IsShaderSource c) =>
a -> b -> Maybe c -> IO (Maybe Program)
loadProgramSafe vert frag geom = do
shaders <- sequence $ catMaybes [
Just $ loadShader VertexShader vert,
Just $ loadShader FragmentShader frag,
liftM (loadShader GeometryShader) geom]
-- mapM_ (putStrLn . fst) shaders
(linklog, maybeProg) <- createShaderProgramSafe shaders
if isNothing maybeProg then do
putStrLn "Failed to link program"
putStrLn linklog
return Nothing
else return maybeProg
|
