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