aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorMarc Sunet <jeannekamikaze@gmail.com>2012-08-06 13:25:11 +0200
committerMarc Sunet <jeannekamikaze@gmail.com>2012-08-06 13:25:11 +0200
commit4d622a038f7a4e34a3252843aacfa70fd072f502 (patch)
treeaaec6cf752cec4f70b20af28cae9715577fc0bae
parent6bb5583d7087419861b250c83f8783996bf5f9f8 (diff)
Initial implementation
-rw-r--r--Spear/Math/Quaternion.hs109
1 files changed, 109 insertions, 0 deletions
diff --git a/Spear/Math/Quaternion.hs b/Spear/Math/Quaternion.hs
index e69de29..4eb88d7 100644
--- a/Spear/Math/Quaternion.hs
+++ b/Spear/Math/Quaternion.hs
@@ -0,0 +1,109 @@
1module Spear.Math.Quaternion
2(
3 Quaternion
4 -- * Construction
5, quat
6, qvec4
7, qvec3
8, qAxisAngle
9 -- * Operations
10, qmul
11, qconj
12, qinv
13, Spear.Math.Quaternion.normalise
14, Spear.Math.Quaternion.norm
15, qrot
16)
17where
18
19
20import qualified Spear.Math.Vector3 as V3
21import Spear.Math.Vector4 as V4
22
23
24newtype Quaternion = Quaternion { getVec :: Vector4 }
25
26
27-- | Build a 'Quaternion'.
28quat :: Float -- x
29 -> Float -- y
30 -> Float -- z
31 -> Float -- w
32 -> Quaternion
33quat x y z w = Quaternion $ vec4 x y z w
34
35
36-- | Build a 'Quaternion' from the given 'Vector4'.
37qvec4 :: Vector4 -> Quaternion
38qvec4 = Quaternion
39
40
41-- | Build a 'Quaternion' from the given 'Vector3' and w.
42qvec3 :: V3.Vector3 -> Float -> Quaternion
43qvec3 v w = Quaternion $ vec4 (V3.x v) (V3.y v) (V3.z v) w
44
45
46-- | Build a 'Quaternion' representing the given rotation.
47qAxisAngle :: V3.Vector3 -> Float -> Quaternion
48qAxisAngle axis angle =
49 let s' = V3.norm axis
50 s = if s' == 0 then 1 else s'
51 a = angle * toRAD * 0.5
52 sa = sin a
53 w = cos a
54 x = V3.x axis * sa * s
55 y = V3.y axis * sa * s
56 z = V3.z axis * sa * s
57 in
58 Quaternion $ vec4 x y z w
59
60
61-- | Compute the product of the given two quaternions.
62qmul :: Quaternion -> Quaternion -> Quaternion
63qmul (Quaternion q1) (Quaternion q2) =
64 let x1 = x q1
65 y1 = y q1
66 z1 = z q1
67 w1 = w q1
68 x2 = x q2
69 y2 = y q2
70 z2 = y q2
71 w2 = w q2
72 w' = w1*w2 - x1*x2 - y1*y2 - z1*z2
73 x' = w1*x2 + x1*w2 + y1*z2 - z1*y2
74 y' = w1*y2 - x1*z2 + y1*w2 + z1*x2
75 z' = w1*z2 + x1*y2 - y1*x2 + z1*w2
76 in
77 Quaternion $ vec4 x' y' z' w'
78
79
80-- | Compute the conjugate of the given 'Quaternion'.
81qconj :: Quaternion -> Quaternion
82qconj (Quaternion q) = Quaternion $ vec4 (-x q) (-y q) (-z q) (w q)
83
84
85-- | Invert the given 'Quaternion'.
86qinv :: Quaternion -> Quaternion
87qinv (Quaternion q) =
88 let m = normSq q
89 in Quaternion $ vec4 (-x q / m) (-y q / m) (-z q / m) (w q / m)
90
91
92-- | Normalise the given 'Quaternion'.
93normalise :: Quaternion -> Quaternion
94normalise = Quaternion . V4.normalise . getVec
95
96
97-- | Compute the norm of the given 'Quaternion'.
98norm :: Quaternion -> Float
99norm = V4.norm . getVec
100
101
102-- | Rotate the given 'Vector3'.
103qrot :: Quaternion -> V3.Vector3 -> V3.Vector3
104qrot q v = toVec3 $ q `qmul` qvec3 v 0 `qmul` qconj q
105 where toVec3 (Quaternion q) = V3.vec3 (x q) (y q) (z q)
106
107
108toRAD = pi / 180
109