diff options
| -rw-r--r-- | Spear/Math/Quad.hs | 31 | ||||
| -rw-r--r-- | Spear/Math/Ray.hs | 31 | ||||
| -rw-r--r-- | Spear/Math/Segment.hs | 21 | ||||
| -rw-r--r-- | Spear/Math/Utils.hs | 21 |
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 @@ | |||
| 1 | module Spear.Math.Quad | ||
| 2 | ( | ||
| 3 | Quad(..) | ||
| 4 | , quadpt | ||
| 5 | ) | ||
| 6 | where | ||
| 7 | |||
| 8 | |||
| 9 | import Spear.Math.Segment | ||
| 10 | import Spear.Math.Utils | ||
| 11 | import Spear.Math.Vector2 | ||
| 12 | |||
| 13 | |||
| 14 | data 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. | ||
| 23 | quadpt :: Quad -> Vector2 -> Bool | ||
| 24 | quadpt (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 @@ | |||
| 1 | module Spear.Math.Ray | ||
| 2 | ( | ||
| 3 | Ray(..) | ||
| 4 | , raylr | ||
| 5 | , rayfb | ||
| 6 | ) | ||
| 7 | where | ||
| 8 | |||
| 9 | |||
| 10 | import Spear.Math.Utils | ||
| 11 | import Spear.Math.Vector2 | ||
| 12 | |||
| 13 | |||
| 14 | data 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. | ||
| 21 | raylr :: Ray -> Vector2 -> Side | ||
| 22 | raylr (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. | ||
| 28 | rayfb :: Ray -> Vector2 -> Face | ||
| 29 | rayfb (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 @@ | |||
| 1 | module Spear.Math.Segment | ||
| 2 | ( | ||
| 3 | Segment(..) | ||
| 4 | , seglr | ||
| 5 | ) | ||
| 6 | where | ||
| 7 | |||
| 8 | |||
| 9 | import Spear.Math.Utils | ||
| 10 | import Spear.Math.Vector2 | ||
| 11 | |||
| 12 | |||
| 13 | -- | A line segment in 2D space. | ||
| 14 | data Segment = Segment {-# UNPACK #-} !Vector2 {-# UNPACK #-} !Vector2 | ||
| 15 | |||
| 16 | |||
| 17 | -- | Classify the given point's position with respect to the given segment. | ||
| 18 | seglr :: Segment -> Vector2 -> Side | ||
| 19 | seglr (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 @@ | |||
| 1 | module Spear.Math.Utils | ||
| 2 | ( | ||
| 3 | Side(..) | ||
| 4 | , Face(..) | ||
| 5 | , orientation2d | ||
| 6 | ) | ||
| 7 | where | ||
| 8 | |||
| 9 | |||
| 10 | import Spear.Math.Vector2 | ||
| 11 | |||
| 12 | |||
| 13 | data Side = L | R deriving (Eq, Show) | ||
| 14 | |||
| 15 | |||
| 16 | data Face = F | B deriving (Eq, Show) | ||
| 17 | |||
| 18 | |||
| 19 | -- | Return the signed area of the triangle defined by the given points. | ||
| 20 | orientation2d :: Vector2 -> Vector2 -> Vector2 -> Float | ||
| 21 | orientation2d p q r = (x q - x p) * (y r - y p) - (y q - y p) * (x r - x p) | ||
