Added Uniform instance for GLmatrix. Bumped version to 3.0.1.0.

Author: svenpanne

CHANGELOG.md

@@ -1,3 +1,7 @@
+3.0.1.0
+-------
+* Added Uniform instance for `GLmatrix`.
+
 3.0.0.2
 -------
 * Removed redundant constraints.

OpenGL.cabal

@@ -1,5 +1,5 @@
 name: OpenGL
-version: 3.0.0.2
+version: 3.0.1.0
 synopsis: A binding for the OpenGL graphics system
 description:
   A Haskell binding for the OpenGL graphics system (GL, version 4.5) and its
@@ -126,6 +126,7 @@ library
     Graphics.Rendering.OpenGL.GL.FramebufferObjects.RenderbufferTarget
     Graphics.Rendering.OpenGL.GL.GLboolean
     Graphics.Rendering.OpenGL.GL.IOState
+    Graphics.Rendering.OpenGL.GL.MatrixComponent
     Graphics.Rendering.OpenGL.GL.PeekPoke
     Graphics.Rendering.OpenGL.GL.PixelData
     Graphics.Rendering.OpenGL.GL.PixelFormat

src/Graphics/Rendering/OpenGL/GL/CoordTrans.hs

@@ -13,8 +13,6 @@
 --
 --------------------------------------------------------------------------------
 
-{-# LANGUAGE TypeSynonymInstances #-}
-
 module Graphics.Rendering.OpenGL.GL.CoordTrans (
    -- * Controlling the Viewport
    depthRange,
@@ -43,9 +41,9 @@ import Foreign.Marshal.Array
 import Foreign.Marshal.Utils
 import Foreign.Ptr
 import Foreign.Storable
-import Graphics.Rendering.OpenGL.GL.Tensor
 import Graphics.Rendering.OpenGL.GL.Capability
 import Graphics.Rendering.OpenGL.GL.Exception
+import Graphics.Rendering.OpenGL.GL.MatrixComponent
 import Graphics.Rendering.OpenGL.GL.PeekPoke
 import Graphics.Rendering.OpenGL.GL.QueryUtils
 import Graphics.Rendering.OpenGL.GL.Texturing.TextureUnit
@@ -180,38 +178,6 @@ data MatrixOrder = ColumnMajor | RowMajor
 
 --------------------------------------------------------------------------------
 
-class Storable c => MatrixComponent c where
-   getMatrix :: GetPNameMatrix p => p -> Ptr c -> IO ()
-   loadMatrix :: Ptr c -> IO ()
-   loadTransposeMatrix :: Ptr c -> IO ()
-   multMatrix_ :: Ptr c -> IO ()
-   multTransposeMatrix :: Ptr c -> IO ()
-   rotate :: c -> Vector3 c -> IO ()
-   translate :: Vector3 c -> IO ()
-   scale :: c -> c -> c -> IO ()
-
-instance MatrixComponent GLfloat where
-   getMatrix = getMatrixf
-   loadMatrix = glLoadMatrixf
-   loadTransposeMatrix = glLoadTransposeMatrixf
-   multMatrix_ = glMultMatrixf
-   multTransposeMatrix = glMultTransposeMatrixf
-   rotate a (Vector3 x y z) = glRotatef a x y z
-   translate (Vector3 x y z) = glTranslatef x y z
-   scale = glScalef
-
-instance MatrixComponent GLdouble where
-   getMatrix = getMatrixd
-   loadMatrix = glLoadMatrixd
-   loadTransposeMatrix = glLoadTransposeMatrixd
-   multMatrix_ = glMultMatrixd
-   multTransposeMatrix = glMultTransposeMatrixd
-   rotate a (Vector3 x y z) = glRotated a x y z
-   translate (Vector3 x y z) = glTranslated x y z
-   scale = glScaled
-
---------------------------------------------------------------------------------
-
 class Matrix m where
    -- | Create a new matrix of the given order (containing undefined elements)
    -- and call the action to fill it with 4x4 elements.

src/Graphics/Rendering/OpenGL/GL/MatrixComponent.hs

@@ -0,0 +1,61 @@
+{-# LANGUAGE TypeSynonymInstances #-}
+{-# OPTIONS_HADDOCK hide #-}
+--------------------------------------------------------------------------------
+-- |
+-- Module      :  Graphics.Rendering.OpenGL.GL.CoordTrans
+-- Copyright   :  (c) Sven Panne 2002-2016
+-- License     :  BSD3
+--
+-- Maintainer  :  Sven Panne <[email protected]>
+-- Stability   :  stable
+-- Portability :  portable
+--
+-- This is a purely internal module for handling matrix components.
+--
+--------------------------------------------------------------------------------
+
+module Graphics.Rendering.OpenGL.GL.MatrixComponent where
+
+import Foreign.Ptr
+import Foreign.Storable
+import Graphics.Rendering.OpenGL.GL.QueryUtils
+import Graphics.Rendering.OpenGL.GL.Tensor
+import Graphics.GL
+
+--------------------------------------------------------------------------------
+
+class Storable c => MatrixComponent c where
+   getMatrix :: GetPNameMatrix p => p -> Ptr c -> IO ()
+   loadMatrix :: Ptr c -> IO ()
+   loadTransposeMatrix :: Ptr c -> IO ()
+   multMatrix_ :: Ptr c -> IO ()
+   multTransposeMatrix :: Ptr c -> IO ()
+   getUniformv :: GLuint -> GLint -> Ptr c -> IO ()
+   uniformMatrix4v :: GLint -> GLsizei -> GLboolean -> Ptr c -> IO ()
+   rotate :: c -> Vector3 c -> IO ()
+   translate :: Vector3 c -> IO ()
+   scale :: c -> c -> c -> IO ()
+
+instance MatrixComponent GLfloat where
+   getMatrix = getMatrixf
+   loadMatrix = glLoadMatrixf
+   loadTransposeMatrix = glLoadTransposeMatrixf
+   multMatrix_ = glMultMatrixf
+   multTransposeMatrix = glMultTransposeMatrixf
+   getUniformv = glGetUniformfv
+   uniformMatrix4v = glUniformMatrix4fv
+   rotate a (Vector3 x y z) = glRotatef a x y z
+   translate (Vector3 x y z) = glTranslatef x y z
+   scale = glScalef
+
+instance MatrixComponent GLdouble where
+   getMatrix = getMatrixd
+   loadMatrix = glLoadMatrixd
+   loadTransposeMatrix = glLoadTransposeMatrixd
+   multMatrix_ = glMultMatrixd
+   multTransposeMatrix = glMultTransposeMatrixd
+   getUniformv = glGetUniformdv
+   uniformMatrix4v = glUniformMatrix4dv
+   rotate a (Vector3 x y z) = glRotated a x y z
+   translate (Vector3 x y z) = glTranslated x y z
+   scale = glScaled

src/Graphics/Rendering/OpenGL/GL/Shaders/Uniform.hs

@@ -1,3 +1,4 @@
+{-# LANGUAGE TypeSynonymInstances #-}
 -----------------------------------------------------------------------------
 -- |
 -- Module      :  Graphics.Rendering.OpenGL.GL.Shaders.Uniform
@@ -13,8 +14,6 @@
 --
 -----------------------------------------------------------------------------
 
-{-# LANGUAGE TypeSynonymInstances #-}
-
 module Graphics.Rendering.OpenGL.GL.Shaders.Uniform (
    -- * Uniform variables
    UniformLocation(..), uniformLocation, activeUniforms, Uniform(..),
@@ -29,6 +28,9 @@ import Foreign.Marshal.Alloc
 import Foreign.Ptr
 import Foreign.Storable
 import Graphics.Rendering.OpenGL.GL.ByteString
+import Graphics.Rendering.OpenGL.GL.CoordTrans
+import Graphics.Rendering.OpenGL.GL.GLboolean
+import Graphics.Rendering.OpenGL.GL.MatrixComponent
 import Graphics.Rendering.OpenGL.GL.Shaders.Program
 import Graphics.Rendering.OpenGL.GL.Shaders.ProgramObjects
 import Graphics.Rendering.OpenGL.GL.Shaders.Variables
@@ -236,13 +238,28 @@ instance UniformComponent a => Uniform (Index1 a) where
 -- getUniform. Even worse is that it requires the `GLint` uniforms while it is an enum or
 -- uint.
 instance Uniform TextureUnit where
-    uniform loc@(UniformLocation ul)  = makeStateVar getter setter
-        where setter (TextureUnit tu) = uniform1 loc (fromIntegral tu :: GLint)
-              getter = do program <- fmap fromJust $ get currentProgram
-                          allocaBytes (sizeOf (undefined :: GLint))  $ \buf -> do
-                             glGetUniformiv (programID program) ul buf
-                             tuID <- peek buf
-                             return . TextureUnit $ fromIntegral tuID
+    uniform loc = makeStateVar getter setter
+        where getter = allocaBytes (sizeOf (undefined :: GLint))  $ \buf -> do
+                          getUniformWith glGetUniformiv loc buf
+                          fmap (TextureUnit . fromIntegral) $ peek buf
+              setter (TextureUnit tu) = uniform1 loc (fromIntegral tu :: GLint)
     uniformv location count = uniform1v location count . (castPtr :: Ptr TextureUnit -> Ptr GLint)
 
+-- | Note: 'uniformv' expects all matrices to be in 'ColumnMajor' form.
+instance MatrixComponent a => Uniform (GLmatrix a) where
+   uniform loc@(UniformLocation ul) = makeStateVar getter setter
+      where getter = withNewMatrix ColumnMajor $ getUniformWith getUniformv loc
+            setter m = withMatrix m $ uniformMatrix4v ul 1 . isRowMajor
+   uniformv (UniformLocation ul) count buf =
+      uniformMatrix4v ul count (marshalGLboolean False) (castPtr buf `asTypeOf` elemType buf)
+      where elemType = undefined :: MatrixComponent c => Ptr (GLmatrix c) -> Ptr c
+
+isRowMajor :: MatrixOrder -> GLboolean
+isRowMajor = marshalGLboolean . (RowMajor ==)
+
+getUniformWith :: (GLuint -> GLint -> Ptr a -> IO ()) -> UniformLocation -> Ptr a -> IO ()
+getUniformWith getter (UniformLocation ul) buf = do
+   program <- fmap (programID . fromJust) $ get currentProgram
+   getter program ul buf
+
 --------------------------------------------------------------------------------