module Graphics.Caramia.Math
( Matrix44(..)
, Matrix33(..)
, Vector3(..)
, Quaternion(..)
, sizeOfMatrix44
, sizeOfMatrix33
, sizeOfVector3
, sizeOfQuaternion
, matrix44
, withMatrix44Ptr
, inverse44
, identity44
, multiply44
, determinant44
, zero44
, perspective44
, distance44
, frustum44
, ortho44
, lookat44
, translate44
, transpose44
, scale44
, rotate44
, matrix33
, withMatrix33Ptr
, inverse33
, identity33
, multiply33
, determinant33
, zero33
, distance33
, transpose33
, matrix33ToMatrix44
, matrix44ToMatrix33
, quaternion
, identityq
, canonicalizeq
, distanceq
, lengthq
, normalizeq
, multiplyq
, zeroq
, axisAngleToQuaternion
, matrix44ToQuaternion
, quaternionToMatrix44
, toTupleq
, fromTupleq
, vector3
, zero3
, distance3
, length3
, plus3
, minus3
, normalize3
, angle3
, cross3
, dot3
, negative3
, scalarMultiply3
, vector3_1ToQuaternion
, vector3Transform44
, toTuple3
, fromTuple3
, _x
, _y
, _z
, prettyShow )
where
import Graphics.Caramia.Prelude
import Foreign.Ptr ( Ptr, castPtr )
import Foreign.Storable ( pokeElemOff, Storable(..) )
import Foreign.Marshal.Array ( allocaArray )
import Foreign.C.Types ( CFloat(..) )
import Graphics.Caramia.Internal.Lens
data Matrix44 = Matrix44 { m11 :: !Float
, m21 :: !Float
, m31 :: !Float
, m41 :: !Float
, m12 :: !Float
, m22 :: !Float
, m32 :: !Float
, m42 :: !Float
, m13 :: !Float
, m23 :: !Float
, m33 :: !Float
, m43 :: !Float
, m14 :: !Float
, m24 :: !Float
, m34 :: !Float
, m44 :: !Float }
deriving ( Eq, Show, Read, Ord, Typeable )
data Matrix33 = Matrix33 { n11 :: !Float
, n21 :: !Float
, n31 :: !Float
, n12 :: !Float
, n22 :: !Float
, n32 :: !Float
, n13 :: !Float
, n23 :: !Float
, n33 :: !Float }
deriving ( Eq, Show, Read, Ord, Typeable )
data Vector3 = Vector3 { x :: !Float
, y :: !Float
, z :: !Float }
deriving ( Eq, Show, Read, Ord, Typeable )
_x :: Lens' Vector3 Float
_x = lens x (\old_vec new_x -> old_vec { x = new_x })
_y :: Lens' Vector3 Float
_y = lens y (\old_vec new_y -> old_vec { y = new_y })
_z :: Lens' Vector3 Float
_z = lens z (\old_vec new_z -> old_vec { z = new_z })
data Quaternion = Quaternion { qx :: !Float
, qy :: !Float
, qz :: !Float
, qw :: !Float }
deriving ( Eq, Show, Read, Ord, Typeable )
sizeOfVector3 :: Int
sizeOfVector3 = sizeOf (undefined :: Vector3)
sizeOfMatrix33 :: Int
sizeOfMatrix33 = sizeOf (undefined :: Matrix33)
sizeOfMatrix44 :: Int
sizeOfMatrix44 = sizeOf (undefined :: Matrix44)
sizeOfQuaternion :: Int
sizeOfQuaternion = sizeOf (undefined :: Quaternion)
instance Storable Vector3 where
sizeOf _ = sizeOf (undefined :: Float) * 3
alignment _ = alignment (undefined :: Float)
peek ptr = do
x <- peekElemOff cptr 0 :: IO Float
y <- peekElemOff cptr 1 :: IO Float
z <- peekElemOff cptr 2 :: IO Float
return $ Vector3 x y z
where
cptr = castPtr ptr :: Ptr Float
poke ptr (Vector3 x y z) = do
pokeElemOff cptr 0 x
pokeElemOff cptr 1 y
pokeElemOff cptr 2 z
where
cptr = castPtr ptr :: Ptr Float
instance Storable Quaternion where
sizeOf _ = sizeOf (undefined :: Float) * 4
alignment _ = alignment (undefined :: Float)
peek ptr = do
x <- peekElemOff cptr 0 :: IO Float
y <- peekElemOff cptr 1 :: IO Float
z <- peekElemOff cptr 2 :: IO Float
w <- peekElemOff cptr 3 :: IO Float
return $ Quaternion x y z w
where
cptr = castPtr ptr :: Ptr Float
poke ptr (Quaternion x y z w) = do
pokeElemOff cptr 0 x
pokeElemOff cptr 1 y
pokeElemOff cptr 2 z
pokeElemOff cptr 3 w
where
cptr = castPtr ptr :: Ptr Float
instance Storable Matrix44 where
sizeOf _ = sizeOf (undefined :: Float) * 16
alignment _ = alignment (undefined :: Float)
peek ptr = do
r11 <- peekElemOff cptr 0 :: IO Float
r21 <- peekElemOff cptr 1 :: IO Float
r31 <- peekElemOff cptr 2 :: IO Float
r41 <- peekElemOff cptr 3 :: IO Float
r12 <- peekElemOff cptr 4 :: IO Float
r22 <- peekElemOff cptr 5 :: IO Float
r32 <- peekElemOff cptr 6 :: IO Float
r42 <- peekElemOff cptr 7 :: IO Float
r13 <- peekElemOff cptr 8 :: IO Float
r23 <- peekElemOff cptr 9 :: IO Float
r33 <- peekElemOff cptr 10 :: IO Float
r43 <- peekElemOff cptr 11 :: IO Float
r14 <- peekElemOff cptr 12 :: IO Float
r24 <- peekElemOff cptr 13 :: IO Float
r34 <- peekElemOff cptr 14 :: IO Float
r44 <- peekElemOff cptr 15 :: IO Float
return $ matrix44 r11 r12 r13 r14
r21 r22 r23 r24
r31 r32 r33 r34
r41 r42 r43 r44
where
cptr = castPtr ptr :: Ptr Float
poke ptr mat = do
pokeElemOff cptr 0 f11
pokeElemOff cptr 1 f21
pokeElemOff cptr 2 f31
pokeElemOff cptr 3 f41
pokeElemOff cptr 4 f12
pokeElemOff cptr 5 f22
pokeElemOff cptr 6 f32
pokeElemOff cptr 7 f42
pokeElemOff cptr 8 f13
pokeElemOff cptr 9 f23
pokeElemOff cptr 10 f33
pokeElemOff cptr 11 f43
pokeElemOff cptr 12 f14
pokeElemOff cptr 13 f24
pokeElemOff cptr 14 f34
pokeElemOff cptr 15 f44
where
cptr = castPtr ptr :: Ptr Float
f11 = m11 mat
f21 = m21 mat
f31 = m31 mat
f41 = m41 mat
f12 = m12 mat
f22 = m22 mat
f32 = m32 mat
f42 = m42 mat
f13 = m13 mat
f23 = m23 mat
f33 = m33 mat
f43 = m43 mat
f14 = m14 mat
f24 = m24 mat
f34 = m34 mat
f44 = m44 mat
instance Storable Matrix33 where
sizeOf _ = sizeOf (undefined :: CFloat) * 9
alignment _ = alignment (undefined :: CFloat)
peek ptr = do
r11 <- peekElemOff cptr 0 :: IO Float
r21 <- peekElemOff cptr 1 :: IO Float
r31 <- peekElemOff cptr 2 :: IO Float
r12 <- peekElemOff cptr 3 :: IO Float
r22 <- peekElemOff cptr 4 :: IO Float
r32 <- peekElemOff cptr 5 :: IO Float
r13 <- peekElemOff cptr 6 :: IO Float
r23 <- peekElemOff cptr 7 :: IO Float
r33 <- peekElemOff cptr 8 :: IO Float
return $ matrix33 r11 r12 r13
r21 r22 r23
r31 r32 r33
where
cptr = castPtr ptr :: Ptr Float
poke ptr mat = do
pokeElemOff cptr 0 f11
pokeElemOff cptr 1 f21
pokeElemOff cptr 2 f31
pokeElemOff cptr 3 f12
pokeElemOff cptr 4 f22
pokeElemOff cptr 5 f32
pokeElemOff cptr 6 f13
pokeElemOff cptr 7 f23
pokeElemOff cptr 8 f33
where
cptr = castPtr ptr :: Ptr Float
f11 = n11 mat
f21 = n21 mat
f31 = n31 mat
f12 = n12 mat
f22 = n22 mat
f32 = n32 mat
f13 = n13 mat
f23 = n23 mat
f33 = n33 mat
vector3 :: Float
-> Float
-> Float
-> Vector3
vector3 !x !y !z = Vector3 { x = x, y = y, z = z }
matrix44 :: Float
-> Float
-> Float
-> Float
-> Float
-> Float
-> Float
-> Float
-> Float
-> Float
-> Float
-> Float
-> Float
-> Float
-> Float
-> Float
-> Matrix44
matrix44 !m11 !m12 !m13 !m14
!m21 !m22 !m23 !m24
!m31 !m32 !m33 !m34
!m41 !m42 !m43 !m44 =
Matrix44 { m11 = m11
, m21 = m21
, m31 = m31
, m41 = m41
, m12 = m12
, m22 = m22
, m32 = m32
, m42 = m42
, m13 = m13
, m23 = m23
, m33 = m33
, m43 = m43
, m14 = m14
, m24 = m24
, m34 = m34
, m44 = m44 }
matrix33 :: Float
-> Float
-> Float
-> Float
-> Float
-> Float
-> Float
-> Float
-> Float
-> Matrix33
matrix33 !m11 !m12 !m13
!m21 !m22 !m23
!m31 !m32 !m33 =
Matrix33 { n11 = m11
, n21 = m21
, n31 = m31
, n12 = m12
, n22 = m22
, n32 = m32
, n13 = m13
, n23 = m23
, n33 = m33 }
matrix33ToMatrix44 :: Matrix33 -> Matrix44
matrix33ToMatrix44 !mat =
Matrix44 { m11 = f11
, m21 = f21
, m31 = f31
, m12 = f12
, m22 = f22
, m32 = f32
, m13 = f13
, m23 = f23
, m33 = f33
, m41 = 0.0
, m42 = 0.0
, m43 = 0.0
, m44 = 1.0
, m14 = 0.0
, m24 = 0.0
, m34 = 0.0 }
where
f11 = n11 mat
f21 = n21 mat
f31 = n31 mat
f12 = n12 mat
f22 = n22 mat
f32 = n32 mat
f13 = n13 mat
f23 = n23 mat
f33 = n33 mat
matrix44ToMatrix33 :: Matrix44 -> Matrix33
matrix44ToMatrix33 !mat =
Matrix33 { n11 = f11
, n21 = f21
, n31 = f31
, n12 = f12
, n22 = f22
, n32 = f32
, n13 = f13
, n23 = f23
, n33 = f33 }
where
f11 = m11 mat
f21 = m21 mat
f31 = m31 mat
f12 = m12 mat
f22 = m22 mat
f32 = m32 mat
f13 = m13 mat
f23 = m23 mat
f33 = m33 mat
withMatrix44Ptr :: Matrix44
-> (Ptr CFloat -> IO a)
-> IO a
withMatrix44Ptr mat action =
allocaArray 16 $ \ptr -> do
pokeElemOff ptr 0 (CFloat $ m11 mat)
pokeElemOff ptr 1 (CFloat $ m21 mat)
pokeElemOff ptr 2 (CFloat $ m31 mat)
pokeElemOff ptr 3 (CFloat $ m41 mat)
pokeElemOff ptr 4 (CFloat $ m12 mat)
pokeElemOff ptr 5 (CFloat $ m22 mat)
pokeElemOff ptr 6 (CFloat $ m32 mat)
pokeElemOff ptr 7 (CFloat $ m42 mat)
pokeElemOff ptr 8 (CFloat $ m13 mat)
pokeElemOff ptr 9 (CFloat $ m23 mat)
pokeElemOff ptr 10 (CFloat $ m33 mat)
pokeElemOff ptr 11 (CFloat $ m43 mat)
pokeElemOff ptr 12 (CFloat $ m14 mat)
pokeElemOff ptr 13 (CFloat $ m24 mat)
pokeElemOff ptr 14 (CFloat $ m34 mat)
pokeElemOff ptr 15 (CFloat $ m44 mat)
action ptr
withMatrix33Ptr :: Matrix33 -> (Ptr CFloat -> IO a) -> IO a
withMatrix33Ptr mat action =
allocaArray 9 $ \ptr -> do
pokeElemOff ptr 0 (CFloat $ n11 mat)
pokeElemOff ptr 1 (CFloat $ n21 mat)
pokeElemOff ptr 2 (CFloat $ n31 mat)
pokeElemOff ptr 3 (CFloat $ n12 mat)
pokeElemOff ptr 4 (CFloat $ n22 mat)
pokeElemOff ptr 5 (CFloat $ n32 mat)
pokeElemOff ptr 6 (CFloat $ n13 mat)
pokeElemOff ptr 7 (CFloat $ n23 mat)
pokeElemOff ptr 8 (CFloat $ n33 mat)
action ptr
identity33 :: Matrix33
identity33 =
Matrix33 { n11 = 1.0
, n21 = 0.0
, n31 = 0.0
, n12 = 0.0
, n22 = 1.0
, n32 = 0.0
, n13 = 0.0
, n23 = 0.0
, n33 = 1.0 }
zero33 :: Matrix33
zero33 =
Matrix33 { n11 = 0.0
, n21 = 0.0
, n31 = 0.0
, n12 = 0.0
, n22 = 0.0
, n32 = 0.0
, n13 = 0.0
, n23 = 0.0
, n33 = 0.0 }
identity44 :: Matrix44
identity44 =
Matrix44 { m11 = 1.0
, m21 = 0.0
, m31 = 0.0
, m41 = 0.0
, m12 = 0.0
, m22 = 1.0
, m32 = 0.0
, m42 = 0.0
, m13 = 0.0
, m23 = 0.0
, m33 = 1.0
, m43 = 0.0
, m14 = 0.0
, m24 = 0.0
, m34 = 0.0
, m44 = 1.0 }
zero44 :: Matrix44
zero44 =
Matrix44 { m11 = 0.0
, m21 = 0.0
, m31 = 0.0
, m41 = 0.0
, m12 = 0.0
, m22 = 0.0
, m32 = 0.0
, m42 = 0.0
, m13 = 0.0
, m23 = 0.0
, m33 = 0.0
, m43 = 0.0
, m14 = 0.0
, m24 = 0.0
, m34 = 0.0
, m44 = 0.0 }
inverse44 :: Matrix44 -> Matrix44
inverse44 !mat4 =
Matrix44 { m11 = (f11 * b11 f12 * b10 + f13 * b9) * det
, m12 = (f02 * b10 f01 * b11 f03 * b9) * det
, m13 = (f31 * b5 f32 * b4 + f33 * b3) * det
, m14 = (f22 * b4 f21 * b5 f23 * b3) * det
, m21 = (f12 * b8 f10 * b11 f13 * b7) * det
, m22 = (f00 * b11 f02 * b8 + f03 * b7) * det
, m23 = (f32 * b2 f30 * b5 f33 * b1) * det
, m24 = (f20 * b5 f22 * b2 + f23 * b1) * det
, m31 = (f10 * b10 f11 * b8 + f13 * b6) * det
, m32 = (f01 * b8 f00 * b10 f03 * b6) * det
, m33 = (f30 * b4 f31 * b2 + f33 * b0) * det
, m34 = (f21 * b2 f20 * b4 f23 * b0) * det
, m41 = (f11 * b7 f10 * b9 f12 * b6) * det
, m42 = (f00 * b9 f01 * b7 + f02 * b6) * det
, m43 = (f31 * b1 f30 * b3 f32 * b0) * det
, m44 = (f20 * b3 f21 * b1 + f22 * b0) * det }
where
f00 = m11 mat4
f10 = m21 mat4
f20 = m31 mat4
f30 = m41 mat4
f01 = m12 mat4
f11 = m22 mat4
f21 = m32 mat4
f31 = m42 mat4
f02 = m13 mat4
f12 = m23 mat4
f22 = m33 mat4
f32 = m43 mat4
f03 = m14 mat4
f13 = m24 mat4
f23 = m34 mat4
f33 = m44 mat4
b0 = f00 * f11 f01 * f10
b1 = f00 * f12 f02 * f10
b2 = f00 * f13 f03 * f10
b3 = f01 * f12 f02 * f11
b4 = f01 * f13 f03 * f11
b5 = f02 * f13 f03 * f12
b6 = f20 * f31 f21 * f30
b7 = f20 * f32 f22 * f30
b8 = f20 * f33 f23 * f30
b9 = f21 * f32 f22 * f31
b10 = f21 * f33 f23 * f31
b11 = f22 * f33 f23 * f32
det' = b0*b11 b1*b10 + b2*b9 + b3*b8 b4*b7 + b5*b6
det = 1.0 / det'
determinant33 :: Matrix33 -> Float
determinant33 !mat = det'
where
det' = f11*f22*f33 + f12*f23*f31 + f13*f21*f32
f13*f22*f31 f12*f21*f33 f11*f23*f32
f11 = n11 mat
f21 = n21 mat
f31 = n31 mat
f12 = n12 mat
f22 = n22 mat
f32 = n32 mat
f13 = n13 mat
f23 = n23 mat
f33 = n33 mat
inverse33 :: Matrix33 -> Matrix33
inverse33 !mat =
Matrix33 { n11 = (f22*f33f23*f32)*det'
, n12 = (f13*f32f12*f33)*det'
, n13 = (f12*f23f13*f22)*det'
, n21 = (f23*f31f21*f33)*det'
, n22 = (f11*f33f13*f31)*det'
, n23 = (f13*f21f11*f23)*det'
, n31 = (f21*f32f22*f31)*det'
, n32 = (f12*f31f11*f32)*det'
, n33 = (f11*f22f12*f21)*det' }
where
det' = 1.0 /
(f11*f22*f33 + f12*f23*f31 + f13*f21*f32
f13*f22*f31 f12*f21*f33 f11*f23*f32)
f11 = n11 mat
f21 = n21 mat
f31 = n31 mat
f12 = n12 mat
f22 = n22 mat
f32 = n32 mat
f13 = n13 mat
f23 = n23 mat
f33 = n33 mat
determinant44 :: Matrix44 -> Float
determinant44 !mat = det'
where
det' = b0*b11 b1*b10 + b2*b9 + b3*b8 b4*b7 + b5*b6
f00 = m11 mat
f10 = m21 mat
f20 = m31 mat
f30 = m41 mat
f01 = m12 mat
f11 = m22 mat
f21 = m32 mat
f31 = m42 mat
f02 = m13 mat
f12 = m23 mat
f22 = m33 mat
f32 = m43 mat
f03 = m14 mat
f13 = m24 mat
f23 = m34 mat
f33 = m44 mat
b0 = f00 * f11 f01 * f10
b1 = f00 * f12 f02 * f10
b2 = f00 * f13 f03 * f10
b3 = f01 * f12 f02 * f11
b4 = f01 * f13 f03 * f11
b5 = f02 * f13 f03 * f12
b6 = f20 * f31 f21 * f30
b7 = f20 * f32 f22 * f30
b8 = f20 * f33 f23 * f30
b9 = f21 * f32 f22 * f31
b10 = f21 * f33 f23 * f31
b11 = f22 * f33 f23 * f32
multiply33 :: Matrix33 -> Matrix33 -> Matrix33
multiply33 !mat1 !mat2 =
Matrix33 { n11 = s11*f11 + s21*f12 + s31*f13
, n21 = s11*f21 + s21*f22 + s31*f23
, n31 = s11*f31 + s21*f32 + s31*f33
, n12 = s12*f11 + s22*f12 + s32*f13
, n22 = s12*f21 + s22*f22 + s32*f23
, n32 = s12*f31 + s22*f32 + s32*f33
, n13 = s13*f11 + s23*f12 + s33*f13
, n23 = s13*f21 + s23*f22 + s33*f23
, n33 = s13*f31 + s23*f32 + s33*f33 }
where
f11 = n11 mat1
f21 = n21 mat1
f31 = n31 mat1
f12 = n12 mat1
f22 = n22 mat1
f32 = n32 mat1
f13 = n13 mat1
f23 = n23 mat1
f33 = n33 mat1
s11 = n11 mat2
s21 = n21 mat2
s31 = n31 mat2
s12 = n12 mat2
s22 = n22 mat2
s32 = n32 mat2
s13 = n13 mat2
s23 = n23 mat2
s33 = n33 mat2
multiply44 :: Matrix44 -> Matrix44 -> Matrix44
multiply44 !mat1 !mat2 =
Matrix44 { m11 = s11*f11 + s21*f12 + s31*f13 + s41*f14
, m21 = s11*f21 + s21*f22 + s31*f23 + s41*f24
, m31 = s11*f31 + s21*f32 + s31*f33 + s41*f34
, m41 = s11*f41 + s21*f42 + s31*f43 + s41*f44
, m12 = s12*f11 + s22*f12 + s32*f13 + s42*f14
, m22 = s12*f21 + s22*f22 + s32*f23 + s42*f24
, m32 = s12*f31 + s22*f32 + s32*f33 + s42*f34
, m42 = s12*f41 + s22*f42 + s32*f43 + s42*f44
, m13 = s13*f11 + s23*f12 + s33*f13 + s43*f14
, m23 = s13*f21 + s23*f22 + s33*f23 + s43*f24
, m33 = s13*f31 + s23*f32 + s33*f33 + s43*f34
, m43 = s13*f41 + s23*f42 + s33*f43 + s43*f44
, m14 = s14*f11 + s24*f12 + s34*f13 + s44*f14
, m24 = s14*f21 + s24*f22 + s34*f23 + s44*f24
, m34 = s14*f31 + s24*f32 + s34*f33 + s44*f34
, m44 = s14*f41 + s24*f42 + s34*f43 + s44*f44 }
where
f11 = m11 mat1
f21 = m21 mat1
f31 = m31 mat1
f41 = m41 mat1
f12 = m12 mat1
f22 = m22 mat1
f32 = m32 mat1
f42 = m42 mat1
f13 = m13 mat1
f23 = m23 mat1
f33 = m33 mat1
f43 = m43 mat1
f14 = m14 mat1
f24 = m24 mat1
f34 = m34 mat1
f44 = m44 mat1
s11 = m11 mat2
s21 = m21 mat2
s31 = m31 mat2
s41 = m41 mat2
s12 = m12 mat2
s22 = m22 mat2
s32 = m32 mat2
s42 = m42 mat2
s13 = m13 mat2
s23 = m23 mat2
s33 = m33 mat2
s43 = m43 mat2
s14 = m14 mat2
s24 = m24 mat2
s34 = m34 mat2
s44 = m44 mat2
distance33 :: Matrix33 -> Matrix33 -> Float
distance33 !mat1 !mat2 =
sqrt $ (f11s11)**2+
(f12s12)**2+
(f13s13)**2+
(f21s21)**2+
(f22s22)**2+
(f23s23)**2+
(f31s31)**2+
(f32s32)**2+
(f33s33)**2
where
f11 = n11 mat1
f21 = n21 mat1
f31 = n31 mat1
f12 = n12 mat1
f22 = n22 mat1
f32 = n32 mat1
f13 = n13 mat1
f23 = n23 mat1
f33 = n33 mat1
s11 = n11 mat2
s21 = n21 mat2
s31 = n31 mat2
s12 = n12 mat2
s22 = n22 mat2
s32 = n32 mat2
s13 = n13 mat2
s23 = n23 mat2
s33 = n33 mat2
distance44 :: Matrix44 -> Matrix44 -> Float
distance44 !mat1 !mat2 =
sqrt $ (f11s11)**2+
(f12s12)**2+
(f13s13)**2+
(f14s14)**2+
(f21s21)**2+
(f22s22)**2+
(f23s23)**2+
(f24s24)**2+
(f31s31)**2+
(f32s32)**2+
(f33s33)**2+
(f34s34)**2+
(f41s41)**2+
(f42s42)**2+
(f43s43)**2+
(f44s44)**2
where
f11 = m11 mat1
f21 = m21 mat1
f31 = m31 mat1
f41 = m41 mat1
f12 = m12 mat1
f22 = m22 mat1
f32 = m32 mat1
f42 = m42 mat1
f13 = m13 mat1
f23 = m23 mat1
f33 = m33 mat1
f43 = m43 mat1
f14 = m14 mat1
f24 = m24 mat1
f34 = m34 mat1
f44 = m44 mat1
s11 = m11 mat2
s21 = m21 mat2
s31 = m31 mat2
s41 = m41 mat2
s12 = m12 mat2
s22 = m22 mat2
s32 = m32 mat2
s42 = m42 mat2
s13 = m13 mat2
s23 = m23 mat2
s33 = m33 mat2
s43 = m43 mat2
s14 = m14 mat2
s24 = m24 mat2
s34 = m34 mat2
s44 = m44 mat2
perspective44 :: Float
-> Float
-> Float
-> Float
-> Matrix44
perspective44 !fov_y !aspect_ratio !near !far =
frustum44 (right) right (top) top near far
where
top = near * tan fov_y
right = top * aspect_ratio
frustum44 :: Float
-> Float
-> Float
-> Float
-> Float
-> Float
-> Matrix44
frustum44 !left !right !bottom !top !near !far =
zero44 { m11 = n2 * rl
, m22 = n2 * tb
, m13 = (right + left) * rl
, m23 = (top + bottom) * tb
, m33 = (far + near) * nf
, m43 = 1.0
, m34 = far * n2 * nf }
where
rl = 1.0 / (right left)
tb = 1.0 / (top bottom)
nf = 1.0 / (near far)
n2 = near * 2.0
ortho44 :: Float
-> Float
-> Float
-> Float
-> Float
-> Float
-> Matrix44
ortho44 !left !right !bottom !top !near !far =
zero44 { m11 = (2.0) * lr
, m22 = (2.0) * bt
, m33 = 2.0 * nf
, m14 = (left + right) * lr
, m24 = (top + bottom) * bt
, m34 = (far + near) * nf
, m44 = 1.0 }
where
lr = 1.0 / (left right)
bt = 1.0 / (bottom top)
nf = 1.0 / (near far)
lookat44 :: Vector3
-> Vector3
-> Vector3
-> Matrix44
lookat44 eye@(Vector3 !eyex !eyey !eyez) !center (Vector3 !ux !uy !uz)
| ec_len < 0.000001 = identity44
| otherwise =
Matrix44 { m11 = xx, m21 = yx, m31 = ecx, m41 = 0.0
, m12 = xy, m22 = yy, m32 = ecy, m42 = 0.0
, m13 = xz, m23 = yz, m33 = ecz, m43 = 0.0
, m14 = (xx * eyex + xy * eyey + xz * eyez)
, m24 = (yx * eyex + yy * eyey + yz * eyez)
, m34 = (ecx * eyex + ecy * eyey + ecz * eyez)
, m44 = 1.0 }
where
ec = eye `minus3` center
Vector3 ecx ecy ecz = normalize3 ec
ec_len = length3 ec
yvec = Vector3 (ecy*xz ecz*xy)
(ecz*xx ecx*xz)
(ecx*xy ecy*xx)
Vector3 yx yy yz =
if length3 yvec == 0.0
then Vector3 0 0 0
else normalize3 yvec
xvec = Vector3 (uy*ecz uz*ecy)
(uz*ecx ux*ecz)
(ux*ecy uy*ecx)
Vector3 xx xy xz =
if length3 xvec == 0.0
then Vector3 0 0 0
else normalize3 xvec
normalize3 :: Vector3 -> Vector3
normalize3 v@(Vector3 !x !y !z) =
Vector3 (x*ilen) (y*ilen) (z*ilen)
where
ilen = 1.0 / length3 v
distance3 :: Vector3 -> Vector3 -> Float
distance3 (Vector3 !x1 !y1 !z1) (Vector3 !x2 !y2 !z2) =
sqrt $ (x2x1)**2 + (y2y1)**2 + (z2z1)**2
length3 :: Vector3 -> Float
length3 (Vector3 !x !y !z) = sqrt $ x**2 + y**2 + z**2
plus3 :: Vector3 -> Vector3 -> Vector3
plus3 (Vector3 !x1 !y1 !z1) (Vector3 !x2 !y2 !z2) =
Vector3 (x1+x2) (y1+y2) (z1+z2)
minus3 :: Vector3 -> Vector3 -> Vector3
minus3 (Vector3 !x1 !y1 !z1) (Vector3 !x2 !y2 !z2) =
Vector3 (x1x2) (y1y2) (z1z2)
negative3 :: Vector3 -> Vector3
negative3 (Vector3 !x !y !z) = Vector3 (x) (y) (z)
scalarMultiply3 :: Float -> Vector3 -> Vector3
scalarMultiply3 scalar (Vector3 !x !y !z) =
Vector3 (x*scalar) (y*scalar) (z*scalar)
scale44 :: Vector3
-> Matrix44
-> Matrix44
scale44 (Vector3 !x !y !z) !mat =
mat { m11 = f11*x
, m21 = f21*x
, m31 = f31*x
, m41 = f41*x
, m12 = f12*y
, m22 = f22*y
, m32 = f32*y
, m42 = f42*y
, m13 = f13*z
, m23 = f23*z
, m33 = f33*z
, m43 = f43*z }
where
f11 = m11 mat
f21 = m21 mat
f31 = m31 mat
f41 = m41 mat
f12 = m12 mat
f22 = m22 mat
f32 = m32 mat
f42 = m42 mat
f13 = m13 mat
f23 = m23 mat
f33 = m33 mat
f43 = m43 mat
transpose33 :: Matrix33 -> Matrix33
transpose33 !mat =
Matrix33 { n11 = f11
, n12 = f21
, n13 = f31
, n21 = f12
, n22 = f22
, n23 = f32
, n31 = f13
, n32 = f23
, n33 = f33 }
where
f11 = n11 mat
f21 = n21 mat
f31 = n31 mat
f12 = n12 mat
f22 = n22 mat
f32 = n32 mat
f13 = n13 mat
f23 = n23 mat
f33 = n33 mat
transpose44 :: Matrix44 -> Matrix44
transpose44 !mat =
Matrix44 { m11 = f11
, m12 = f21
, m13 = f31
, m14 = f41
, m21 = f12
, m22 = f22
, m23 = f32
, m24 = f42
, m31 = f13
, m32 = f23
, m33 = f33
, m34 = f43
, m41 = f14
, m42 = f24
, m43 = f34
, m44 = f44 }
where
f11 = m11 mat
f21 = m21 mat
f31 = m31 mat
f41 = m41 mat
f12 = m12 mat
f22 = m22 mat
f32 = m32 mat
f42 = m42 mat
f13 = m13 mat
f23 = m23 mat
f33 = m33 mat
f43 = m43 mat
f14 = m14 mat
f24 = m24 mat
f34 = m34 mat
f44 = m44 mat
translate44 :: Vector3
-> Matrix44
-> Matrix44
translate44 (Vector3 !x !y !z) !mat =
mat { m14 = f11*x + f12*y + f13*z + f14
, m24 = f21*x + f22*y + f23*z + f24
, m34 = f31*x + f32*y + f33*z + f34
, m44 = f41*x + f42*y + f43*z + f44 }
where
f11 = m11 mat
f21 = m21 mat
f31 = m31 mat
f41 = m41 mat
f12 = m12 mat
f22 = m22 mat
f32 = m32 mat
f42 = m42 mat
f13 = m13 mat
f23 = m23 mat
f33 = m33 mat
f43 = m43 mat
f14 = m14 mat
f24 = m24 mat
f34 = m34 mat
f44 = m44 mat
rotate44 :: Float
-> Vector3
-> Matrix44
-> Matrix44
rotate44 !radians !axis !mat =
mat { m11 = f11*r11 + f21*r12 + f31*r13
, m21 = f12*r11 + f21*r12 + f32*r13
, m31 = f13*r11 + f23*r12 + f33*r13
, m41 = f14*r11 + f24*r12 + f34*r13
, m12 = f11*r21 + f21*r22 + f31*r23
, m22 = f12*r21 + f22*r22 + f32*r23
, m32 = f13*r21 + f23*r22 + f33*r23
, m42 = f14*r21 + f24*r22 + f34*r23
, m13 = f11*r31 + f21*r32 + f31*r33
, m23 = f12*r31 + f22*r32 + f32*r33
, m33 = f13*r31 + f23*r32 + f33*r33
, m43 = f14*r31 + f24*r32 + f31*r33 }
where
r11 = x*x*t+cosf
r12 = y*x*t+z*sinf
r13 = z*x*ty*sinf
r21 = x*y*tz*sinf
r22 = y*y*t+cosf
r23 = z*y*t+x*sinf
r31 = x*z*t+y*sinf
r32 = y*z*tx*sinf
r33 = z*z*t+cosf
f11 = m11 mat
f21 = m21 mat
f31 = m31 mat
f12 = m12 mat
f22 = m22 mat
f32 = m32 mat
f13 = m13 mat
f23 = m23 mat
f33 = m33 mat
f14 = m14 mat
f24 = m24 mat
f34 = m34 mat
t = 1 cosf
sinf = sin radians
cosf = cos radians
(Vector3 !x !y !z) = normalize3 axis
vector3Transform44 :: Matrix44 -> Vector3 -> Vector3
vector3Transform44 !mat (Vector3 !x !y !z) =
Vector3 { x = f11*x + f12*y + f13*z + f14
, y = f21*x + f22*y + f23*z + f24
, z = f31*x + f32*y + f33*z + f34 }
where
f11 = m11 mat
f21 = m21 mat
f31 = m31 mat
f12 = m12 mat
f22 = m22 mat
f32 = m32 mat
f13 = m13 mat
f23 = m23 mat
f33 = m33 mat
f14 = m14 mat
f24 = m24 mat
f34 = m34 mat
cross3 :: Vector3 -> Vector3 -> Vector3
cross3 (Vector3 !x1 !y1 !z1) (Vector3 !x2 !y2 !z2) =
Vector3 { x = y1*z2 z1*y2
, y = z1*x2 x1*z2
, z = x1*y2 y1*x2 }
angle3 :: Vector3 -> Vector3 -> Float
angle3 v1 v2 = acos $ n1 `dot3` n2
where
n1 = normalize3 v1
n2 = normalize3 v2
dot3 :: Vector3 -> Vector3 -> Float
dot3 (Vector3 !x1 !y1 !z1) (Vector3 !x2 !y2 !z2) =
x1*x2 + y1*y2 + z1*z2
toTuple3 :: Vector3 -> (Float, Float, Float)
toTuple3 (Vector3 !x !y !z) = (x, y, z)
fromTuple3 :: (Float, Float, Float) -> Vector3
fromTuple3 (!x, !y, !z) =
Vector3 { x = x, y = y, z = z }
zero3 :: Vector3
zero3 = Vector3 { x = 0, y = 0, z = 0 }
toList4 :: Matrix44 -> [Float]
toList4 mat =
(\f -> f mat) <$>
[m11, m21, m31, m41
,m12, m22, m32, m42
,m13, m23, m33, m43
,m14, m24, m34, m44]
quaternion :: Float
-> Float
-> Float
-> Float
-> Quaternion
quaternion !x !y !z !w =
Quaternion { qx = x, qy = y, qz = z, qw = w }
toTupleq :: Quaternion -> (Float, Float, Float, Float)
toTupleq (Quaternion !x !y !z !w) = (x, y, z, w)
fromTupleq :: (Float, Float, Float, Float) -> Quaternion
fromTupleq (!x, !y, !z, !w) = Quaternion x y z w
canonicalizeq :: Quaternion -> Quaternion
canonicalizeq q@(Quaternion !x !y !z !w) =
canonicalizeq'
where
canonicalizeq'
| w > 0 = q
| otherwise = Quaternion (x) (y) (z) (w)
normalizeq :: Quaternion -> Quaternion
normalizeq (Quaternion !x !y !z !w) =
Quaternion (x*t) (y*t) (z*t) (w*t)
where
t = 1.0 / sqrt (x*x + y*y + z*z + w*w)
distanceq :: Quaternion -> Quaternion -> Float
distanceq (Quaternion !x1 !y1 !z1 !w1)
(Quaternion !x2 !y2 !z2 !w2) =
sqrt $ (x1x2)**2 + (y1y2)**2 + (z1z2)**2 + (w1w2)**2
lengthq :: Quaternion -> Float
lengthq (Quaternion !x !y !z !w) =
sqrt $ x*x + y*y + z*z + w*w
axisAngleToQuaternion :: Float
-> Vector3
-> Quaternion
axisAngleToQuaternion !radians !vec =
Quaternion { qx = x * sin_angle
, qy = y * sin_angle
, qz = z * sin_angle
, qw = cos hangle }
where
Vector3 x y z = normalize3 vec
sin_angle = sin hangle
hangle = radians * 0.5
zeroq :: Quaternion
zeroq = Quaternion 0 0 0 0
quaternionToMatrix44 :: Quaternion -> Matrix44
quaternionToMatrix44 !q =
identity44 { m11 = 1 yy2 zz2
, m22 = 1 xx2 zz2
, m33 = 1 xx2 yy2
, m32 = yz2 wx2
, m23 = yz2 + wx2
, m21 = xy2 wz2
, m12 = xy2 + wz2
, m13 = xz2 wy2
, m31 = xz2 + wy2 }
where
Quaternion x y z w = normalizeq q
x2 = x+x
y2 = y+y
z2 = z+z
xx2 = x*x2
yy2 = y*y2
zz2 = z*z2
yz2 = y*z2
wx2 = w*x2
xy2 = x*y2
wz2 = w*z2
xz2 = x*z2
wy2 = w*y2
matrix44ToQuaternion :: Matrix44 -> Quaternion
matrix44ToQuaternion !mat =
matrix44ToQuaternion'
where
matrix44ToQuaternion'
| trace > 0 =
let t = trace + 1
s = 0.5 * isqrt t
in Quaternion { qw = s * t
, qz = (f12 f21) * s
, qy = (f31 f13) * s
, qx = (f23 f32) * s }
| f11 > f22 && f11 > f33 =
let t = f11 f22 f33 + 1
s = 0.5 * isqrt t
in Quaternion { qx = s * t
, qy = (f12 + f21) * s
, qz = (f31 + f13) * s
, qw = (f23 f32) * s }
| f22 > f33 =
let t = (f11) + f22 f33 + 1
s = 0.5 * isqrt t
in Quaternion { qy = s * t
, qx = (f12 + f21) * s
, qw = (f31 f13) * s
, qz = (f23 + f32) * s }
| otherwise =
let t = (f11) f22 + f33 + 1
s = 0.5 * isqrt t
in Quaternion { qz = s * t
, qw = (f12 f21) * s
, qx = (f31 + f13) * s
, qy = (f23 + f32) * s }
trace = f11 + f22 + f33
isqrt = (1.0 /) . sqrt
f11 = m11 mat
f21 = m21 mat
f31 = m31 mat
f12 = m12 mat
f22 = m22 mat
f32 = m32 mat
f13 = m13 mat
f23 = m23 mat
f33 = m33 mat
identityq :: Quaternion
identityq = quaternion 0 0 0 1
vector3_1ToQuaternion :: Vector3 -> Float -> Quaternion
vector3_1ToQuaternion (Vector3 x y z) = quaternion x y z
multiplyq :: Quaternion -> Quaternion -> Quaternion
multiplyq (Quaternion !x1 !y1 !z1 !w1)
(Quaternion !x2 !y2 !z2 !w2) =
Quaternion { qw = w1*w2 x1*x2 y1*y2 z1*z2
, qx = w1*x2 + x1*w2 + y1*z2 z1*y2
, qy = w1*y2 x1*z2 + y1*w2 + z1*x2
, qz = w1*z2 + x1*y2 y1*x2 + z1*w2 }
pad :: Int -> String -> String
pad wanted_len str
| len < wanted_len = str ++ replicate (wanted_len len) ' '
| otherwise = str
where
len = length str
prettyShow :: Matrix44 -> String
prettyShow mat =
lines [[f11,f12,f13,f14],[f21,f22,f23,f24],
[f31,f32,f33,f34],[f41,f42,f43,f44]]
where
lines = concatMap ((++ "\n") . line)
line marks =
"[ " ++ concatMap ((" " ++) . pad wanted_len . show) marks ++ " ]"
wanted_len = 1 + maximum (map (length . show) $ toList4 mat)
f11 = m11 mat
f21 = m21 mat
f31 = m31 mat
f41 = m41 mat
f12 = m12 mat
f22 = m22 mat
f32 = m32 mat
f42 = m42 mat
f13 = m13 mat
f23 = m23 mat
f33 = m33 mat
f43 = m43 mat
f14 = m14 mat
f24 = m24 mat
f34 = m34 mat
f44 = m44 mat