--------------------------------------------------------------------------------
-- |
-- Module      :  Graphics.Rendering.OGL.GL.CoordTrans
-- Copyright   :  (c) Sven Panne 2002-2006
-- License     :  BSD-style (see the file libraries/OpenGL/LICENSE)
-- 
-- Maintainer  :  sven.panne@aedion.de
-- Stability   :  stable
-- Portability :  portable
--
-- This module corresponds to section 2.11 (Coordinate Transformations) of the
-- OpenGL 2.1 specs.
--
--------------------------------------------------------------------------------

module Graphics.Rendering.OGL.GL.CoordTrans (
   -- * Controlling the Viewport
   depthRange,
   Position(..), Size(..), viewport, maxViewportDims,

   -- * Matrices
   MatrixMode(..), matrixMode,
   Vector2(..), Vector3(..),
   MatrixOrder(..), MatrixComponent(rotate,translate,scale), Matrix(..),
   currentMatrix, matrix, multMatrix, GLmatrix, loadIdentity,
   ortho, frustum, depthClamp,
   activeTexture,
   preservingMatrix, unsafePreservingMatrix,
   stackDepth, maxStackDepth,

   -- * Normal Transformation
   rescaleNormal, normalize,

   -- * Generating Texture Coordinates
   Plane(..), TextureCoordName(..), TextureGenMode(..), textureGenMode
) where

import Foreign.ForeignPtr ( ForeignPtr, mallocForeignPtrArray, withForeignPtr )
import Foreign.Marshal.Alloc ( alloca )
import Foreign.Marshal.Array ( allocaArray, peekArray, pokeArray, withArray )
import Foreign.Marshal.Utils ( with )
import Foreign.Ptr ( Ptr, castPtr )
import Foreign.Storable ( Storable(..) )
import Graphics.Rendering.OGL.Monad
import Graphics.Rendering.OGL.GL.Capability (
   EnableCap(CapRescaleNormal, CapNormalize,CapDepthClamp,
             CapTextureGenS, CapTextureGenT,
             CapTextureGenR, CapTextureGenQ),
   makeCapability, makeStateVarMaybe )
import Graphics.Rendering.OGL.GL.BasicTypes (
   GLenum, GLint, GLsizei, GLfloat, GLdouble, GLclampd, Capability(..) )
import Graphics.Rendering.OGL.GL.Exception ( bracket, unsafeBracket_ )
import Graphics.Rendering.OGL.GL.Extensions (
   FunPtr, unsafePerformIO, Invoker, getProcAddress )
import Graphics.Rendering.OGL.GL.PeekPoke (
   peek1, peek2, peek3, peek4, poke2, poke3, poke4 )
import Graphics.Rendering.OGL.GL.QueryUtils (
   GetPName(GetDepthRange,GetViewport,GetMaxViewportDims,GetMatrixMode,
            GetModelviewMatrix,GetProjectionMatrix,
            GetTextureMatrix, GetColorMatrix,GetMatrixPalette,GetActiveTexture,
            GetCurrentMatrixStackDepth,GetModelviewStackDepth,
            GetMaxModelviewStackDepth,GetProjectionStackDepth,
            GetMaxProjectionStackDepth,GetTextureStackDepth,
            GetMaxTextureStackDepth,GetColorMatrixStackDepth,
            GetMaxColorMatrixStackDepth,GetMaxMatrixPaletteStackDepth),
   getInteger2, getInteger4, getEnum1, getSizei1, getFloatv,
   getDouble2, getDoublev, modelviewIndexToEnum, modelviewEnumToIndex )
import Graphics.Rendering.OGL.GL.StateVar (
   GettableStateVar, makeGettableStateVar, getIO, ($$=),
   StateVar, makeStateVar )
import Graphics.Rendering.OGL.GL.Texturing.TextureUnit (
   marshalTextureUnit, unmarshalTextureUnit )
import Graphics.Rendering.OGL.GL.VertexSpec ( TextureUnit )
import Graphics.Rendering.OGL.GLU.ErrorsInternal (
   recordInvalidEnum, recordInvalidValue )

--------------------------------------------------------------------------------

#include "HsOpenGLExt.h"
#include "HsOpenGLTypes.h"

--------------------------------------------------------------------------------

-- | After clipping and division by /w/, depth coordinates range from -1 to 1,
-- corresponding to the near and far clipping planes. 'depthRange' specifies a
-- linear mapping of the normalized depth coordinates in this range to window
-- depth coordinates. Regardless of the actual depth buffer implementation,
-- window coordinate depth values are treated as though they range from 0
-- through 1 (like color components). Thus, the values accepted by 'depthRange'
-- are both clamped to this range before they are accepted.
--
-- The initial setting of (0, 1) maps the near plane to 0 and the far plane to
-- 1. With this mapping, the depth buffer range is fully utilized.
--
-- It is not necessary that the near value be less than the far value. Reverse
-- mappings such as (1, 0) are acceptable.

depthRange :: StateVar (GLclampd, GLclampd)
depthRange = makeStateVar (getDouble2 (,) GetDepthRange) (uncurry glDepthRange)

foreign import CALLCONV unsafe "glDepthRange" glDepthRange ::
   GLclampd -> GLclampd -> IO ()

--------------------------------------------------------------------------------

-- | A 2-dimensional position, measured in pixels.
data Position = Position !GLint !GLint
   deriving ( Eq, Ord, Show )

-- | A 2-dimensional size, measured in pixels.
data Size = Size !GLsizei !GLsizei
   deriving ( Eq, Ord, Show )

-- | Controls the affine transformation from normalized device coordinates to
-- window coordinates. The viewport state variable consists of the coordinates
-- (/x/, /y/) of the lower left corner of the viewport rectangle, (in pixels,
-- initial value (0,0)), and the size (/width/, /height/) of the viewport. When
-- a GL context is first attached to a window, /width/ and /height/ are set to
-- the dimensions of that window.
--
-- Let (/xnd/, /ynd/) be normalized device coordinates. Then the window
-- coordinates (/xw/, /yw/) are computed as follows:
--
-- /xw/ = (/xnd/ + 1) (/width/  \/ 2) + /x/
--
-- /yw/ = (/ynd/ + 1) (/heigth/ \/ 2) + /y/
--
-- Viewport width and height are silently clamped to a range that depends on the
-- implementation, see 'maxViewportDims'.

viewport :: StateVar (Position, Size)
viewport = makeStateVar (getInteger4 makeVp GetViewport)
                        (\(Position x y, Size w h) -> glViewport x y w h)
   where makeVp x y w h = (Position x y, Size (fromIntegral w) (fromIntegral h))

foreign import CALLCONV unsafe "glViewport" glViewport ::
   GLint -> GLint -> GLsizei -> GLsizei -> IO ()

-- | The implementation-dependent maximum viewport width and height.

maxViewportDims :: GettableStateVar Size
maxViewportDims = makeGettableStateVar (getInteger2 Size GetMaxViewportDims)

--------------------------------------------------------------------------------

-- | A matrix stack.

data MatrixMode =
     Modelview GLsizei  -- ^ The modelview matrix stack of the specified vertex unit.
   | Projection         -- ^ The projection matrix stack.
   | Texture            -- ^ The texture matrix stack.
   | Color              -- ^ The color matrix stack.
   | MatrixPalette      -- ^ The matrix palette stack.
   deriving ( Eq, Ord, Show )

marshalMatrixMode :: MatrixMode -> Maybe GLenum
marshalMatrixMode x = case x of
   Modelview i -> modelviewIndexToEnum i
   Projection -> Just 0x1701
   Texture -> Just 0x1702
   Color -> Just 0x1800
   MatrixPalette -> Just 0x8840

unmarshalMatrixMode :: GLenum -> MatrixMode
unmarshalMatrixMode x
   | x == 0x1701 = Projection
   | x == 0x1702 = Texture
   | x == 0x1800 = Color
   | x == 0x8840 = MatrixPalette
   | otherwise =
        case modelviewEnumToIndex x of
           Just i -> Modelview i
           Nothing -> error ("unmarshalMatrixMode: illegal value " ++ show x)

matrixModeToGetMatrix :: MatrixMode -> GetPName
matrixModeToGetMatrix x = case x of
   Modelview _   -> GetModelviewMatrix -- ???
   Projection    -> GetProjectionMatrix
   Texture       -> GetTextureMatrix
   Color         -> GetColorMatrix
   MatrixPalette -> GetMatrixPalette

matrixModeToGetStackDepth :: MatrixMode -> GetPName
matrixModeToGetStackDepth x =  case x of
   Modelview _   -> GetModelviewStackDepth
   Projection    -> GetProjectionStackDepth
   Texture       -> GetTextureStackDepth
   Color         -> GetColorMatrixStackDepth
   MatrixPalette -> error "matrixModeToGetStackDepth: impossible"

matrixModeToGetMaxStackDepth :: MatrixMode -> GetPName
matrixModeToGetMaxStackDepth x = case x of
   Modelview _    -> GetMaxModelviewStackDepth
   Projection     -> GetMaxProjectionStackDepth
   Texture        -> GetMaxTextureStackDepth
   Color          -> GetMaxColorMatrixStackDepth
   MatrixPalette  -> GetMaxMatrixPaletteStackDepth

--------------------------------------------------------------------------------

-- | Controls which matrix stack is the target for subsequent matrix operations.
-- The initial value is ('Modelview' 0).

matrixMode :: StateVar MatrixMode
matrixMode =
   makeStateVar (getEnum1 unmarshalMatrixMode GetMatrixMode)
                (maybe recordInvalidValue glMatrixMode . marshalMatrixMode)

foreign import CALLCONV unsafe "glMatrixMode" glMatrixMode :: GLenum -> IO ()

--------------------------------------------------------------------------------

data Vector2 a = Vector2 !a !a
   deriving ( Eq, Ord, Show )

instance Storable a => Storable (Vector2 a) where
   sizeOf    ~(Vector2 x _) = 2 * sizeOf x
   alignment ~(Vector2 x _) = alignment x
   peek                     = peek2 Vector2 . castPtr
   poke ptr   (Vector2 x y) = poke2 (castPtr ptr) x y

--------------------------------------------------------------------------------

data Vector3 a = Vector3 !a !a !a
   deriving ( Eq, Ord, Show )

instance Storable a => Storable (Vector3 a) where
   sizeOf    ~(Vector3 x _ _) = 3 * sizeOf x
   alignment ~(Vector3 x _ _) = alignment x
   peek                       = peek3 Vector3 . castPtr
   poke ptr   (Vector3 x y z) = poke3 (castPtr ptr) x y z

--------------------------------------------------------------------------------

data MatrixOrder = ColumnMajor | RowMajor
   deriving ( Eq, Ord, Show )

--------------------------------------------------------------------------------

class (Num c, Storable c) => MatrixComponent c where
   getMatrix :: GetPName -> Ptr c -> GL ()
   loadMatrix :: Ptr c -> GL ()
   loadTransposeMatrix :: Ptr c -> GL ()
   multMatrix_ :: Ptr c -> GL ()
   multTransposeMatrix :: Ptr c -> GL ()
   rotate :: c -> Vector3 c -> GL ()
   translate :: Vector3 c -> GL ()
   scale :: c -> c -> c -> GL ()

instance MatrixComponent GLfloat_ where
   getMatrix x y = liftIO (getFloatv x y)
   loadMatrix = glLoadMatrixf
   loadTransposeMatrix = glLoadTransposeMatrixfARB
   multMatrix_ = glMultMatrixf
   multTransposeMatrix = glMultTransposeMatrixfARB
   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 x y = liftIO (getDoublev x y)
   loadMatrix = glLoadMatrixd
   loadTransposeMatrix = glLoadTransposeMatrixdARB
   multMatrix_ = glMultMatrixd
   multTransposeMatrix = glMultTransposeMatrixdARB
   rotate a (Vector3 x y z) = glRotated a x y z
   translate (Vector3 x y z) = glTranslated x y z
   scale = glScaled

--------------------------------------------------------------------------------

foreign import CALLCONV unsafe "glLoadMatrixf" glLoadMatrixf :: Ptr GLfloat -> GL ()
foreign import CALLCONV unsafe "glLoadMatrixd" glLoadMatrixd :: Ptr GLdouble -> GL ()

EXTENSION_ENTRY("GL_ARB_transpose_matrix or OpenGL 1.3",glLoadTransposeMatrixfARB,Ptr GLfloat -> GL ())
EXTENSION_ENTRY("GL_ARB_transpose_matrix or OpenGL 1.3",glLoadTransposeMatrixdARB,Ptr GLdouble -> GL ())

foreign import CALLCONV unsafe "glMultMatrixf" glMultMatrixf :: Ptr GLfloat -> GL ()
foreign import CALLCONV unsafe "glMultMatrixd" glMultMatrixd :: Ptr GLdouble -> GL ()

EXTENSION_ENTRY("GL_ARB_transpose_matrix or OpenGL 1.3",glMultTransposeMatrixfARB,Ptr GLfloat -> GL ())
EXTENSION_ENTRY("GL_ARB_transpose_matrix or OpenGL 1.3",glMultTransposeMatrixdARB,Ptr GLdouble -> GL ())

foreign import CALLCONV unsafe "glRotatef" glRotatef :: GLfloat -> GLfloat -> GLfloat -> GLfloat -> GL ()
foreign import CALLCONV unsafe "glRotated" glRotated :: GLdouble -> GLdouble -> GLdouble -> GLdouble -> GL ()

foreign import CALLCONV unsafe "glTranslatef" glTranslatef :: GLfloat -> GLfloat -> GLfloat -> GL ()
foreign import CALLCONV unsafe "glTranslated" glTranslated :: GLdouble -> GLdouble -> GLdouble -> GL ()

foreign import CALLCONV unsafe "glScalef" glScalef :: GLfloat -> GLfloat -> GLfloat -> GL ()
foreign import CALLCONV unsafe "glScaled" glScaled :: GLdouble -> GLdouble -> GLdouble -> GL ()

--------------------------------------------------------------------------------

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.
   withNewMatrix ::
      MatrixComponent c => MatrixOrder -> (Ptr c -> GL ()) -> GL (m c)

   -- | Call the action with the given matrix. /Note:/ The action is /not/
   -- allowed to modify the matrix elements!
   withMatrix ::
      MatrixComponent c =>  m c -> (MatrixOrder -> Ptr c -> GL a) -> GL a

   newMatrix :: MatrixComponent c =>  MatrixOrder -> [c] -> GL (m c)
   getMatrixComponents :: MatrixComponent c =>  MatrixOrder -> m c -> GL [c]

   withNewMatrix order act = liftIO $ 
      allocaArray 16 $ \p -> do
         runGL $ act p
         components <- peekArray 16 p
         runGL $ newMatrix order components

   withMatrix mat act = do
      components <- getMatrixComponents ColumnMajor mat
      liftIO $ withArray components (runGL . act ColumnMajor)

   newMatrix order components =
      withNewMatrix order (liftIO . (flip pokeArray (take 16 components)))

   getMatrixComponents desiredOrder mat =
      withMatrix mat $ \order p -> liftIO $ 
        if desiredOrder == order
           then peekArray 16 p
           else mapM (peekElemOff p) [ 0, 4,  8, 12,
                                       1, 5,  9, 13,
                                       2, 6, 10, 14,
                                       3, 7, 11, 15 ]

--------------------------------------------------------------------------------

{-# DEPRECATED currentMatrix "use `matrix' instead" #-}
currentMatrix :: (Matrix m, MatrixComponent c) => StateVar (m c)
currentMatrix = matrix Nothing

matrix :: (Matrix m, MatrixComponent c) => Maybe MatrixMode -> StateVar (m c)
matrix maybeMode =
   makeStateVar
      (maybe (getIO matrixMode) return maybeMode >>= (getMatrix' . matrixModeToGetMatrix))
      (maybe id withMatrixMode maybeMode . setMatrix)

withMatrixMode :: MatrixMode -> IO a -> IO a
withMatrixMode mode act =
   preservingMatrixMode $ do
      matrixMode $$= mode
      act

getMatrix' :: (Matrix m, MatrixComponent c) => GetPName -> IO (m c)
getMatrix' = runGL . withNewMatrix ColumnMajor . getMatrix

setMatrix :: (Matrix m, MatrixComponent c) => m c -> IO ()
setMatrix mat = runGL $
   withMatrix mat $ \order ->
      case order of
         ColumnMajor -> loadMatrix
         RowMajor    -> loadTransposeMatrix

multMatrix :: (Matrix m, MatrixComponent c) => m c -> GL ()
multMatrix mat = 
   withMatrix mat $ \order ->
      case order of
         ColumnMajor -> multMatrix_
         RowMajor    -> multTransposeMatrix

--------------------------------------------------------------------------------

data GLmatrix a = GLmatrix MatrixOrder (ForeignPtr a)
#ifdef __HADDOCK__
-- Help Haddock a bit, because it doesn't do any instance inference.
instance Eq (GLmatrix a)
instance Ord (GLmatrix a)
instance Show (GLmatrix a)
#else
   deriving ( Eq, Ord, Show )
#endif

instance Matrix GLmatrix where
   withNewMatrix order f = do
      fp <- liftIO $ mallocForeignPtrArray 16
      liftIO $ withForeignPtr fp (runGL . f)
      return $ GLmatrix order fp

   withMatrix (GLmatrix order fp) f = liftIO $ withForeignPtr fp (runGL . f order)

--------------------------------------------------------------------------------

foreign import CALLCONV unsafe "glLoadIdentity" loadIdentity :: GL ()

--------------------------------------------------------------------------------

foreign import CALLCONV unsafe "glOrtho" ortho ::
   GLdouble -> GLdouble -> GLdouble -> GLdouble -> GLdouble -> GLdouble -> GL ()

foreign import CALLCONV unsafe "glFrustum" frustum ::
   GLdouble -> GLdouble -> GLdouble -> GLdouble -> GLdouble -> GLdouble -> GL ()

--------------------------------------------------------------------------------

depthClamp :: StateVar Capability
depthClamp = makeCapability CapDepthClamp

--------------------------------------------------------------------------------

activeTexture :: StateVar TextureUnit
activeTexture = makeStateVar (getEnum1 unmarshalTextureUnit GetActiveTexture)
                             (glActiveTextureARB . marshalTextureUnit)

EXTENSION_ENTRY("GL_ARB_multitexture or OpenGL 1.3",glActiveTextureARB,GLenum -> IO ())   

--------------------------------------------------------------------------------

-- | Push the current matrix stack down by one, duplicating the current matrix,
-- excute the given action, and pop the current matrix stack, replacing the
-- current matrix with the one below it on the stack (i.e. restoring it to its
-- previous state). The returned value is that of the given action. Note that
-- a round-trip to the server is probably required. For a more efficient
-- version, see 'unsafePreservingMatrix'.

preservingMatrix :: GL a -> GL a
preservingMatrix = unsafePreservingMatrix . liftIO . preservingMatrixMode . runGL

-- performance paranoia: No (un-)marshaling by avoiding matrixMode
preservingMatrixMode :: IO a -> IO a
preservingMatrixMode = bracket (getEnum1 id GetMatrixMode) glMatrixMode . const

-- | A more efficient, but potentially dangerous version of 'preservingMatrix':
-- The given action is not allowed to throw an exception or change the
-- current matrix mode permanently.

unsafePreservingMatrix :: GL a -> GL a
unsafePreservingMatrix x = liftIO $ unsafeBracket_ glPushMatrix glPopMatrix (runGL x)

foreign import CALLCONV unsafe "glPushMatrix" glPushMatrix :: IO ()

foreign import CALLCONV unsafe "glPopMatrix" glPopMatrix :: IO ()

--------------------------------------------------------------------------------

stackDepth :: Maybe MatrixMode -> GettableStateVar GLsizei
stackDepth maybeMode =
   makeGettableStateVar $
      case maybeMode of
         Nothing -> getSizei1 id GetCurrentMatrixStackDepth -- only with ARB_fragment_program
         Just MatrixPalette -> do recordInvalidEnum ; return 0
         Just mode -> getSizei1 id (matrixModeToGetStackDepth mode)

maxStackDepth :: MatrixMode -> GettableStateVar GLsizei
maxStackDepth =
   makeGettableStateVar . getSizei1 id . matrixModeToGetMaxStackDepth

--------------------------------------------------------------------------------

-- | If 'rescaleNormal' contains 'Enabled', normal vectors specified with
-- 'Graphics.Rendering.OGL.GL.VertexSpec.normal' are scaled by a scaling
-- factor derived from the modelview matrix. 'rescaleNormal' requires that the
-- originally specified normals were of unit length, and that the modelview
-- matrix contains only uniform scales for proper results. The initial value of
-- 'rescaleNormal' is 'Disabled'.

rescaleNormal :: StateVar Capability
rescaleNormal = makeCapability CapRescaleNormal

-- | If 'normalize' contains 'Enabled', normal vectors specified with
-- 'Graphics.Rendering.OGL.GL.VertexSpec.normal' are scaled to unit length
-- after transformation. The initial value of 'normalize' is 'Disabled'.

normalize :: StateVar Capability
normalize = makeCapability CapNormalize

--------------------------------------------------------------------------------

data Plane a = Plane !a !a !a !a
   deriving ( Eq, Ord, Show )

instance Storable a => Storable (Plane a) where
   sizeOf    ~(Plane a _ _ _) = 4 * sizeOf a
   alignment ~(Plane a _ _ _) = alignment a
   peek                       = peek4 Plane . castPtr
   poke ptr   (Plane a b c d) = poke4 (castPtr ptr) a b c d

--------------------------------------------------------------------------------

data TextureCoordName =
     S
   | T
   | R
   | Q
   deriving ( Eq, Ord, Show )

marshalTextureCoordName :: TextureCoordName -> GLenum
marshalTextureCoordName x = case x of
   S -> 0x2000
   T -> 0x2001
   R -> 0x2002
   Q -> 0x2003

--------------------------------------------------------------------------------

data TextureGenParameter =
     TextureGenMode
   | ObjectPlane
   | EyePlane

marshalTextureGenParameter :: TextureGenParameter -> GLenum
marshalTextureGenParameter x = case x of
   TextureGenMode -> 0x2500
   ObjectPlane -> 0x2501
   EyePlane -> 0x2502

--------------------------------------------------------------------------------

data TextureGenMode' =
     EyeLinear'
   | ObjectLinear'
   | SphereMap'
   | NormalMap'
   | ReflectionMap'

marshalTextureGenMode' :: TextureGenMode' -> GLint
marshalTextureGenMode' x = case x of
   EyeLinear' -> 0x2400
   ObjectLinear' -> 0x2401
   SphereMap' -> 0x2402
   NormalMap' -> 0x8511
   ReflectionMap' -> 0x8512

unmarshalTextureGenMode' :: GLint -> TextureGenMode'
unmarshalTextureGenMode' x
   | x == 0x2400 = EyeLinear'
   | x == 0x2401 = ObjectLinear'
   | x == 0x2402 = SphereMap'
   | x == 0x8511 = NormalMap'
   | x == 0x8512 = ReflectionMap'
   | otherwise = error ("unmarshalTextureGenMode': illegal value " ++ show x)

--------------------------------------------------------------------------------

data TextureGenMode =
     EyeLinear    (Plane GLdouble)
   | ObjectLinear (Plane GLdouble)
   | SphereMap
   | NormalMap
   | ReflectionMap
   deriving ( Eq, Ord, Show )

marshalTextureGenMode :: TextureGenMode -> GLint
marshalTextureGenMode = marshalTextureGenMode' . convertMode
   where convertMode (EyeLinear    _) = EyeLinear'
         convertMode (ObjectLinear _) = ObjectLinear'
         convertMode SphereMap        = SphereMap'
         convertMode NormalMap        = NormalMap'
         convertMode ReflectionMap    = ReflectionMap'

--------------------------------------------------------------------------------

textureGenMode :: TextureCoordName -> StateVar (Maybe TextureGenMode)
textureGenMode coord =
   makeStateVarMaybe
      (return $ textureCoordNameToEnableCap coord)
      (do mode <- getMode coord
          case mode of
             EyeLinear'     -> fmap EyeLinear $ getPlane coord EyePlane
             ObjectLinear'  -> fmap ObjectLinear $ getPlane coord ObjectPlane
             SphereMap'     -> return SphereMap
             NormalMap'     -> return NormalMap
             ReflectionMap' -> return ReflectionMap)
      (\mode -> do
         setMode coord mode
         case mode of
            EyeLinear    plane -> setPlane coord EyePlane    plane
            ObjectLinear plane -> setPlane coord ObjectPlane plane
            _ -> return ())

--------------------------------------------------------------------------------

textureCoordNameToEnableCap :: TextureCoordName -> EnableCap
textureCoordNameToEnableCap coord = case coord of
   S -> CapTextureGenS
   T -> CapTextureGenT
   R -> CapTextureGenR
   Q -> CapTextureGenQ

--------------------------------------------------------------------------------

getMode :: TextureCoordName -> IO TextureGenMode'
getMode coord = alloca $ \buf -> do
   glGetTexGeniv (marshalTextureCoordName coord)
                 (marshalTextureGenParameter TextureGenMode)
                 buf
   peek1 unmarshalTextureGenMode' buf

foreign import CALLCONV unsafe "glGetTexGeniv" glGetTexGeniv ::
   GLenum -> GLenum -> Ptr GLint -> IO ()

setMode :: TextureCoordName -> TextureGenMode -> IO ()
setMode coord mode =
   glTexGeni (marshalTextureCoordName coord)
             (marshalTextureGenParameter TextureGenMode)
             (marshalTextureGenMode mode)

foreign import CALLCONV unsafe "glTexGeni" glTexGeni ::
    GLenum -> GLenum -> GLint -> IO ()

--------------------------------------------------------------------------------

getPlane :: TextureCoordName -> TextureGenParameter -> IO (Plane GLdouble)
getPlane coord param = alloca $ \planeBuffer -> do
   glGetTexGendv (marshalTextureCoordName coord)
                 (marshalTextureGenParameter param)
                 planeBuffer
   peek planeBuffer

foreign import CALLCONV unsafe "glGetTexGendv" glGetTexGendv ::
   GLenum -> GLenum -> Ptr (Plane GLdouble) -> IO ()

setPlane :: TextureCoordName -> TextureGenParameter -> Plane GLdouble -> IO ()
setPlane coord param plane =
   with plane $ \planeBuffer ->
      glTexGendv (marshalTextureCoordName coord)
                 (marshalTextureGenParameter param)
                 planeBuffer

foreign import CALLCONV unsafe "glTexGendv" glTexGendv ::
   GLenum -> GLenum -> Ptr (Plane GLdouble) -> IO ()