summaryrefslogtreecommitdiff
path: root/src/Game/Internal/LoadShaders.hs
diff options
context:
space:
mode:
Diffstat (limited to 'src/Game/Internal/LoadShaders.hs')
-rw-r--r--src/Game/Internal/LoadShaders.hs75
1 files changed, 36 insertions, 39 deletions
diff --git a/src/Game/Internal/LoadShaders.hs b/src/Game/Internal/LoadShaders.hs
index ded2da9..86b549f 100644
--- a/src/Game/Internal/LoadShaders.hs
+++ b/src/Game/Internal/LoadShaders.hs
@@ -12,10 +12,11 @@
-- Red Book Authors.
--
--------------------------------------------------------------------------------
-
-module Game.Internal.LoadShaders (
- ShaderSource(..), ShaderInfo(..), loadShaders
-) where
+module Game.Internal.LoadShaders
+ ( ShaderSource(..)
+ , ShaderInfo(..)
+ , loadShaders
+ ) where
import Control.Exception
import Control.Monad
@@ -23,17 +24,15 @@ import qualified Data.ByteString as B
import Graphics.Rendering.OpenGL
--------------------------------------------------------------------------------
-
-- | The source of the shader source code.
-
-data ShaderSource =
- ByteStringSource B.ByteString
+data ShaderSource
+ = ByteStringSource B.ByteString
-- ^ The shader source code is directly given as a 'B.ByteString'.
- | StringSource String
+ | StringSource String
-- ^ The shader source code is directly given as a 'String'.
- | FileSource FilePath
+ | FileSource FilePath
-- ^ The shader source code is located in the file at the given 'FilePath'.
- deriving ( Eq, Ord, Show )
+ deriving (Eq, Ord, Show)
getSource :: ShaderSource -> IO B.ByteString
getSource (ByteStringSource bs) = return bs
@@ -41,49 +40,47 @@ 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 )
+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
+ 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
+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 ::
+ (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)
+ action object
+ ok <- get (getStatus object)
+ unless ok $ do
+ infoLog <- get (getInfoLog object)
+ fail (message ++ " log: " ++ infoLog)