diff --git a/GLUtil.cabal b/GLUtil.cabal --- a/GLUtil.cabal +++ b/GLUtil.cabal @@ -1,5 +1,5 @@ Name: GLUtil -Version: 0.7.1 +Version: 0.7.4 Synopsis: Miscellaneous OpenGL utilities. License: BSD3 License-file: LICENSE @@ -48,6 +48,7 @@ bytestring, array, containers >= 0.5, + cpphs, linear >= 1.1.3, JuicyPixels >= 3, OpenGLRaw >= 1.1, diff --git a/src/Graphics/GLUtil/ShaderProgram.hs b/src/Graphics/GLUtil/ShaderProgram.hs --- a/src/Graphics/GLUtil/ShaderProgram.hs +++ b/src/Graphics/GLUtil/ShaderProgram.hs @@ -5,18 +5,21 @@ (-- * The ShaderProgram type ShaderProgram(..), -- * Simple shader programs utilizing a vertex shader and a fragment shader - simpleShaderProgram, simpleShaderProgramWith, simpleShaderExplicit, + simpleShaderProgram, simpleShaderProgramWith, simpleShaderExplicit, + simpleShaderProgramBS, simpleShaderProgramWithBS, simpleShaderExplicitBS, -- * Explicit shader loading - loadShaderProgramWith, + loadShaderProgram, loadShaderProgramWith, + loadShaderProgramBS, loadShaderProgramWithBS, -- * Working with ShaderProgram parameters getAttrib, enableAttrib, setAttrib, setUniform, getUniform) where import Prelude hiding (lookup) import Control.Applicative ((<$>), (<*>)) +import qualified Data.ByteString as BS import Data.List (find, findIndex, isSuffixOf) import Data.Map.Strict (Map, fromList, lookup) import Data.Maybe (isJust, isNothing, catMaybes) import Graphics.GLUtil.Shaders (loadShader, linkShaderProgram, - linkShaderProgramWith) + linkShaderProgramWith, loadShaderBS) import Graphics.GLUtil.GLError (throwError) import Graphics.Rendering.OpenGL @@ -33,9 +36,18 @@ -- and uniforms are desired, consider using 'loadShaderProgram'. simpleShaderExplicit :: FilePath -> FilePath -> ([String],[String]) -> IO ShaderProgram -simpleShaderExplicit vsrc fsrc names = - do vs <- loadShader VertexShader vsrc - fs <- loadShader FragmentShader fsrc +simpleShaderExplicit = simpleShaderExplicit' loadShader + +simpleShaderExplicitBS :: BS.ByteString -> BS.ByteString -> ([String],[String]) + -> IO ShaderProgram +simpleShaderExplicitBS = simpleShaderExplicit' (loadShaderBS "ByteString literal") + +simpleShaderExplicit' :: (ShaderType -> a -> IO Shader) + -> a -> a -> ([String],[String]) + -> IO ShaderProgram +simpleShaderExplicit' load vsrc fsrc names = + do vs <- load VertexShader vsrc + fs <- load FragmentShader fsrc p <- linkShaderProgram [vs,fs] throwError (attrs,unis) <- getExplicits p names @@ -48,6 +60,13 @@ simpleShaderProgram vsrc fsrc = simpleShaderProgramWith vsrc fsrc (\_ -> return ()) +-- |Load a 'ShaderProgram' from vertex and fragment shader source +-- strings. The active attributes and uniforms in the linked program +-- are recorded in the 'ShaderProgram'. +simpleShaderProgramBS :: BS.ByteString -> BS.ByteString -> IO ShaderProgram +simpleShaderProgramBS vsrc fsrc = + simpleShaderProgramWithBS vsrc fsrc (\_ -> return ()) + -- |Load a 'ShaderProgram' from a vertex shader source file and a -- fragment shader source file. The active attributes and uniforms in -- the linked program are recorded in the 'ShaderProgram'. The @@ -60,14 +79,42 @@ simpleShaderProgramWith vsrc fsrc m = loadShaderProgramWith [(VertexShader, vsrc), (FragmentShader, fsrc)] m --- | Helper for @load*Program*@ variants. +-- |Load a 'ShaderProgram' from vertex and fragment shader source +-- strings. See 'simpleShaderProgramWith' for more information. +simpleShaderProgramWithBS :: BS.ByteString -> BS.ByteString + -> (Program -> IO ()) -> IO ShaderProgram +simpleShaderProgramWithBS vsrc fsrc m = + loadShaderProgramWithBS [(VertexShader, vsrc), (FragmentShader, fsrc)] m + loadShaderProgramWith :: [(ShaderType, FilePath)] -> (Program -> IO ()) -> IO ShaderProgram -loadShaderProgramWith sources m = - do p <- mapM (uncurry loadShader) sources >>= flip linkShaderProgramWith m +loadShaderProgramWith = loadShaderProgramWith' loadShader + +loadShaderProgramWithBS :: [(ShaderType, BS.ByteString)] -> (Program -> IO ()) + -> IO ShaderProgram +loadShaderProgramWithBS = loadShaderProgramWith' (loadShaderBS "ByteString literal") + +-- | Helper for @load*Program*@ variants. +loadShaderProgramWith' :: (ShaderType -> a -> IO Shader) + -> [(ShaderType, a)] -> (Program -> IO ()) + -> IO ShaderProgram +loadShaderProgramWith' load sources m = + do p <- mapM (uncurry load) sources >>= flip linkShaderProgramWith m throwError (attrs,unis) <- getActives p return $ ShaderProgram (fromList attrs) (fromList unis) p + +-- |Load a 'ShaderProgram' from a list of individual shader program +-- files. The active attributes and uniforms in the linked program are +-- recorded in the 'ShaderProgram' +loadShaderProgram :: [(ShaderType, FilePath)] -> IO ShaderProgram +loadShaderProgram = flip loadShaderProgramWith (const (return ())) + +-- | Load a 'ShaderProgram' from a list of individual shader program +-- source strings. The active attributes and uniforms in the linked program are +-- recorded in the 'ShaderProgram' +loadShaderProgramBS :: [(ShaderType, BS.ByteString)] -> IO ShaderProgram +loadShaderProgramBS = flip loadShaderProgramWithBS (const (return ())) -- | Get all attributes and uniforms used by a program. Note that -- unused parameters may be elided by the compiler, and so will not be diff --git a/src/Graphics/GLUtil/Shaders.hs b/src/Graphics/GLUtil/Shaders.hs --- a/src/Graphics/GLUtil/Shaders.hs +++ b/src/Graphics/GLUtil/Shaders.hs @@ -1,5 +1,5 @@ -- |Utilities for working with fragment and vertex shader programs. -module Graphics.GLUtil.Shaders (loadShader, +module Graphics.GLUtil.Shaders (loadShader, loadShaderBS, linkShaderProgram, linkShaderProgramWith, namedUniform, uniformScalar, uniformVec, uniformMat, @@ -16,9 +16,14 @@ -- |Load a shader program from a file. loadShader :: ShaderType -> FilePath -> IO Shader -loadShader st filePath = do +loadShader st filePath = BS.readFile filePath >>= loadShaderBS filePath st + +-- | @loadShaderBS fileName shaderType src@ loads a shader from source +-- code, @src@. The file name is used only for error reporting. +loadShaderBS :: FilePath -> ShaderType -> BS.ByteString -> IO Shader +loadShaderBS filePath st src = do shader <- createShader st - BS.readFile filePath >>= (shaderSourceBS shader $=) + shaderSourceBS shader $= src compileShader shader printError ok <- get (compileStatus shader) diff --git a/src/Graphics/GLUtil/Textures.hs b/src/Graphics/GLUtil/Textures.hs --- a/src/Graphics/GLUtil/Textures.hs +++ b/src/Graphics/GLUtil/Textures.hs @@ -18,7 +18,7 @@ import Graphics.GLUtil.TypeMapping (HasGLType(..)) -- |Pixel format of image data. -data TexColor = TexMono | TexRGB | TexBGR | TexRGBA +data TexColor = TexMono | TexRG | TexRGB | TexBGR | TexRGBA -- |A basic texture information record. data TexInfo a = TexInfo { texWidth :: GLsizei @@ -77,6 +77,14 @@ => Int -> Int -> TexColor -> proxy a -> IO TextureObject freshTexture w h c _ = loadTexture $ texInfo w h c (nullPtr::Ptr a) +-- |Create a new 2D texture with uninitialized 'Word8' contents. +freshTextureWord8 :: Int -> Int -> TexColor -> IO TextureObject +freshTextureWord8 w h c = loadTexture $ texInfo w h c (nullPtr::Ptr Word8) + +-- |Create a new 2D texture with uninitialized 'GLfloat' contents. +freshTextureFloat :: Int -> Int -> TexColor -> IO TextureObject +freshTextureFloat w h c = loadTexture $ texInfo w h c (nullPtr::Ptr GLfloat) + -- |Create a new 2D texture with data from a 'TexInfo'. loadTexture :: IsPixelData a => TexInfo a -> IO TextureObject loadTexture tex = do [obj] <- genObjectNames 1 @@ -93,7 +101,14 @@ GL.Float -> loadAux R32F Red GL.UnsignedByte -> loadAux R8 Red _ -> loadAux Luminance' Luminance - + loadTex TexRG = case pixelType of + GL.UnsignedShort -> loadAux RG16 RGInteger + GL.Float -> loadAux RG32F RG + GL.UnsignedByte -> loadAux RG8UI RGInteger + GL.Byte -> loadAux RG8I RGInteger + GL.Int -> loadAux RG32I RGInteger + GL.UnsignedInt -> loadAux RG32UI RGInteger + _ -> error "Unknown pixelType for TexRG" loadTex TexRGB = loadAux RGBA' RGB loadTex TexBGR = loadAux RGBA' BGR loadTex TexRGBA = loadAux RGBA' RGBA