aboutsummaryrefslogtreecommitdiff
path: root/Spear/Math/Vector/Vector3.hs
diff options
context:
space:
mode:
Diffstat (limited to 'Spear/Math/Vector/Vector3.hs')
-rw-r--r--Spear/Math/Vector/Vector3.hs368
1 files changed, 184 insertions, 184 deletions
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)
generated by cgit v1.2.3 (git 2.25.1) at 2024-11-01 10:27:55 +0000