aboutsummaryrefslogtreecommitdiff
path: root/Spear/Math/Vector
diff options
context:
space:
mode:
Diffstat (limited to 'Spear/Math/Vector')
-rw-r--r--Spear/Math/Vector/Class.hs84
-rw-r--r--Spear/Math/Vector/Vector2.hs260
-rw-r--r--Spear/Math/Vector/Vector3.hs368
-rw-r--r--Spear/Math/Vector/Vector4.hs332
4 files changed, 522 insertions, 522 deletions
diff --git a/Spear/Math/Vector/Class.hs b/Spear/Math/Vector/Class.hs
index 05a7206..19ddfac 100644
--- a/Spear/Math/Vector/Class.hs
+++ b/Spear/Math/Vector/Class.hs
@@ -1,43 +1,43 @@
1module Spear.Math.Vector.Class 1module Spear.Math.Vector.Class
2where 2where
3 3
4class (Fractional a, Ord a) => VectorClass a where 4class (Fractional a, Ord a) => VectorClass a where
5 -- | Create a vector from the given list. 5 -- | Create a vector from the given list.
6 fromList :: [Float] -> a 6 fromList :: [Float] -> a
7 7
8 -- | Return the vector's x coordinate. 8 -- | Return the vector's x coordinate.
9 x :: a -> Float 9 x :: a -> Float
10 x _ = 0 10 x _ = 0
11 11
12 -- | Return the vector's y coordinate. 12 -- | Return the vector's y coordinate.
13 y :: a -> Float 13 y :: a -> Float
14 y _ = 0 14 y _ = 0
15 15
16 -- | Return the vector's z coordinate. 16 -- | Return the vector's z coordinate.
17 z :: a -> Float 17 z :: a -> Float
18 z _ = 0 18 z _ = 0
19 19
20 -- | Return the vector's w coordinate. 20 -- | Return the vector's w coordinate.
21 w :: a -> Float 21 w :: a -> Float
22 w _ = 0 22 w _ = 0
23 23
24 -- | Return the vector's ith coordinate. 24 -- | Return the vector's ith coordinate.
25 (!) :: a -> Int -> Float 25 (!) :: a -> Int -> Float
26 26
27 -- | Compute the given vectors' dot product. 27 -- | Compute the given vectors' dot product.
28 dot :: a -> a -> Float 28 dot :: a -> a -> Float
29 29
30 -- | Compute the given vector's squared norm. 30 -- | Compute the given vector's squared norm.
31 normSq :: a -> Float 31 normSq :: a -> Float
32 32
33 -- | Compute the given vector's norm. 33 -- | Compute the given vector's norm.
34 norm :: a -> Float 34 norm :: a -> Float
35 35
36 -- | Multiply the given vector with the given scalar. 36 -- | Multiply the given vector with the given scalar.
37 scale :: Float -> a -> a 37 scale :: Float -> a -> a
38 38
39 -- | Negate the given vector. 39 -- | Negate the given vector.
40 neg :: a -> a 40 neg :: a -> a
41 41
42 -- | Normalise the given vector. 42 -- | Normalise the given vector.
43 normalise :: a -> a \ No newline at end of file 43 normalise :: a -> a \ No newline at end of file
diff --git a/Spear/Math/Vector/Vector2.hs b/Spear/Math/Vector/Vector2.hs
index 616d9dd..0b29ec4 100644
--- a/Spear/Math/Vector/Vector2.hs
+++ b/Spear/Math/Vector/Vector2.hs
@@ -1,130 +1,130 @@
1module Spear.Math.Vector.Vector2 1module Spear.Math.Vector.Vector2
2( 2(
3 Vector2 3 Vector2
4 -- * Construction 4 -- * Construction
5, unitx2 5, unitx2
6, unity2 6, unity2
7, zero2 7, zero2
8, vec2 8, vec2
9 -- * Operations 9 -- * Operations
10, perp 10, perp
11) 11)
12where 12where
13 13
14 14
15import Spear.Math.Vector.Class 15import Spear.Math.Vector.Class
16 16
17 17
18import Foreign.C.Types (CFloat) 18import Foreign.C.Types (CFloat)
19import Foreign.Storable 19import Foreign.Storable
20 20
21 21
22-- | Represents a vector in 2D. 22-- | Represents a vector in 2D.
23data Vector2 = Vector2 {-# UNPACK #-} !Float {-# UNPACK #-} !Float deriving (Eq, Show) 23data Vector2 = Vector2 {-# UNPACK #-} !Float {-# UNPACK #-} !Float deriving (Eq, Show)
24 24
25 25
26instance Num Vector2 where 26instance Num Vector2 where
27 Vector2 ax ay + Vector2 bx by = Vector2 (ax + bx) (ay + by) 27 Vector2 ax ay + Vector2 bx by = Vector2 (ax + bx) (ay + by)
28 Vector2 ax ay - Vector2 bx by = Vector2 (ax - bx) (ay - by) 28 Vector2 ax ay - Vector2 bx by = Vector2 (ax - bx) (ay - by)
29 Vector2 ax ay * Vector2 bx by = Vector2 (ax * bx) (ay * by) 29 Vector2 ax ay * Vector2 bx by = Vector2 (ax * bx) (ay * by)
30 abs (Vector2 ax ay) = Vector2 (abs ax) (abs ay) 30 abs (Vector2 ax ay) = Vector2 (abs ax) (abs ay)
31 signum (Vector2 ax ay) = Vector2 (signum ax) (signum ay) 31 signum (Vector2 ax ay) = Vector2 (signum ax) (signum ay)
32 fromInteger i = Vector2 i' i' where i' = fromInteger i 32 fromInteger i = Vector2 i' i' where i' = fromInteger i
33 33
34 34
35instance Fractional Vector2 where 35instance Fractional Vector2 where
36 Vector2 ax ay / Vector2 bx by = Vector2 (ax / bx) (ay / by) 36 Vector2 ax ay / Vector2 bx by = Vector2 (ax / bx) (ay / by)
37 fromRational r = Vector2 r' r' where r' = fromRational r 37 fromRational r = Vector2 r' r' where r' = fromRational r
38 38
39 39
40instance Ord Vector2 where 40instance Ord Vector2 where
41 Vector2 ax ay <= Vector2 bx by = (ax <= bx) || (ax == bx && ay <= by) 41 Vector2 ax ay <= Vector2 bx by = (ax <= bx) || (ax == bx && ay <= by)
42 Vector2 ax ay >= Vector2 bx by = (ax >= bx) || (ax == bx && ay >= by) 42 Vector2 ax ay >= Vector2 bx by = (ax >= bx) || (ax == bx && ay >= by)
43 Vector2 ax ay < Vector2 bx by = (ax < bx) || (ax == bx && ay < by) 43 Vector2 ax ay < Vector2 bx by = (ax < bx) || (ax == bx && ay < by)
44 Vector2 ax ay > Vector2 bx by = (ax > bx) || (ax == bx && ay > by) 44 Vector2 ax ay > Vector2 bx by = (ax > bx) || (ax == bx && ay > by)
45 max (Vector2 ax ay) (Vector2 bx by) = Vector2 (Prelude.max ax bx) (Prelude.max ay by) 45 max (Vector2 ax ay) (Vector2 bx by) = Vector2 (Prelude.max ax bx) (Prelude.max ay by)
46 min (Vector2 ax ay) (Vector2 bx by) = Vector2 (Prelude.min ax bx) (Prelude.min ay by) 46 min (Vector2 ax ay) (Vector2 bx by) = Vector2 (Prelude.min ax bx) (Prelude.min ay by)
47 47
48 48
49instance VectorClass Vector2 where 49instance VectorClass Vector2 where
50 {-# INLINABLE fromList #-} 50 {-# INLINABLE fromList #-}
51 fromList (ax:ay:_) = Vector2 ax ay 51 fromList (ax:ay:_) = Vector2 ax ay
52 52
53 {-# INLINABLE x #-} 53 {-# INLINABLE x #-}
54 x (Vector2 ax _) = ax 54 x (Vector2 ax _) = ax
55 55
56 {-# INLINABLE y #-} 56 {-# INLINABLE y #-}
57 y (Vector2 _ ay) = ay 57 y (Vector2 _ ay) = ay
58 58
59 {-# INLINABLE (!) #-} 59 {-# INLINABLE (!) #-}
60 (Vector2 ax _) ! 0 = ax 60 (Vector2 ax _) ! 0 = ax
61 (Vector2 _ ay) ! 1 = ay 61 (Vector2 _ ay) ! 1 = ay
62 _ ! _ = 0 62 _ ! _ = 0
63 63
64 {-# INLINABLE dot #-} 64 {-# INLINABLE dot #-}
65 Vector2 ax ay `dot` Vector2 bx by = ax*bx + ay*by 65 Vector2 ax ay `dot` Vector2 bx by = ax*bx + ay*by
66 66
67 {-# INLINABLE normSq #-} 67 {-# INLINABLE normSq #-}
68 normSq (Vector2 ax ay) = ax*ax + ay*ay 68 normSq (Vector2 ax ay) = ax*ax + ay*ay
69 69
70 {-# INLINABLE norm #-} 70 {-# INLINABLE norm #-}
71 norm = sqrt . normSq 71 norm = sqrt . normSq
72 72
73 {-# INLINABLE scale #-} 73 {-# INLINABLE scale #-}
74 scale s (Vector2 ax ay) = Vector2 (s*ax) (s*ay) 74 scale s (Vector2 ax ay) = Vector2 (s*ax) (s*ay)
75 75
76 {-# INLINABLE neg #-} 76 {-# INLINABLE neg #-}
77 neg (Vector2 ax ay) = Vector2 (-ax) (-ay) 77 neg (Vector2 ax ay) = Vector2 (-ax) (-ay)
78 78
79 {-# INLINABLE normalise #-} 79 {-# INLINABLE normalise #-}
80 normalise v = 80 normalise v =
81 let n' = norm v 81 let n' = norm v
82 n = if n' == 0 then 1 else n' 82 n = if n' == 0 then 1 else n'
83 in scale (1.0 / n) v 83 in scale (1.0 / n) v
84 84
85 85
86sizeFloat = sizeOf (undefined :: CFloat) 86sizeFloat = sizeOf (undefined :: CFloat)
87 87
88 88
89instance Storable Vector2 where 89instance Storable Vector2 where
90 sizeOf _ = 2*sizeFloat 90 sizeOf _ = 2*sizeFloat
91 alignment _ = alignment (undefined :: CFloat) 91 alignment _ = alignment (undefined :: CFloat)
92 92
93 peek ptr = do 93 peek ptr = do
94 ax <- peekByteOff ptr 0 94 ax <- peekByteOff ptr 0
95 ay <- peekByteOff ptr $ sizeFloat 95 ay <- peekByteOff ptr $ sizeFloat
96 return (Vector2 ax ay) 96 return (Vector2 ax ay)
97 97
98 poke ptr (Vector2 ax ay) = do 98 poke ptr (Vector2 ax ay) = do
99 pokeByteOff ptr 0 ax 99 pokeByteOff ptr 0 ax
100 pokeByteOff ptr sizeFloat ay 100 pokeByteOff ptr sizeFloat ay
101 101
102 102
103-- | Get the vector's x coordinate. 103-- | Get the vector's x coordinate.
104 104
105 105
106 106
107-- | Unit vector along the X axis. 107-- | Unit vector along the X axis.
108unitx2 = Vector2 1 0 108unitx2 = Vector2 1 0
109 109
110 110
111-- | Unit vector along the Y axis. 111-- | Unit vector along the Y axis.
112unity2 = Vector2 0 1 112unity2 = Vector2 0 1
113 113
114 114
115-- | Zero vector. 115-- | Zero vector.
116zero2 = Vector2 0 0 116zero2 = Vector2 0 0
117 117
118 118
119-- | Create a vector from the given values. 119-- | Create a vector from the given values.
120vec2 :: Float -> Float -> Vector2 120vec2 :: Float -> Float -> Vector2
121vec2 ax ay = Vector2 ax ay 121vec2 ax ay = Vector2 ax ay
122 122
123 123
124-- | Compute a vector perpendicular to the given one, satisfying: 124-- | Compute a vector perpendicular to the given one, satisfying:
125-- 125--
126-- perp (Vector2 0 1) = Vector2 1 0 126-- perp (Vector2 0 1) = Vector2 1 0
127-- 127--
128-- perp (Vector2 1 0) = Vector2 0 (-1) 128-- perp (Vector2 1 0) = Vector2 0 (-1)
129perp :: Vector2 -> Vector2 129perp :: Vector2 -> Vector2
130perp (Vector2 x y) = Vector2 y (-x) 130perp (Vector2 x y) = Vector2 y (-x)
diff --git a/Spear/Math/Vector/Vector3.hs b/Spear/Math/Vector/Vector3.hs
index 8a1cfa9..70bd299 100644
--- a/Spear/Math/Vector/Vector3.hs
+++ b/Spear/Math/Vector/Vector3.hs
@@ -1,184 +1,184 @@
1module Spear.Math.Vector.Vector3 1module Spear.Math.Vector.Vector3
2( 2(
3 Vector3 3 Vector3
4, Right3 4, Right3
5, Up3 5, Up3
6, Forward3 6, Forward3
7, Position3 7, Position3
8 -- * Construction 8 -- * Construction
9, unitx3 9, unitx3
10, unity3 10, unity3
11, unitz3 11, unitz3
12, zero3 12, zero3
13, vec3 13, vec3
14, orbit 14, orbit
15 -- * Operations 15 -- * Operations
16, cross 16, cross
17) 17)
18where 18where
19 19
20 20
21import Spear.Math.Vector.Class 21import Spear.Math.Vector.Class
22 22
23import Foreign.C.Types (CFloat) 23import Foreign.C.Types (CFloat)
24import Foreign.Storable 24import Foreign.Storable
25 25
26type Right3 = Vector3 26type Right3 = Vector3
27type Up3 = Vector3 27type Up3 = Vector3
28type Forward3 = Vector3 28type Forward3 = Vector3
29type Position3 = Vector3 29type Position3 = Vector3
30 30
31 31
32-- | Represents a vector in 3D. 32-- | Represents a vector in 3D.
33data Vector3 = Vector3 33data Vector3 = Vector3
34 {-# UNPACK #-} !Float 34 {-# UNPACK #-} !Float
35 {-# UNPACK #-} !Float 35 {-# UNPACK #-} !Float
36 {-# UNPACK #-} !Float 36 {-# UNPACK #-} !Float
37 deriving (Eq, Show) 37 deriving (Eq, Show)
38 38
39instance Num Vector3 where 39instance Num Vector3 where
40 Vector3 ax ay az + Vector3 bx by bz = Vector3 (ax + bx) (ay + by) (az + bz) 40 Vector3 ax ay az + Vector3 bx by bz = Vector3 (ax + bx) (ay + by) (az + bz)
41 Vector3 ax ay az - Vector3 bx by bz = Vector3 (ax - bx) (ay - by) (az - bz) 41 Vector3 ax ay az - Vector3 bx by bz = Vector3 (ax - bx) (ay - by) (az - bz)
42 Vector3 ax ay az * Vector3 bx by bz = Vector3 (ax * bx) (ay * by) (az * bz) 42 Vector3 ax ay az * Vector3 bx by bz = Vector3 (ax * bx) (ay * by) (az * bz)
43 abs (Vector3 ax ay az) = Vector3 (abs ax) (abs ay) (abs az) 43 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) 44 signum (Vector3 ax ay az) = Vector3 (signum ax) (signum ay) (signum az)
45 fromInteger i = Vector3 i' i' i' where i' = fromInteger i 45 fromInteger i = Vector3 i' i' i' where i' = fromInteger i
46 46
47 47
48instance Fractional Vector3 where 48instance Fractional Vector3 where
49 Vector3 ax ay az / Vector3 bx by bz = Vector3 (ax / bx) (ay / by) (az / bz) 49 Vector3 ax ay az / Vector3 bx by bz = Vector3 (ax / bx) (ay / by) (az / bz)
50 fromRational r = Vector3 r' r' r' where r' = fromRational r 50 fromRational r = Vector3 r' r' r' where r' = fromRational r
51 51
52 52
53instance Ord Vector3 where 53instance Ord Vector3 where
54 Vector3 ax ay az <= Vector3 bx by bz 54 Vector3 ax ay az <= Vector3 bx by bz
55 = (ax <= bx) 55 = (ax <= bx)
56 || (az == bx && ay <= by) 56 || (az == bx && ay <= by)
57 || (ax == bx && ay == by && az <= bz) 57 || (ax == bx && ay == by && az <= bz)
58 58
59 Vector3 ax ay az >= Vector3 bx by bz 59 Vector3 ax ay az >= Vector3 bx by bz
60 = (ax >= bx) 60 = (ax >= bx)
61 || (ax == bx && ay >= by) 61 || (ax == bx && ay >= by)
62 || (ax == bx && ay == by && az >= bz) 62 || (ax == bx && ay == by && az >= bz)
63 63
64 Vector3 ax ay az < Vector3 bx by bz 64 Vector3 ax ay az < Vector3 bx by bz
65 = (ax < bx) 65 = (ax < bx)
66 || (az == bx && ay < by) 66 || (az == bx && ay < by)
67 || (ax == bx && ay == by && az < bz) 67 || (ax == bx && ay == by && az < bz)
68 68
69 Vector3 ax ay az > Vector3 bx by bz 69 Vector3 ax ay az > Vector3 bx by bz
70 = (ax > bx) 70 = (ax > bx)
71 || (ax == bx && ay > by) 71 || (ax == bx && ay > by)
72 || (ax == bx && ay == by && az > bz) 72 || (ax == bx && ay == by && az > bz)
73 73
74 max (Vector3 ax ay az) (Vector3 bx by bz) = Vector3 (Prelude.max ax bx) (Prelude.max ay by) (Prelude.max az bz) 74 max (Vector3 ax ay az) (Vector3 bx by bz) = Vector3 (Prelude.max ax bx) (Prelude.max ay by) (Prelude.max az bz)
75 75
76 min (Vector3 ax ay az) (Vector3 bx by bz) = Vector3 (Prelude.min ax bx) (Prelude.min ay by) (Prelude.min az bz) 76 min (Vector3 ax ay az) (Vector3 bx by bz) = Vector3 (Prelude.min ax bx) (Prelude.min ay by) (Prelude.min az bz)
77 77
78 78
79instance VectorClass Vector3 where 79instance VectorClass Vector3 where
80 {-# INLINABLE fromList #-} 80 {-# INLINABLE fromList #-}
81 fromList (ax:ay:az:_) = Vector3 ax ay az 81 fromList (ax:ay:az:_) = Vector3 ax ay az
82 82
83 {-# INLINABLE x #-} 83 {-# INLINABLE x #-}
84 x (Vector3 ax _ _ ) = ax 84 x (Vector3 ax _ _ ) = ax
85 85
86 {-# INLINABLE y #-} 86 {-# INLINABLE y #-}
87 y (Vector3 _ ay _ ) = ay 87 y (Vector3 _ ay _ ) = ay
88 88
89 {-# INLINABLE z #-} 89 {-# INLINABLE z #-}
90 z (Vector3 _ _ az) = az 90 z (Vector3 _ _ az) = az
91 91
92 {-# INLINABLE (!) #-} 92 {-# INLINABLE (!) #-}
93 (Vector3 ax _ _) ! 0 = ax 93 (Vector3 ax _ _) ! 0 = ax
94 (Vector3 _ ay _) ! 1 = ay 94 (Vector3 _ ay _) ! 1 = ay
95 (Vector3 _ _ az) ! 2 = az 95 (Vector3 _ _ az) ! 2 = az
96 _ ! _ = 0 96 _ ! _ = 0
97 97
98 {-# INLINABLE dot #-} 98 {-# INLINABLE dot #-}
99 Vector3 ax ay az `dot` Vector3 bx by bz = ax*bx + ay*by + az*bz 99 Vector3 ax ay az `dot` Vector3 bx by bz = ax*bx + ay*by + az*bz
100 100
101 {-# INLINABLE normSq #-} 101 {-# INLINABLE normSq #-}
102 normSq (Vector3 ax ay az) = ax*ax + ay*ay + az*az 102 normSq (Vector3 ax ay az) = ax*ax + ay*ay + az*az
103 103
104 {-# INLINABLE norm #-} 104 {-# INLINABLE norm #-}
105 norm = sqrt . normSq 105 norm = sqrt . normSq
106 106
107 {-# INLINABLE scale #-} 107 {-# INLINABLE scale #-}
108 scale s (Vector3 ax ay az) = Vector3 (s*ax) (s*ay) (s*az) 108 scale s (Vector3 ax ay az) = Vector3 (s*ax) (s*ay) (s*az)
109 109
110 {-# INLINABLE neg #-} 110 {-# INLINABLE neg #-}
111 neg (Vector3 ax ay az) = Vector3 (-ax) (-ay) (-az) 111 neg (Vector3 ax ay az) = Vector3 (-ax) (-ay) (-az)
112 112
113 {-# INLINABLE normalise #-} 113 {-# INLINABLE normalise #-}
114 normalise v = 114 normalise v =
115 let n' = norm v 115 let n' = norm v
116 n = if n' == 0 then 1 else n' 116 n = if n' == 0 then 1 else n'
117 in scale (1.0 / n) v 117 in scale (1.0 / n) v
118 118
119 119
120sizeFloat = sizeOf (undefined :: CFloat) 120sizeFloat = sizeOf (undefined :: CFloat)
121 121
122 122
123instance Storable Vector3 where 123instance Storable Vector3 where
124 sizeOf _ = 3*sizeFloat 124 sizeOf _ = 3*sizeFloat
125 alignment _ = alignment (undefined :: CFloat) 125 alignment _ = alignment (undefined :: CFloat)
126 126
127 peek ptr = do 127 peek ptr = do
128 ax <- peekByteOff ptr 0 128 ax <- peekByteOff ptr 0
129 ay <- peekByteOff ptr $ 1*sizeFloat 129 ay <- peekByteOff ptr $ 1*sizeFloat
130 az <- peekByteOff ptr $ 2*sizeFloat 130 az <- peekByteOff ptr $ 2*sizeFloat
131 return (Vector3 ax ay az) 131 return (Vector3 ax ay az)
132 132
133 poke ptr (Vector3 ax ay az) = do 133 poke ptr (Vector3 ax ay az) = do
134 pokeByteOff ptr 0 ax 134 pokeByteOff ptr 0 ax
135 pokeByteOff ptr (1*sizeFloat) ay 135 pokeByteOff ptr (1*sizeFloat) ay
136 pokeByteOff ptr (2*sizeFloat) az 136 pokeByteOff ptr (2*sizeFloat) az
137 137
138 138
139-- | Unit vector along the X axis. 139-- | Unit vector along the X axis.
140unitx3 = Vector3 1 0 0 140unitx3 = Vector3 1 0 0
141 141
142 142
143-- | Unit vector along the Y axis. 143-- | Unit vector along the Y axis.
144unity3 = Vector3 0 1 0 144unity3 = Vector3 0 1 0
145 145
146 146
147-- | Unit vector along the Z axis. 147-- | Unit vector along the Z axis.
148unitz3 = Vector3 0 0 1 148unitz3 = Vector3 0 0 1
149 149
150 150
151-- | Zero vector. 151-- | Zero vector.
152zero3 = Vector3 0 0 0 152zero3 = Vector3 0 0 0
153 153
154 154
155-- | Create a 3D vector from the given values. 155-- | Create a 3D vector from the given values.
156vec3 :: Float -> Float -> Float -> Vector3 156vec3 :: Float -> Float -> Float -> Vector3
157vec3 ax ay az = Vector3 ax ay az 157vec3 ax ay az = Vector3 ax ay az
158 158
159 159
160-- | Create a 3D vector as a point on a sphere. 160-- | Create a 3D vector as a point on a sphere.
161orbit :: Vector3 -- ^ Sphere center. 161orbit :: Vector3 -- ^ Sphere center.
162 -> Float -- ^ Sphere radius 162 -> Float -- ^ Sphere radius
163 -> Float -- ^ Azimuth angle. 163 -> Float -- ^ Azimuth angle.
164 -> Float -- ^ Zenith angle. 164 -> Float -- ^ Zenith angle.
165 -> Vector3 165 -> Vector3
166 166
167orbit center radius anglex angley = 167orbit center radius anglex angley =
168 let ax = anglex * pi / 180 168 let ax = anglex * pi / 180
169 ay = angley * pi / 180 169 ay = angley * pi / 180
170 sx = sin ax 170 sx = sin ax
171 sy = sin ay 171 sy = sin ay
172 cx = cos ax 172 cx = cos ax
173 cy = cos ay 173 cy = cos ay
174 px = x center + radius*cy*sx 174 px = x center + radius*cy*sx
175 py = y center + radius*sy 175 py = y center + radius*sy
176 pz = z center + radius*cx*cy 176 pz = z center + radius*cx*cy
177 in 177 in
178 vec3 px py pz 178 vec3 px py pz
179 179
180 180
181-- | Compute the given vectors' cross product. 181-- | Compute the given vectors' cross product.
182cross :: Vector3 -> Vector3 -> Vector3 182cross :: Vector3 -> Vector3 -> Vector3
183(Vector3 ax ay az) `cross` (Vector3 bx by bz) = 183(Vector3 ax ay az) `cross` (Vector3 bx by bz) =
184 Vector3 (ay * bz - az * by) (az * bx - ax * bz) (ax * by - ay * bx) 184 Vector3 (ay * bz - az * by) (az * bx - ax * bz) (ax * by - ay * bx)
diff --git a/Spear/Math/Vector/Vector4.hs b/Spear/Math/Vector/Vector4.hs
index 5185763..3b5ed95 100644
--- a/Spear/Math/Vector/Vector4.hs
+++ b/Spear/Math/Vector/Vector4.hs
@@ -1,166 +1,166 @@
1module Spear.Math.Vector.Vector4 1module Spear.Math.Vector.Vector4
2( 2(
3 Vector4 3 Vector4
4 -- * Construction 4 -- * Construction
5, unitx4 5, unitx4
6, unity4 6, unity4
7, unitz4 7, unitz4
8, vec4 8, vec4
9 -- * Operations 9 -- * Operations
10, cross' 10, cross'
11) 11)
12where 12where
13 13
14 14
15import Spear.Math.Vector.Class 15import Spear.Math.Vector.Class
16 16
17import Foreign.C.Types (CFloat) 17import Foreign.C.Types (CFloat)
18import Foreign.Storable 18import Foreign.Storable
19 19
20 20
21-- | Represents a vector in 3D. 21-- | Represents a vector in 3D.
22data Vector4 = Vector4 22data Vector4 = Vector4
23 {-# UNPACK #-} !Float 23 {-# UNPACK #-} !Float
24 {-# UNPACK #-} !Float 24 {-# UNPACK #-} !Float
25 {-# UNPACK #-} !Float 25 {-# UNPACK #-} !Float
26 {-# UNPACK #-} !Float 26 {-# UNPACK #-} !Float
27 deriving (Eq, Show) 27 deriving (Eq, Show)
28 28
29 29
30instance Num Vector4 where 30instance Num Vector4 where
31 Vector4 ax ay az aw + Vector4 bx by bz bw = Vector4 (ax + bx) (ay + by) (az + bz) (aw + bw) 31 Vector4 ax ay az aw + Vector4 bx by bz bw = Vector4 (ax + bx) (ay + by) (az + bz) (aw + bw)
32 Vector4 ax ay az aw - Vector4 bx by bz bw = Vector4 (ax - bx) (ay - by) (az - bz) (aw - bw) 32 Vector4 ax ay az aw - Vector4 bx by bz bw = Vector4 (ax - bx) (ay - by) (az - bz) (aw - bw)
33 Vector4 ax ay az aw * Vector4 bx by bz bw = Vector4 (ax * bx) (ay * by) (az * bz) (aw * bw) 33 Vector4 ax ay az aw * Vector4 bx by bz bw = Vector4 (ax * bx) (ay * by) (az * bz) (aw * bw)
34 abs (Vector4 ax ay az aw) = Vector4 (abs ax) (abs ay) (abs az) (abs aw) 34 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) 35 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 36 fromInteger i = Vector4 i' i' i' i' where i' = fromInteger i
37 37
38 38
39instance Fractional Vector4 where 39instance Fractional Vector4 where
40 Vector4 ax ay az aw / Vector4 bx by bz bw = Vector4 (ax / bx) (ay / by) (az / bz) (aw / bw) 40 Vector4 ax ay az aw / Vector4 bx by bz bw = Vector4 (ax / bx) (ay / by) (az / bz) (aw / bw)
41 fromRational r = Vector4 r' r' r' r' where r' = fromRational r 41 fromRational r = Vector4 r' r' r' r' where r' = fromRational r
42 42
43 43
44instance Ord Vector4 where 44instance Ord Vector4 where
45 Vector4 ax ay az aw <= Vector4 bx by bz bw 45 Vector4 ax ay az aw <= Vector4 bx by bz bw
46 = (ax <= bx) 46 = (ax <= bx)
47 || (az == bx && ay <= by) 47 || (az == bx && ay <= by)
48 || (ax == bx && ay == by && az <= bz) 48 || (ax == bx && ay == by && az <= bz)
49 || (ax == bx && ay == by && az == bz && aw <= bw) 49 || (ax == bx && ay == by && az == bz && aw <= bw)
50 50
51 Vector4 ax ay az aw >= Vector4 bx by bz bw 51 Vector4 ax ay az aw >= Vector4 bx by bz bw
52 = (ax >= bx) 52 = (ax >= bx)
53 || (ax == bx && ay >= by) 53 || (ax == bx && ay >= by)
54 || (ax == bx && ay == by && az >= bz) 54 || (ax == bx && ay == by && az >= bz)
55 || (ax == bx && ay == by && az == bz && aw >= bw) 55 || (ax == bx && ay == by && az == bz && aw >= bw)
56 56
57 Vector4 ax ay az aw < Vector4 bx by bz bw 57 Vector4 ax ay az aw < Vector4 bx by bz bw
58 = (ax < bx) 58 = (ax < bx)
59 || (az == bx && ay < by) 59 || (az == bx && ay < by)
60 || (ax == bx && ay == by && az < bz) 60 || (ax == bx && ay == by && az < bz)
61 || (ax == bx && ay == by && az == bz && aw < bw) 61 || (ax == bx && ay == by && az == bz && aw < bw)
62 62
63 Vector4 ax ay az aw > Vector4 bx by bz bw 63 Vector4 ax ay az aw > Vector4 bx by bz bw
64 = (ax > bx) 64 = (ax > bx)
65 || (ax == bx && ay > by) 65 || (ax == bx && ay > by)
66 || (ax == bx && ay == by && az > bz) 66 || (ax == bx && ay == by && az > bz)
67 || (ax == bx && ay == by && az == bz && aw > bw) 67 || (ax == bx && ay == by && az == bz && aw > bw)
68 68
69 min (Vector4 ax ay az aw) (Vector4 bx by bz bw) = 69 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) 70 Vector4 (Prelude.min ax bx) (Prelude.min ay by) (Prelude.min az bz) (Prelude.min aw bw)
71 71
72 max (Vector4 ax ay az aw) (Vector4 bx by bz bw) = 72 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) 73 Vector4 (Prelude.max ax bx) (Prelude.max ay by) (Prelude.max az bz) (Prelude.min aw bw)
74 74
75 75
76instance VectorClass Vector4 where 76instance VectorClass Vector4 where
77 {-# INLINABLE fromList #-} 77 {-# INLINABLE fromList #-}
78 fromList (ax:ay:az:aw:_) = Vector4 ax ay az aw 78 fromList (ax:ay:az:aw:_) = Vector4 ax ay az aw
79 79
80 {-# INLINABLE x #-} 80 {-# INLINABLE x #-}
81 x (Vector4 ax _ _ _ ) = ax 81 x (Vector4 ax _ _ _ ) = ax
82 82
83 {-# INLINABLE y #-} 83 {-# INLINABLE y #-}
84 y (Vector4 _ ay _ _ ) = ay 84 y (Vector4 _ ay _ _ ) = ay
85 85
86 {-# INLINABLE z #-} 86 {-# INLINABLE z #-}
87 z (Vector4 _ _ az _ ) = az 87 z (Vector4 _ _ az _ ) = az
88 88
89 {-# INLINABLE w #-} 89 {-# INLINABLE w #-}
90 w (Vector4 _ _ _ aw) = aw 90 w (Vector4 _ _ _ aw) = aw
91 91
92 {-# INLINABLE (!) #-} 92 {-# INLINABLE (!) #-}
93 (Vector4 ax _ _ _) ! 0 = ax 93 (Vector4 ax _ _ _) ! 0 = ax
94 (Vector4 _ ay _ _) ! 1 = ay 94 (Vector4 _ ay _ _) ! 1 = ay
95 (Vector4 _ _ az _) ! 2 = az 95 (Vector4 _ _ az _) ! 2 = az
96 (Vector4 _ _ _ aw) ! 3 = aw 96 (Vector4 _ _ _ aw) ! 3 = aw
97 _ ! _ = 0 97 _ ! _ = 0
98 98
99 {-# INLINABLE dot #-} 99 {-# INLINABLE dot #-}
100 Vector4 ax ay az aw `dot` Vector4 bx by bz bw = ax*bx + ay*by + az*bz + aw*bw 100 Vector4 ax ay az aw `dot` Vector4 bx by bz bw = ax*bx + ay*by + az*bz + aw*bw
101 101
102 {-# INLINABLE normSq #-} 102 {-# INLINABLE normSq #-}
103 normSq (Vector4 ax ay az aw) = ax*ax + ay*ay + az*az + aw*aw 103 normSq (Vector4 ax ay az aw) = ax*ax + ay*ay + az*az + aw*aw
104 104
105 {-# INLINABLE norm #-} 105 {-# INLINABLE norm #-}
106 norm = sqrt . normSq 106 norm = sqrt . normSq
107 107
108 {-# INLINABLE scale #-} 108 {-# INLINABLE scale #-}
109 scale s (Vector4 ax ay az aw) = Vector4 (s*ax) (s*ay) (s*az) (s*aw) 109 scale s (Vector4 ax ay az aw) = Vector4 (s*ax) (s*ay) (s*az) (s*aw)
110 110
111 {-# INLINABLE neg #-} 111 {-# INLINABLE neg #-}
112 neg (Vector4 ax ay az aw) = Vector4 (-ax) (-ay) (-az) (-aw) 112 neg (Vector4 ax ay az aw) = Vector4 (-ax) (-ay) (-az) (-aw)
113 113
114 {-# INLINABLE normalise #-} 114 {-# INLINABLE normalise #-}
115 normalise v = 115 normalise v =
116 let n' = norm v 116 let n' = norm v
117 n = if n' == 0 then 1 else n' 117 n = if n' == 0 then 1 else n'
118 in scale (1.0 / n) v 118 in scale (1.0 / n) v
119 119
120 120
121sizeFloat = sizeOf (undefined :: CFloat) 121sizeFloat = sizeOf (undefined :: CFloat)
122 122
123 123
124instance Storable Vector4 where 124instance Storable Vector4 where
125 sizeOf _ = 4*sizeFloat 125 sizeOf _ = 4*sizeFloat
126 alignment _ = alignment (undefined :: CFloat) 126 alignment _ = alignment (undefined :: CFloat)
127 127
128 peek ptr = do 128 peek ptr = do
129 ax <- peekByteOff ptr 0 129 ax <- peekByteOff ptr 0
130 ay <- peekByteOff ptr $ 1 * sizeFloat 130 ay <- peekByteOff ptr $ 1 * sizeFloat
131 az <- peekByteOff ptr $ 2 * sizeFloat 131 az <- peekByteOff ptr $ 2 * sizeFloat
132 aw <- peekByteOff ptr $ 3 * sizeFloat 132 aw <- peekByteOff ptr $ 3 * sizeFloat
133 return (Vector4 ax ay az aw) 133 return (Vector4 ax ay az aw)
134 134
135 poke ptr (Vector4 ax ay az aw) = do 135 poke ptr (Vector4 ax ay az aw) = do
136 pokeByteOff ptr 0 ax 136 pokeByteOff ptr 0 ax
137 pokeByteOff ptr (1 * sizeFloat) ay 137 pokeByteOff ptr (1 * sizeFloat) ay
138 pokeByteOff ptr (2 * sizeFloat) az 138 pokeByteOff ptr (2 * sizeFloat) az
139 pokeByteOff ptr (3 * sizeFloat) aw 139 pokeByteOff ptr (3 * sizeFloat) aw
140 140
141 141
142-- | Unit vector along the X axis. 142-- | Unit vector along the X axis.
143unitx4 = Vector4 1 0 0 0 143unitx4 = Vector4 1 0 0 0
144 144
145 145
146-- | Unit vector along the Y axis. 146-- | Unit vector along the Y axis.
147unity4 = Vector4 0 1 0 0 147unity4 = Vector4 0 1 0 0
148 148
149 149
150-- | Unit vector along the Z axis. 150-- | Unit vector along the Z axis.
151unitz4 = Vector4 0 0 1 0 151unitz4 = Vector4 0 0 1 0
152 152
153-- | Unit vector along the W axis. 153-- | Unit vector along the W axis.
154unitw4 = Vector4 0 0 0 1 154unitw4 = Vector4 0 0 0 1
155 155
156 156
157-- | Create a 4D vector from the given values. 157-- | Create a 4D vector from the given values.
158vec4 :: Float -> Float -> Float -> Float -> Vector4 158vec4 :: Float -> Float -> Float -> Float -> Vector4
159vec4 ax ay az aw = Vector4 ax ay az aw 159vec4 ax ay az aw = Vector4 ax ay az aw
160 160
161 161
162-- | Compute the given vectors' cross product. 162-- | 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. 163-- The vectors are projected to 3D space. The resulting vector is the cross product of the vectors' projections with w=0.
164cross' :: Vector4 -> Vector4 -> Vector4 164cross' :: Vector4 -> Vector4 -> Vector4
165(Vector4 ax ay az _) `cross'` (Vector4 bx by bz _) = 165(Vector4 ax ay az _) `cross'` (Vector4 bx by bz _) =
166 Vector4 (ay * bz - az * by) (az * bx - ax * bz) (ax * by - ay * bx) 0 166 Vector4 (ay * bz - az * by) (az * bx - ax * bz) (ax * by - ay * bx) 0
generated by cgit v1.2.3 (git 2.25.1) at 2024-12-28 04:29:46 +0000