module Graphics.GLMatrix (
translationMatrix, frustumMatrix,
identityMatrix, toGLFormat, withMatrix,
matrixMulVec, matrix4x4To3x3, matrix3x3To4x4,
invertMatrix4x4ON, scalingMatrix,
rotationMatrix, lookAtMatrixG, orthoMatrix,
perspectiveMatrix, addVec,
setMatrix4x4Uniform,
Matrix4x4, Matrix3x3, Vector4, Vector3
) where
import Data.List (transpose)
import Foreign (Ptr)
import Foreign.C (withCString)
import Foreign.Marshal.Array (withArray)
import Graphics.Rendering.OpenGL.Raw
(GLfloat, GLuint, glGetUniformLocation,
glUniformMatrix4fv, gl_FALSE)
type Matrix4x4 = [[GLfloat]]
type Matrix3x3 = [[GLfloat]]
type Vector4 = [GLfloat]
type Vector3 = [GLfloat]
instance Num Matrix4x4 where
a * b =
map (\row -> map (dotVec row) at) b
where at = transpose a
a + b = applyToIndices2 a b (+)
abs = map (map abs)
fromInteger i =
[
[fromInteger i, 0, 0, 0],
[0, fromInteger i, 0, 0],
[0, 0, fromInteger i, 0],
[0, 0, 0, fromInteger i]
]
signum = map (map signum)
setMatrix4x4Uniform :: GLuint -> Matrix4x4 -> String -> IO ()
setMatrix4x4Uniform shader matrix var = do
loc <- withCString var $ glGetUniformLocation shader
withMatrix matrix (glUniformMatrix4fv loc 1 (fromIntegral gl_FALSE))
withMatrix :: Matrix4x4 -> (Ptr GLfloat -> IO a) -> IO a
withMatrix = withArray . toGLFormat
applyToIndices2 :: [[a]] -> [[b]] -> (a -> b -> c) -> [[c]]
applyToIndices2 (a:as) (b:bs) f =
applyToIndices a b f : applyToIndices2 as bs f
applyToIndices2 _ _ _ = []
applyToIndices :: [a] -> [b] -> (a -> b -> c) -> [c]
applyToIndices (a:as) (b:bs) f =
f a b : applyToIndices as bs f
applyToIndices _ _ _ = []
toGLFormat :: Matrix4x4 -> [GLfloat]
toGLFormat = concat
identityMatrix :: Matrix4x4
identityMatrix =
[
[1,0,0,0],
[0,1,0,0],
[0,0,1,0],
[0,0,0,1]
]
matrixMulVec :: Matrix4x4 -> Vector4 -> Vector4
matrixMulVec m v = map (dotVec v) (transpose m)
matrix4x4To3x3 :: Matrix4x4 -> Matrix3x3
matrix4x4To3x3 m = take 3 $ map vec4To3 m
matrix3x3To4x4 :: Matrix3x3 -> Matrix4x4
matrix3x3To4x4 [x,y,z] = [x ++ [0], y ++ [0], z ++ [0], [0,0,0,1]]
matrix3x3To4x4 m = m
invertMatrix4x4ON :: Matrix4x4 -> Matrix4x4
invertMatrix4x4ON m =
let [a,b,c] = transpose $ matrix4x4To3x3 m
[_,_,_,t4] = m
t = vec4To3 t4
in [
vec3To4 a 0, vec3To4 b 0, vec3To4 c 0,
[dotVec a t, dotVec b t, dotVec c t, t4 !! 3]
]
translationMatrix :: Vector3 -> Matrix4x4
translationMatrix [x,y,z] =
[[1,0,0,0],
[0,1,0,0],
[0,0,1,0],
[x,y,z,1]]
translationMatrix _ = identityMatrix
scalingMatrix :: Vector3 -> Matrix4x4
scalingMatrix [x,y,z] =
[[x,0,0,0],
[0,y,0,0],
[0,0,z,0],
[0,0,0,1]]
scalingMatrix _ = identityMatrix
rotationMatrix :: GLfloat -> Vector3 -> Matrix4x4
rotationMatrix angle axis =
let [x,y,z] = normalizeVec axis
c = cos angle
s = sin angle
c1 = 1c
in [
[x*x*c1+c, y*x*c1+z*s, z*x*c1y*s, 0],
[x*y*c1z*s, y*y*c1+c, y*z*c1+x*s, 0],
[x*z*c1+y*s, y*z*c1x*s, z*z*c1+c, 0],
[0,0,0,1]
]
lookAtMatrixG :: Vector3 -> Vector3 -> Vector3 -> Matrix4x4
lookAtMatrixG eye center up =
let z = directionVec eye center
x = normalizeVec $ crossVec3 up z
y = normalizeVec $ crossVec3 z x
in matrix3x3To4x4 (transpose [x,y,z]) *
translationMatrix (negateVec eye)
frustumMatrix ::
GLfloat -> GLfloat -> GLfloat -> GLfloat -> GLfloat -> GLfloat -> Matrix4x4
frustumMatrix left right bottom top znear zfar =
let x = 2*znear/(rightleft)
y = 2*znear/(topbottom)
a = (right+left)/(rightleft)
b = (top+bottom)/(topbottom)
c = (zfar+znear)/(zfarznear)
d = 2*zfar*znear/(zfarznear)
in
[[x, 0, 0, 0],
[0, y, 0, 0],
[a, b, c, 1],
[0, 0, d, 0]]
orthoMatrix ::
GLfloat -> GLfloat -> GLfloat -> GLfloat -> GLfloat -> GLfloat -> Matrix4x4
orthoMatrix l r b t n f =
let ai = 2/(rl)
bi = 2/(tb)
ci = 2/(fn)
di = (r+l)/(rl)
ei = (t+b)/(tb)
fi = (f+n)/(fn)
in
[[ai, 0, 0, 0],
[0, bi, 0, 0],
[0, 0, ci, 0],
[di, ei, fi, 1]]
perspectiveMatrix :: GLfloat -> GLfloat -> GLfloat -> GLfloat -> Matrix4x4
perspectiveMatrix fovy aspect znear zfar =
let ymax = znear * tan (fovy * pi / 360.0)
ymin = ymax
xmin = ymin * aspect
xmax = ymax * aspect
in frustumMatrix xmin xmax ymin ymax znear zfar
normalizeVec :: [GLfloat] -> [GLfloat]
normalizeVec v = scaleVec (recip $ lengthVec v) v
scaleVec :: GLfloat -> [GLfloat] -> [GLfloat]
scaleVec s = map (s*)
lengthVec :: [GLfloat] -> GLfloat
lengthVec v = sqrt.sum $ map square v
innerVec :: [GLfloat] -> [GLfloat] -> [GLfloat]
innerVec = zipWith (*)
addVec :: [GLfloat] -> [GLfloat] -> [GLfloat]
addVec = zipWith (+)
subVec :: [GLfloat] -> [GLfloat] -> [GLfloat]
subVec = zipWith ()
negateVec :: [GLfloat] -> [GLfloat]
negateVec = map negate
directionVec :: [GLfloat] -> [GLfloat] -> [GLfloat]
directionVec u v = normalizeVec (subVec u v)
dotVec :: [GLfloat] -> [GLfloat] -> GLfloat
dotVec a b = sum $ innerVec a b
crossVec3 :: [GLfloat] -> [GLfloat] -> [GLfloat]
crossVec3 [u0,u1,u2] [v0,v1,v2] = [u1*v2u2*v1, u2*v0u0*v2, u0*v1u1*v0]
crossVec3 _ _ = [0,0,1]
vec4To3 :: Vector4 -> Vector3
vec4To3 = take 3
vec3To4 :: Vector3 -> GLfloat -> Vector4
vec3To4 v i = v ++ [i]
square :: GLfloat -> GLfloat
square x = x * x