1 files changed, 35 insertions, 0 deletions

diff --git a/Spear/Math/Sphere.hs b/Spear/Math/Sphere.hs
new file mode 100644
index 0000000..4a9e3fc
--- /dev/null
+++ b/Spear/Math/Sphere.hs
@@ -0,0 +1,35 @@
+module Spear.Math.Sphere
+(
+    Sphere(..)
+,   sphere
+,   spherept
+)
+where
+
+
+import Spear.Math.Vector3 as Vector
+
+
+-- | A bounding volume.
+data Sphere = Sphere
+    { center :: {-# UNPACK #-} !Vector3
+    , radius :: {-# UNPACK #-} !Float
+    }
+
+
+-- | Create a 'Sphere' from the given points.
+sphere :: [Vector3] -> Sphere
+
+sphere [] = error "Attempting to build a BoundingVolume from an empty list!"
+
+sphere (x:xs) = Sphere c r
+    where
+        c = min + (max-min)/2
+        r = norm $ max - c
+        (min,max) = foldr update (x,x) xs
+        update p (min,max) = (Vector.min p min, Vector.max p max)
+
+
+-- | Return 'True' if the given 'Sphere' contains the given point, 'False' otherwise.         
+spherept :: Sphere -> Vector3 -> Bool
+(Sphere center radius) `spherept` p = radius*radius >= normSq (p - center)