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
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
|
module Graphics.Glyph.Shaders where
import Control.Monad
import qualified Data.ByteString as BS
import qualified Data.ByteString.Lazy as BSL
import Data.List as List
import Data.Maybe
import Graphics.Glyph.Util
import Graphics.Rendering.OpenGL
{- 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 = loadShaderBS path typ =<< BS.readFile path
instance IsShaderSource BS.ByteString where
loadShader = loadShaderBS "Inlined"
instance IsShaderSource BSL.ByteString where
loadShader typ = loadShader typ . toStrict
where
toStrict = BS.concat . BSL.toChunks
noShader :: Maybe String
noShader = Nothing
loadShaderBS :: String -> ShaderType -> BS.ByteString -> IO (String, Maybe Shader)
loadShaderBS ctx typ src = do
shader <- createShader typ
shaderSourceBS shader $= src
compileShader shader
ok <- get (compileStatus shader)
infoLog <- get (shaderInfoLog shader)
unless ok $
deleteObjectNames [shader]
if not ok
then return (unlines $ map ((ctx ++ " " ++ show typ ++ ": ") ++) $ lines infoLog, Nothing)
else return (infoLog, Just shader)
{- 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
getUniformLocationsSafe :: Program -> [String] -> IO [Maybe UniformLocation]
getUniformLocationsSafe prog uniforms =
forM uniforms $ \uniform -> do
tmp <- get $ uniformLocation prog uniform
case tmp of
UniformLocation (-1) -> return $ Nothing
_ -> return $ Just tmp
loadProgramFullSafe ::
( IsShaderSource tc,
IsShaderSource te,
IsShaderSource g,
IsShaderSource v,
IsShaderSource f
) =>
Maybe (tc, te) ->
Maybe g ->
v ->
f ->
IO (Maybe Program)
loadProgramFullSafe tess geometry vert frag = do
let (ts1, ts2) = distribMaybe tess
shaders <-
sequence $
catMaybes
[ Just $ loadShader VertexShader vert,
Just $ loadShader FragmentShader frag,
liftM (loadShader GeometryShader) geometry,
liftM (loadShader TessControlShader) ts1,
liftM (loadShader TessEvaluationShader) ts2
]
(linklog, maybeProg) <- createShaderProgramSafe shaders
if isNothing maybeProg
then do
putStrLn "Failed to link program"
putStrLn linklog
return Nothing
else return maybeProg
loadProgramSafe ::
( IsShaderSource a,
IsShaderSource b,
IsShaderSource c
) =>
a ->
b ->
Maybe c ->
IO (Maybe Program)
loadProgramSafe vert frag geom = loadProgramFullSafe (Nothing :: Maybe (String, String)) geom vert frag
|
