#define Flt Double
#define VECT_Double
module Data.Vect.Flt.OpenGL where
import Control.Monad
import Data.Vect.Flt.Base
import Data.Vect.Flt.Util.Projective
import qualified Graphics.Rendering.OpenGL as GL
import Foreign
import Unsafe.Coerce
import Graphics.Rendering.OpenGL hiding
( Normal3 , rotate , translate , scale
, matrix , currentMatrix , withMatrix , multMatrix
)
#ifdef VECT_Float
type GLflt = GLfloat
#endif
#ifdef VECT_Double
type GLflt = GLdouble
#endif
glflt :: Flt -> GLflt
unflt :: GLflt -> Flt
glflt = unsafeCoerce
unflt = unsafeCoerce
#define GL_XY (glflt x) (glflt y)
#define GL_XYZ (glflt x) (glflt y) (glflt z)
#define GL_XYZW (glflt x) (glflt y) (glflt z) (glflt w)
#define GL_RGB (glflt r) (glflt g) (glflt b)
#define GL_RGBA (glflt r) (glflt g) (glflt b) (glflt a)
#define GL_UV (glflt u) (glflt v)
#define GL_UVW (glflt u) (glflt v) (glflt w)
#define GL_UVWZ (glflt u) (glflt v) (glflt w) (glflt z)
#define UN_XY (unflt x) (unflt y)
#define UN_XYZ (unflt x) (unflt y) (unflt z)
#define UN_XYZW (unflt x) (unflt y) (unflt z) (unflt w)
class ToOpenGLMatrix m where
makeGLMatrix :: m -> IO (GLmatrix GLflt)
class FromOpenGLMatrix m where
peekGLMatrix :: GLmatrix GLflt -> IO m
setMatrix :: ToOpenGLMatrix m => Maybe MatrixMode -> m -> IO ()
setMatrix mode m = makeGLMatrix m >>= \x -> GL.matrix mode $= x
getMatrix :: FromOpenGLMatrix m => Maybe MatrixMode -> IO m
getMatrix mode = get (GL.matrix mode) >>= peekGLMatrix
matrix :: (ToOpenGLMatrix m, FromOpenGLMatrix m) => Maybe MatrixMode -> StateVar m
matrix mode = makeStateVar (getMatrix mode) (setMatrix mode)
currentMatrix :: (ToOpenGLMatrix m, FromOpenGLMatrix m) => StateVar m
currentMatrix = matrix Nothing
multMatrix :: ToOpenGLMatrix m => m -> IO ()
multMatrix m = makeGLMatrix m >>= GL.multMatrix
instance ToOpenGLMatrix Mat4 where
makeGLMatrix m = GL.withNewMatrix GL.ColumnMajor (flip poke m . (castPtr :: Ptr GLflt -> Ptr Mat4))
instance FromOpenGLMatrix Mat4 where
peekGLMatrix x = GL.withMatrix x $ \_ p -> peek (castPtr p)
instance ToOpenGLMatrix Mat3 where
makeGLMatrix m = makeGLMatrix (extendWith 1 m :: Mat4)
instance ToOpenGLMatrix Mat2 where
makeGLMatrix m = makeGLMatrix (extendWith 1 m :: Mat4)
instance ToOpenGLMatrix Ortho4 where
makeGLMatrix m = makeGLMatrix (fromOrtho m :: Mat4)
instance ToOpenGLMatrix Ortho3 where
makeGLMatrix m = makeGLMatrix (fromOrtho m :: Mat3)
instance ToOpenGLMatrix Ortho2 where
makeGLMatrix m = makeGLMatrix (fromOrtho m :: Mat2)
instance ToOpenGLMatrix Proj4 where
makeGLMatrix m = makeGLMatrix (fromProjective m :: Mat4)
instance ToOpenGLMatrix Proj3 where
makeGLMatrix m = makeGLMatrix (fromProjective m :: Mat3)
radianToDegrees :: RealFrac a => a -> a
radianToDegrees x = x * 57.295779513082322
degreesToRadian :: Floating a => a -> a
degreesToRadian x = x * 1.7453292519943295e-2
glRotate :: Flt -> Vec3 -> IO ()
glRotate angle (Vec3 x y z) = GL.rotate (glflt $ radianToDegrees angle) (Vector3 GL_XYZ)
glTranslate :: Vec3 -> IO ()
glTranslate (Vec3 x y z) = GL.translate (Vector3 GL_XYZ)
glScale3 :: Vec3 -> IO ()
glScale3 (Vec3 x y z) = GL.scale GL_XYZ
glScale :: Flt -> IO ()
glScale x = let s = glflt x in GL.scale s s s
orthoMatrix
:: (Flt,Flt)
-> (Flt,Flt)
-> (Flt,Flt)
-> Mat4
orthoMatrix (l,r) (b,t) (n,f) = Mat4
(Vec4 (2/(rl)) 0 0 0)
(Vec4 0 (2/(tb)) 0 0)
(Vec4 0 0 (2/(fn)) 0)
(Vec4 ((r+l)/(rl)) ((t+b)/(tb)) ((f+n)/(fn)) 1)
orthoMatrix2
:: Vec3
-> Vec3
-> Mat4
orthoMatrix2 (Vec3 l t n) (Vec3 r b f) = orthoMatrix (l,r) (b,t) (n,f)
frustumMatrix
:: (Flt,Flt)
-> (Flt,Flt)
-> (Flt,Flt)
-> Mat4
frustumMatrix (l,r) (b,t) (n,f) = Mat4
(Vec4 (2*n/(rl)) 0 0 0)
(Vec4 0 (2*n/(tb)) 0 0)
(Vec4 ((r+l)/(rl)) ((t+b)/(tb)) ((f+n)/(fn)) (1))
(Vec4 0 0 (2*f*n/(fn)) 0)
frustumMatrix2
:: Vec3
-> Vec3
-> Mat4
frustumMatrix2 (Vec3 l t n) (Vec3 r b f) = frustumMatrix (l,r) (b,t) (n,f)
inverseFrustumMatrix
:: (Flt,Flt)
-> (Flt,Flt)
-> (Flt,Flt)
-> Mat4
inverseFrustumMatrix (l,r) (b,t) (n,f) = Mat4
(Vec4 (0.5*(rl)/n) 0 0 0)
(Vec4 0 (0.5*(tb)/n) 0 0)
(Vec4 0 0 0 (0.5*(nf)/(f*n)))
(Vec4 (0.5*(r+l)/n) (0.5*(t+b)/n) (1) (0.5*(f+n)/(f*n)))
instance GL.Vertex Vec2 where
vertex (Vec2 x y) = GL.vertex (GL.Vertex2 GL_XY)
vertexv p = peek p >>= vertex
instance GL.Vertex Vec3 where
vertex (Vec3 x y z) = GL.vertex (GL.Vertex3 GL_XYZ)
vertexv p = peek p >>= vertex
instance GL.Vertex Vec4 where
vertex (Vec4 x y z w) = GL.vertex (GL.Vertex4 GL_XYZW)
vertexv p = peek p >>= vertex
instance GL.Normal Normal3 where
normal u = GL.normal (GL.Normal3 GL_XYZ)
where Vec3 x y z = fromNormal u
normalv p = peek p >>= normal
instance GL.Normal Vec3 where
normal (Vec3 x y z) = GL.normal (GL.Normal3 GL_XYZ)
normalv p = peek p >>= normal
instance GL.Color Vec3 where
color (Vec3 r g b) = GL.color (GL.Color3 GL_RGB)
colorv p = peek p >>= color
instance GL.Color Vec4 where
color (Vec4 r g b a) = GL.color (GL.Color4 GL_RGBA)
colorv p = peek p >>= color
instance GL.SecondaryColor Vec3 where
secondaryColor (Vec3 r g b) = GL.secondaryColor (GL.Color3 GL_RGB)
secondaryColorv p = peek p >>= secondaryColor
instance GL.TexCoord Vec2 where
texCoord (Vec2 u v) = GL.texCoord (GL.TexCoord2 GL_UV)
texCoordv p = peek p >>= texCoord
multiTexCoord unit (Vec2 u v) = GL.multiTexCoord unit (GL.TexCoord2 GL_UV)
multiTexCoordv unit p = peek p >>= multiTexCoord unit
instance GL.TexCoord Vec3 where
texCoord (Vec3 u v w) = GL.texCoord (GL.TexCoord3 GL_UVW)
texCoordv p = peek p >>= texCoord
multiTexCoord unit (Vec3 u v w) = GL.multiTexCoord unit (GL.TexCoord3 GL_UVW)
multiTexCoordv unit p = peek p >>= multiTexCoord unit
instance GL.TexCoord Vec4 where
texCoord (Vec4 u v w z) = GL.texCoord (GL.TexCoord4 GL_UVWZ)
texCoordv p = peek p >>= texCoord
multiTexCoord unit (Vec4 u v w z) = GL.multiTexCoord unit (GL.TexCoord4 GL_UVWZ)
multiTexCoordv unit p = peek p >>= multiTexCoord unit
class VertexAttrib' a where
vertexAttrib :: GL.AttribLocation -> a -> IO ()
instance VertexAttrib' Flt where
vertexAttrib loc x = GL.vertexAttrib1 loc (glflt x)
instance VertexAttrib' Vec2 where
vertexAttrib loc (Vec2 x y) = GL.vertexAttrib2 loc GL_XY
instance VertexAttrib' Vec3 where
vertexAttrib loc (Vec3 x y z) = GL.vertexAttrib3 loc GL_XYZ
instance VertexAttrib' Vec4 where
vertexAttrib loc (Vec4 x y z w) = GL.vertexAttrib4 loc GL_XYZW
instance VertexAttrib' Normal2 where
vertexAttrib loc u = GL.vertexAttrib2 loc GL_XY
where Vec2 x y = fromNormal u
instance VertexAttrib' Normal3 where
vertexAttrib loc u = GL.vertexAttrib3 loc GL_XYZ
where Vec3 x y z = fromNormal u
instance VertexAttrib' Normal4 where
vertexAttrib loc u = GL.vertexAttrib4 loc GL_XYZW
where Vec4 x y z w = fromNormal u
#ifdef VECT_Float
instance GL.Uniform Flt where
uniform loc = GL.makeStateVar getter setter where
getter = liftM (\(GL.Index1 x) -> (unflt x)) $ get (uniform loc)
setter x = ($=) (uniform loc) (Index1 (glflt x))
uniformv loc cnt ptr = uniformv loc cnt (castPtr ptr :: Ptr (Index1 GLflt))
instance GL.Uniform Vec2 where
uniform loc = GL.makeStateVar getter setter where
getter = liftM (\(GL.Vertex2 x y) -> Vec2 UN_XY) $ get (uniform loc)
setter (Vec2 x y) = ($=) (uniform loc) (Vertex2 GL_XY)
uniformv loc cnt ptr = uniformv loc cnt (castPtr ptr :: Ptr (Vertex2 GLflt))
instance GL.Uniform Vec3 where
uniform loc = GL.makeStateVar getter setter where
getter = liftM (\(GL.Vertex3 x y z) -> Vec3 UN_XYZ) $ get (uniform loc)
setter (Vec3 x y z) = ($=) (uniform loc) (Vertex3 GL_XYZ)
uniformv loc cnt ptr = uniformv loc cnt (castPtr ptr :: Ptr (Vertex3 GLflt))
instance GL.Uniform Vec4 where
uniform loc = GL.makeStateVar getter setter where
getter = liftM (\(GL.Vertex4 x y z w) -> Vec4 UN_XYZW) $ get (uniform loc)
setter (Vec4 x y z w) = ($=) (uniform loc) (Vertex4 GL_XYZW)
uniformv loc cnt ptr = uniformv loc cnt (castPtr ptr :: Ptr (Vertex4 GLflt))
#endif