blob: 43d423bd9d3f65cf6629928a194caea56d7b3125 (
plain)
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
|
--------------------------------------------------------------------------------
--------------------------------------------------------------------------------
-- |
-- Module : LoadShaders
-- Copyright : (c) Sven Panne 2013
-- License : BSD3
--
-- Maintainer : Sven Panne <svenpanne@gmail.com>
-- Stability : stable
-- Portability : portable
--
-- Utilities for shader handling, adapted from LoadShaders.cpp which is (c) The
-- Red Book Authors.
module Game.Internal.LoadShaders
( ShaderSource (..),
ShaderInfo (..),
loadShaders,
)
where
import Control.Exception
import Control.Monad
import qualified Data.ByteString as B
import Graphics.Rendering.OpenGL
--------------------------------------------------------------------------------
-- | The source of the shader source code.
data ShaderSource
= -- | The shader source code is directly given as a 'B.ByteString'.
ByteStringSource B.ByteString
| -- | The shader source code is directly given as a 'String'.
StringSource String
| -- | The shader source code is located in the file at the given 'FilePath'.
FileSource FilePath
deriving (Eq, Ord, Show)
getSource :: ShaderSource -> IO B.ByteString
getSource (ByteStringSource bs) = return bs
getSource (StringSource str) = return $ packUtf8 str
getSource (FileSource path) = B.readFile path
--------------------------------------------------------------------------------
-- | A description of a shader: The type of the shader plus its source code.
data ShaderInfo
= ShaderInfo ShaderType ShaderSource
deriving (Eq, Ord, Show)
--------------------------------------------------------------------------------
-- | Create a new program object from the given shaders, throwing an
-- 'IOException' if something goes wrong.
loadShaders :: [ShaderInfo] -> IO Program
loadShaders infos =
createProgram `bracketOnError` deleteObjectName $ \program -> do
loadCompileAttach program infos
linkAndCheck program
return program
linkAndCheck :: Program -> IO ()
linkAndCheck = checked linkProgram linkStatus programInfoLog "link"
loadCompileAttach :: Program -> [ShaderInfo] -> IO ()
loadCompileAttach _ [] = return ()
loadCompileAttach program (ShaderInfo shType source : infos) =
createShader shType `bracketOnError` deleteObjectName $ \shader -> do
src <- getSource source
shaderSourceBS shader $= src
compileAndCheck shader
attachShader program shader
loadCompileAttach program infos
compileAndCheck :: Shader -> IO ()
compileAndCheck = checked compileShader compileStatus shaderInfoLog "compile"
checked ::
(t -> IO ()) ->
(t -> GettableStateVar Bool) ->
(t -> GettableStateVar String) ->
String ->
t ->
IO ()
checked action getStatus getInfoLog message object = do
action object
ok <- get (getStatus object)
unless ok $ do
infoLog <- get (getInfoLog object)
fail (message ++ " log: " ++ infoLog)
|
