aboutsummaryrefslogtreecommitdiff
path: root/Spear/Math/Vector
diff options
context:
space:
mode:
Diffstat (limited to 'Spear/Math/Vector')
-rw-r--r--Spear/Math/Vector/Vector.hs93
-rw-r--r--Spear/Math/Vector/Vector2.hs113
-rw-r--r--Spear/Math/Vector/Vector3.hs150
-rw-r--r--Spear/Math/Vector/Vector4.hs142
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 @@
1module Spear.Math.Vector.Vector 1{-# LANGUAGE FlexibleContexts #-}
2where 2
3 3module Spear.Math.Vector.Vector where
4class (Fractional a, Ord a) => Vector a where 4
5 -- | Create a vector from the given list. 5import Spear.Math.Algebra
6 fromList :: [Float] -> a 6
7 7
8 -- | Return the vector's x coordinate. 8class
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
1module Spear.Math.Vector.Vector2 5module Spear.Math.Vector.Vector2
2( 6(
3 Vector2(..) 7 Vector2(..)
@@ -14,30 +18,72 @@ module Spear.Math.Vector.Vector2
14) 18)
15where 19where
16 20
21import Spear.Math.Algebra
17import Spear.Math.Vector.Vector 22import Spear.Math.Vector.Vector
23import Spear.Prelude
18 24
19import Foreign.C.Types (CFloat) 25import Foreign.C.Types (CFloat)
20import Foreign.Storable 26import Foreign.Storable
27import qualified Prelude as P
28
21 29
22type Right2 = Vector2 30type Right2 = Vector2
23type Up2 = Vector2 31type Up2 = Vector2
24type Position2 = Vector2 32type Position2 = Vector2
25 33
34
26-- | Represents a vector in 2D. 35-- | Represents a vector in 2D.
27data Vector2 = Vector2 {-# UNPACK #-} !Float {-# UNPACK #-} !Float deriving (Eq, Show) 36data Vector2 = Vector2 {-# UNPACK #-} !Float {-# UNPACK #-} !Float deriving (Eq, Show)
28 37
29 38
30instance Num Vector2 where 39instance 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
44instance 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
49instance 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
54instance Quotient Vector2 Vector2 where
55 {-# INLINABLE (/) #-}
56 Vector2 ax ay / Vector2 bx by = Vector2 (ax / bx) (ay / by)
57
58
59-- Scalar product.
60instance Product Vector2 Float Vector2 where
61 {-# INLINABLE (*) #-}
62 (Vector2 x y) * s = Vector2 (s * x) (s * y)
63
64
65instance Product Float Vector2 Vector2 where
66 {-# INLINABLE (*) #-}
67 s * (Vector2 x y) = Vector2 (s * x) (s * y)
68
69
70-- Scalar division.
71instance Quotient Vector2 Float where
72 {-# INLINABLE (/) #-}
73 (Vector2 x y) / s = Vector2 (x / s) (y / s)
74
75
76instance 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
39instance Fractional Vector2 where 85instance 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
53instance Vector Vector2 where 99instance 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
90sizeFloat = sizeOf (undefined :: CFloat) 133sizeFloat = sizeOf (undefined :: CFloat)
91 134
92 135
93instance Storable Vector2 where 136instance 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.
117vec2 :: Float -> Float -> Vector2 160vec2 :: Float -> Float -> Vector2
118vec2 ax ay = Vector2 ax ay 161vec2 = 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
1module Spear.Math.Vector.Vector3 5module 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)
18where 23where
19 24
20 25import Spear.Math.Algebra
21import Spear.Math.Vector.Vector 26import Spear.Math.Vector.Vector
27import Spear.Prelude
22 28
23import Foreign.C.Types (CFloat) 29import Foreign.C.Types (CFloat)
24import Foreign.Storable 30import Foreign.Storable
31import qualified Prelude as P
25 32
26type Right3 = Vector3 33type Right3 = Vector3
27type Up3 = Vector3 34type Up3 = Vector3
28type Forward3 = Vector3 35type Forward3 = Vector3
29type Position3 = Vector3 36type 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
39instance Num Vector3 where 46
47sizeVector3 = (3::Int) * sizeOf (undefined :: CFloat)
48
49
50instance 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
55instance 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
60instance 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
65instance 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.
71instance Product Vector3 Float Vector3 where
72 {-# INLINABLE (*) #-}
73 (Vector3 x y z) * s = Vector3 (s * x) (s * y) (s * z)
74
75
76instance 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.
82instance Quotient Vector3 Float where
83 {-# INLINABLE (/) #-}
84 (Vector3 x y z) / s = Vector3 (x / s) (y / s) (y / s)
85
86
87instance 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
48instance Fractional Vector3 where 96instance 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
79instance Vector Vector3 where 129instance 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
120sizeFloat = sizeOf (undefined :: CFloat) 167sizeFloat = sizeOf (undefined :: CFloat)
121 168
122 169
123instance Storable Vector3 where 170instance 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.
140unitx3 = Vector3 1 0 0 187unitx3 = Vector3 1 0 0
141 188
142
143-- | Unit vector along the Y axis. 189-- | Unit vector along the Y axis.
144unity3 = Vector3 0 1 0 190unity3 = Vector3 0 1 0
145 191
146
147-- | Unit vector along the Z axis. 192-- | Unit vector along the Z axis.
148unitz3 = Vector3 0 0 1 193unitz3 = Vector3 0 0 1
149 194
150
151-- | Zero vector. 195-- | Zero vector.
152zero3 = Vector3 0 0 0 196zero3 = 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.
156vec3 :: Float -> Float -> Float -> Vector3 199vec3 :: Float -> Float -> Float -> Vector3
157vec3 ax ay az = Vector3 ax ay az 200vec3 = 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.
161orbit :: Vector3 -- ^ Sphere center. 203orbit :: 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
167orbit center radius anglex angley = 208orbit 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.
182cross :: Vector3 -> Vector3 -> Vector3 220cross :: 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
1module Spear.Math.Vector.Vector4 5module Spear.Math.Vector.Vector4
2( 6(
3 Vector4(..) 7 Vector4(..)
@@ -11,11 +15,13 @@ module Spear.Math.Vector.Vector4
11) 15)
12where 16where
13 17
14 18import Spear.Math.Algebra
15import Spear.Math.Vector.Vector 19import Spear.Math.Vector.Vector
20import Spear.Prelude
16 21
17import Foreign.C.Types (CFloat) 22import Foreign.C.Types (CFloat)
18import Foreign.Storable 23import Foreign.Storable
24import 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
36instance 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
42instance 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
48instance 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
54instance 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.
61instance 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
66instance 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.
72instance Quotient Vector4 Float where
73 {-# INLINABLE (/) #-}
74 (Vector4 x y z w) / s = Vector4 (x / s) (y / s) (y / s) (w / s)
75
76
30instance Num Vector4 where 77instance 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
39instance Fractional Vector4 where 86instance 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
76instance Vector Vector4 where 123instance 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
121sizeFloat = sizeOf (undefined :: CFloat) 165sizeFloat = sizeOf (undefined :: CFloat)
122 166
123 167
124instance Storable Vector4 where 168instance 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.
143unitx4 = Vector4 1 0 0 0 187unitx4 = Vector4 1 0 0 0
144 188
145
146-- | Unit vector along the Y axis. 189-- | Unit vector along the Y axis.
147unity4 = Vector4 0 1 0 0 190unity4 = Vector4 0 1 0 0
148 191
149
150-- | Unit vector along the Z axis. 192-- | Unit vector along the Z axis.
151unitz4 = Vector4 0 0 1 0 193unitz4 = Vector4 0 0 1 0
152 194
153-- | Unit vector along the W axis. 195-- | Unit vector along the W axis.
154unitw4 = Vector4 0 0 0 1 196unitw4 = 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.
158vec4 :: Float -> Float -> Float -> Float -> Vector4 199vec4 :: Float -> Float -> Float -> Float -> Vector4
159vec4 ax ay az aw = Vector4 ax ay az aw 200vec4 = 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.