aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
-rw-r--r--Spear/Math/Quad.hs31
-rw-r--r--Spear/Math/Ray.hs31
-rw-r--r--Spear/Math/Segment.hs21
-rw-r--r--Spear/Math/Utils.hs21
4 files changed, 104 insertions, 0 deletions
diff --git a/Spear/Math/Quad.hs b/Spear/Math/Quad.hs
new file mode 100644
index 0000000..e75607c
--- /dev/null
+++ b/Spear/Math/Quad.hs
@@ -0,0 +1,31 @@
1module Spear.Math.Quad
2(
3 Quad(..)
4, quadpt
5)
6where
7
8
9import Spear.Math.Segment
10import Spear.Math.Utils
11import Spear.Math.Vector2
12
13
14data Quad = Quad
15 { tl :: {-# UNPACK #-} !Vector2 -- ^ Top left
16 , tr :: {-# UNPACK #-} !Vector2 -- ^ Top right
17 , br :: {-# UNPACK #-} !Vector2 -- ^ Bottom right
18 , bl :: {-# UNPACK #-} !Vector2 -- ^ Bottom left
19 }
20
21
22-- | Return 'True' if the given point is inside the given quad, 'False' otherwise.
23quadpt :: Quad -> Vector2 -> Bool
24quadpt (Quad tl tr br bl) p =
25 let
26 s1 = seglr (Segment tl tr) p
27 s2 = seglr (Segment tr br) p
28 s3 = seglr (Segment br bl) p
29 s4 = seglr (Segment bl tl) p
30 in
31 R == s1 && s1 == s2 && s2 == s3 && s3 == s4
diff --git a/Spear/Math/Ray.hs b/Spear/Math/Ray.hs
new file mode 100644
index 0000000..697d609
--- /dev/null
+++ b/Spear/Math/Ray.hs
@@ -0,0 +1,31 @@
1module Spear.Math.Ray
2(
3 Ray(..)
4, raylr
5, rayfb
6)
7where
8
9
10import Spear.Math.Utils
11import Spear.Math.Vector2
12
13
14data Ray = Ray
15 { origin :: {-# UNPACK #-} !Vector2
16 , dir :: {-# UNPACK #-} !Vector2
17 }
18
19
20-- | Classify the given point's position with respect to the given ray. Left/Right test.
21raylr :: Ray -> Vector2 -> Side
22raylr (Ray o d) p
23 | orientation2d o (o+d) p < 0 = R
24 | otherwise = L
25
26
27-- | Classify the given point's position with respect to the given ray. Front/Back test.
28rayfb :: Ray -> Vector2 -> Face
29rayfb (Ray o d) p
30 | orientation2d o (perp d) p > 0 = F
31 | otherwise = B
diff --git a/Spear/Math/Segment.hs b/Spear/Math/Segment.hs
new file mode 100644
index 0000000..a89ee05
--- /dev/null
+++ b/Spear/Math/Segment.hs
@@ -0,0 +1,21 @@
1module Spear.Math.Segment
2(
3 Segment(..)
4, seglr
5)
6where
7
8
9import Spear.Math.Utils
10import Spear.Math.Vector2
11
12
13-- | A line segment in 2D space.
14data Segment = Segment {-# UNPACK #-} !Vector2 {-# UNPACK #-} !Vector2
15
16
17-- | Classify the given point's position with respect to the given segment.
18seglr :: Segment -> Vector2 -> Side
19seglr (Segment p0 p1) p
20 | orientation2d p0 p1 p < 0 = R
21 | otherwise = L
diff --git a/Spear/Math/Utils.hs b/Spear/Math/Utils.hs
new file mode 100644
index 0000000..28f012e
--- /dev/null
+++ b/Spear/Math/Utils.hs
@@ -0,0 +1,21 @@
1module Spear.Math.Utils
2(
3 Side(..)
4, Face(..)
5, orientation2d
6)
7where
8
9
10import Spear.Math.Vector2
11
12
13data Side = L | R deriving (Eq, Show)
14
15
16data Face = F | B deriving (Eq, Show)
17
18
19-- | Return the signed area of the triangle defined by the given points.
20orientation2d :: Vector2 -> Vector2 -> Vector2 -> Float
21orientation2d p q r = (x q - x p) * (y r - y p) - (y q - y p) * (x r - x p)