diff options
author | Marc Sunet <jeannekamikaze@gmail.com> | 2012-08-06 13:25:11 +0200 |
---|---|---|
committer | Marc Sunet <jeannekamikaze@gmail.com> | 2012-08-06 13:25:11 +0200 |
commit | 4d622a038f7a4e34a3252843aacfa70fd072f502 (patch) | |
tree | aaec6cf752cec4f70b20af28cae9715577fc0bae | |
parent | 6bb5583d7087419861b250c83f8783996bf5f9f8 (diff) |
Initial implementation
-rw-r--r-- | Spear/Math/Quaternion.hs | 109 |
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 @@ | |||
1 | module 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 | ) | ||
17 | where | ||
18 | |||
19 | |||
20 | import qualified Spear.Math.Vector3 as V3 | ||
21 | import Spear.Math.Vector4 as V4 | ||
22 | |||
23 | |||
24 | newtype Quaternion = Quaternion { getVec :: Vector4 } | ||
25 | |||
26 | |||
27 | -- | Build a 'Quaternion'. | ||
28 | quat :: Float -- x | ||
29 | -> Float -- y | ||
30 | -> Float -- z | ||
31 | -> Float -- w | ||
32 | -> Quaternion | ||
33 | quat x y z w = Quaternion $ vec4 x y z w | ||
34 | |||
35 | |||
36 | -- | Build a 'Quaternion' from the given 'Vector4'. | ||
37 | qvec4 :: Vector4 -> Quaternion | ||
38 | qvec4 = Quaternion | ||
39 | |||
40 | |||
41 | -- | Build a 'Quaternion' from the given 'Vector3' and w. | ||
42 | qvec3 :: V3.Vector3 -> Float -> Quaternion | ||
43 | qvec3 v w = Quaternion $ vec4 (V3.x v) (V3.y v) (V3.z v) w | ||
44 | |||
45 | |||
46 | -- | Build a 'Quaternion' representing the given rotation. | ||
47 | qAxisAngle :: V3.Vector3 -> Float -> Quaternion | ||
48 | qAxisAngle 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. | ||
62 | qmul :: Quaternion -> Quaternion -> Quaternion | ||
63 | qmul (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'. | ||
81 | qconj :: Quaternion -> Quaternion | ||
82 | qconj (Quaternion q) = Quaternion $ vec4 (-x q) (-y q) (-z q) (w q) | ||
83 | |||
84 | |||
85 | -- | Invert the given 'Quaternion'. | ||
86 | qinv :: Quaternion -> Quaternion | ||
87 | qinv (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'. | ||
93 | normalise :: Quaternion -> Quaternion | ||
94 | normalise = Quaternion . V4.normalise . getVec | ||
95 | |||
96 | |||
97 | -- | Compute the norm of the given 'Quaternion'. | ||
98 | norm :: Quaternion -> Float | ||
99 | norm = V4.norm . getVec | ||
100 | |||
101 | |||
102 | -- | Rotate the given 'Vector3'. | ||
103 | qrot :: Quaternion -> V3.Vector3 -> V3.Vector3 | ||
104 | qrot 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 | |||
108 | toRAD = pi / 180 | ||
109 | |||