```{-# OPTIONS_GHC -DFlt=Float -DVECT_Float #-}

-- TODO: the pointer versions of these functions should be really implemented
-- via the pointer versions of the original opengl functions...

-- | OpenGL support, inclduing 'vertex', 'texCoord', etc instances for 'Vec2', 'Vec3' and 'Vec4'.

module Data.Vect.Flt.OpenGL where

import Data.Vect.Flt.Base
import qualified Graphics.Rendering.OpenGL as GL

import Foreign

import Graphics.Rendering.OpenGL hiding (Normal3,rotate,translate,scale)

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

{-# SPECIALISE radianToDegrees :: Float -> Float #-}
{-# SPECIALISE radianToDegrees :: Double -> Double #-}
radianToDegrees :: RealFrac a => a -> a
radianToDegrees x = x * 57.295779513082322

{-# SPECIALIZE degreesToRadian :: Float  -> Float  #-}
{-# SPECIALIZE degreesToRadian :: Double -> Double #-}
degreesToRadian :: Floating a => a -> a
degreesToRadian x = x * 1.7453292519943295e-2

-- | The angle is in radians. (WARNING: OpenGL uses degrees!)
rotate :: Flt -> Vec3 -> IO ()
rotate angle (Vec3 x y z) = GL.rotate (radianToDegrees angle) (Vector3 x y z)

translate :: Vec3 -> IO ()
translate (Vec3 x y z) = GL.translate (Vector3 x y z)

scale3 :: Vec3 -> IO ()
scale3 (Vec3 x y z) = GL.scale x y z

scale :: Flt -> IO ()
scale x = GL.scale x x x

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

-- Vertex instances

instance GL.Vertex Vec2 where
vertex (Vec2 x y) = GL.vertex (GL.Vertex2 x y)
vertexv p = peek p >>= vertex

instance GL.Vertex Vec3 where
vertex (Vec3 x y z) = GL.vertex (GL.Vertex3 x y z)
vertexv p = peek p >>= vertex

instance GL.Vertex Vec4 where
vertex (Vec4 x y z w) = GL.vertex (GL.Vertex4 x y z w)
vertexv p = peek p >>= vertex

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

-- the Normal instance
-- note that there is no Normal2\/Normal4 in the OpenGL binding

instance GL.Normal Normal3 where
normal (Normal3 (Vec3 x y z)) = GL.normal (GL.Normal3 x y z)
normalv p = peek p >>= normal

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

-- Color instances

instance GL.Color Vec3 where
color (Vec3 r g b) = GL.color (GL.Color3 r g b)
colorv p = peek p >>= color

instance GL.Color Vec4 where
color (Vec4 r g b a) = GL.color (GL.Color4 r g b a)
colorv p = peek p >>= color

instance GL.SecondaryColor Vec3 where
secondaryColor (Vec3 r g b) = GL.secondaryColor (GL.Color3 r g b)
secondaryColorv p = peek p >>= secondaryColor

{-
-- there is no such thing?
instance GL.SecondaryColor Vec4 where
secondaryColor (Vec4 r g b a) = GL.secondaryColor (GL.Color4 r g b a)
secondaryColorv p = peek p >>= secondaryColor
-}

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

-- TexCoord instances

instance GL.TexCoord Vec2 where
texCoord (Vec2 u v) = GL.texCoord (GL.TexCoord2 u v)
texCoordv p = peek p >>= texCoord
multiTexCoord unit (Vec2 u v) = GL.multiTexCoord unit (GL.TexCoord2 u v)
multiTexCoordv unit p = peek p >>= multiTexCoord unit

instance GL.TexCoord Vec3 where
texCoord (Vec3 u v w) = GL.texCoord (GL.TexCoord3 u v w)
texCoordv p = peek p >>= texCoord
multiTexCoord unit (Vec3 u v w) = GL.multiTexCoord unit (GL.TexCoord3 u v w)
multiTexCoordv unit p = peek p >>= multiTexCoord unit

instance GL.TexCoord Vec4 where
texCoord (Vec4 u v w z) = GL.texCoord (GL.TexCoord4 u v w z)
texCoordv p = peek p >>= texCoord
multiTexCoord unit (Vec4 u v w z) = GL.multiTexCoord unit (GL.TexCoord4 u v w z)
multiTexCoordv unit p = peek p >>= multiTexCoord unit

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

-- Vertex Attributes (experimental)

class VertexAttrib' a where
vertexAttrib :: GL.AttribLocation -> a -> IO ()

instance VertexAttrib' {- ' CPP is sensitive to primes -} Flt where
vertexAttrib loc x = GL.vertexAttrib1 loc x

instance VertexAttrib' Vec2 where
vertexAttrib loc (Vec2 x y) = GL.vertexAttrib2 loc x y

instance VertexAttrib' Vec3 where
vertexAttrib loc (Vec3 x y z) = GL.vertexAttrib3 loc x y z

instance VertexAttrib' Vec4 where
vertexAttrib loc (Vec4 x y z w) = GL.vertexAttrib4 loc x y z w

instance VertexAttrib' Normal2 where
vertexAttrib loc (Normal2 (Vec2 x y)) = GL.vertexAttrib2 loc x y

instance VertexAttrib' Normal3 where
vertexAttrib loc (Normal3 (Vec3 x y z)) = GL.vertexAttrib3 loc x y z

instance VertexAttrib' Normal4 where
vertexAttrib loc (Normal4 (Vec4 x y z w)) = GL.vertexAttrib4 loc x y z w

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

-- Uniform (again, experimental)

-- (note that the uniform location code in the OpenGL 2.2.1.1 is broken;
-- a work-around is to put a zero character at the end of uniform names)

{-
toFloat :: Flt -> Float
toFloat = realToFrac

fromFloat :: Float -> Flt
fromFloat = realToFrac
-}

-- Uniforms are always floats...
#ifdef VECT_Float

instance GL.Uniform Flt where
uniform loc = GL.makeStateVar getter setter where
getter = liftM (\(GL.Index1 x) -> x) \$ get (uniform loc)
setter x = (\$=) (uniform loc) (Index1 x)
uniformv loc cnt ptr = uniformv loc cnt (castPtr ptr :: Ptr (Index1 Flt))

instance GL.Uniform Vec2 where
uniform loc = GL.makeStateVar getter setter where
getter = liftM (\(GL.Vertex2 x y) -> Vec2 x y) \$ get (uniform loc)
setter (Vec2 x y) = (\$=) (uniform loc) (Vertex2 x y)
uniformv loc cnt ptr = uniformv loc (2*cnt) (castPtr ptr :: Ptr Flt)

instance GL.Uniform Vec3 where
uniform loc = GL.makeStateVar getter setter where
getter = liftM (\(GL.Vertex3 x y z) -> Vec3 x y z) \$ get (uniform loc)
setter (Vec3 x y z) = (\$=) (uniform loc) (Vertex3 x y z)
uniformv loc cnt ptr = uniformv loc (3*cnt) (castPtr ptr :: Ptr Flt)

instance GL.Uniform Vec4 where
uniform loc = GL.makeStateVar getter setter where
getter = liftM (\(GL.Vertex4 x y z w) -> Vec4 x y z w) \$ get (uniform loc)
setter (Vec4 x y z w) = (\$=) (uniform loc) (Vertex4 x y z w)
uniformv loc cnt ptr = uniformv loc (4*cnt) (castPtr ptr :: Ptr Flt)

#endif
```