aboutsummaryrefslogtreecommitdiff
path: root/Spear/GLSL/Management.hs
diff options
context:
space:
mode:
Diffstat (limited to 'Spear/GLSL/Management.hs')
-rw-r--r--Spear/GLSL/Management.hs297
1 files changed, 0 insertions, 297 deletions
diff --git a/Spear/GLSL/Management.hs b/Spear/GLSL/Management.hs
deleted file mode 100644
index 81cf45f..0000000
--- a/Spear/GLSL/Management.hs
+++ /dev/null
@@ -1,297 +0,0 @@
1module Spear.GLSL.Management
2(
3 -- * Data types
4 GLSLShader
5, GLSLProgram
6, ShaderType(..)
7 -- * Program manipulation
8, newProgram
9, releaseProgram
10, linkProgram
11, useProgram
12, withGLSLProgram
13 -- * Shader manipulation
14, attachShader
15, detachShader
16, loadShader
17, newShader
18, releaseShader
19 -- ** Source loading
20, loadSource
21, shaderSource
22, readSource
23, compile
24 -- * Location
25, attribLocation
26, fragLocation
27, uniformLocation
28 -- * Helper functions
29, ($=)
30, Data.StateVar.get
31)
32where
33
34
35import Spear.Setup
36
37import Control.Monad ((<=<), forM)
38import Control.Monad.Trans.State as State
39import Control.Monad.Trans.Error
40import Control.Monad.Trans.Class
41import Control.Monad (mapM_, when)
42import qualified Data.ByteString.Char8 as B
43import Data.StateVar
44import Foreign.Ptr
45import Foreign.Storable
46import Foreign.C.String
47import Foreign.Marshal.Alloc (alloca)
48import Foreign.Marshal.Array (withArray)
49import Graphics.Rendering.OpenGL.Raw.Core31
50import System.Directory (doesFileExist, getCurrentDirectory, setCurrentDirectory)
51import Unsafe.Coerce
52
53
54-- | Represents a GLSL shader handle.
55data GLSLShader = GLSLShader
56 { getShader :: GLuint
57 , getShaderKey :: Resource
58 }
59
60
61-- | Represents a GLSL program handle.
62data GLSLProgram = GLSLProgram
63 { getProgram :: GLuint
64 , getProgramKey :: Resource
65 }
66
67
68-- | Encodes several shader types.
69data ShaderType = VertexShader | FragmentShader deriving (Eq, Show)
70
71
72toGLShader :: ShaderType -> GLenum
73toGLShader VertexShader = gl_VERTEX_SHADER
74toGLShader FragmentShader = gl_FRAGMENT_SHADER
75
76
77-- | Apply the given function to the GLSLProgram's id.
78withGLSLProgram :: GLSLProgram -> (GLuint -> a) -> a
79withGLSLProgram prog f = f $ getProgram prog
80
81
82-- | Get the location of the given uniform variable within the given program.
83uniformLocation :: GLSLProgram -> String -> GettableStateVar GLint
84uniformLocation prog var = makeGettableStateVar get
85 where
86 get = withCString var $ \str -> glGetUniformLocation (getProgram prog) (unsafeCoerce str)
87
88
89-- | Get or set the location of the given variable to a fragment shader colour number.
90fragLocation :: GLSLProgram -> String -> StateVar GLint
91fragLocation prog var = makeStateVar get set
92 where
93 get = withCString var $ \str -> glGetFragDataLocation (getProgram prog) (unsafeCoerce str)
94 set idx = withCString var $ \str ->
95 glBindFragDataLocation (getProgram prog) (unsafeCoerce idx) (unsafeCoerce str)
96
97
98-- | Get or set the location of the given attribute within the given program.
99attribLocation :: GLSLProgram -> String -> StateVar GLint
100attribLocation prog var = makeStateVar get set
101 where
102 get = withCString var $ \str -> glGetAttribLocation (getProgram prog) (unsafeCoerce str)
103 set idx = withCString var $ \str ->
104 glBindAttribLocation (getProgram prog) (unsafeCoerce idx) (unsafeCoerce str)
105
106
107-- | Create a 'GLSLProgram'.
108newProgram :: [GLSLShader] -> Setup GLSLProgram
109newProgram shaders = do
110 h <- setupIO glCreateProgram
111 when (h == 0) $ setupError "glCreateProgram failed"
112 rkey <- register $ deleteProgram h
113 let program = GLSLProgram h rkey
114
115 mapM_ (setupIO . attachShader program) shaders
116 linkProgram program
117
118 return program
119
120
121-- | Release the given 'GLSLProgram'.
122releaseProgram :: GLSLProgram -> Setup ()
123releaseProgram = release . getProgramKey
124
125
126-- | Delete the given 'GLSLProgram'.
127deleteProgram :: GLuint -> IO ()
128--deleteProgram = glDeleteProgram
129deleteProgram prog = do
130 putStrLn $ "Deleting shader program " ++ show prog
131 glDeleteProgram prog
132
133
134-- | Link the given GLSL program.
135linkProgram :: GLSLProgram -> Setup ()
136linkProgram prog = do
137 let h = getProgram prog
138 err <- setupIO $ do
139 glLinkProgram h
140 alloca $ \statptr -> do
141 glGetProgramiv h gl_LINK_STATUS statptr
142 status <- peek statptr
143 case status of
144 0 -> getStatus glGetProgramiv glGetProgramInfoLog h
145 _ -> return ""
146
147 case length err of
148 0 -> return ()
149 _ -> setupError err
150
151
152-- | Use the given GLSL program.
153useProgram :: GLSLProgram -> IO ()
154useProgram prog = glUseProgram $ getProgram prog
155
156
157-- | Attach the given GLSL shader to the given GLSL program.
158attachShader :: GLSLProgram -> GLSLShader -> IO ()
159attachShader prog shader = glAttachShader (getProgram prog) (getShader shader)
160
161
162-- | Detach the given GLSL shader from the given GLSL program.
163detachShader :: GLSLProgram -> GLSLShader -> IO ()
164detachShader prog shader = glDetachShader (getProgram prog) (getShader shader)
165
166
167-- | Load a shader from the file specified by the given string.
168--
169-- This function creates a new shader. To load source code into an existing shader,
170-- see 'loadSource', 'shaderSource' and 'readSource'.
171loadShader :: FilePath -> ShaderType -> Setup GLSLShader
172loadShader file shaderType = do
173 shader <- newShader shaderType
174 loadSource file shader
175 compile file shader
176 return shader
177
178
179-- | Create a new shader.
180newShader :: ShaderType -> Setup GLSLShader
181newShader shaderType = do
182 h <- setupIO $ glCreateShader (toGLShader shaderType)
183 case h of
184 0 -> setupError "glCreateShader failed"
185 _ -> do
186 rkey <- register $ deleteShader h
187 return $ GLSLShader h rkey
188
189
190-- | Release the given 'GLSLShader'.
191releaseShader :: GLSLShader -> Setup ()
192releaseShader = release . getShaderKey
193
194
195-- | Free the given shader.
196deleteShader :: GLuint -> IO ()
197--deleteShader = glDeleteShader
198deleteShader shader = do
199 putStrLn $ "Deleting shader " ++ show shader
200 glDeleteShader shader
201
202
203-- | Load a shader source from the file specified by the given string into the given shader.
204loadSource :: FilePath -> GLSLShader -> Setup ()
205loadSource file h = do
206 exists <- setupIO $ doesFileExist file
207 case exists of
208 False -> setupError "the specified shader file does not exist"
209 True -> setupIO $ do
210 code <- readSource file
211 withCString code $ shaderSource h
212
213
214-- | Load the given shader source into the given shader.
215shaderSource :: GLSLShader -> CString -> IO ()
216shaderSource shader str =
217 let ptr = unsafeCoerce str
218 in withArray [ptr] $ flip (glShaderSource (getShader shader) 1) nullPtr
219
220
221-- | Compile the given shader.
222compile :: FilePath -> GLSLShader -> Setup ()
223compile file shader = do
224 let h = getShader shader
225
226 -- Compile
227 setupIO $ glCompileShader h
228
229 -- Verify status
230 err <- setupIO $ alloca $ \statusPtr -> do
231 glGetShaderiv h gl_COMPILE_STATUS statusPtr
232 result <- peek statusPtr
233 case result of
234 0 -> getStatus glGetShaderiv glGetShaderInfoLog h
235 _ -> return ""
236
237 case length err of
238 0 -> return ()
239 _ -> setupError $ "Unable to compile shader " ++ file ++ ":\n" ++ err
240
241
242type StatusCall = GLuint -> GLenum -> Ptr GLint -> IO ()
243type LogCall = GLuint -> GLsizei -> Ptr GLsizei -> Ptr GLchar -> IO ()
244
245
246getStatus :: StatusCall -> LogCall -> GLuint -> IO String
247getStatus getStatus getLog h = do
248 alloca $ \lenPtr -> do
249 getStatus h gl_INFO_LOG_LENGTH lenPtr
250 len <- peek lenPtr
251 case len of
252 0 -> return ""
253 _ -> withCString (replicate (unsafeCoerce len) '\0') $ getErrorString getLog h (unsafeCoerce len)
254
255
256getErrorString :: LogCall -> GLuint -> GLsizei -> CString -> IO String
257getErrorString getLog h len str = do
258 let ptr = unsafeCoerce str
259 getLog h len nullPtr ptr
260 peekCString str
261
262
263-- | Load the shader source specified by the given file.
264--
265-- This function implements an #include mechanism, so the given file can
266-- refer to other files.
267readSource :: FilePath -> IO String
268readSource = fmap B.unpack . readSource'
269
270
271readSource' :: FilePath -> IO B.ByteString
272readSource' file = do
273 let includeB = B.pack "#include"
274 newLineB = B.pack "\n"
275 isInclude = ((==) includeB) . B.take 8
276 clean = B.dropWhile (\c -> c == ' ')
277 cleanInclude = B.filter (\c -> c /= '"') . B.dropWhile (\c -> c /= ' ')
278 toLines = B.splitWith (\c -> c == '\n' || c == '\r')
279 addNewLine s = if (B.last s /= '\n') then B.append s newLineB else s
280 parse = fmap B.concat . (fmap . fmap $ flip B.append newLineB) . sequence .
281 fmap (processLine . clean) . toLines
282 processLine l =
283 if isInclude l
284 then readSource' $ B.unpack . clean . cleanInclude $ l
285 else return l
286
287 contents <- B.readFile file
288
289 dir <- getCurrentDirectory
290 let dir' = dir ++ "/" ++ (reverse . dropWhile (\c -> c /= '/') . reverse) file
291
292 setCurrentDirectory dir'
293 code <- parse contents
294 setCurrentDirectory dir
295
296 return code
297
generated by cgit v1.2.3 (git 2.25.1) at 2025-12-24 09:42:16 +0000