diff options
Diffstat (limited to 'Spear/Math/Sphere.hs')
| -rw-r--r-- | Spear/Math/Sphere.hs | 52 |
1 files changed, 26 insertions, 26 deletions
diff --git a/Spear/Math/Sphere.hs b/Spear/Math/Sphere.hs index 9c80811..197a9b2 100644 --- a/Spear/Math/Sphere.hs +++ b/Spear/Math/Sphere.hs | |||
| @@ -1,26 +1,26 @@ | |||
| 1 | module Spear.Math.Sphere | 1 | module Spear.Math.Sphere |
| 2 | where | 2 | where |
| 3 | 3 | ||
| 4 | import Spear.Math.Vector | 4 | import Spear.Math.Vector |
| 5 | 5 | ||
| 6 | import Data.List (foldl') | 6 | import Data.List (foldl') |
| 7 | 7 | ||
| 8 | -- | A sphere in 3D space. | 8 | -- | A sphere in 3D space. |
| 9 | data Sphere = Sphere | 9 | data Sphere = Sphere |
| 10 | { center :: {-# UNPACK #-} !Vector3 | 10 | { center :: {-# UNPACK #-} !Vector3 |
| 11 | , radius :: {-# UNPACK #-} !Float | 11 | , radius :: {-# UNPACK #-} !Float |
| 12 | } | 12 | } |
| 13 | 13 | ||
| 14 | -- | Create a sphere from the given points. | 14 | -- | Create a sphere from the given points. |
| 15 | sphere :: [Vector3] -> Sphere | 15 | sphere :: [Vector3] -> Sphere |
| 16 | sphere [] = Sphere zero3 0 | 16 | sphere [] = Sphere zero3 0 |
| 17 | sphere (x:xs) = Sphere c r | 17 | sphere (x:xs) = Sphere c r |
| 18 | where | 18 | where |
| 19 | c = pmin + (pmax-pmin)/2 | 19 | c = pmin + (pmax-pmin)/2 |
| 20 | r = norm $ pmax - c | 20 | r = norm $ pmax - c |
| 21 | (pmin,pmax) = foldl' update (x,x) xs | 21 | (pmin,pmax) = foldl' update (x,x) xs |
| 22 | update (pmin,pmax) p = (min p pmin, max p pmax) | 22 | update (pmin,pmax) p = (min p pmin, max p pmax) |
| 23 | 23 | ||
| 24 | -- | Return 'True' if the given sphere contains the given point, 'False' otherwise. | 24 | -- | Return 'True' if the given sphere contains the given point, 'False' otherwise. |
| 25 | circlept :: Sphere -> Vector3 -> Bool | 25 | circlept :: Sphere -> Vector3 -> Bool |
| 26 | circlept (Sphere c r) p = r*r >= normSq (p - c) | 26 | circlept (Sphere c r) p = r*r >= normSq (p - c) |