diff options
Diffstat (limited to 'Spear/Math/Vector')
-rw-r--r-- | Spear/Math/Vector/Vector.hs | 93 | ||||
-rw-r--r-- | Spear/Math/Vector/Vector2.hs | 113 | ||||
-rw-r--r-- | Spear/Math/Vector/Vector3.hs | 150 | ||||
-rw-r--r-- | Spear/Math/Vector/Vector4.hs | 142 |
4 files changed, 313 insertions, 185 deletions
diff --git a/Spear/Math/Vector/Vector.hs b/Spear/Math/Vector/Vector.hs index 35b04e2..e7f6d53 100644 --- a/Spear/Math/Vector/Vector.hs +++ b/Spear/Math/Vector/Vector.hs | |||
@@ -1,43 +1,50 @@ | |||
1 | module Spear.Math.Vector.Vector | 1 | {-# LANGUAGE FlexibleContexts #-} |
2 | where | 2 | |
3 | 3 | module Spear.Math.Vector.Vector where | |
4 | class (Fractional a, Ord a) => Vector a where | 4 | |
5 | -- | Create a vector from the given list. | 5 | import Spear.Math.Algebra |
6 | fromList :: [Float] -> a | 6 | |
7 | 7 | ||
8 | -- | Return the vector's x coordinate. | 8 | class |
9 | x :: a -> Float | 9 | ( Addition v v |
10 | x _ = 0 | 10 | , Subtraction v v |
11 | 11 | , Product v v v | |
12 | -- | Return the vector's y coordinate. | 12 | , Product v Float v -- Scalar product. |
13 | y :: a -> Float | 13 | , Product Float v v) -- Scalar product. |
14 | y _ = 0 | 14 | => Vector v where |
15 | 15 | -- | Create a vector from the given list. | |
16 | -- | Return the vector's z coordinate. | 16 | fromList :: [Float] -> v |
17 | z :: a -> Float | 17 | |
18 | z _ = 0 | 18 | -- | Get the vector's x coordinate. |
19 | 19 | x :: v -> Float | |
20 | -- | Return the vector's w coordinate. | 20 | x _ = 0 |
21 | w :: a -> Float | 21 | |
22 | w _ = 0 | 22 | -- | Get the vector's y coordinate. |
23 | 23 | y :: v -> Float | |
24 | -- | Return the vector's ith coordinate. | 24 | y _ = 0 |
25 | (!) :: a -> Int -> Float | 25 | |
26 | 26 | -- | Get the vector's z coordinate. | |
27 | -- | Compute the given vectors' dot product. | 27 | z :: v -> Float |
28 | dot :: a -> a -> Float | 28 | z _ = 0 |
29 | 29 | ||
30 | -- | Compute the given vector's squared norm. | 30 | -- | Get the vector's w coordinate. |
31 | normSq :: a -> Float | 31 | w :: v -> Float |
32 | 32 | w _ = 0 | |
33 | -- | Compute the given vector's norm. | 33 | |
34 | norm :: a -> Float | 34 | -- | Get the vector's ith coordinate. |
35 | 35 | (!) :: v -> Int -> Float | |
36 | -- | Multiply the given vector with the given scalar. | 36 | |
37 | scale :: Float -> a -> a | 37 | -- | Compute the given vectors' dot product. |
38 | 38 | dot :: v -> v -> Float | |
39 | -- | Negate the given vector. | 39 | |
40 | neg :: a -> a | 40 | -- | Compute the given vector's squared norm. |
41 | 41 | normSq :: v -> Float | |
42 | -- | Normalise the given vector. | 42 | |
43 | normalise :: a -> a | 43 | -- | Compute the given vector's norm. |
44 | norm :: v -> Float | ||
45 | |||
46 | -- | Negate the given vector. | ||
47 | neg :: v -> v | ||
48 | |||
49 | -- | Normalise the given vector. | ||
50 | normalise :: v -> v | ||
diff --git a/Spear/Math/Vector/Vector2.hs b/Spear/Math/Vector/Vector2.hs index 5bbb632..1ede3a9 100644 --- a/Spear/Math/Vector/Vector2.hs +++ b/Spear/Math/Vector/Vector2.hs | |||
@@ -1,3 +1,7 @@ | |||
1 | {-# LANGUAGE MultiParamTypeClasses #-} | ||
2 | {-# LANGUAGE NoImplicitPrelude #-} | ||
3 | {-# LANGUAGE TypeFamilies #-} | ||
4 | |||
1 | module Spear.Math.Vector.Vector2 | 5 | module Spear.Math.Vector.Vector2 |
2 | ( | 6 | ( |
3 | Vector2(..) | 7 | Vector2(..) |
@@ -14,30 +18,72 @@ module Spear.Math.Vector.Vector2 | |||
14 | ) | 18 | ) |
15 | where | 19 | where |
16 | 20 | ||
21 | import Spear.Math.Algebra | ||
17 | import Spear.Math.Vector.Vector | 22 | import Spear.Math.Vector.Vector |
23 | import Spear.Prelude | ||
18 | 24 | ||
19 | import Foreign.C.Types (CFloat) | 25 | import Foreign.C.Types (CFloat) |
20 | import Foreign.Storable | 26 | import Foreign.Storable |
27 | import qualified Prelude as P | ||
28 | |||
21 | 29 | ||
22 | type Right2 = Vector2 | 30 | type Right2 = Vector2 |
23 | type Up2 = Vector2 | 31 | type Up2 = Vector2 |
24 | type Position2 = Vector2 | 32 | type Position2 = Vector2 |
25 | 33 | ||
34 | |||
26 | -- | Represents a vector in 2D. | 35 | -- | Represents a vector in 2D. |
27 | data Vector2 = Vector2 {-# UNPACK #-} !Float {-# UNPACK #-} !Float deriving (Eq, Show) | 36 | data Vector2 = Vector2 {-# UNPACK #-} !Float {-# UNPACK #-} !Float deriving (Eq, Show) |
28 | 37 | ||
29 | 38 | ||
30 | instance Num Vector2 where | 39 | instance Addition Vector2 Vector2 where |
40 | {-# INLINABLE (+) #-} | ||
31 | Vector2 ax ay + Vector2 bx by = Vector2 (ax + bx) (ay + by) | 41 | Vector2 ax ay + Vector2 bx by = Vector2 (ax + bx) (ay + by) |
42 | |||
43 | |||
44 | instance Subtraction Vector2 Vector2 where | ||
45 | {-# INLINABLE (-) #-} | ||
32 | Vector2 ax ay - Vector2 bx by = Vector2 (ax - bx) (ay - by) | 46 | Vector2 ax ay - Vector2 bx by = Vector2 (ax - bx) (ay - by) |
47 | |||
48 | |||
49 | instance Product Vector2 Vector2 Vector2 where | ||
50 | {-# INLINABLE (*) #-} | ||
33 | Vector2 ax ay * Vector2 bx by = Vector2 (ax * bx) (ay * by) | 51 | Vector2 ax ay * Vector2 bx by = Vector2 (ax * bx) (ay * by) |
52 | |||
53 | |||
54 | instance Quotient Vector2 Vector2 where | ||
55 | {-# INLINABLE (/) #-} | ||
56 | Vector2 ax ay / Vector2 bx by = Vector2 (ax / bx) (ay / by) | ||
57 | |||
58 | |||
59 | -- Scalar product. | ||
60 | instance Product Vector2 Float Vector2 where | ||
61 | {-# INLINABLE (*) #-} | ||
62 | (Vector2 x y) * s = Vector2 (s * x) (s * y) | ||
63 | |||
64 | |||
65 | instance Product Float Vector2 Vector2 where | ||
66 | {-# INLINABLE (*) #-} | ||
67 | s * (Vector2 x y) = Vector2 (s * x) (s * y) | ||
68 | |||
69 | |||
70 | -- Scalar division. | ||
71 | instance Quotient Vector2 Float where | ||
72 | {-# INLINABLE (/) #-} | ||
73 | (Vector2 x y) / s = Vector2 (x / s) (y / s) | ||
74 | |||
75 | |||
76 | instance Num Vector2 where | ||
77 | (+) = add | ||
78 | (-) = sub | ||
79 | (*) = mul | ||
34 | abs (Vector2 ax ay) = Vector2 (abs ax) (abs ay) | 80 | abs (Vector2 ax ay) = Vector2 (abs ax) (abs ay) |
35 | signum (Vector2 ax ay) = Vector2 (signum ax) (signum ay) | 81 | signum (Vector2 ax ay) = Vector2 (signum ax) (signum ay) |
36 | fromInteger i = Vector2 i' i' where i' = fromInteger i | 82 | fromInteger i = Vector2 i' i' where i' = fromInteger i |
37 | 83 | ||
38 | 84 | ||
39 | instance Fractional Vector2 where | 85 | instance Fractional Vector2 where |
40 | Vector2 ax ay / Vector2 bx by = Vector2 (ax / bx) (ay / by) | 86 | (/) = Spear.Math.Algebra.div |
41 | fromRational r = Vector2 r' r' where r' = fromRational r | 87 | fromRational r = Vector2 r' r' where r' = fromRational r |
42 | 88 | ||
43 | 89 | ||
@@ -46,52 +92,49 @@ instance Ord Vector2 where | |||
46 | Vector2 ax ay >= Vector2 bx by = (ax >= bx) || (ax == bx && ay >= by) | 92 | Vector2 ax ay >= Vector2 bx by = (ax >= bx) || (ax == bx && ay >= by) |
47 | Vector2 ax ay < Vector2 bx by = (ax < bx) || (ax == bx && ay < by) | 93 | Vector2 ax ay < Vector2 bx by = (ax < bx) || (ax == bx && ay < by) |
48 | Vector2 ax ay > Vector2 bx by = (ax > bx) || (ax == bx && ay > by) | 94 | Vector2 ax ay > Vector2 bx by = (ax > bx) || (ax == bx && ay > by) |
49 | max (Vector2 ax ay) (Vector2 bx by) = Vector2 (Prelude.max ax bx) (Prelude.max ay by) | 95 | max (Vector2 ax ay) (Vector2 bx by) = Vector2 (max ax bx) (max ay by) |
50 | min (Vector2 ax ay) (Vector2 bx by) = Vector2 (Prelude.min ax bx) (Prelude.min ay by) | 96 | min (Vector2 ax ay) (Vector2 bx by) = Vector2 (min ax bx) (min ay by) |
51 | 97 | ||
52 | 98 | ||
53 | instance Vector Vector2 where | 99 | instance Vector Vector2 where |
54 | {-# INLINABLE fromList #-} | 100 | {-# INLINABLE fromList #-} |
55 | fromList (ax:ay:_) = Vector2 ax ay | 101 | fromList (ax:ay:_) = Vector2 ax ay |
56 | |||
57 | {-# INLINABLE x #-} | ||
58 | x (Vector2 ax _) = ax | ||
59 | 102 | ||
60 | {-# INLINABLE y #-} | 103 | {-# INLINABLE x #-} |
61 | y (Vector2 _ ay) = ay | 104 | x (Vector2 ax _) = ax |
62 | 105 | ||
63 | {-# INLINABLE (!) #-} | 106 | {-# INLINABLE y #-} |
64 | (Vector2 ax _) ! 0 = ax | 107 | y (Vector2 _ ay) = ay |
65 | (Vector2 _ ay) ! 1 = ay | ||
66 | _ ! _ = 0 | ||
67 | 108 | ||
68 | {-# INLINABLE dot #-} | 109 | {-# INLINABLE (!) #-} |
69 | Vector2 ax ay `dot` Vector2 bx by = ax*bx + ay*by | 110 | (Vector2 ax _) ! 0 = ax |
111 | (Vector2 _ ay) ! 1 = ay | ||
112 | _ ! _ = 0 | ||
70 | 113 | ||
71 | {-# INLINABLE normSq #-} | 114 | {-# INLINABLE dot #-} |
72 | normSq (Vector2 ax ay) = ax*ax + ay*ay | 115 | Vector2 ax ay `dot` Vector2 bx by = ax*bx + ay*by |
73 | 116 | ||
74 | {-# INLINABLE norm #-} | 117 | {-# INLINABLE normSq #-} |
75 | norm = sqrt . normSq | 118 | normSq (Vector2 ax ay) = ax*ax + ay*ay |
76 | 119 | ||
77 | {-# INLINABLE scale #-} | 120 | {-# INLINABLE norm #-} |
78 | scale s (Vector2 ax ay) = Vector2 (s*ax) (s*ay) | 121 | norm = sqrt . normSq |
79 | 122 | ||
80 | {-# INLINABLE neg #-} | 123 | {-# INLINABLE neg #-} |
81 | neg (Vector2 ax ay) = Vector2 (-ax) (-ay) | 124 | neg (Vector2 ax ay) = Vector2 (-ax) (-ay) |
82 | 125 | ||
83 | {-# INLINABLE normalise #-} | 126 | {-# INLINABLE normalise #-} |
84 | normalise v = | 127 | normalise v = |
85 | let n' = norm v | 128 | let n' = norm v |
86 | n = if n' == 0 then 1 else n' | 129 | n = if n' == 0 then 1 else n' |
87 | in scale (1.0 / n) v | 130 | in ((1.0::Float) / n) * v |
88 | 131 | ||
89 | 132 | ||
90 | sizeFloat = sizeOf (undefined :: CFloat) | 133 | sizeFloat = sizeOf (undefined :: CFloat) |
91 | 134 | ||
92 | 135 | ||
93 | instance Storable Vector2 where | 136 | instance Storable Vector2 where |
94 | sizeOf _ = 2*sizeFloat | 137 | sizeOf _ = (2::Int) * sizeFloat |
95 | alignment _ = alignment (undefined :: CFloat) | 138 | alignment _ = alignment (undefined :: CFloat) |
96 | 139 | ||
97 | peek ptr = do | 140 | peek ptr = do |
@@ -115,9 +158,9 @@ zero2 = Vector2 0 0 | |||
115 | 158 | ||
116 | -- | Create a vector from the given values. | 159 | -- | Create a vector from the given values. |
117 | vec2 :: Float -> Float -> Vector2 | 160 | vec2 :: Float -> Float -> Vector2 |
118 | vec2 ax ay = Vector2 ax ay | 161 | vec2 = Vector2 |
119 | 162 | ||
120 | -- | Compute a vector perpendicular to the given one, satisfying: | 163 | -- | Compute a perpendicular vector satisfying: |
121 | -- | 164 | -- |
122 | -- perp (Vector2 0 1) = Vector2 1 0 | 165 | -- perp (Vector2 0 1) = Vector2 1 0 |
123 | -- | 166 | -- |
diff --git a/Spear/Math/Vector/Vector3.hs b/Spear/Math/Vector/Vector3.hs index 82deba2..9d44c8b 100644 --- a/Spear/Math/Vector/Vector3.hs +++ b/Spear/Math/Vector/Vector3.hs | |||
@@ -1,3 +1,7 @@ | |||
1 | {-# LANGUAGE MultiParamTypeClasses #-} | ||
2 | {-# LANGUAGE NoImplicitPrelude #-} | ||
3 | {-# LANGUAGE TypeFamilies #-} | ||
4 | |||
1 | module Spear.Math.Vector.Vector3 | 5 | module Spear.Math.Vector.Vector3 |
2 | ( | 6 | ( |
3 | Vector3(..) | 7 | Vector3(..) |
@@ -5,6 +9,7 @@ module Spear.Math.Vector.Vector3 | |||
5 | , Up3 | 9 | , Up3 |
6 | , Forward3 | 10 | , Forward3 |
7 | , Position3 | 11 | , Position3 |
12 | , sizeVector3 | ||
8 | -- * Construction | 13 | -- * Construction |
9 | , unitx3 | 14 | , unitx3 |
10 | , unity3 | 15 | , unity3 |
@@ -17,15 +22,17 @@ module Spear.Math.Vector.Vector3 | |||
17 | ) | 22 | ) |
18 | where | 23 | where |
19 | 24 | ||
20 | 25 | import Spear.Math.Algebra | |
21 | import Spear.Math.Vector.Vector | 26 | import Spear.Math.Vector.Vector |
27 | import Spear.Prelude | ||
22 | 28 | ||
23 | import Foreign.C.Types (CFloat) | 29 | import Foreign.C.Types (CFloat) |
24 | import Foreign.Storable | 30 | import Foreign.Storable |
31 | import qualified Prelude as P | ||
25 | 32 | ||
26 | type Right3 = Vector3 | 33 | type Right3 = Vector3 |
27 | type Up3 = Vector3 | 34 | type Up3 = Vector3 |
28 | type Forward3 = Vector3 | 35 | type Forward3 = Vector3 |
29 | type Position3 = Vector3 | 36 | type Position3 = Vector3 |
30 | 37 | ||
31 | 38 | ||
@@ -36,17 +43,58 @@ data Vector3 = Vector3 | |||
36 | {-# UNPACK #-} !Float | 43 | {-# UNPACK #-} !Float |
37 | deriving (Eq, Show) | 44 | deriving (Eq, Show) |
38 | 45 | ||
39 | instance Num Vector3 where | 46 | |
47 | sizeVector3 = (3::Int) * sizeOf (undefined :: CFloat) | ||
48 | |||
49 | |||
50 | instance Addition Vector3 Vector3 where | ||
51 | {-# INLINABLE (+) #-} | ||
40 | Vector3 ax ay az + Vector3 bx by bz = Vector3 (ax + bx) (ay + by) (az + bz) | 52 | Vector3 ax ay az + Vector3 bx by bz = Vector3 (ax + bx) (ay + by) (az + bz) |
53 | |||
54 | |||
55 | instance Subtraction Vector3 Vector3 where | ||
56 | {-# INLINABLE (-) #-} | ||
41 | Vector3 ax ay az - Vector3 bx by bz = Vector3 (ax - bx) (ay - by) (az - bz) | 57 | Vector3 ax ay az - Vector3 bx by bz = Vector3 (ax - bx) (ay - by) (az - bz) |
58 | |||
59 | |||
60 | instance Product Vector3 Vector3 Vector3 where | ||
61 | {-# INLINABLE (*) #-} | ||
42 | Vector3 ax ay az * Vector3 bx by bz = Vector3 (ax * bx) (ay * by) (az * bz) | 62 | Vector3 ax ay az * Vector3 bx by bz = Vector3 (ax * bx) (ay * by) (az * bz) |
63 | |||
64 | |||
65 | instance Quotient Vector3 Vector3 where | ||
66 | {-# INLINABLE (/) #-} | ||
67 | Vector3 ax ay az / Vector3 bx by bz = Vector3 (ax / bx) (ay / by) (az / bz) | ||
68 | |||
69 | |||
70 | -- Scalar product. | ||
71 | instance Product Vector3 Float Vector3 where | ||
72 | {-# INLINABLE (*) #-} | ||
73 | (Vector3 x y z) * s = Vector3 (s * x) (s * y) (s * z) | ||
74 | |||
75 | |||
76 | instance Product Float Vector3 Vector3 where | ||
77 | {-# INLINABLE (*) #-} | ||
78 | s * (Vector3 x y z) = Vector3 (s * x) (s * y) (s * z) | ||
79 | |||
80 | |||
81 | -- Scalar division. | ||
82 | instance Quotient Vector3 Float where | ||
83 | {-# INLINABLE (/) #-} | ||
84 | (Vector3 x y z) / s = Vector3 (x / s) (y / s) (y / s) | ||
85 | |||
86 | |||
87 | instance Num Vector3 where | ||
88 | (+) = add | ||
89 | (-) = sub | ||
90 | (*) = mul | ||
43 | abs (Vector3 ax ay az) = Vector3 (abs ax) (abs ay) (abs az) | 91 | abs (Vector3 ax ay az) = Vector3 (abs ax) (abs ay) (abs az) |
44 | signum (Vector3 ax ay az) = Vector3 (signum ax) (signum ay) (signum az) | 92 | signum (Vector3 ax ay az) = Vector3 (signum ax) (signum ay) (signum az) |
45 | fromInteger i = Vector3 i' i' i' where i' = fromInteger i | 93 | fromInteger i = Vector3 i' i' i' where i' = fromInteger i |
46 | 94 | ||
47 | 95 | ||
48 | instance Fractional Vector3 where | 96 | instance Fractional Vector3 where |
49 | Vector3 ax ay az / Vector3 bx by bz = Vector3 (ax / bx) (ay / by) (az / bz) | 97 | (/) = Spear.Math.Algebra.div |
50 | fromRational r = Vector3 r' r' r' where r' = fromRational r | 98 | fromRational r = Vector3 r' r' r' where r' = fromRational r |
51 | 99 | ||
52 | 100 | ||
@@ -71,91 +119,85 @@ instance Ord Vector3 where | |||
71 | || (ax == bx && ay > by) | 119 | || (ax == bx && ay > by) |
72 | || (ax == bx && ay == by && az > bz) | 120 | || (ax == bx && ay == by && az > bz) |
73 | 121 | ||
74 | max (Vector3 ax ay az) (Vector3 bx by bz) = Vector3 (Prelude.max ax bx) (Prelude.max ay by) (Prelude.max az bz) | 122 | max (Vector3 ax ay az) (Vector3 bx by bz) = |
123 | Vector3 (max ax bx) (max ay by) (max az bz) | ||
75 | 124 | ||
76 | min (Vector3 ax ay az) (Vector3 bx by bz) = Vector3 (Prelude.min ax bx) (Prelude.min ay by) (Prelude.min az bz) | 125 | min (Vector3 ax ay az) (Vector3 bx by bz) = |
126 | Vector3 (min ax bx) (min ay by) (min az bz) | ||
77 | 127 | ||
78 | 128 | ||
79 | instance Vector Vector3 where | 129 | instance Vector Vector3 where |
80 | {-# INLINABLE fromList #-} | 130 | {-# INLINABLE fromList #-} |
81 | fromList (ax:ay:az:_) = Vector3 ax ay az | 131 | fromList (ax:ay:az:_) = Vector3 ax ay az |
82 | |||
83 | {-# INLINABLE x #-} | ||
84 | x (Vector3 ax _ _ ) = ax | ||
85 | 132 | ||
86 | {-# INLINABLE y #-} | 133 | {-# INLINABLE x #-} |
87 | y (Vector3 _ ay _ ) = ay | 134 | x (Vector3 ax _ _ ) = ax |
88 | 135 | ||
89 | {-# INLINABLE z #-} | 136 | {-# INLINABLE y #-} |
90 | z (Vector3 _ _ az) = az | 137 | y (Vector3 _ ay _ ) = ay |
91 | 138 | ||
92 | {-# INLINABLE (!) #-} | 139 | {-# INLINABLE z #-} |
93 | (Vector3 ax _ _) ! 0 = ax | 140 | z (Vector3 _ _ az) = az |
94 | (Vector3 _ ay _) ! 1 = ay | ||
95 | (Vector3 _ _ az) ! 2 = az | ||
96 | _ ! _ = 0 | ||
97 | 141 | ||
98 | {-# INLINABLE dot #-} | 142 | {-# INLINABLE (!) #-} |
99 | Vector3 ax ay az `dot` Vector3 bx by bz = ax*bx + ay*by + az*bz | 143 | (Vector3 ax _ _) ! 0 = ax |
144 | (Vector3 _ ay _) ! 1 = ay | ||
145 | (Vector3 _ _ az) ! 2 = az | ||
146 | _ ! _ = 0 | ||
100 | 147 | ||
101 | {-# INLINABLE normSq #-} | 148 | {-# INLINABLE dot #-} |
102 | normSq (Vector3 ax ay az) = ax*ax + ay*ay + az*az | 149 | Vector3 ax ay az `dot` Vector3 bx by bz = ax*bx + ay*by + az*bz |
103 | 150 | ||
104 | {-# INLINABLE norm #-} | 151 | {-# INLINABLE normSq #-} |
105 | norm = sqrt . normSq | 152 | normSq (Vector3 ax ay az) = ax*ax + ay*ay + az*az |
106 | 153 | ||
107 | {-# INLINABLE scale #-} | 154 | {-# INLINABLE norm #-} |
108 | scale s (Vector3 ax ay az) = Vector3 (s*ax) (s*ay) (s*az) | 155 | norm = sqrt . normSq |
109 | 156 | ||
110 | {-# INLINABLE neg #-} | 157 | {-# INLINABLE neg #-} |
111 | neg (Vector3 ax ay az) = Vector3 (-ax) (-ay) (-az) | 158 | neg (Vector3 ax ay az) = Vector3 (-ax) (-ay) (-az) |
112 | 159 | ||
113 | {-# INLINABLE normalise #-} | 160 | {-# INLINABLE normalise #-} |
114 | normalise v = | 161 | normalise v = |
115 | let n' = norm v | 162 | let n' = norm v |
116 | n = if n' == 0 then 1 else n' | 163 | n = if n' == 0 then 1 else n' |
117 | in scale (1.0 / n) v | 164 | in ((1.0::Float) / n) * v |
118 | 165 | ||
119 | 166 | ||
120 | sizeFloat = sizeOf (undefined :: CFloat) | 167 | sizeFloat = sizeOf (undefined :: CFloat) |
121 | 168 | ||
122 | 169 | ||
123 | instance Storable Vector3 where | 170 | instance Storable Vector3 where |
124 | sizeOf _ = 3*sizeFloat | 171 | sizeOf _ = (3::Int) * sizeFloat |
125 | alignment _ = alignment (undefined :: CFloat) | 172 | alignment _ = alignment (undefined :: CFloat) |
126 | 173 | ||
127 | peek ptr = do | 174 | peek ptr = do |
128 | ax <- peekByteOff ptr 0 | 175 | ax <- peekByteOff ptr 0 |
129 | ay <- peekByteOff ptr $ 1*sizeFloat | 176 | ay <- peekByteOff ptr $ (1::Int) * sizeFloat |
130 | az <- peekByteOff ptr $ 2*sizeFloat | 177 | az <- peekByteOff ptr $ (2::Int) * sizeFloat |
131 | return (Vector3 ax ay az) | 178 | return (Vector3 ax ay az) |
132 | 179 | ||
133 | poke ptr (Vector3 ax ay az) = do | 180 | poke ptr (Vector3 ax ay az) = do |
134 | pokeByteOff ptr 0 ax | 181 | pokeByteOff ptr 0 ax |
135 | pokeByteOff ptr (1*sizeFloat) ay | 182 | pokeByteOff ptr ((1::Int) * sizeFloat) ay |
136 | pokeByteOff ptr (2*sizeFloat) az | 183 | pokeByteOff ptr ((2::Int) * sizeFloat) az |
137 | 184 | ||
138 | 185 | ||
139 | -- | Unit vector along the X axis. | 186 | -- | Unit vector along the X axis. |
140 | unitx3 = Vector3 1 0 0 | 187 | unitx3 = Vector3 1 0 0 |
141 | 188 | ||
142 | |||
143 | -- | Unit vector along the Y axis. | 189 | -- | Unit vector along the Y axis. |
144 | unity3 = Vector3 0 1 0 | 190 | unity3 = Vector3 0 1 0 |
145 | 191 | ||
146 | |||
147 | -- | Unit vector along the Z axis. | 192 | -- | Unit vector along the Z axis. |
148 | unitz3 = Vector3 0 0 1 | 193 | unitz3 = Vector3 0 0 1 |
149 | 194 | ||
150 | |||
151 | -- | Zero vector. | 195 | -- | Zero vector. |
152 | zero3 = Vector3 0 0 0 | 196 | zero3 = Vector3 0 0 0 |
153 | 197 | ||
154 | |||
155 | -- | Create a 3D vector from the given values. | 198 | -- | Create a 3D vector from the given values. |
156 | vec3 :: Float -> Float -> Float -> Vector3 | 199 | vec3 :: Float -> Float -> Float -> Vector3 |
157 | vec3 ax ay az = Vector3 ax ay az | 200 | vec3 = Vector3 |
158 | |||
159 | 201 | ||
160 | -- | Create a 3D vector as a point on a sphere. | 202 | -- | Create a 3D vector as a point on a sphere. |
161 | orbit :: Vector3 -- ^ Sphere center. | 203 | orbit :: Vector3 -- ^ Sphere center. |
@@ -163,21 +205,17 @@ orbit :: Vector3 -- ^ Sphere center. | |||
163 | -> Float -- ^ Azimuth angle. | 205 | -> Float -- ^ Azimuth angle. |
164 | -> Float -- ^ Zenith angle. | 206 | -> Float -- ^ Zenith angle. |
165 | -> Vector3 | 207 | -> Vector3 |
166 | |||
167 | orbit center radius anglex angley = | 208 | orbit center radius anglex angley = |
168 | let ax = anglex * pi / 180 | 209 | let sx = sin anglex |
169 | ay = angley * pi / 180 | 210 | sy = sin angley |
170 | sx = sin ax | 211 | cx = cos anglex |
171 | sy = sin ay | 212 | cy = cos angley |
172 | cx = cos ax | ||
173 | cy = cos ay | ||
174 | px = x center + radius*cy*sx | 213 | px = x center + radius*cy*sx |
175 | py = y center + radius*sy | 214 | py = y center + radius*sy |
176 | pz = z center + radius*cx*cy | 215 | pz = z center + radius*cx*cy |
177 | in | 216 | in |
178 | vec3 px py pz | 217 | vec3 px py pz |
179 | 218 | ||
180 | |||
181 | -- | Compute the given vectors' cross product. | 219 | -- | Compute the given vectors' cross product. |
182 | cross :: Vector3 -> Vector3 -> Vector3 | 220 | cross :: Vector3 -> Vector3 -> Vector3 |
183 | (Vector3 ax ay az) `cross` (Vector3 bx by bz) = | 221 | (Vector3 ax ay az) `cross` (Vector3 bx by bz) = |
diff --git a/Spear/Math/Vector/Vector4.hs b/Spear/Math/Vector/Vector4.hs index 325eefc..907295e 100644 --- a/Spear/Math/Vector/Vector4.hs +++ b/Spear/Math/Vector/Vector4.hs | |||
@@ -1,3 +1,7 @@ | |||
1 | {-# LANGUAGE MultiParamTypeClasses #-} | ||
2 | {-# LANGUAGE NoImplicitPrelude #-} | ||
3 | {-# LANGUAGE TypeFamilies #-} | ||
4 | |||
1 | module Spear.Math.Vector.Vector4 | 5 | module Spear.Math.Vector.Vector4 |
2 | ( | 6 | ( |
3 | Vector4(..) | 7 | Vector4(..) |
@@ -11,11 +15,13 @@ module Spear.Math.Vector.Vector4 | |||
11 | ) | 15 | ) |
12 | where | 16 | where |
13 | 17 | ||
14 | 18 | import Spear.Math.Algebra | |
15 | import Spear.Math.Vector.Vector | 19 | import Spear.Math.Vector.Vector |
20 | import Spear.Prelude | ||
16 | 21 | ||
17 | import Foreign.C.Types (CFloat) | 22 | import Foreign.C.Types (CFloat) |
18 | import Foreign.Storable | 23 | import Foreign.Storable |
24 | import qualified Prelude as P | ||
19 | 25 | ||
20 | 26 | ||
21 | -- | Represents a vector in 3D. | 27 | -- | Represents a vector in 3D. |
@@ -27,17 +33,58 @@ data Vector4 = Vector4 | |||
27 | deriving (Eq, Show) | 33 | deriving (Eq, Show) |
28 | 34 | ||
29 | 35 | ||
36 | instance Addition Vector4 Vector4 where | ||
37 | {-# INLINABLE (+) #-} | ||
38 | Vector4 ax ay az aw + Vector4 bx by bz bw = | ||
39 | Vector4 (ax + bx) (ay + by) (az + bz) (aw + bw) | ||
40 | |||
41 | |||
42 | instance Subtraction Vector4 Vector4 where | ||
43 | {-# INLINABLE (-) #-} | ||
44 | Vector4 ax ay az aw - Vector4 bx by bz bw = | ||
45 | Vector4 (ax - bx) (ay - by) (az - bz) (aw - bw) | ||
46 | |||
47 | |||
48 | instance Product Vector4 Vector4 Vector4 where | ||
49 | {-# INLINABLE (*) #-} | ||
50 | Vector4 ax ay az aw * Vector4 bx by bz bw = | ||
51 | Vector4 (ax * bx) (ay * by) (az * bz) (aw * bw) | ||
52 | |||
53 | |||
54 | instance Quotient Vector4 Vector4 where | ||
55 | {-# INLINABLE (/) #-} | ||
56 | Vector4 ax ay az aw / Vector4 bx by bz bw = | ||
57 | Vector4 (ax / bx) (ay / by) (az / bz) (aw / bw) | ||
58 | |||
59 | |||
60 | -- Scalar product. | ||
61 | instance Product Vector4 Float Vector4 where | ||
62 | {-# INLINABLE (*) #-} | ||
63 | (Vector4 x y z w) * s = Vector4 (s * x) (s * y) (s * z) (s * w) | ||
64 | |||
65 | |||
66 | instance Product Float Vector4 Vector4 where | ||
67 | {-# INLINABLE (*) #-} | ||
68 | s * (Vector4 x y z w) = Vector4 (s * x) (s * y) (s * z) (s * w) | ||
69 | |||
70 | |||
71 | -- Scalar division. | ||
72 | instance Quotient Vector4 Float where | ||
73 | {-# INLINABLE (/) #-} | ||
74 | (Vector4 x y z w) / s = Vector4 (x / s) (y / s) (y / s) (w / s) | ||
75 | |||
76 | |||
30 | instance Num Vector4 where | 77 | instance Num Vector4 where |
31 | Vector4 ax ay az aw + Vector4 bx by bz bw = Vector4 (ax + bx) (ay + by) (az + bz) (aw + bw) | 78 | (+) = add |
32 | Vector4 ax ay az aw - Vector4 bx by bz bw = Vector4 (ax - bx) (ay - by) (az - bz) (aw - bw) | 79 | (-) = sub |
33 | Vector4 ax ay az aw * Vector4 bx by bz bw = Vector4 (ax * bx) (ay * by) (az * bz) (aw * bw) | 80 | (*) = mul |
34 | abs (Vector4 ax ay az aw) = Vector4 (abs ax) (abs ay) (abs az) (abs aw) | 81 | abs (Vector4 ax ay az aw) = Vector4 (abs ax) (abs ay) (abs az) (abs aw) |
35 | signum (Vector4 ax ay az aw) = Vector4 (signum ax) (signum ay) (signum az) (signum aw) | 82 | signum (Vector4 ax ay az aw) = Vector4 (signum ax) (signum ay) (signum az) (signum aw) |
36 | fromInteger i = Vector4 i' i' i' i' where i' = fromInteger i | 83 | fromInteger i = Vector4 i' i' i' i' where i' = fromInteger i |
37 | 84 | ||
38 | 85 | ||
39 | instance Fractional Vector4 where | 86 | instance Fractional Vector4 where |
40 | Vector4 ax ay az aw / Vector4 bx by bz bw = Vector4 (ax / bx) (ay / by) (az / bz) (aw / bw) | 87 | (/) = Spear.Math.Algebra.div |
41 | fromRational r = Vector4 r' r' r' r' where r' = fromRational r | 88 | fromRational r = Vector4 r' r' r' r' where r' = fromRational r |
42 | 89 | ||
43 | 90 | ||
@@ -67,97 +114,90 @@ instance Ord Vector4 where | |||
67 | || (ax == bx && ay == by && az == bz && aw > bw) | 114 | || (ax == bx && ay == by && az == bz && aw > bw) |
68 | 115 | ||
69 | min (Vector4 ax ay az aw) (Vector4 bx by bz bw) = | 116 | min (Vector4 ax ay az aw) (Vector4 bx by bz bw) = |
70 | Vector4 (Prelude.min ax bx) (Prelude.min ay by) (Prelude.min az bz) (Prelude.min aw bw) | 117 | Vector4 (min ax bx) (min ay by) (min az bz) (min aw bw) |
71 | 118 | ||
72 | max (Vector4 ax ay az aw) (Vector4 bx by bz bw) = | 119 | max (Vector4 ax ay az aw) (Vector4 bx by bz bw) = |
73 | Vector4 (Prelude.max ax bx) (Prelude.max ay by) (Prelude.max az bz) (Prelude.min aw bw) | 120 | Vector4 (max ax bx) (max ay by) (max az bz) (min aw bw) |
74 | 121 | ||
75 | 122 | ||
76 | instance Vector Vector4 where | 123 | instance Vector Vector4 where |
77 | {-# INLINABLE fromList #-} | 124 | {-# INLINABLE fromList #-} |
78 | fromList (ax:ay:az:aw:_) = Vector4 ax ay az aw | 125 | fromList (ax:ay:az:aw:_) = Vector4 ax ay az aw |
79 | 126 | ||
80 | {-# INLINABLE x #-} | 127 | {-# INLINABLE x #-} |
81 | x (Vector4 ax _ _ _ ) = ax | 128 | x (Vector4 ax _ _ _ ) = ax |
82 | 129 | ||
83 | {-# INLINABLE y #-} | 130 | {-# INLINABLE y #-} |
84 | y (Vector4 _ ay _ _ ) = ay | 131 | y (Vector4 _ ay _ _ ) = ay |
85 | 132 | ||
86 | {-# INLINABLE z #-} | 133 | {-# INLINABLE z #-} |
87 | z (Vector4 _ _ az _ ) = az | 134 | z (Vector4 _ _ az _ ) = az |
88 | 135 | ||
89 | {-# INLINABLE w #-} | 136 | {-# INLINABLE w #-} |
90 | w (Vector4 _ _ _ aw) = aw | 137 | w (Vector4 _ _ _ aw) = aw |
91 | 138 | ||
92 | {-# INLINABLE (!) #-} | 139 | {-# INLINABLE (!) #-} |
93 | (Vector4 ax _ _ _) ! 0 = ax | 140 | (Vector4 ax _ _ _) ! 0 = ax |
94 | (Vector4 _ ay _ _) ! 1 = ay | 141 | (Vector4 _ ay _ _) ! 1 = ay |
95 | (Vector4 _ _ az _) ! 2 = az | 142 | (Vector4 _ _ az _) ! 2 = az |
96 | (Vector4 _ _ _ aw) ! 3 = aw | 143 | (Vector4 _ _ _ aw) ! 3 = aw |
97 | _ ! _ = 0 | 144 | _ ! _ = 0 |
98 | 145 | ||
99 | {-# INLINABLE dot #-} | 146 | {-# INLINABLE dot #-} |
100 | Vector4 ax ay az aw `dot` Vector4 bx by bz bw = ax*bx + ay*by + az*bz + aw*bw | 147 | Vector4 ax ay az aw `dot` Vector4 bx by bz bw = ax*bx + ay*by + az*bz + aw*bw |
101 | 148 | ||
102 | {-# INLINABLE normSq #-} | 149 | {-# INLINABLE normSq #-} |
103 | normSq (Vector4 ax ay az aw) = ax*ax + ay*ay + az*az + aw*aw | 150 | normSq (Vector4 ax ay az aw) = ax*ax + ay*ay + az*az + aw*aw |
104 | 151 | ||
105 | {-# INLINABLE norm #-} | 152 | {-# INLINABLE norm #-} |
106 | norm = sqrt . normSq | 153 | norm = sqrt . normSq |
107 | 154 | ||
108 | {-# INLINABLE scale #-} | 155 | {-# INLINABLE neg #-} |
109 | scale s (Vector4 ax ay az aw) = Vector4 (s*ax) (s*ay) (s*az) (s*aw) | 156 | neg (Vector4 ax ay az aw) = Vector4 (-ax) (-ay) (-az) (-aw) |
110 | 157 | ||
111 | {-# INLINABLE neg #-} | 158 | {-# INLINABLE normalise #-} |
112 | neg (Vector4 ax ay az aw) = Vector4 (-ax) (-ay) (-az) (-aw) | 159 | normalise v = |
113 | 160 | let n' = norm v | |
114 | {-# INLINABLE normalise #-} | 161 | n = if n' == 0 then 1 else n' |
115 | normalise v = | 162 | in ((1.0::Float) / n) * v |
116 | let n' = norm v | ||
117 | n = if n' == 0 then 1 else n' | ||
118 | in scale (1.0 / n) v | ||
119 | 163 | ||
120 | 164 | ||
121 | sizeFloat = sizeOf (undefined :: CFloat) | 165 | sizeFloat = sizeOf (undefined :: CFloat) |
122 | 166 | ||
123 | 167 | ||
124 | instance Storable Vector4 where | 168 | instance Storable Vector4 where |
125 | sizeOf _ = 4*sizeFloat | 169 | sizeOf _ = (4::Int) * sizeFloat |
126 | alignment _ = alignment (undefined :: CFloat) | 170 | alignment _ = alignment (undefined :: CFloat) |
127 | 171 | ||
128 | peek ptr = do | 172 | peek ptr = do |
129 | ax <- peekByteOff ptr 0 | 173 | ax <- peekByteOff ptr 0 |
130 | ay <- peekByteOff ptr $ 1 * sizeFloat | 174 | ay <- peekByteOff ptr $ (1::Int) * sizeFloat |
131 | az <- peekByteOff ptr $ 2 * sizeFloat | 175 | az <- peekByteOff ptr $ (2::Int) * sizeFloat |
132 | aw <- peekByteOff ptr $ 3 * sizeFloat | 176 | aw <- peekByteOff ptr $ (3::Int) * sizeFloat |
133 | return (Vector4 ax ay az aw) | 177 | return (Vector4 ax ay az aw) |
134 | 178 | ||
135 | poke ptr (Vector4 ax ay az aw) = do | 179 | poke ptr (Vector4 ax ay az aw) = do |
136 | pokeByteOff ptr 0 ax | 180 | pokeByteOff ptr 0 ax |
137 | pokeByteOff ptr (1 * sizeFloat) ay | 181 | pokeByteOff ptr ((1::Int) * sizeFloat) ay |
138 | pokeByteOff ptr (2 * sizeFloat) az | 182 | pokeByteOff ptr ((2::Int) * sizeFloat) az |
139 | pokeByteOff ptr (3 * sizeFloat) aw | 183 | pokeByteOff ptr ((3::Int) * sizeFloat) aw |
140 | 184 | ||
141 | 185 | ||
142 | -- | Unit vector along the X axis. | 186 | -- | Unit vector along the X axis. |
143 | unitx4 = Vector4 1 0 0 0 | 187 | unitx4 = Vector4 1 0 0 0 |
144 | 188 | ||
145 | |||
146 | -- | Unit vector along the Y axis. | 189 | -- | Unit vector along the Y axis. |
147 | unity4 = Vector4 0 1 0 0 | 190 | unity4 = Vector4 0 1 0 0 |
148 | 191 | ||
149 | |||
150 | -- | Unit vector along the Z axis. | 192 | -- | Unit vector along the Z axis. |
151 | unitz4 = Vector4 0 0 1 0 | 193 | unitz4 = Vector4 0 0 1 0 |
152 | 194 | ||
153 | -- | Unit vector along the W axis. | 195 | -- | Unit vector along the W axis. |
154 | unitw4 = Vector4 0 0 0 1 | 196 | unitw4 = Vector4 0 0 0 1 |
155 | 197 | ||
156 | |||
157 | -- | Create a 4D vector from the given values. | 198 | -- | Create a 4D vector from the given values. |
158 | vec4 :: Float -> Float -> Float -> Float -> Vector4 | 199 | vec4 :: Float -> Float -> Float -> Float -> Vector4 |
159 | vec4 ax ay az aw = Vector4 ax ay az aw | 200 | vec4 = Vector4 |
160 | |||
161 | 201 | ||
162 | -- | Compute the given vectors' cross product. | 202 | -- | Compute the given vectors' cross product. |
163 | -- The vectors are projected to 3D space. The resulting vector is the cross product of the vectors' projections with w=0. | 203 | -- The vectors are projected to 3D space. The resulting vector is the cross product of the vectors' projections with w=0. |