--------------------------------------------------------------------------------
-- |
-- Module      :  Graphics.Rendering.OpenGL.GL.VertexSpec
-- Copyright   :  (c) Sven Panne 2002-2019
-- License     :  BSD3
-- 
-- Maintainer  :  Sven Panne <svenpanne@gmail.com>
-- Stability   :  stable
-- Portability :  portable
--
-- This module corresponds to section 2.7 (Vertex Specification) of the
-- OpenGL 2.1 specs.
--
--------------------------------------------------------------------------------

{-# LANGUAGE TypeSynonymInstances #-}

module Graphics.Rendering.OpenGL.GL.VertexSpec (
   -- * Vertex Coordinates
   Vertex(..),
   VertexComponent,

   -- * Auxiliary Vertex Attributes
   -- $AuxiliaryVertexAttributes

   -- ** Texture Coordinates
   currentTextureCoords, TexCoord(..),
   TexCoordComponent,
   TexCoord1(..), TexCoord2(..), TexCoord3(..), TexCoord4(..),

   -- ** Normal
   currentNormal, Normal(..),
   NormalComponent,
   Normal3(..),

   -- ** Fog Coordinate
   currentFogCoord, FogCoord(..),
   FogCoordComponent,
   FogCoord1(..),

   -- ** Color and Secondary Color
   rgbaMode,
   currentColor, Color(..),
   currentSecondaryColor, SecondaryColor(..),
   ColorComponent,
   Color3(..), Color4(..),

   currentIndex, Index(..),
   IndexComponent,
   Index1(..),

   -- * Generic Vertex Attributes
   IntegerHandling(..), AttribLocation(..),
   currentVertexAttrib, currentVertexAttribI, currentVertexAttribIu,
   VertexAttrib(..), VertexAttribComponent(..),

   -- * Texture Units
   TextureUnit(..), maxTextureUnit
) where

import Data.StateVar
import Foreign.Marshal.Array
import Foreign.Ptr
import Foreign.Storable
import Graphics.Rendering.OpenGL.GL.GLboolean
import Graphics.Rendering.OpenGL.GL.PeekPoke
import Graphics.Rendering.OpenGL.GL.QueryUtils
import Graphics.Rendering.OpenGL.GL.Tensor
import Graphics.Rendering.OpenGL.GL.Texturing.TextureUnit
import Graphics.Rendering.OpenGL.GL.VertexAttributes
import Graphics.GL

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

-- | The class of all types which can be used as a vertex coordinate.

class VertexComponent a where
   vertex2 :: a -> a -> IO ()
   vertex3 :: a -> a -> a -> IO ()
   vertex4 :: a -> a -> a -> a -> IO ()

   vertex2v :: Ptr a -> IO ()
   vertex3v :: Ptr a -> IO ()
   vertex4v :: Ptr a -> IO ()

instance VertexComponent GLshort where
   vertex2 = glVertex2s
   vertex3 = glVertex3s
   vertex4 = glVertex4s

   vertex2v = glVertex2sv
   vertex3v = glVertex3sv
   vertex4v = glVertex4sv

instance VertexComponent GLint where
   vertex2 = glVertex2i
   vertex3 = glVertex3i
   vertex4 = glVertex4i

   vertex2v = glVertex2iv
   vertex3v = glVertex3iv
   vertex4v = glVertex4iv

instance VertexComponent GLfloat where
   vertex2 = glVertex2f
   vertex3 = glVertex3f
   vertex4 = glVertex4f

   vertex2v = glVertex2fv
   vertex3v = glVertex3fv
   vertex4v = glVertex4fv

instance VertexComponent GLdouble where
   vertex2 = glVertex2d
   vertex3 = glVertex3d
   vertex4 = glVertex4d

   vertex2v = glVertex2dv
   vertex3v = glVertex3dv
   vertex4v = glVertex4dv

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

-- | Specify the (/x/, /y/, /z/, /w/) coordinates of a four-dimensional vertex.
-- This must only be done during
-- 'Graphics.Rendering.OpenGL.GL.BeginEnd.renderPrimitive', otherwise the
-- behaviour is unspecified. The current values of the auxiliary vertex
-- attributes are associated with the vertex.
-- 
-- Note that there is no such thing as a \"current vertex\" which could be
-- retrieved.

class Vertex a where
   vertex  ::     a -> IO ()
   vertexv :: Ptr a -> IO ()

instance VertexComponent a => Vertex (Vertex2 a) where
   vertex (Vertex2 x y) = vertex2 x y
   vertexv = vertex2v . (castPtr :: Ptr (Vertex2 b) -> Ptr b)

instance VertexComponent a => Vertex (Vertex3 a) where
   vertex (Vertex3 x y z) = vertex3 x y z
   vertexv = vertex3v . (castPtr :: Ptr (Vertex3 b) -> Ptr b)

instance VertexComponent a => Vertex (Vertex4 a) where
   vertex (Vertex4 x y z w) = vertex4 x y z w
   vertexv = vertex4v . (castPtr :: Ptr (Vertex4 b) -> Ptr b)

--------------------------------------------------------------------------------
-- $AuxiliaryVertexAttributes
-- Apart from its coordinates in four-dimensional space, every vertex has
-- associated /auxiliary attributes/: Its texture coordinates, a normal, a
-- fog coordinate, and a color plus a secondary color. For every attribute, the
-- OpenGL state contains its current value, which can be changed at any time.
--
-- Every attribute has a \"natural\" format via which it can be manipulated
-- directly as part of the OpenGL state, e.g. the current texture coordinates
-- are internally handled as @'TexCoord4' 'GLfloat'@. Different formats are
-- converted to this format, e.g. the /s/, /r/, and /t/ coordinates of a
-- @'TexCoord3' 'GLint'@ are converted to floating point values and a /q/
-- coordinate of 1.0 is implicitly assumed.
--
-- Consequently, the vast majority of classes, functions, and data types in this
-- module are for convenience only and offer no additional functionality.

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

-- | The current texture coordinates (/s/, /t/, /r/, /q/) for the current
-- texture unit (see 'Graphics.Rendering.OpenGL.GL.CoordTrans.activeTexture').
-- The initial value is (0,0,0,1) for all texture units.

currentTextureCoords :: StateVar (TexCoord4 GLfloat)
currentTextureCoords =
   makeStateVar (getFloat4 TexCoord4 GetCurrentTextureCoords) texCoord

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

-- | The class of all types which can be used as a texture coordinate.

class TexCoordComponent a where
   texCoord1 :: a -> IO ()
   texCoord2 :: a -> a -> IO ()
   texCoord3 :: a -> a -> a -> IO ()
   texCoord4 :: a -> a -> a -> a -> IO ()

   texCoord1v :: Ptr a -> IO ()
   texCoord2v :: Ptr a -> IO ()
   texCoord3v :: Ptr a -> IO ()
   texCoord4v :: Ptr a -> IO ()

   multiTexCoord1 :: GLenum -> a -> IO ()
   multiTexCoord2 :: GLenum -> a -> a -> IO ()
   multiTexCoord3 :: GLenum -> a -> a -> a -> IO ()
   multiTexCoord4 :: GLenum -> a -> a -> a -> a -> IO ()

   multiTexCoord1v :: GLenum -> Ptr a -> IO ()
   multiTexCoord2v :: GLenum -> Ptr a -> IO ()
   multiTexCoord3v :: GLenum -> Ptr a -> IO ()
   multiTexCoord4v :: GLenum -> Ptr a -> IO ()

instance TexCoordComponent GLshort where
   texCoord1 = glTexCoord1s
   texCoord2 = glTexCoord2s
   texCoord3 = glTexCoord3s
   texCoord4 = glTexCoord4s

   texCoord1v = glTexCoord1sv
   texCoord2v = glTexCoord2sv
   texCoord3v = glTexCoord3sv
   texCoord4v = glTexCoord4sv

   multiTexCoord1 = glMultiTexCoord1s
   multiTexCoord2 = glMultiTexCoord2s
   multiTexCoord3 = glMultiTexCoord3s
   multiTexCoord4 = glMultiTexCoord4s

   multiTexCoord1v = glMultiTexCoord1sv
   multiTexCoord2v = glMultiTexCoord2sv
   multiTexCoord3v = glMultiTexCoord3sv
   multiTexCoord4v = glMultiTexCoord4sv

instance TexCoordComponent GLint where
   texCoord1 = glTexCoord1i
   texCoord2 = glTexCoord2i
   texCoord3 = glTexCoord3i
   texCoord4 = glTexCoord4i

   texCoord1v = glTexCoord1iv
   texCoord2v = glTexCoord2iv
   texCoord3v = glTexCoord3iv
   texCoord4v = glTexCoord4iv

   multiTexCoord1 = glMultiTexCoord1i
   multiTexCoord2 = glMultiTexCoord2i
   multiTexCoord3 = glMultiTexCoord3i
   multiTexCoord4 = glMultiTexCoord4i

   multiTexCoord1v = glMultiTexCoord1iv
   multiTexCoord2v = glMultiTexCoord2iv
   multiTexCoord3v = glMultiTexCoord3iv
   multiTexCoord4v = glMultiTexCoord4iv

instance TexCoordComponent GLfloat where
   texCoord1 = glTexCoord1f
   texCoord2 = glTexCoord2f
   texCoord3 = glTexCoord3f
   texCoord4 = glTexCoord4f

   texCoord1v = glTexCoord1fv
   texCoord2v = glTexCoord2fv
   texCoord3v = glTexCoord3fv
   texCoord4v = glTexCoord4fv

   multiTexCoord1 = glMultiTexCoord1f
   multiTexCoord2 = glMultiTexCoord2f
   multiTexCoord3 = glMultiTexCoord3f
   multiTexCoord4 = glMultiTexCoord4f

   multiTexCoord1v = glMultiTexCoord1fv
   multiTexCoord2v = glMultiTexCoord2fv
   multiTexCoord3v = glMultiTexCoord3fv
   multiTexCoord4v = glMultiTexCoord4fv

instance TexCoordComponent GLdouble where
   texCoord1 = glTexCoord1d
   texCoord2 = glTexCoord2d
   texCoord3 = glTexCoord3d
   texCoord4 = glTexCoord4d

   texCoord1v = glTexCoord1dv
   texCoord2v = glTexCoord2dv
   texCoord3v = glTexCoord3dv
   texCoord4v = glTexCoord4dv

   multiTexCoord1 = glMultiTexCoord1d
   multiTexCoord2 = glMultiTexCoord2d
   multiTexCoord3 = glMultiTexCoord3d
   multiTexCoord4 = glMultiTexCoord4d

   multiTexCoord1v = glMultiTexCoord1dv
   multiTexCoord2v = glMultiTexCoord2dv
   multiTexCoord3v = glMultiTexCoord3dv
   multiTexCoord4v = glMultiTexCoord4dv

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

-- | Change the current texture coordinates of the current or given texture
-- unit.

class TexCoord a where
   texCoord       ::                    a -> IO ()
   texCoordv      ::                Ptr a -> IO ()
   multiTexCoord  :: TextureUnit ->     a -> IO ()
   multiTexCoordv :: TextureUnit -> Ptr a -> IO ()

instance TexCoordComponent a => TexCoord (TexCoord1 a) where
   texCoord (TexCoord1 s) = texCoord1 s
   texCoordv = texCoord1v . (castPtr :: Ptr (TexCoord1 b) -> Ptr b)
   multiTexCoord u (TexCoord1 s) =
      multiTexCoord1 (marshalTextureUnit u) s
   multiTexCoordv u =
      multiTexCoord1v (marshalTextureUnit u) . (castPtr :: Ptr (TexCoord1 b) -> Ptr b)

instance TexCoordComponent a => TexCoord (TexCoord2 a) where
   texCoord (TexCoord2 s t) = texCoord2 s t
   texCoordv = texCoord2v . (castPtr :: Ptr (TexCoord2 b) -> Ptr b)
   multiTexCoord u (TexCoord2 s t) =
      multiTexCoord2 (marshalTextureUnit u) s t
   multiTexCoordv u =
      multiTexCoord2v (marshalTextureUnit u) . (castPtr :: Ptr (TexCoord2 b) -> Ptr b)

instance TexCoordComponent a => TexCoord (TexCoord3 a) where
   texCoord (TexCoord3 s t r) = texCoord3 s t r
   texCoordv = texCoord3v . (castPtr :: Ptr (TexCoord3 b) -> Ptr b)
   multiTexCoord u (TexCoord3 s t r) =
      multiTexCoord3 (marshalTextureUnit u) s t r
   multiTexCoordv u =
      multiTexCoord3v (marshalTextureUnit u) . (castPtr :: Ptr (TexCoord3 b) -> Ptr b)

instance TexCoordComponent a => TexCoord (TexCoord4 a) where
   texCoord (TexCoord4 s t r q) = texCoord4 s t r q
   texCoordv = texCoord4v . (castPtr :: Ptr (TexCoord4 b) -> Ptr b)
   multiTexCoord u (TexCoord4 s t r q) =
      multiTexCoord4 (marshalTextureUnit u) s t r q
   multiTexCoordv u =
      multiTexCoord4v (marshalTextureUnit u) . (castPtr :: Ptr (TexCoord4 b) -> Ptr b)

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

-- | The current normal (/x/, /y/, /z/). The initial value is the unit vector
-- (0, 0, 1).

currentNormal :: StateVar (Normal3 GLfloat)
currentNormal = makeStateVar (getFloat3 Normal3 GetCurrentNormal) normal

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

-- | The class of all types which can be used as a component of a normal.

class NormalComponent a where
   normal3 :: a -> a -> a -> IO ()
   normal3v :: Ptr a -> IO ()

instance NormalComponent GLbyte where
   normal3 = glNormal3b
   normal3v = glNormal3bv

instance NormalComponent GLshort where
   normal3 = glNormal3s
   normal3v = glNormal3sv

instance NormalComponent GLint where
   normal3 = glNormal3i
   normal3v = glNormal3iv

instance NormalComponent GLfloat where
   normal3 = glNormal3f
   normal3v = glNormal3fv

instance NormalComponent GLdouble where
   normal3 = glNormal3d
   normal3v = glNormal3dv

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

-- | Change the current normal. Integral arguments are converted to
-- floating-point with a linear mapping that maps the most positive
-- representable integer value to 1.0, and the most negative representable
-- integer value to -1.0.
--
-- Normals specified with 'normal' or 'normalv' need not have unit length.
-- If 'Graphics.Rendering.OpenGL.GL.CoordTrans.normalize' is enabled, then
-- normals of any length specified with 'normal' or 'normalv' are normalized
-- after transformation. If
-- 'Graphics.Rendering.OpenGL.GL.CoordTrans.rescaleNormal' is enabled, normals
-- are scaled by a scaling factor derived from the modelview matrix.
-- 'Graphics.Rendering.OpenGL.GL.CoordTrans.rescaleNormal' requires that the
-- originally specified normals were of unit length, and that the modelview
-- matrix contains only uniform scales for proper results. Normalization is 
-- initially disabled.

class Normal a where
   normal  ::     a -> IO ()
   normalv :: Ptr a -> IO ()

instance NormalComponent a => Normal (Normal3 a) where
   normal (Normal3 x y z) = normal3 x y z
   normalv = normal3v . (castPtr :: Ptr (Normal3 b) -> Ptr b)

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

-- | The current fog coordinate. The initial value is 0.

currentFogCoord :: StateVar (FogCoord1 GLfloat)
currentFogCoord =
   makeStateVar (getFloat1 FogCoord1 GetCurrentFogCoord) fogCoord

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

-- | The class of all types which can be used as the fog coordinate.

class FogCoordComponent a where
   fogCoord1 :: a -> IO ()
   fogCoord1v :: Ptr a -> IO ()

instance FogCoordComponent GLfloat where
   fogCoord1 = glFogCoordf
   fogCoord1v = glFogCoordfv

instance FogCoordComponent GLdouble where
   fogCoord1 = glFogCoordd
   fogCoord1v = glFogCoorddv

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

-- | Change the current fog coordinate.

class FogCoord a where
   fogCoord  ::     a -> IO ()
   fogCoordv :: Ptr a -> IO ()

instance FogCoordComponent a => FogCoord (FogCoord1 a) where
   fogCoord (FogCoord1 c) = fogCoord1 c
   fogCoordv = fogCoord1v . (castPtr :: Ptr (FogCoord1 b) -> Ptr b)

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

-- | If 'rgbaMode' contains 'True', the color buffers store RGBA value. If
-- color indexes are stored, it contains 'False'.

rgbaMode :: GettableStateVar Bool
rgbaMode = makeGettableStateVar (getBoolean1 unmarshalGLboolean GetRGBAMode)

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

-- The current color (/R/, /G/, /B/, /A/). The initial value is (1, 1, 1, 1).
-- Note that this state variable is significant only when the GL is in RGBA
-- mode.

currentColor :: StateVar (Color4 GLfloat)
currentColor =
   makeStateVar (getFloat4 Color4 GetCurrentColor) color

-- The current secondary color (/R/, /G/, /B/). The initial value is (0, 0, 0).
-- Note that this state variable is significant only when the GL is in RGBA
-- mode.

currentSecondaryColor :: StateVar (Color3 GLfloat)
currentSecondaryColor =
   makeStateVar
      (do Color4 r g b _ <- getFloat4 Color4 GetCurrentSecondaryColor
          return $ Color3 r g b)
      secondaryColor

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

-- | The class of all types which can be used as a color component.

class ColorComponent a where
   color3 :: a -> a -> a -> IO ()
   color4 :: a -> a -> a -> a -> IO ()

   color3v :: Ptr a -> IO ()
   color4v :: Ptr a -> IO ()

   secondaryColor3  :: a -> a -> a -> IO ()
   secondaryColor3v :: Ptr a -> IO ()

instance ColorComponent GLbyte where
   color3 = glColor3b
   color4 = glColor4b

   color3v = glColor3bv
   color4v = glColor4bv

   secondaryColor3 = glSecondaryColor3b
   secondaryColor3v = glSecondaryColor3bv

instance ColorComponent GLshort where
   color3 = glColor3s
   color4 = glColor4s

   color3v = glColor3sv
   color4v = glColor4sv

   secondaryColor3 = glSecondaryColor3s
   secondaryColor3v = glSecondaryColor3sv

instance ColorComponent GLint where
   color3 = glColor3i
   color4 = glColor4i

   color3v = glColor3iv
   color4v = glColor4iv

   secondaryColor3 = glSecondaryColor3i
   secondaryColor3v = glSecondaryColor3iv

instance ColorComponent GLfloat where
   color3 = glColor3f
   color4 = glColor4f

   color3v = glColor3fv
   color4v = glColor4fv

   secondaryColor3 = glSecondaryColor3f
   secondaryColor3v = glSecondaryColor3fv

instance ColorComponent GLdouble where
   color3 = glColor3d
   color4 = glColor4d

   color3v = glColor3dv
   color4v = glColor4dv

   secondaryColor3 = glSecondaryColor3d
   secondaryColor3v = glSecondaryColor3dv

instance ColorComponent GLubyte where
   color3 = glColor3ub
   color4 = glColor4ub

   color3v = glColor3ubv
   color4v = glColor4ubv

   secondaryColor3 = glSecondaryColor3ub
   secondaryColor3v = glSecondaryColor3ubv

instance ColorComponent GLushort where
   color3 = glColor3us
   color4 = glColor4us

   color3v = glColor3usv
   color4v = glColor4usv

   secondaryColor3 = glSecondaryColor3us
   secondaryColor3v = glSecondaryColor3usv

instance ColorComponent GLuint where
   color3 = glColor3ui
   color4 = glColor4ui

   color3v = glColor3uiv
   color4v = glColor4uiv

   secondaryColor3 = glSecondaryColor3ui
   secondaryColor3v = glSecondaryColor3uiv

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

-- | Change the current color.

class Color a where
   color  ::     a -> IO ()
   colorv :: Ptr a -> IO ()

instance ColorComponent a => Color (Color3 a) where
   color (Color3 r g b) = color3 r g b
   colorv = color3v . (castPtr :: Ptr (Color3 b) -> Ptr b)

instance ColorComponent a => Color (Color4 a) where
   color (Color4 r g b a) = color4 r g b a
   colorv = color4v . (castPtr :: Ptr (Color4 b) -> Ptr b)

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

-- | Change the current secondary color.

class SecondaryColor a where
   secondaryColor  ::     a -> IO ()
   secondaryColorv :: Ptr a -> IO ()

instance ColorComponent a => SecondaryColor (Color3 a) where
   secondaryColor (Color3 r g b) = secondaryColor3 r g b
   secondaryColorv = secondaryColor3v . (castPtr :: Ptr (Color3 b) -> Ptr b)

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

-- The current color index. The initial value is 1. Note that this state
-- variable is significant only when the GL is in color index mode.

currentIndex :: StateVar (Index1 GLint)
currentIndex = makeStateVar (getInteger1 Index1 GetCurrentIndex) index

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

-- | The class of all types which can be used as a color index.

class IndexComponent a where
   index1 :: a -> IO ()
   index1v :: Ptr a -> IO ()

instance IndexComponent GLshort where
   index1 = glIndexs
   index1v = glIndexsv

instance IndexComponent GLint where
   index1 = glIndexi
   index1v = glIndexiv

instance IndexComponent GLfloat where
   index1 = glIndexf
   index1v = glIndexfv

instance IndexComponent GLdouble where
   index1 = glIndexd
   index1v = glIndexdv

instance IndexComponent GLubyte where
   index1 = glIndexub
   index1v = glIndexubv

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

-- | Change the current color index.

class Index a where
   index  ::     a -> IO ()  -- Collision with Prelude.index
   indexv :: Ptr a -> IO ()

instance IndexComponent a => Index (Index1 a) where
   index (Index1 i) = index1 i
   indexv = index1v . (castPtr :: Ptr (Index1 b) -> Ptr b)

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

data IntegerHandling =
     ToFloat
   | ToNormalizedFloat
   | KeepIntegral
   deriving ( Eq, Ord, Show )

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

currentVertexAttrib :: AttribLocation -> StateVar (Vertex4 GLfloat)
currentVertexAttrib location =
   makeStateVar
      (getVertexAttribFloat4 Vertex4 location GetCurrentVertexAttrib)
      (vertexAttrib ToFloat location)

currentVertexAttribI :: AttribLocation -> StateVar (Vertex4 GLint)
currentVertexAttribI location =
   makeStateVar
      (getVertexAttribIInteger4 Vertex4 location GetCurrentVertexAttrib)
      (vertexAttrib ToNormalizedFloat location)

currentVertexAttribIu :: AttribLocation -> StateVar (Vertex4 GLuint)
currentVertexAttribIu location =
   makeStateVar
      (getVertexAttribIuInteger4 Vertex4 location GetCurrentVertexAttrib)
      (vertexAttrib KeepIntegral location)

--------------------------------------------------------------------------------
-- The generic vertex attribute API is not as orthogonal as we would like.
-- Minimal methods: vertexAttrib4v and vertexAttrib4Nv and vertexAttrib4Iv

-- | The class of all types which can be used as a generic vertex attribute.
-- NOTE: Do not use the methods of this class directly, they were only exported
-- by accident and will be hidden in future versions of this package.

class (Storable a, Num a) => VertexAttribComponent a where
   vertexAttrib1 :: AttribLocation -> a -> IO ()
   vertexAttrib2 :: AttribLocation -> a -> a -> IO ()
   vertexAttrib3 :: AttribLocation -> a -> a -> a -> IO ()
   vertexAttrib4 :: AttribLocation -> a -> a -> a -> a -> IO ()

   vertexAttrib1N :: AttribLocation -> a -> IO ()
   vertexAttrib2N :: AttribLocation -> a -> a -> IO ()
   vertexAttrib3N :: AttribLocation -> a -> a -> a -> IO ()
   vertexAttrib4N :: AttribLocation -> a -> a -> a -> a -> IO ()

   vertexAttrib1I :: AttribLocation -> a -> IO ()
   vertexAttrib2I :: AttribLocation -> a -> a -> IO ()
   vertexAttrib3I :: AttribLocation -> a -> a -> a -> IO ()
   vertexAttrib4I :: AttribLocation -> a -> a -> a -> a -> IO ()

   vertexAttrib1v :: AttribLocation -> Ptr a -> IO ()
   vertexAttrib2v :: AttribLocation -> Ptr a -> IO ()
   vertexAttrib3v :: AttribLocation -> Ptr a -> IO ()
   vertexAttrib4v :: AttribLocation -> Ptr a -> IO ()

   vertexAttrib1Nv :: AttribLocation -> Ptr a -> IO ()
   vertexAttrib2Nv :: AttribLocation -> Ptr a -> IO ()
   vertexAttrib3Nv :: AttribLocation -> Ptr a -> IO ()
   vertexAttrib4Nv :: AttribLocation -> Ptr a -> IO ()

   vertexAttrib1Iv :: AttribLocation -> Ptr a -> IO ()
   vertexAttrib2Iv :: AttribLocation -> Ptr a -> IO ()
   vertexAttrib3Iv :: AttribLocation -> Ptr a -> IO ()
   vertexAttrib4Iv :: AttribLocation -> Ptr a -> IO ()

   vertexAttrib1 location x = vertexAttrib4 location x 0 0 1
   vertexAttrib2 location x y = vertexAttrib4 location x y 0 1
   vertexAttrib3 location x y z = vertexAttrib4 location x y z 1
   vertexAttrib4 location x y z w = allocaArray 4 $ \buf -> do
                                       poke4 buf x y z w
                                       vertexAttrib4v location buf

   vertexAttrib1N location x = vertexAttrib4N location x 0 0 1
   vertexAttrib2N location x y = vertexAttrib4N location x y 0 1
   vertexAttrib3N location x y z = vertexAttrib4N location x y z 1
   vertexAttrib4N location x y z w = allocaArray 4 $ \buf -> do
                                       poke4 buf x y z w
                                       vertexAttrib4Nv location buf

   vertexAttrib1I location x = vertexAttrib4I location x 0 0 1
   vertexAttrib2I location x y = vertexAttrib4I location x y 0 1
   vertexAttrib3I location x y z = vertexAttrib4I location x y z 1
   vertexAttrib4I location x y z w = allocaArray 4 $ \buf -> do
                                       poke4 buf x y z w
                                       vertexAttrib4Iv location buf

   vertexAttrib1v location = peek1M $ vertexAttrib1 location
   vertexAttrib2v location = peek2M $ vertexAttrib2 location
   vertexAttrib3v location = peek3M $ vertexAttrib3 location

   vertexAttrib1Nv location = peek1M $ vertexAttrib1N location
   vertexAttrib2Nv location = peek2M $ vertexAttrib2N location
   vertexAttrib3Nv location = peek3M $ vertexAttrib3N location

   vertexAttrib1Iv location = peek1M $ vertexAttrib1I location
   vertexAttrib2Iv location = peek2M $ vertexAttrib2I location
   vertexAttrib3Iv location = peek3M $ vertexAttrib3I location

instance VertexAttribComponent GLbyte where
   vertexAttrib4v (AttribLocation al) = glVertexAttrib4bv al
   vertexAttrib4Nv (AttribLocation al) = glVertexAttrib4Nbv al
   vertexAttrib4Iv (AttribLocation al) = glVertexAttribI4bv al

instance VertexAttribComponent GLubyte where
   vertexAttrib4N (AttribLocation al) = glVertexAttrib4Nub al
   vertexAttrib4v (AttribLocation al) = glVertexAttrib4ubv al
   vertexAttrib4Nv (AttribLocation al) = glVertexAttrib4Nubv al
   vertexAttrib4Iv (AttribLocation al) = glVertexAttribI4ubv al

instance VertexAttribComponent GLshort where
   vertexAttrib1 (AttribLocation al) = glVertexAttrib1s al
   vertexAttrib2 (AttribLocation al) = glVertexAttrib2s al
   vertexAttrib3 (AttribLocation al) = glVertexAttrib3s al
   vertexAttrib4 (AttribLocation al) = glVertexAttrib4s al

   vertexAttrib1v (AttribLocation al) = glVertexAttrib1sv al
   vertexAttrib2v (AttribLocation al) = glVertexAttrib2sv al
   vertexAttrib3v (AttribLocation al) = glVertexAttrib3sv al
   vertexAttrib4v (AttribLocation al) = glVertexAttrib4sv al

   vertexAttrib4Nv (AttribLocation al) = glVertexAttrib4Nsv al

   vertexAttrib4Iv (AttribLocation al) = glVertexAttribI4sv al

instance VertexAttribComponent GLushort where
   vertexAttrib4v (AttribLocation al) = glVertexAttrib4usv al
   vertexAttrib4Nv (AttribLocation al) = glVertexAttrib4Nusv al
   vertexAttrib4Iv (AttribLocation al) = glVertexAttribI4usv al

instance VertexAttribComponent GLint where
   vertexAttrib1I (AttribLocation al) = glVertexAttribI1i al
   vertexAttrib2I (AttribLocation al) = glVertexAttribI2i al
   vertexAttrib3I (AttribLocation al) = glVertexAttribI3i al
   vertexAttrib4I (AttribLocation al) = glVertexAttribI4i al

   vertexAttrib4v (AttribLocation al) = glVertexAttrib4iv al

   vertexAttrib4Nv (AttribLocation al) = glVertexAttrib4Niv al

   vertexAttrib1Iv (AttribLocation al) = glVertexAttribI1iv al
   vertexAttrib2Iv (AttribLocation al) = glVertexAttribI2iv al
   vertexAttrib3Iv (AttribLocation al) = glVertexAttribI3iv al
   vertexAttrib4Iv (AttribLocation al) = glVertexAttribI4iv al

instance VertexAttribComponent GLuint where
   vertexAttrib1I (AttribLocation al) = glVertexAttribI1ui al
   vertexAttrib2I (AttribLocation al) = glVertexAttribI2ui al
   vertexAttrib3I (AttribLocation al) = glVertexAttribI3ui al
   vertexAttrib4I (AttribLocation al) = glVertexAttribI4ui al

   vertexAttrib4v (AttribLocation al) = glVertexAttrib4uiv al

   vertexAttrib4Nv (AttribLocation al) = glVertexAttrib4Nuiv al

   vertexAttrib1Iv (AttribLocation al) = glVertexAttribI1uiv al
   vertexAttrib2Iv (AttribLocation al) = glVertexAttribI2uiv al
   vertexAttrib3Iv (AttribLocation al) = glVertexAttribI3uiv al
   vertexAttrib4Iv (AttribLocation al) = glVertexAttribI4uiv al

instance VertexAttribComponent GLfloat where
   vertexAttrib1 (AttribLocation al) = glVertexAttrib1f al
   vertexAttrib2 (AttribLocation al) = glVertexAttrib2f al
   vertexAttrib3 (AttribLocation al) = glVertexAttrib3f al
   vertexAttrib4 (AttribLocation al) = glVertexAttrib4f al

   vertexAttrib1v (AttribLocation al) = glVertexAttrib1fv al
   vertexAttrib2v (AttribLocation al) = glVertexAttrib2fv al
   vertexAttrib3v (AttribLocation al) = glVertexAttrib3fv al
   vertexAttrib4v (AttribLocation al) = glVertexAttrib4fv al

   vertexAttrib4Nv = vertexAttrib4v

   vertexAttrib4Iv = vertexAttrib4IvRealFrac

vertexAttrib4IvRealFrac :: (Storable a, RealFrac a) => AttribLocation -> Ptr a -> IO ()
vertexAttrib4IvRealFrac location = peek4M $ \x y z w ->
   vertexAttrib4I location (toGLint x) (toGLint y) (toGLint z) (toGLint w)

-- formula 2.6 from the OpenGL 3.1 spec
toGLint :: RealFrac a => a -> GLint
toGLint = truncate . (fromIntegral (maxBound :: GLint) *). clamp
   where clamp = max (-1.0) . min 1.0

instance VertexAttribComponent GLdouble where
   vertexAttrib1 (AttribLocation al) = glVertexAttrib1d al
   vertexAttrib2 (AttribLocation al) = glVertexAttrib2d al
   vertexAttrib3 (AttribLocation al) = glVertexAttrib3d al
   vertexAttrib4 (AttribLocation al) = glVertexAttrib4d al

   vertexAttrib1v (AttribLocation al) = glVertexAttrib1dv al
   vertexAttrib2v (AttribLocation al) = glVertexAttrib2dv al
   vertexAttrib3v (AttribLocation al) = glVertexAttrib3dv al
   vertexAttrib4v (AttribLocation al) = glVertexAttrib4dv al

   vertexAttrib4Nv = vertexAttrib4v

   vertexAttrib4Iv = vertexAttrib4IvRealFrac

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

class VertexAttrib a where
   vertexAttrib  :: IntegerHandling -> AttribLocation ->     a -> IO ()
   vertexAttribv :: IntegerHandling -> AttribLocation -> Ptr a -> IO ()

instance VertexAttribComponent a => VertexAttrib (Vertex1 a) where
   vertexAttrib ToFloat location (Vertex1 i) = vertexAttrib1 location i
   vertexAttrib ToNormalizedFloat location (Vertex1 i) = vertexAttrib1N location i
   vertexAttrib KeepIntegral location (Vertex1 i) = vertexAttrib1I location i

   vertexAttribv ToFloat location = vertexAttrib1v location . (castPtr :: Ptr (Vertex1 b) -> Ptr b)
   vertexAttribv ToNormalizedFloat location = vertexAttrib1Nv location . (castPtr :: Ptr (Vertex1 b) -> Ptr b)
   vertexAttribv KeepIntegral location = vertexAttrib1Iv location . (castPtr :: Ptr (Vertex1 b) -> Ptr b)

instance VertexAttribComponent a => VertexAttrib (Vertex2 a) where
   vertexAttrib ToFloat location (Vertex2 x y) = vertexAttrib2 location x y
   vertexAttrib ToNormalizedFloat location (Vertex2 x y) = vertexAttrib2N location x y
   vertexAttrib KeepIntegral location (Vertex2 x y) = vertexAttrib2I location x y

   vertexAttribv ToFloat location = vertexAttrib2v location . (castPtr :: Ptr (Vertex2 b) -> Ptr b)
   vertexAttribv ToNormalizedFloat location = vertexAttrib2Nv location . (castPtr :: Ptr (Vertex2 b) -> Ptr b)
   vertexAttribv KeepIntegral location = vertexAttrib2Iv location . (castPtr :: Ptr (Vertex2 b) -> Ptr b)

instance VertexAttribComponent a => VertexAttrib (Vertex3 a) where
   vertexAttrib ToFloat location (Vertex3 x y z) = vertexAttrib3 location x y z
   vertexAttrib ToNormalizedFloat location (Vertex3 x y z) = vertexAttrib3N location x y z
   vertexAttrib KeepIntegral location (Vertex3 x y z) = vertexAttrib3I location x y z

   vertexAttribv ToFloat location = vertexAttrib3v location . (castPtr :: Ptr (Vertex3 b) -> Ptr b)
   vertexAttribv ToNormalizedFloat location = vertexAttrib3Nv location . (castPtr :: Ptr (Vertex3 b) -> Ptr b)
   vertexAttribv KeepIntegral location = vertexAttrib3Iv location . (castPtr :: Ptr (Vertex3 b) -> Ptr b)

instance VertexAttribComponent a => VertexAttrib (Vertex4 a) where
   vertexAttrib ToFloat location (Vertex4 x y z w) = vertexAttrib4 location x y z w
   vertexAttrib ToNormalizedFloat location (Vertex4 x y z w) = vertexAttrib4N location x y z w
   vertexAttrib KeepIntegral location (Vertex4 x y z w) = vertexAttrib4I location x y z w

   vertexAttribv ToFloat location = vertexAttrib4v location . (castPtr :: Ptr (Vertex4 b) -> Ptr b)
   vertexAttribv ToNormalizedFloat location = vertexAttrib4Nv location . (castPtr :: Ptr (Vertex4 b) -> Ptr b)
   vertexAttribv KeepIntegral location = vertexAttrib4Iv location . (castPtr :: Ptr (Vertex4 b) -> Ptr b)

instance VertexAttribComponent a => VertexAttrib (Vector1 a) where
   vertexAttrib ToFloat location (Vector1 i) = vertexAttrib1 location i
   vertexAttrib ToNormalizedFloat location (Vector1 i) = vertexAttrib1N location i
   vertexAttrib KeepIntegral location (Vector1 i) = vertexAttrib1I location i

   vertexAttribv ToFloat location = vertexAttrib1v location . (castPtr :: Ptr (Vector1 b) -> Ptr b)
   vertexAttribv ToNormalizedFloat location = vertexAttrib1Nv location . (castPtr :: Ptr (Vector1 b) -> Ptr b)
   vertexAttribv KeepIntegral location = vertexAttrib1Iv location . (castPtr :: Ptr (Vector1 b) -> Ptr b)

instance VertexAttribComponent a => VertexAttrib (Vector2 a) where
   vertexAttrib ToFloat location (Vector2 x y) = vertexAttrib2 location x y
   vertexAttrib ToNormalizedFloat location (Vector2 x y) = vertexAttrib2N location x y
   vertexAttrib KeepIntegral location (Vector2 x y) = vertexAttrib2I location x y

   vertexAttribv ToFloat location = vertexAttrib2v location . (castPtr :: Ptr (Vector2 b) -> Ptr b)
   vertexAttribv ToNormalizedFloat location = vertexAttrib2Nv location . (castPtr :: Ptr (Vector2 b) -> Ptr b)
   vertexAttribv KeepIntegral location = vertexAttrib2Iv location . (castPtr :: Ptr (Vector2 b) -> Ptr b)

instance VertexAttribComponent a => VertexAttrib (Vector3 a) where
   vertexAttrib ToFloat location (Vector3 x y z) = vertexAttrib3 location x y z
   vertexAttrib ToNormalizedFloat location (Vector3 x y z) = vertexAttrib3N location x y z
   vertexAttrib KeepIntegral location (Vector3 x y z) = vertexAttrib3I location x y z

   vertexAttribv ToFloat location = vertexAttrib3v location . (castPtr :: Ptr (Vector3 b) -> Ptr b)
   vertexAttribv ToNormalizedFloat location = vertexAttrib3Nv location . (castPtr :: Ptr (Vector3 b) -> Ptr b)
   vertexAttribv KeepIntegral location = vertexAttrib3Iv location . (castPtr :: Ptr (Vector3 b) -> Ptr b)

instance VertexAttribComponent a => VertexAttrib (Vector4 a) where
   vertexAttrib ToFloat location (Vector4 x y z w) = vertexAttrib4 location x y z w
   vertexAttrib ToNormalizedFloat location (Vector4 x y z w) = vertexAttrib4N location x y z w
   vertexAttrib KeepIntegral location (Vector4 x y z w) = vertexAttrib4I location x y z w

   vertexAttribv ToFloat location = vertexAttrib4v location . (castPtr :: Ptr (Vector4 b) -> Ptr b)
   vertexAttribv ToNormalizedFloat location = vertexAttrib4Nv location . (castPtr :: Ptr (Vector4 b) -> Ptr b)
   vertexAttribv KeepIntegral location = vertexAttrib4Iv location . (castPtr :: Ptr (Vector4 b) -> Ptr b)

instance VertexAttribComponent a => VertexAttrib (TexCoord1 a) where
   vertexAttrib ToFloat location (TexCoord1 s) = vertexAttrib1 location s
   vertexAttrib ToNormalizedFloat location (TexCoord1 s) = vertexAttrib1N location s
   vertexAttrib KeepIntegral location (TexCoord1 s) = vertexAttrib1I location s

   vertexAttribv ToFloat location = vertexAttrib1v location . (castPtr :: Ptr (TexCoord1 b) -> Ptr b)
   vertexAttribv ToNormalizedFloat location = vertexAttrib1Nv location . (castPtr :: Ptr (TexCoord1 b) -> Ptr b)
   vertexAttribv KeepIntegral location = vertexAttrib1Iv location . (castPtr :: Ptr (TexCoord1 b) -> Ptr b)

instance VertexAttribComponent a => VertexAttrib (TexCoord2 a) where
   vertexAttrib ToFloat location (TexCoord2 s t) = vertexAttrib2 location s t
   vertexAttrib ToNormalizedFloat location (TexCoord2 s t) = vertexAttrib2N location s t
   vertexAttrib KeepIntegral location (TexCoord2 s t) = vertexAttrib2I location s t

   vertexAttribv ToFloat location = vertexAttrib2v location . (castPtr :: Ptr (TexCoord2 b) -> Ptr b)
   vertexAttribv ToNormalizedFloat location = vertexAttrib2Nv location . (castPtr :: Ptr (TexCoord2 b) -> Ptr b)
   vertexAttribv KeepIntegral location = vertexAttrib2Iv location . (castPtr :: Ptr (TexCoord2 b) -> Ptr b)

instance VertexAttribComponent a => VertexAttrib (TexCoord3 a) where
   vertexAttrib ToFloat location (TexCoord3 s t u) = vertexAttrib3 location s t u
   vertexAttrib ToNormalizedFloat location (TexCoord3 s t u) = vertexAttrib3N location s t u
   vertexAttrib KeepIntegral location (TexCoord3 s t u) = vertexAttrib3I location s t u

   vertexAttribv ToFloat location = vertexAttrib3v location . (castPtr :: Ptr (TexCoord3 b) -> Ptr b)
   vertexAttribv ToNormalizedFloat location = vertexAttrib3Nv location . (castPtr :: Ptr (TexCoord3 b) -> Ptr b)
   vertexAttribv KeepIntegral location = vertexAttrib3Iv location . (castPtr :: Ptr (TexCoord3 b) -> Ptr b)

instance VertexAttribComponent a => VertexAttrib (TexCoord4 a) where
   vertexAttrib ToFloat location (TexCoord4 s t u v) = vertexAttrib4 location s t u v
   vertexAttrib ToNormalizedFloat location (TexCoord4 s t u v) = vertexAttrib4N location s t u v
   vertexAttrib KeepIntegral location (TexCoord4 s t u v) = vertexAttrib4I location s t u v

   vertexAttribv ToFloat location = vertexAttrib4v location . (castPtr :: Ptr (TexCoord4 b) -> Ptr b)
   vertexAttribv ToNormalizedFloat location = vertexAttrib4Nv location . (castPtr :: Ptr (TexCoord4 b) -> Ptr b)
   vertexAttribv KeepIntegral location = vertexAttrib4Iv location . (castPtr :: Ptr (TexCoord4 b) -> Ptr b)

instance VertexAttribComponent a => VertexAttrib (Normal3 a) where
   vertexAttrib ToFloat location (Normal3 x y z) = vertexAttrib3 location x y z
   vertexAttrib ToNormalizedFloat location (Normal3 x y z) = vertexAttrib3N location x y z
   vertexAttrib KeepIntegral location (Normal3 x y z) = vertexAttrib3I location x y z

   vertexAttribv ToFloat location = vertexAttrib3v location . (castPtr :: Ptr (Normal3 b) -> Ptr b)
   vertexAttribv ToNormalizedFloat location = vertexAttrib3Nv location . (castPtr :: Ptr (Normal3 b) -> Ptr b)
   vertexAttribv KeepIntegral location = vertexAttrib3Iv location . (castPtr :: Ptr (Normal3 b) -> Ptr b)

instance VertexAttribComponent a => VertexAttrib (FogCoord1 a) where
   vertexAttrib ToFloat location (FogCoord1 c) = vertexAttrib1 location c
   vertexAttrib ToNormalizedFloat location (FogCoord1 c) = vertexAttrib1N location c
   vertexAttrib KeepIntegral location (FogCoord1 c) = vertexAttrib1I location c

   vertexAttribv ToFloat location = vertexAttrib1v location . (castPtr :: Ptr (FogCoord1 b) -> Ptr b)
   vertexAttribv ToNormalizedFloat location = vertexAttrib1Nv location . (castPtr :: Ptr (FogCoord1 b) -> Ptr b)
   vertexAttribv KeepIntegral location = vertexAttrib1Iv location . (castPtr :: Ptr (FogCoord1 b) -> Ptr b)

instance VertexAttribComponent a => VertexAttrib (Color3 a) where
   vertexAttrib ToFloat location (Color3 r g b) = vertexAttrib3 location r g b
   vertexAttrib ToNormalizedFloat location (Color3 r g b) = vertexAttrib3N location r g b
   vertexAttrib KeepIntegral location (Color3 r g b) = vertexAttrib3I location r g b

   vertexAttribv ToFloat location = vertexAttrib3v location . (castPtr :: Ptr (Color3 b) -> Ptr b)
   vertexAttribv ToNormalizedFloat location = vertexAttrib3Nv location . (castPtr :: Ptr (Color3 b) -> Ptr b)
   vertexAttribv KeepIntegral location = vertexAttrib3Iv location . (castPtr :: Ptr (Color3 b) -> Ptr b)

instance VertexAttribComponent a => VertexAttrib (Color4 a) where
   vertexAttrib ToFloat location (Color4 r g b a) = vertexAttrib4 location r g b a
   vertexAttrib ToNormalizedFloat location (Color4 r g b a) = vertexAttrib4N location r g b a
   vertexAttrib KeepIntegral location (Color4 r g b a) = vertexAttrib4I location r g b a

   vertexAttribv ToFloat location = vertexAttrib4v location . (castPtr :: Ptr (Color4 b) -> Ptr b)
   vertexAttribv ToNormalizedFloat location = vertexAttrib4Nv location . (castPtr :: Ptr (Color4 b) -> Ptr b)
   vertexAttribv KeepIntegral location = vertexAttrib4Iv location . (castPtr :: Ptr (Color4 b) -> Ptr b)

instance VertexAttribComponent a => VertexAttrib (Index1 a) where
   vertexAttrib ToFloat location (Index1 i) = vertexAttrib1 location i
   vertexAttrib ToNormalizedFloat location (Index1 i) = vertexAttrib1N location i
   vertexAttrib KeepIntegral location (Index1 i) = vertexAttrib1I location i

   vertexAttribv ToFloat location = vertexAttrib1v location . (castPtr :: Ptr (Index1 b) -> Ptr b)
   vertexAttribv ToNormalizedFloat location = vertexAttrib1Nv location . (castPtr :: Ptr (Index1 b) -> Ptr b)
   vertexAttribv KeepIntegral location = vertexAttrib1Iv location . (castPtr :: Ptr (Index1 b) -> Ptr b)

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

-- | An implementation must support at least 2 texture units, but it may
-- support up to 32 ones. This state variable can be used to query the actual
-- implementation limit.

maxTextureUnit :: GettableStateVar TextureUnit
maxTextureUnit =
   makeGettableStateVar (getEnum1 (TextureUnit . fromIntegral) GetMaxTextureUnits)