GLUtil 0.6.7.1 → 0.7

raw patch · 5 files changed

+73/−160 lines, 5 filesdep ~OpenGLPVP ok

version bump matches the API change (PVP)

Dependency ranges changed: OpenGL

API changes (from Hackage documentation)

Files

• GLUtil.cabal +2/−2
• examples/example1.hs +5/−5
• src/Graphics/GLUtil/ShaderProgram.hs +29/−46
• src/Graphics/GLUtil/Shaders.hs +23/−97
• src/Graphics/GLUtil/Textures.hs +14/−10

@@ -1,5 +1,5 @@ Name:                GLUtil-Version:             0.6.7.1+Version:             0.7 Synopsis:            Miscellaneous OpenGL utilities. License:             BSD3 License-file:        LICENSE@@ -51,7 +51,7 @@                        linear >= 1.1.3,                        JuicyPixels >= 3,                        OpenGLRaw >= 1.1,-                       OpenGL >= 2.4 && < 2.9,+                       OpenGL >= 2.9,                        vector >= 0.7   Build-tools:         cpphs   GHC-Options:         -Odph -Wall

@@ -11,7 +11,7 @@ import Graphics.GLUtil  -- | A value to carry around a shader program and its parameters.-data Shaders = Shaders { program        :: Program+data Shaders = Shaders { getProgram        :: Program                        , fadeFactorU    :: UniformLocation                        , texturesU      :: [UniformLocation]                         , positionA      :: AttribLocation }@@ -40,9 +40,9 @@ -- | Load and compile our GLSL program, and pull out the parameters we -- want. initShaders :: IO Shaders-initShaders = do vs <- loadShader $ "shaders" </> "hello-gl.vert"-                 fs <- loadShader $ "shaders" </> "hello-gl.frag"-                 p <- linkShaderProgram [vs] [fs]+initShaders = do vs <- loadShader VertexShader $ "shaders" </> "hello-gl.vert"+                 fs <- loadShader FragmentShader $ "shaders" </> "hello-gl.frag"+                 p <- linkShaderProgram [vs,fs]                  Shaders p                    <$> get (uniformLocation p "fade_factor")                    <*> mapM (get . uniformLocation p)@@ -84,7 +84,7 @@ drawInit :: Resources -> IO () drawInit r = do clearColor $= Color4 1 1 1 1                 clear [ColorBuffer]-                currentProgram $= Just (program (shaders r))+                currentProgram $= Just (getProgram (shaders r))                 setupTexturing r                 setupGeometry r 

@@ -1,20 +1,23 @@ -- |Convenience interface for working with GLSL shader -- programs. Provides an interface for setting attributes and -- uniforms.-module Graphics.GLUtil.ShaderProgram (ShaderProgram(..), loadShaderProgram, -                                      loadShaderProgramWith,-                                      loadGeoProgram,-                                      loadGeoProgramWith,-                                      loadShaderExplicit, -                                      getAttrib, enableAttrib, setAttrib, -                                      setUniform, getUniform) where+module Graphics.GLUtil.ShaderProgram +  (-- * The ShaderProgram type+   ShaderProgram(..), +   -- * Simple shader programs utilizing a vertex shader and a+   -- fragment shader+   simpleShaderProgram, simpleShaderProgramWith, simpleShaderExplicit, +   -- * Explicit shader loading+   loadShaderProgramWith,+   -- * Working with ShaderProgram parameters+   getAttrib, enableAttrib, setAttrib, setUniform, getUniform) where import Prelude hiding (lookup) import Control.Applicative ((<$>), (<*>)) import Data.List (find, findIndex, isSuffixOf) import Data.Map.Strict (Map, fromList, lookup) import Data.Maybe (isJust, isNothing, catMaybes)-import Graphics.GLUtil.Shaders (loadShader, loadGeoShader, linkShaderProgram,-                                linkGeoProgramWith)+import Graphics.GLUtil.Shaders (loadShader, linkShaderProgram,+                                linkShaderProgramWith) import Graphics.GLUtil.GLError (throwError) import Graphics.Rendering.OpenGL @@ -29,12 +32,12 @@ -- files. the third argument is a tuple of the attribute names and -- uniform names that will be set in this program. If all attributes -- and uniforms are desired, consider using 'loadShaderProgram'.-loadShaderExplicit :: FilePath -> FilePath -> ([String],[String])-                   -> IO ShaderProgram-loadShaderExplicit vsrc fsrc names =-  do vs <- loadShader vsrc-     fs <- loadShader fsrc-     p <- linkShaderProgram [vs] [fs]+simpleShaderExplicit :: FilePath -> FilePath -> ([String],[String])+                     -> IO ShaderProgram+simpleShaderExplicit vsrc fsrc names =+  do vs <- loadShader VertexShader vsrc+     fs <- loadShader FragmentShader fsrc+     p <- linkShaderProgram [vs,fs]      throwError      (attrs,unis) <- getExplicits p names      return $ ShaderProgram (fromList attrs) (fromList unis) p@@ -42,16 +45,9 @@ -- |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'.-loadShaderProgram :: FilePath -> FilePath -> IO ShaderProgram-loadShaderProgram vsrc fsrc = loadShaderProgramWith vsrc fsrc (\_ -> return ())---- |Load a 'ShaderProgram' from a vertex shader source file, a--- geometry shader source file, and a fragment shader source file. The--- active attributes and uniforms in the linked program are recorded--- in the 'ShaderProgram'.-loadGeoProgram :: FilePath -> FilePath -> FilePath -> IO ShaderProgram-loadGeoProgram vsrc gsrc fsrc = -  loadGeoProgramWith vsrc gsrc fsrc (\_ -> return ())+simpleShaderProgram :: FilePath -> FilePath -> IO ShaderProgram+simpleShaderProgram vsrc fsrc = +  simpleShaderProgramWith vsrc fsrc (\_ -> return ())  -- |Load a 'ShaderProgram' from a vertex shader source file and a -- fragment shader source file. The active attributes and uniforms in@@ -60,29 +56,16 @@ -- objects are attached to the program, but before linking. This -- supports the use of 'bindFragDataLocation' to map fragment shader -- outputs.-loadShaderProgramWith :: FilePath -> FilePath -> (Program -> IO ())-                      -> IO ShaderProgram-loadShaderProgramWith vsrc fsrc m = loadProgramWithAux vsrc Nothing fsrc m---- |Load a 'ShaderProgram' from a vertex shader source file, a--- geometry shader source file, and a fragment shader source file. The--- active attributes and uniforms in the linked program are recorded--- in the 'ShaderProgram'. The supplied 'IO' function is applied to--- the new program after shader objects are attached to the program,--- but before linking. This supports the use of 'bindFragDataLocation'--- to map fragment shader outputs.-loadGeoProgramWith :: FilePath -> FilePath -> FilePath -> (Program -> IO ())-                   -> IO ShaderProgram-loadGeoProgramWith vsrc gsrc fsrc m = loadProgramWithAux vsrc (Just gsrc) fsrc m+simpleShaderProgramWith :: FilePath -> FilePath -> (Program -> IO ())+                        -> IO ShaderProgram+simpleShaderProgramWith vsrc fsrc m = +  loadShaderProgramWith [(VertexShader, vsrc), (FragmentShader, fsrc)] m  -- | Helper for @load*Program*@ variants.-loadProgramWithAux :: FilePath -> Maybe FilePath -> FilePath-                   -> (Program -> IO ()) -> IO ShaderProgram-loadProgramWithAux vsrc gsrc fsrc m =-  do vs <- loadShader vsrc-     gs <- maybe (return []) (fmap (:[]) . loadGeoShader) gsrc-     fs <- loadShader fsrc-     p <- linkGeoProgramWith [vs] gs [fs] m+loadShaderProgramWith :: [(ShaderType, FilePath)] -> (Program -> IO ())+                      -> IO ShaderProgram+loadShaderProgramWith sources m =+  do p <- mapM (uncurry loadShader) sources >>= flip linkShaderProgramWith m      throwError      (attrs,unis) <- getActives p      return $ ShaderProgram (fromList attrs) (fromList unis) p

@@ -1,32 +1,24 @@ -- |Utilities for working with fragment and vertex shader programs.-module Graphics.GLUtil.Shaders (loadShader, loadGeoShader,-                                linkShaderProgram,-                                linkShaderProgramWith, -                                linkGeoProgram, linkGeoProgramWith,+module Graphics.GLUtil.Shaders (loadShader,+                                linkShaderProgram, linkShaderProgramWith,                                 namedUniform,                                  uniformScalar, uniformVec, uniformMat,                                  namedUniformMat, uniformGLMat4) where-import Control.Applicative ((<$>))-import Control.Monad (unless, replicateM)-import Foreign.C.String (peekCStringLen, withCStringLen)-import Foreign.Marshal.Alloc (alloca, allocaBytes)-import Foreign.Marshal.Array (withArray)-import Foreign.Storable (peek)+import Control.Monad (unless)+import qualified Data.ByteString as BS import Graphics.Rendering.OpenGL import Graphics.Rendering.OpenGL.Raw.Core31-import Graphics.Rendering.OpenGL.Raw.ARB.GeometryShader4 import Graphics.GLUtil.GLError import Foreign.Ptr (Ptr) import Unsafe.Coerce (unsafeCoerce) --- This module is based on the ogl2brick example in the GLUT package.+-- 'loadShader' is based on the ogl2brick example in the GLUT package.  -- |Load a shader program from a file.-loadShader :: Shader s => FilePath -> IO s-loadShader filePath = do-  src <- readFile filePath-  [shader] <- genObjectNames 1-  shaderSource shader $= [src]+loadShader :: ShaderType -> FilePath -> IO Shader+loadShader st filePath = do+  shader <- createShader st+  BS.readFile filePath >>= (shaderSourceBS shader $=)   compileShader shader   printError   ok <- get (compileStatus shader)@@ -39,92 +31,26 @@     ioError (userError "shader compilation failed")   return shader --- |Specialized loading for geometry shaders that are not yet fully--- supported by the Haskell OpenGL package.-loadGeoShader :: FilePath -> IO GeometryShader-loadGeoShader filePath = do-  src <- readFile filePath-  [shader@(GeometryShader gid)] <- genObjectNames 1-  setSource gid src-  glCompileShader gid-  printError-  ok <- alloca $ \buf -> do-          glGetShaderiv gid gl_COMPILE_STATUS buf-          fmap (> 0) (peek buf)-  infoLogLen <- alloca $ \ptr -> do glGetShaderiv gid gl_INFO_LOG_LENGTH ptr-                                    peek ptr-  infoLog <- alloca $ \len ->-               allocaBytes (fromIntegral infoLogLen) $ \chars -> do -                 glGetShaderInfoLog gid infoLogLen len chars-                 len' <- fromIntegral <$> peek len-                 peekCStringLen (chars, len')-  unless (null infoLog)-         (mapM_ putStrLn -                ["Shader info log for '" ++ filePath ++ "':", infoLog, ""])-  unless ok $ do-    deleteObjectNames [shader]-    ioError (userError "shader compilation failed")-  return shader-  where setSource i src = -          do withCStringLen src $ \(charBuf,len)-> do-               withArray [charBuf] $ \charBufsBuf ->-                 withArray [fromIntegral len] $ \lengthsBuf ->-                   glShaderSource i 1 charBufsBuf lengthsBuf----- |Link vertex and fragment shaders into a 'Program'.-linkShaderProgram :: [VertexShader] -> [FragmentShader] -> IO Program-linkShaderProgram vs fs = linkShaderProgramWith vs fs (\_ -> return ())---- |Link vertex and fragment shaders into a 'Program'. The supplied--- 'IO' action is run after attaching shader objects to the new--- program, but before linking. This supports the use of--- 'bindFragDataLocation' to map fragment shader outputs.-linkShaderProgramWith :: [VertexShader] -> [FragmentShader]-                      -> (Program -> IO ()) -> IO Program-linkShaderProgramWith vs fs m = linkGeoProgramWith vs [] fs m--newtype GeometryShader = GeometryShader { geometryShaderID :: GLuint }-  deriving (Eq,Ord,Show)--instance ObjectName GeometryShader where-  genObjectNames n = replicateM n $ -                     fmap GeometryShader (glCreateShader gl_GEOMETRY_SHADER)-  deleteObjectNames = mapM_ (glDeleteShader . geometryShaderID)-  isObjectName = fmap (> 0) . glIsShader . geometryShaderID---- |Link vertex, geometry, and fragment shaders into a 'Program'.-linkGeoProgram :: [VertexShader] -> [GeometryShader] -> [FragmentShader]-               -> IO Program-linkGeoProgram vs gs fs = linkGeoProgramWith vs gs fs (\_ -> return ())+-- |Link shaders into a 'Program'.+linkShaderProgram :: [Shader] -> IO Program+linkShaderProgram shaders = linkShaderProgramWith shaders (const $ return ()) --- |Link vertex, geometry, and fragment shaders into a 'Program'. The--- supplied 'IO' action is run after attaching shader objects to the--- new program, but before linking. This supports the use of--- 'bindFragDataLocation' to map fragment shader outputs.-linkGeoProgramWith :: [VertexShader] -> [GeometryShader] -> [FragmentShader]-                   -> (Program -> IO ()) -> IO Program-linkGeoProgramWith vs gs fs m = do-  [prog] <- genObjectNames 1-  attachedShaders prog $= (vs, fs)-  mapM_ (glAttachShader (unsafeCoerce prog) . geometryShaderID) gs-  m prog-  linkProgram prog-  printError-  ok <- get (linkStatus prog)-  infoLog <- get (programInfoLog prog)-  unless (null infoLog)-         (mapM_ putStrLn ["Program info log:", infoLog, ""])-  unless ok $ do-    deleteObjectNames [prog]-    ioError (userError "GLSL linking failed")-  return prog+-- |Link shaders into a 'Program' with the given action performed+-- after attaching shaders, but before linking the program. This is+-- most commonly used to set the 'bindFragDataLocation' state+-- variable.+linkShaderProgramWith :: [Shader] -> (Program -> IO ()) -> IO Program+linkShaderProgramWith shaders prelink = do p <- createProgram+                                           mapM_ (attachShader p) shaders+                                           prelink p+                                           linkProgram p+                                           return p  -- |Work with a named uniform shader parameter. Note that this looks -- up the variable name on each access, so uniform parameters that -- will be accessed frequently should instead be resolved to a -- 'UniformLocation'.-namedUniform :: (Uniform a) => String -> StateVar a+namedUniform :: Uniform a => String -> StateVar a namedUniform name = makeStateVar (loc >>= get) (\x -> loc >>= ($= x))   where loc = do Just p <- get currentProgram                  l <- get (uniformLocation p name)

@@ -95,7 +95,7 @@         sz = TextureSize2D (texWidth tex) (texHeight tex)         pixelType = glType (undefined::Elem a)         loadAux i e = withPixels (texData tex) $ -                      (texImage2D Nothing NoProxy 0 i sz 0 .+                      (texImage2D Texture2D NoProxy 0 i sz 0 .                        PixelData e pixelType)  -- | Set texture coordinate wrapping options for both the 'S' and 'T'@@ -115,7 +115,7 @@  -- | Bind each of the given textures to successive texture units at -- the given 'TextureTarget' starting with texture unit 0.-withTextures :: TextureTarget -> [TextureObject] -> IO a -> IO a+withTextures :: BindableTextureTarget t => t -> [TextureObject] -> IO a -> IO a withTextures tt ts m = do mapM_ aux (zip ts [0..])                           r <- m                           cleanup 0 ts@@ -136,7 +136,8 @@ -- paired with. The given action is run with these bindings, then the -- texture bindings are reset. If you don't care which texture units -- are used, consider using 'withTextures' or 'withTextures2D'.-withTexturesAt :: TextureTarget -> [(TextureObject,GLuint)] -> IO a -> IO a+withTexturesAt :: BindableTextureTarget t+               => t -> [(TextureObject,GLuint)] -> IO a -> IO a withTexturesAt tt ts m = do mapM_ aux ts                             r <- m                             mapM_ (cleanup . snd) ts@@ -146,10 +147,13 @@         cleanup i = do activeTexture $= TextureUnit i                        textureBinding tt $= Nothing --- | Generate a complete set of mipmaps for the currently bound--- texture object.-generateMipmap' :: TextureTarget -> IO ()-generateMipmap' Texture2D = glGenerateMipmap gl_TEXTURE_2D-generateMipmap' TextureCubeMap = glGenerateMipmap gl_TEXTURE_CUBE_MAP-generateMipmap' _ = error $ "generateMipmap' is only defined for "++-                            "2D textures and cube maps."+class MipMappable t where+  -- | Generate a complete set of mipmaps for the currently bound+  -- texture object.+  generateMipmap' :: t -> IO ()++instance MipMappable TextureTarget2D where+  generateMipmap' _ = glGenerateMipmap gl_TEXTURE_2D++instance MipMappable TextureTargetCubeMap where+  generateMipmap' _ = glGenerateMipmap gl_TEXTURE_CUBE_MAP