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 Graphics.Rendering.OpenGL hiding
( Normal3 , rotate , translate , scale
, matrix , currentMatrix , withMatrix , multMatrix
)
class ToOpenGLMatrix m where
makeGLMatrix :: m -> IO (GLmatrix Flt)
class FromOpenGLMatrix m where
peekGLMatrix :: GLmatrix Flt -> 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)
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 (radianToDegrees angle) (Vector3 x y z)
glTranslate :: Vec3 -> IO ()
glTranslate (Vec3 x y z) = GL.translate (Vector3 x y z)
glScale3 :: Vec3 -> IO ()
glScale3 (Vec3 x y z) = GL.scale x y z
glScale :: Flt -> IO ()
glScale x = GL.scale x x x
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)
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
instance GL.Normal Normal3 where
normal u = GL.normal (GL.Normal3 x y z)
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 x y z)
normalv p = peek p >>= normal
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
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
class VertexAttrib' a where
vertexAttrib :: GL.AttribLocation -> a -> IO ()
instance VertexAttrib' 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 u = GL.vertexAttrib2 loc x y
where Vec2 x y = fromNormal u
instance VertexAttrib' Normal3 where
vertexAttrib loc u = GL.vertexAttrib3 loc x y z
where Vec3 x y z = fromNormal u
instance VertexAttrib' Normal4 where
vertexAttrib loc u = GL.vertexAttrib4 loc x y z w
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) -> 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