From 64a19ca92ec41258887c267a8f9c4d62d04c1698 Mon Sep 17 00:00:00 2001
From: Marc Sunet <jeannekamikaze@gmail.com>
Date: Tue, 28 Aug 2012 18:55:05 +0200
Subject: Added Quad, Ray, Segment and Utils

---
 Spear/Math/Quad.hs    | 31 +++++++++++++++++++++++++++++++
 Spear/Math/Ray.hs     | 31 +++++++++++++++++++++++++++++++
 Spear/Math/Segment.hs | 21 +++++++++++++++++++++
 Spear/Math/Utils.hs   | 21 +++++++++++++++++++++
 4 files changed, 104 insertions(+)
 create mode 100644 Spear/Math/Quad.hs
 create mode 100644 Spear/Math/Ray.hs
 create mode 100644 Spear/Math/Segment.hs
 create mode 100644 Spear/Math/Utils.hs

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 @@
+module Spear.Math.Quad
+(
+    Quad(..)
+,   quadpt
+)
+where
+
+
+import Spear.Math.Segment
+import Spear.Math.Utils
+import Spear.Math.Vector2
+
+
+data Quad = Quad
+    { tl :: {-# UNPACK #-} !Vector2 -- ^ Top left
+    , tr :: {-# UNPACK #-} !Vector2 -- ^ Top right
+    , br :: {-# UNPACK #-} !Vector2 -- ^ Bottom right
+    , bl :: {-# UNPACK #-} !Vector2 -- ^ Bottom left
+    }
+
+
+-- | Return 'True' if the given point is inside the given quad, 'False' otherwise.
+quadpt :: Quad -> Vector2 -> Bool
+quadpt (Quad tl tr br bl) p =
+    let
+        s1 = seglr (Segment tl tr) p
+        s2 = seglr (Segment tr br) p
+        s3 = seglr (Segment br bl) p
+        s4 = seglr (Segment bl tl) p
+    in
+        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 @@
+module Spear.Math.Ray
+(
+    Ray(..)
+,   raylr
+,   rayfb
+)
+where
+
+
+import Spear.Math.Utils
+import Spear.Math.Vector2
+
+
+data Ray = Ray
+    { origin :: {-# UNPACK #-} !Vector2
+    , dir    :: {-# UNPACK #-} !Vector2
+    }
+
+
+-- | Classify the given point's position with respect to the given ray. Left/Right test.
+raylr :: Ray -> Vector2 -> Side
+raylr (Ray o d) p
+    | orientation2d o (o+d) p < 0 = R
+    | otherwise = L
+
+
+-- | Classify the given point's position with respect to the given ray. Front/Back test.
+rayfb :: Ray -> Vector2 -> Face
+rayfb (Ray o d) p
+    | orientation2d o (perp d) p > 0 = F
+    | 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 @@
+module Spear.Math.Segment
+(
+    Segment(..)
+,   seglr
+)
+where
+
+
+import Spear.Math.Utils
+import Spear.Math.Vector2
+
+
+-- | A line segment in 2D space.
+data Segment = Segment {-# UNPACK #-} !Vector2 {-# UNPACK #-} !Vector2
+
+
+-- | Classify the given point's position with respect to the given segment.
+seglr :: Segment -> Vector2 -> Side
+seglr (Segment p0 p1) p
+    | orientation2d p0 p1 p < 0 = R
+    | 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 @@
+module Spear.Math.Utils
+(
+    Side(..)
+,   Face(..)
+,   orientation2d
+)
+where
+
+
+import Spear.Math.Vector2
+
+
+data Side = L | R deriving (Eq, Show)
+
+
+data Face = F | B deriving (Eq, Show)
+
+
+-- | Return the signed area of the triangle defined by the given points.
+orientation2d :: Vector2 -> Vector2 -> Vector2 -> Float
+orientation2d p q r = (x q - x p) * (y r - y p) - (y q - y p) * (x r - x p)
-- 
cgit v1.2.3