-- SPDX-License-Identifier: MPL-2.0

{- | Shared finite Euclidean geometry. Coordinates are bounded by 1e50 to keep
Double products representable; exact Rational predicates determine signs.
Public checked operations validate constructors, including raw record values.
-}
module HMath.Geometry.Internal where

import HMath.Error (MathError (..))

-- | Cartesian two-dimensional point, also used for vectors.
data Point2 = P2 Double Double deriving (Point2 -> Point2 -> Bool
(Point2 -> Point2 -> Bool)
-> (Point2 -> Point2 -> Bool) -> Eq Point2
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Point2 -> Point2 -> Bool
== :: Point2 -> Point2 -> Bool
$c/= :: Point2 -> Point2 -> Bool
/= :: Point2 -> Point2 -> Bool
Eq, Eq Point2
Eq Point2 =>
(Point2 -> Point2 -> Ordering)
-> (Point2 -> Point2 -> Bool)
-> (Point2 -> Point2 -> Bool)
-> (Point2 -> Point2 -> Bool)
-> (Point2 -> Point2 -> Bool)
-> (Point2 -> Point2 -> Point2)
-> (Point2 -> Point2 -> Point2)
-> Ord Point2
Point2 -> Point2 -> Bool
Point2 -> Point2 -> Ordering
Point2 -> Point2 -> Point2
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: Point2 -> Point2 -> Ordering
compare :: Point2 -> Point2 -> Ordering
$c< :: Point2 -> Point2 -> Bool
< :: Point2 -> Point2 -> Bool
$c<= :: Point2 -> Point2 -> Bool
<= :: Point2 -> Point2 -> Bool
$c> :: Point2 -> Point2 -> Bool
> :: Point2 -> Point2 -> Bool
$c>= :: Point2 -> Point2 -> Bool
>= :: Point2 -> Point2 -> Bool
$cmax :: Point2 -> Point2 -> Point2
max :: Point2 -> Point2 -> Point2
$cmin :: Point2 -> Point2 -> Point2
min :: Point2 -> Point2 -> Point2
Ord, Int -> Point2 -> ShowS
[Point2] -> ShowS
Point2 -> String
(Int -> Point2 -> ShowS)
-> (Point2 -> String) -> ([Point2] -> ShowS) -> Show Point2
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Point2 -> ShowS
showsPrec :: Int -> Point2 -> ShowS
$cshow :: Point2 -> String
show :: Point2 -> String
$cshowList :: [Point2] -> ShowS
showList :: [Point2] -> ShowS
Show)

-- | Cartesian right-handed three-dimensional point/vector.
data Point3 = P3 Double Double Double deriving (Point3 -> Point3 -> Bool
(Point3 -> Point3 -> Bool)
-> (Point3 -> Point3 -> Bool) -> Eq Point3
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Point3 -> Point3 -> Bool
== :: Point3 -> Point3 -> Bool
$c/= :: Point3 -> Point3 -> Bool
/= :: Point3 -> Point3 -> Bool
Eq, Eq Point3
Eq Point3 =>
(Point3 -> Point3 -> Ordering)
-> (Point3 -> Point3 -> Bool)
-> (Point3 -> Point3 -> Bool)
-> (Point3 -> Point3 -> Bool)
-> (Point3 -> Point3 -> Bool)
-> (Point3 -> Point3 -> Point3)
-> (Point3 -> Point3 -> Point3)
-> Ord Point3
Point3 -> Point3 -> Bool
Point3 -> Point3 -> Ordering
Point3 -> Point3 -> Point3
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: Point3 -> Point3 -> Ordering
compare :: Point3 -> Point3 -> Ordering
$c< :: Point3 -> Point3 -> Bool
< :: Point3 -> Point3 -> Bool
$c<= :: Point3 -> Point3 -> Bool
<= :: Point3 -> Point3 -> Bool
$c> :: Point3 -> Point3 -> Bool
> :: Point3 -> Point3 -> Bool
$c>= :: Point3 -> Point3 -> Bool
>= :: Point3 -> Point3 -> Bool
$cmax :: Point3 -> Point3 -> Point3
max :: Point3 -> Point3 -> Point3
$cmin :: Point3 -> Point3 -> Point3
min :: Point3 -> Point3 -> Point3
Ord, Int -> Point3 -> ShowS
[Point3] -> ShowS
Point3 -> String
(Int -> Point3 -> ShowS)
-> (Point3 -> String) -> ([Point3] -> ShowS) -> Show Point3
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Point3 -> ShowS
showsPrec :: Int -> Point3 -> ShowS
$cshow :: Point3 -> String
show :: Point3 -> String
$cshowList :: [Point3] -> ShowS
showList :: [Point3] -> ShowS
Show)

-- | A point of dimension 1..16.
newtype PointND = PointND [Double] deriving (PointND -> PointND -> Bool
(PointND -> PointND -> Bool)
-> (PointND -> PointND -> Bool) -> Eq PointND
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: PointND -> PointND -> Bool
== :: PointND -> PointND -> Bool
$c/= :: PointND -> PointND -> Bool
/= :: PointND -> PointND -> Bool
Eq, Eq PointND
Eq PointND =>
(PointND -> PointND -> Ordering)
-> (PointND -> PointND -> Bool)
-> (PointND -> PointND -> Bool)
-> (PointND -> PointND -> Bool)
-> (PointND -> PointND -> Bool)
-> (PointND -> PointND -> PointND)
-> (PointND -> PointND -> PointND)
-> Ord PointND
PointND -> PointND -> Bool
PointND -> PointND -> Ordering
PointND -> PointND -> PointND
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: PointND -> PointND -> Ordering
compare :: PointND -> PointND -> Ordering
$c< :: PointND -> PointND -> Bool
< :: PointND -> PointND -> Bool
$c<= :: PointND -> PointND -> Bool
<= :: PointND -> PointND -> Bool
$c> :: PointND -> PointND -> Bool
> :: PointND -> PointND -> Bool
$c>= :: PointND -> PointND -> Bool
>= :: PointND -> PointND -> Bool
$cmax :: PointND -> PointND -> PointND
max :: PointND -> PointND -> PointND
$cmin :: PointND -> PointND -> PointND
min :: PointND -> PointND -> PointND
Ord, Int -> PointND -> ShowS
[PointND] -> ShowS
PointND -> String
(Int -> PointND -> ShowS)
-> (PointND -> String) -> ([PointND] -> ShowS) -> Show PointND
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> PointND -> ShowS
showsPrec :: Int -> PointND -> ShowS
$cshow :: PointND -> String
show :: PointND -> String
$cshowList :: [PointND] -> ShowS
showList :: [PointND] -> ShowS
Show)

-- | Parametric line origin+t*direction; direction must be nonzero.
data Line = Line PointND PointND deriving (Line -> Line -> Bool
(Line -> Line -> Bool) -> (Line -> Line -> Bool) -> Eq Line
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Line -> Line -> Bool
== :: Line -> Line -> Bool
$c/= :: Line -> Line -> Bool
/= :: Line -> Line -> Bool
Eq, Int -> Line -> ShowS
[Line] -> ShowS
Line -> String
(Int -> Line -> ShowS)
-> (Line -> String) -> ([Line] -> ShowS) -> Show Line
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Line -> ShowS
showsPrec :: Int -> Line -> ShowS
$cshow :: Line -> String
show :: Line -> String
$cshowList :: [Line] -> ShowS
showList :: [Line] -> ShowS
Show)

-- | Parametric ray origin+t*direction, t>=0.
data Ray = Ray Point3 Point3 deriving (Ray -> Ray -> Bool
(Ray -> Ray -> Bool) -> (Ray -> Ray -> Bool) -> Eq Ray
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Ray -> Ray -> Bool
== :: Ray -> Ray -> Bool
$c/= :: Ray -> Ray -> Bool
/= :: Ray -> Ray -> Bool
Eq, Int -> Ray -> ShowS
[Ray] -> ShowS
Ray -> String
(Int -> Ray -> ShowS)
-> (Ray -> String) -> ([Ray] -> ShowS) -> Show Ray
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Ray -> ShowS
showsPrec :: Int -> Ray -> ShowS
$cshow :: Ray -> String
show :: Ray -> String
$cshowList :: [Ray] -> ShowS
showList :: [Ray] -> ShowS
Show)

-- | Closed segment with two endpoints; zero length is valid.
data Segment = Segment PointND PointND deriving (Segment -> Segment -> Bool
(Segment -> Segment -> Bool)
-> (Segment -> Segment -> Bool) -> Eq Segment
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Segment -> Segment -> Bool
== :: Segment -> Segment -> Bool
$c/= :: Segment -> Segment -> Bool
/= :: Segment -> Segment -> Bool
Eq, Int -> Segment -> ShowS
[Segment] -> ShowS
Segment -> String
(Int -> Segment -> ShowS)
-> (Segment -> String) -> ([Segment] -> ShowS) -> Show Segment
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Segment -> ShowS
showsPrec :: Int -> Segment -> ShowS
$cshow :: Segment -> String
show :: Segment -> String
$cshowList :: [Segment] -> ShowS
showList :: [Segment] -> ShowS
Show)

-- | Plane normal dot x = offset, with a nonzero normal.
data Plane = Plane Point3 Double deriving (Plane -> Plane -> Bool
(Plane -> Plane -> Bool) -> (Plane -> Plane -> Bool) -> Eq Plane
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Plane -> Plane -> Bool
== :: Plane -> Plane -> Bool
$c/= :: Plane -> Plane -> Bool
/= :: Plane -> Plane -> Bool
Eq, Int -> Plane -> ShowS
[Plane] -> ShowS
Plane -> String
(Int -> Plane -> ShowS)
-> (Plane -> String) -> ([Plane] -> ShowS) -> Show Plane
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Plane -> ShowS
showsPrec :: Int -> Plane -> ShowS
$cshow :: Plane -> String
show :: Plane -> String
$cshowList :: [Plane] -> ShowS
showList :: [Plane] -> ShowS
Show)

-- | Closed triangle; zero-area triangles are rejected by triangle operations.
data Triangle = Triangle Point2 Point2 Point2 deriving (Triangle -> Triangle -> Bool
(Triangle -> Triangle -> Bool)
-> (Triangle -> Triangle -> Bool) -> Eq Triangle
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Triangle -> Triangle -> Bool
== :: Triangle -> Triangle -> Bool
$c/= :: Triangle -> Triangle -> Bool
/= :: Triangle -> Triangle -> Bool
Eq, Int -> Triangle -> ShowS
[Triangle] -> ShowS
Triangle -> String
(Int -> Triangle -> ShowS)
-> (Triangle -> String) -> ([Triangle] -> ShowS) -> Show Triangle
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Triangle -> ShowS
showsPrec :: Int -> Triangle -> ShowS
$cshow :: Triangle -> String
show :: Triangle -> String
$cshowList :: [Triangle] -> ShowS
showList :: [Triangle] -> ShowS
Show)

-- | Axis-aligned rectangle with ordered corners.
data Rectangle = Rectangle Point2 Point2 deriving (Rectangle -> Rectangle -> Bool
(Rectangle -> Rectangle -> Bool)
-> (Rectangle -> Rectangle -> Bool) -> Eq Rectangle
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Rectangle -> Rectangle -> Bool
== :: Rectangle -> Rectangle -> Bool
$c/= :: Rectangle -> Rectangle -> Bool
/= :: Rectangle -> Rectangle -> Bool
Eq, Int -> Rectangle -> ShowS
[Rectangle] -> ShowS
Rectangle -> String
(Int -> Rectangle -> ShowS)
-> (Rectangle -> String)
-> ([Rectangle] -> ShowS)
-> Show Rectangle
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Rectangle -> ShowS
showsPrec :: Int -> Rectangle -> ShowS
$cshow :: Rectangle -> String
show :: Rectangle -> String
$cshowList :: [Rectangle] -> ShowS
showList :: [Rectangle] -> ShowS
Show)

-- | Circle with nonnegative radius.
data Circle = Circle Point2 Double deriving (Circle -> Circle -> Bool
(Circle -> Circle -> Bool)
-> (Circle -> Circle -> Bool) -> Eq Circle
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Circle -> Circle -> Bool
== :: Circle -> Circle -> Bool
$c/= :: Circle -> Circle -> Bool
/= :: Circle -> Circle -> Bool
Eq, Int -> Circle -> ShowS
[Circle] -> ShowS
Circle -> String
(Int -> Circle -> ShowS)
-> (Circle -> String) -> ([Circle] -> ShowS) -> Show Circle
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Circle -> ShowS
showsPrec :: Int -> Circle -> ShowS
$cshow :: Circle -> String
show :: Circle -> String
$cshowList :: [Circle] -> ShowS
showList :: [Circle] -> ShowS
Show)

-- | Rotated ellipse: positive semiaxes, counterclockwise angle in radians.
data Ellipse = Ellipse Point2 Double Double Double deriving (Ellipse -> Ellipse -> Bool
(Ellipse -> Ellipse -> Bool)
-> (Ellipse -> Ellipse -> Bool) -> Eq Ellipse
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Ellipse -> Ellipse -> Bool
== :: Ellipse -> Ellipse -> Bool
$c/= :: Ellipse -> Ellipse -> Bool
/= :: Ellipse -> Ellipse -> Bool
Eq, Int -> Ellipse -> ShowS
[Ellipse] -> ShowS
Ellipse -> String
(Int -> Ellipse -> ShowS)
-> (Ellipse -> String) -> ([Ellipse] -> ShowS) -> Show Ellipse
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Ellipse -> ShowS
showsPrec :: Int -> Ellipse -> ShowS
$cshow :: Ellipse -> String
show :: Ellipse -> String
$cshowList :: [Ellipse] -> ShowS
showList :: [Ellipse] -> ShowS
Show)

-- | Simple polygon; vertices are implicitly closed and no duplicate endpoint is needed.
newtype Polygon = Polygon [Point2] deriving (Polygon -> Polygon -> Bool
(Polygon -> Polygon -> Bool)
-> (Polygon -> Polygon -> Bool) -> Eq Polygon
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Polygon -> Polygon -> Bool
== :: Polygon -> Polygon -> Bool
$c/= :: Polygon -> Polygon -> Bool
/= :: Polygon -> Polygon -> Bool
Eq, Int -> Polygon -> ShowS
[Polygon] -> ShowS
Polygon -> String
(Int -> Polygon -> ShowS)
-> (Polygon -> String) -> ([Polygon] -> ShowS) -> Show Polygon
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Polygon -> ShowS
showsPrec :: Int -> Polygon -> ShowS
$cshow :: Polygon -> String
show :: Polygon -> String
$cshowList :: [Polygon] -> ShowS
showList :: [Polygon] -> ShowS
Show)

-- | Closed sphere, including a zero radius.
data Sphere = Sphere Point3 Double deriving (Sphere -> Sphere -> Bool
(Sphere -> Sphere -> Bool)
-> (Sphere -> Sphere -> Bool) -> Eq Sphere
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Sphere -> Sphere -> Bool
== :: Sphere -> Sphere -> Bool
$c/= :: Sphere -> Sphere -> Bool
/= :: Sphere -> Sphere -> Bool
Eq, Int -> Sphere -> ShowS
[Sphere] -> ShowS
Sphere -> String
(Int -> Sphere -> ShowS)
-> (Sphere -> String) -> ([Sphere] -> ShowS) -> Show Sphere
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Sphere -> ShowS
showsPrec :: Int -> Sphere -> ShowS
$cshow :: Sphere -> String
show :: Sphere -> String
$cshowList :: [Sphere] -> ShowS
showList :: [Sphere] -> ShowS
Show)

-- | Ordered, closed axis-aligned bounds in 1..16 dimensions.
data AABB = AABB PointND PointND deriving (AABB -> AABB -> Bool
(AABB -> AABB -> Bool) -> (AABB -> AABB -> Bool) -> Eq AABB
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: AABB -> AABB -> Bool
== :: AABB -> AABB -> Bool
$c/= :: AABB -> AABB -> Bool
/= :: AABB -> AABB -> Bool
Eq, Int -> AABB -> ShowS
[AABB] -> ShowS
AABB -> String
(Int -> AABB -> ShowS)
-> (AABB -> String) -> ([AABB] -> ShowS) -> Show AABB
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> AABB -> ShowS
showsPrec :: Int -> AABB -> ShowS
$cshow :: AABB -> String
show :: AABB -> String
$cshowList :: [AABB] -> ShowS
showList :: [AABB] -> ShowS
Show)

-- | Oriented three-dimensional box: center, three orthonormal axes, half-extents.
data OBB = OBB Point3 [Point3] Point3 deriving (OBB -> OBB -> Bool
(OBB -> OBB -> Bool) -> (OBB -> OBB -> Bool) -> Eq OBB
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: OBB -> OBB -> Bool
== :: OBB -> OBB -> Bool
$c/= :: OBB -> OBB -> Bool
/= :: OBB -> OBB -> Bool
Eq, Int -> OBB -> ShowS
[OBB] -> ShowS
OBB -> String
(Int -> OBB -> ShowS)
-> (OBB -> String) -> ([OBB] -> ShowS) -> Show OBB
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> OBB -> ShowS
showsPrec :: Int -> OBB -> ShowS
$cshow :: OBB -> String
show :: OBB -> String
$cshowList :: [OBB] -> ShowS
showList :: [OBB] -> ShowS
Show)

-- | Capsule around the closed axis segment.
data Capsule = Capsule Point3 Point3 Double deriving (Capsule -> Capsule -> Bool
(Capsule -> Capsule -> Bool)
-> (Capsule -> Capsule -> Bool) -> Eq Capsule
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Capsule -> Capsule -> Bool
== :: Capsule -> Capsule -> Bool
$c/= :: Capsule -> Capsule -> Bool
/= :: Capsule -> Capsule -> Bool
Eq, Int -> Capsule -> ShowS
[Capsule] -> ShowS
Capsule -> String
(Int -> Capsule -> ShowS)
-> (Capsule -> String) -> ([Capsule] -> ShowS) -> Show Capsule
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Capsule -> ShowS
showsPrec :: Int -> Capsule -> ShowS
$cshow :: Capsule -> String
show :: Capsule -> String
$cshowList :: [Capsule] -> ShowS
showList :: [Capsule] -> ShowS
Show)

-- | Finite cylinder with endpoint centers and radius; endpoints must differ.
data Cylinder = Cylinder Point3 Point3 Double deriving (Cylinder -> Cylinder -> Bool
(Cylinder -> Cylinder -> Bool)
-> (Cylinder -> Cylinder -> Bool) -> Eq Cylinder
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Cylinder -> Cylinder -> Bool
== :: Cylinder -> Cylinder -> Bool
$c/= :: Cylinder -> Cylinder -> Bool
/= :: Cylinder -> Cylinder -> Bool
Eq, Int -> Cylinder -> ShowS
[Cylinder] -> ShowS
Cylinder -> String
(Int -> Cylinder -> ShowS)
-> (Cylinder -> String) -> ([Cylinder] -> ShowS) -> Show Cylinder
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Cylinder -> ShowS
showsPrec :: Int -> Cylinder -> ShowS
$cshow :: Cylinder -> String
show :: Cylinder -> String
$cshowList :: [Cylinder] -> ShowS
showList :: [Cylinder] -> ShowS
Show)

-- | Finite cone with apex, base center, and radius; axis must be nonzero.
data Cone = Cone Point3 Point3 Double deriving (Cone -> Cone -> Bool
(Cone -> Cone -> Bool) -> (Cone -> Cone -> Bool) -> Eq Cone
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Cone -> Cone -> Bool
== :: Cone -> Cone -> Bool
$c/= :: Cone -> Cone -> Bool
/= :: Cone -> Cone -> Bool
Eq, Int -> Cone -> ShowS
[Cone] -> ShowS
Cone -> String
(Int -> Cone -> ShowS)
-> (Cone -> String) -> ([Cone] -> ShowS) -> Show Cone
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Cone -> ShowS
showsPrec :: Int -> Cone -> ShowS
$cshow :: Cone -> String
show :: Cone -> String
$cshowList :: [Cone] -> ShowS
showList :: [Cone] -> ShowS
Show)

-- | Convex frustum represented by six inward half-spaces n dot x >= offset.
newtype Frustum = Frustum [Plane] deriving (Frustum -> Frustum -> Bool
(Frustum -> Frustum -> Bool)
-> (Frustum -> Frustum -> Bool) -> Eq Frustum
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Frustum -> Frustum -> Bool
== :: Frustum -> Frustum -> Bool
$c/= :: Frustum -> Frustum -> Bool
/= :: Frustum -> Frustum -> Bool
Eq, Int -> Frustum -> ShowS
[Frustum] -> ShowS
Frustum -> String
(Int -> Frustum -> ShowS)
-> (Frustum -> String) -> ([Frustum] -> ShowS) -> Show Frustum
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Frustum -> ShowS
showsPrec :: Int -> Frustum -> ShowS
$cshow :: Frustum -> String
show :: Frustum -> String
$cshowList :: [Frustum] -> ShowS
showList :: [Frustum] -> ShowS
Show)

-- | Sign of an exact predicate on the input Double values.
data Orientation = Clockwise | Collinear | Counterclockwise deriving (Orientation -> Orientation -> Bool
(Orientation -> Orientation -> Bool)
-> (Orientation -> Orientation -> Bool) -> Eq Orientation
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Orientation -> Orientation -> Bool
== :: Orientation -> Orientation -> Bool
$c/= :: Orientation -> Orientation -> Bool
/= :: Orientation -> Orientation -> Bool
Eq, Eq Orientation
Eq Orientation =>
(Orientation -> Orientation -> Ordering)
-> (Orientation -> Orientation -> Bool)
-> (Orientation -> Orientation -> Bool)
-> (Orientation -> Orientation -> Bool)
-> (Orientation -> Orientation -> Bool)
-> (Orientation -> Orientation -> Orientation)
-> (Orientation -> Orientation -> Orientation)
-> Ord Orientation
Orientation -> Orientation -> Bool
Orientation -> Orientation -> Ordering
Orientation -> Orientation -> Orientation
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: Orientation -> Orientation -> Ordering
compare :: Orientation -> Orientation -> Ordering
$c< :: Orientation -> Orientation -> Bool
< :: Orientation -> Orientation -> Bool
$c<= :: Orientation -> Orientation -> Bool
<= :: Orientation -> Orientation -> Bool
$c> :: Orientation -> Orientation -> Bool
> :: Orientation -> Orientation -> Bool
$c>= :: Orientation -> Orientation -> Bool
>= :: Orientation -> Orientation -> Bool
$cmax :: Orientation -> Orientation -> Orientation
max :: Orientation -> Orientation -> Orientation
$cmin :: Orientation -> Orientation -> Orientation
min :: Orientation -> Orientation -> Orientation
Ord, Int -> Orientation -> ShowS
[Orientation] -> ShowS
Orientation -> String
(Int -> Orientation -> ShowS)
-> (Orientation -> String)
-> ([Orientation] -> ShowS)
-> Show Orientation
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Orientation -> ShowS
showsPrec :: Int -> Orientation -> ShowS
$cshow :: Orientation -> String
show :: Orientation -> String
$cshowList :: [Orientation] -> ShowS
showList :: [Orientation] -> ShowS
Show)

-- | Point position with boundary reported separately.
data Location = Outside | Boundary | Inside deriving (Location -> Location -> Bool
(Location -> Location -> Bool)
-> (Location -> Location -> Bool) -> Eq Location
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Location -> Location -> Bool
== :: Location -> Location -> Bool
$c/= :: Location -> Location -> Bool
/= :: Location -> Location -> Bool
Eq, Eq Location
Eq Location =>
(Location -> Location -> Ordering)
-> (Location -> Location -> Bool)
-> (Location -> Location -> Bool)
-> (Location -> Location -> Bool)
-> (Location -> Location -> Bool)
-> (Location -> Location -> Location)
-> (Location -> Location -> Location)
-> Ord Location
Location -> Location -> Bool
Location -> Location -> Ordering
Location -> Location -> Location
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: Location -> Location -> Ordering
compare :: Location -> Location -> Ordering
$c< :: Location -> Location -> Bool
< :: Location -> Location -> Bool
$c<= :: Location -> Location -> Bool
<= :: Location -> Location -> Bool
$c> :: Location -> Location -> Bool
> :: Location -> Location -> Bool
$c>= :: Location -> Location -> Bool
>= :: Location -> Location -> Bool
$cmax :: Location -> Location -> Location
max :: Location -> Location -> Location
$cmin :: Location -> Location -> Location
min :: Location -> Location -> Location
Ord, Int -> Location -> ShowS
[Location] -> ShowS
Location -> String
(Int -> Location -> ShowS)
-> (Location -> String) -> ([Location] -> ShowS) -> Show Location
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Location -> ShowS
showsPrec :: Int -> Location -> ShowS
$cshow :: Location -> String
show :: Location -> String
$cshowList :: [Location] -> ShowS
showList :: [Location] -> ShowS
Show)

{- | Test whether a Double is neither NaN nor infinite. This alone does not impose the
geometry coordinate magnitude cap.
-}
finite :: Double -> Bool
finite :: Double -> Bool
finite Double
x = Bool -> Bool
not (Double -> Bool
forall a. RealFloat a => a -> Bool
isNaN Double
x Bool -> Bool -> Bool
|| Double -> Bool
forall a. RealFloat a => a -> Bool
isInfinite Double
x)

{- | Given predicate then diagnostic text, return Right () if satisfied or Left (DomainError
text).
-}
require :: Bool -> String -> Either MathError ()
require :: Bool -> String -> Either MathError ()
require Bool
condition String
message = if Bool
condition then () -> Either MathError ()
forall a b. b -> Either a b
Right () else MathError -> Either MathError ()
forall a b. a -> Either a b
Left (String -> MathError
DomainError String
message)

{- | Accept a finite geometry coordinate only when its absolute value is \<=1e50, bounding
downstream Double products.
-}
coord :: Double -> Bool
coord :: Double -> Bool
coord Double
x = Double -> Bool
finite Double
x Bool -> Bool -> Bool
&& Double -> Double
forall a. Num a => a -> a
abs Double
x Double -> Double -> Bool
forall a. Ord a => a -> a -> Bool
<= Double
1e50

-- | Extract [x,y] from a Point2 without validation.
coords2 :: Point2 -> [Double]
coords2 :: Point2 -> [Double]
coords2 (P2 Double
x Double
y) = [Double
x, Double
y]

-- | Extract [x,y,z] from a Point3 without validation.
coords3 :: Point3 -> [Double]
coords3 :: Point3 -> [Double]
coords3 (P3 Double
x Double
y Double
z) = [Double
x, Double
y, Double
z]

-- | Extract ordered coordinate list from a PointND without validation.
coordsND :: PointND -> [Double]
coordsND :: PointND -> [Double]
coordsND (PointND [Double]
xs) = [Double]
xs

{- | Validate both Point2 coordinates as finite with absolute magnitude \<=1e50; invalid data
returns DomainError.
-}
check2 :: Point2 -> Either MathError ()
check2 :: Point2 -> Either MathError ()
check2 Point2
p = Bool -> String -> Either MathError ()
require ((Double -> Bool) -> [Double] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all Double -> Bool
coord (Point2 -> [Double]
coords2 Point2
p)) String
"invalid 2D coordinates (finite, |x|<=1e50)"

{- | Validate all Point3 coordinates as finite with absolute magnitude \<=1e50; invalid data
returns DomainError.
-}
check3 :: Point3 -> Either MathError ()
check3 :: Point3 -> Either MathError ()
check3 Point3
p = Bool -> String -> Either MathError ()
require ((Double -> Bool) -> [Double] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all Double -> Bool
coord (Point3 -> [Double]
coords3 Point3
p)) String
"invalid 3D coordinates (finite, |x|<=1e50)"

{- | Require 1..16 coordinates, all finite and bounded by 1e50 in magnitude. Invalid PointND
returns DomainError.
-}
checkND :: PointND -> Either MathError ()
checkND :: PointND -> Either MathError ()
checkND (PointND [Double]
xs) =
    Bool -> String -> Either MathError ()
require
        (Bool -> Bool
not ([Double] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Double]
xs) Bool -> Bool -> Bool
&& [Double] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Double]
xs Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
16 Bool -> Bool -> Bool
&& (Double -> Bool) -> [Double] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all Double -> Bool
coord [Double]
xs)
        String
"invalid ND point (dimension 1..16, |x|<=1e50)"

{- | Validate both ND points and require equal dimensions. Invalid coordinates/rank/mismatch
return DomainError.
-}
checkPair :: PointND -> PointND -> Either MathError ()
checkPair :: PointND -> PointND -> Either MathError ()
checkPair PointND
a PointND
b =
    PointND -> Either MathError ()
checkND PointND
a
        Either MathError () -> Either MathError () -> Either MathError ()
forall a b.
Either MathError a -> Either MathError b -> Either MathError b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> PointND -> Either MathError ()
checkND PointND
b
        Either MathError () -> Either MathError () -> Either MathError ()
forall a b.
Either MathError a -> Either MathError b -> Either MathError b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Bool -> String -> Either MathError ()
require ([Double] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length (PointND -> [Double]
coordsND PointND
a) Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== [Double] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length (PointND -> [Double]
coordsND PointND
b)) String
"point dimensions differ"

{- | Return the supplied list if every Double is finite, otherwise Left NonFiniteResult.
This checks numerical results without the coordinate magnitude cap.
-}
checked :: [Double] -> Either MathError [Double]
checked :: [Double] -> Either MathError [Double]
checked [Double]
xs = if (Double -> Bool) -> [Double] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all Double -> Bool
finite [Double]
xs then [Double] -> Either MathError [Double]
forall a b. b -> Either a b
Right [Double]
xs else MathError -> Either MathError [Double]
forall a b. a -> Either a b
Left MathError
NonFiniteResult

{- | Given x,y, construct Point2 after bounded finite-coordinate validation. Invalid values
return DomainError.
-}
point2 :: Double -> Double -> Either MathError Point2
point2 :: Double -> Double -> Either MathError Point2
point2 Double
x Double
y = let p :: Point2
p = Double -> Double -> Point2
P2 Double
x Double
y in Point2 -> Either MathError ()
check2 Point2
p Either MathError ()
-> Either MathError Point2 -> Either MathError Point2
forall a b.
Either MathError a -> Either MathError b -> Either MathError b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Point2 -> Either MathError Point2
forall a b. b -> Either a b
Right Point2
p

{- | Given x,y,z, construct Point3 after bounded finite-coordinate validation. Invalid
values return DomainError.
-}
point3 :: Double -> Double -> Double -> Either MathError Point3
point3 :: Double -> Double -> Double -> Either MathError Point3
point3 Double
x Double
y Double
z = let p :: Point3
p = Double -> Double -> Double -> Point3
P3 Double
x Double
y Double
z in Point3 -> Either MathError ()
check3 Point3
p Either MathError ()
-> Either MathError Point3 -> Either MathError Point3
forall a b.
Either MathError a -> Either MathError b -> Either MathError b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Point3 -> Either MathError Point3
forall a b. b -> Either a b
Right Point3
p

{- | Construct a checked ND point from 1..16 bounded finite coordinates. Invalid
dimension/value returns DomainError.
-}
pointND :: [Double] -> Either MathError PointND
pointND :: [Double] -> Either MathError PointND
pointND [Double]
xs = let p :: PointND
p = [Double] -> PointND
PointND [Double]
xs in PointND -> Either MathError ()
checkND PointND
p Either MathError ()
-> Either MathError PointND -> Either MathError PointND
forall a b.
Either MathError a -> Either MathError b -> Either MathError b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> PointND -> Either MathError PointND
forall a b. b -> Either a b
Right PointND
p

{- | Unchecked sum of pairwise list products using zipWith; unequal lists truncate to the
shorter length. Checked geometry callers must validate matching dimensions first.
-}
dot :: [Double] -> [Double] -> Double
dot :: [Double] -> [Double] -> Double
dot [Double]
a [Double]
b = [Double] -> Double
forall a. Num a => [a] -> a
forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
sum ((Double -> Double -> Double) -> [Double] -> [Double] -> [Double]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith Double -> Double -> Double
forall a. Num a => a -> a -> a
(*) [Double]
a [Double]
b)

{- | Return scaled Euclidean list norm to reduce intermediate overflow; empty/all-zero list
yields zero. No finiteness check is added.
-}
norm :: [Double] -> Double
norm :: [Double] -> Double
norm [Double]
xs =
    let size :: Double
size = [Double] -> Double
forall a. Ord a => [a] -> a
forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
maximum (Double
0 Double -> [Double] -> [Double]
forall a. a -> [a] -> [a]
: (Double -> Double) -> [Double] -> [Double]
forall a b. (a -> b) -> [a] -> [b]
map Double -> Double
forall a. Num a => a -> a
abs [Double]
xs)
     in if Double
size Double -> Double -> Bool
forall a. Eq a => a -> a -> Bool
== Double
0 then Double
0 else Double
size Double -> Double -> Double
forall a. Num a => a -> a -> a
* Double -> Double
forall a. Floating a => a -> a
sqrt ([Double] -> Double
forall a. Num a => [a] -> a
forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
sum [(Double
x Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ Double
size) Double -> Int -> Double
forall a b. (Num a, Integral b) => a -> b -> a
^ (Int
2 :: Int) | Double
x <- [Double]
xs])

{- | Unchecked coordinatewise left-minus-right list subtraction, truncating to the shorter
list on mismatch.
-}
sub :: [Double] -> [Double] -> [Double]
sub :: [Double] -> [Double] -> [Double]
sub = (Double -> Double -> Double) -> [Double] -> [Double] -> [Double]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith (-)

-- | Unchecked coordinatewise list addition, truncating to the shorter list on mismatch.
plus :: [Double] -> [Double] -> [Double]
plus :: [Double] -> [Double] -> [Double]
plus = (Double -> Double -> Double) -> [Double] -> [Double] -> [Double]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith Double -> Double -> Double
forall a. Num a => a -> a -> a
(+)

{- | Given Double scalar then coordinate list, return all coordinates multiplied by it
without validation.
-}
scale :: Double -> [Double] -> [Double]
scale :: Double -> [Double] -> [Double]
scale Double
a = (Double -> Double) -> [Double] -> [Double]
forall a b. (a -> b) -> [a] -> [b]
map (Double -> Double -> Double
forall a. Num a => a -> a -> a
* Double
a)

{- | Return right-handed cross product of two Point3 vectors. Coordinates/results are
unchecked at this helper boundary.
-}
cross :: Point3 -> Point3 -> Point3
cross :: Point3 -> Point3 -> Point3
cross (P3 Double
a Double
b Double
c) (P3 Double
x Double
y Double
z) = Double -> Double -> Double -> Point3
P3 (Double
b Double -> Double -> Double
forall a. Num a => a -> a -> a
* Double
z Double -> Double -> Double
forall a. Num a => a -> a -> a
- Double
c Double -> Double -> Double
forall a. Num a => a -> a -> a
* Double
y) (Double
c Double -> Double -> Double
forall a. Num a => a -> a -> a
* Double
x Double -> Double -> Double
forall a. Num a => a -> a -> a
- Double
a Double -> Double -> Double
forall a. Num a => a -> a -> a
* Double
z) (Double
a Double -> Double -> Double
forall a. Num a => a -> a -> a
* Double
y Double -> Double -> Double
forall a. Num a => a -> a -> a
- Double
b Double -> Double -> Double
forall a. Num a => a -> a -> a
* Double
x)

-- | Add Point2 coordinates componentwise without validation.
add2 :: Point2 -> Point2 -> Point2
add2 :: Point2 -> Point2 -> Point2
add2 (P2 Double
x Double
y) (P2 Double
a Double
b) = Double -> Double -> Point2
P2 (Double
x Double -> Double -> Double
forall a. Num a => a -> a -> a
+ Double
a) (Double
y Double -> Double -> Double
forall a. Num a => a -> a -> a
+ Double
b)

-- | Subtract right Point2 coordinates from left, without validation.
sub2 :: Point2 -> Point2 -> Point2
sub2 :: Point2 -> Point2 -> Point2
sub2 (P2 Double
x Double
y) (P2 Double
a Double
b) = Double -> Double -> Point2
P2 (Double
x Double -> Double -> Double
forall a. Num a => a -> a -> a
- Double
a) (Double
y Double -> Double -> Double
forall a. Num a => a -> a -> a
- Double
b)

-- | Given scalar then Point2, scale both coordinates without validation.
scale2 :: Double -> Point2 -> Point2
scale2 :: Double -> Point2 -> Point2
scale2 Double
t (P2 Double
x Double
y) = Double -> Double -> Point2
P2 (Double
t Double -> Double -> Double
forall a. Num a => a -> a -> a
* Double
x) (Double
t Double -> Double -> Double
forall a. Num a => a -> a -> a
* Double
y)

-- | Return 2D determinant ax*by-ay*bx as Double without validation.
cross2 :: Point2 -> Point2 -> Double
cross2 :: Point2 -> Point2 -> Double
cross2 (P2 Double
x Double
y) (P2 Double
a Double
b) = Double
x Double -> Double -> Double
forall a. Num a => a -> a -> a
* Double
b Double -> Double -> Double
forall a. Num a => a -> a -> a
- Double
y Double -> Double -> Double
forall a. Num a => a -> a -> a
* Double
a

-- | Return 2D dot product ax*bx+ay*by without validation.
dot2 :: Point2 -> Point2 -> Double
dot2 :: Point2 -> Point2 -> Double
dot2 Point2
a Point2
b = [Double] -> [Double] -> Double
dot (Point2 -> [Double]
coords2 Point2
a) (Point2 -> [Double]
coords2 Point2
b)

-- | Return scaled Euclidean length of a Point2 without checked finite validation.
norm2 :: Point2 -> Double
norm2 :: Point2 -> Double
norm2 = [Double] -> Double
norm ([Double] -> Double) -> (Point2 -> [Double]) -> Point2 -> Double
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Point2 -> [Double]
coords2

{- | Convert a list of exactly three Doubles to Point3; all other lengths return origin P3 0
0 0. This helper does not validate finite coordinates.
-}
from3 :: [Double] -> Point3
from3 :: [Double] -> Point3
from3 [Double
x, Double
y, Double
z] = Double -> Double -> Double -> Point3
P3 Double
x Double
y Double
z
from3 [Double]
_ = Double -> Double -> Double -> Point3
P3 Double
0 Double
0 Double
0

{- | Pair each polygon-list element with its cyclic successor, including the last-to-first
edge. Empty list returns []; singleton returns one self-pair.
-}
edges :: [a] -> [(a, a)]
edges :: forall a. [a] -> [(a, a)]
edges [] = []
edges xs :: [a]
xs@(a
first : [a]
rest) = [a] -> [a] -> [(a, a)]
forall a b. [a] -> [b] -> [(a, b)]
zip [a]
xs ([a]
rest [a] -> [a] -> [a]
forall a. [a] -> [a] -> [a]
++ [a
first])

{- | Given finite points a,b,c, compute exact Rational determinant of their represented
Double coordinates. Positive is counterclockwise, zero collinear; non-finite inputs
violate this unchecked helper's precondition.
-}
orientExact :: Point2 -> Point2 -> Point2 -> Rational
orientExact :: Point2 -> Point2 -> Point2 -> Rational
orientExact (P2 Double
ax Double
ay) (P2 Double
bx Double
by) (P2 Double
cx Double
cy) =
    (Double -> Rational
forall a. Real a => a -> Rational
toRational Double
bx Rational -> Rational -> Rational
forall a. Num a => a -> a -> a
- Double -> Rational
forall a. Real a => a -> Rational
toRational Double
ax) Rational -> Rational -> Rational
forall a. Num a => a -> a -> a
* (Double -> Rational
forall a. Real a => a -> Rational
toRational Double
cy Rational -> Rational -> Rational
forall a. Num a => a -> a -> a
- Double -> Rational
forall a. Real a => a -> Rational
toRational Double
ay)
        Rational -> Rational -> Rational
forall a. Num a => a -> a -> a
- (Double -> Rational
forall a. Real a => a -> Rational
toRational Double
by Rational -> Rational -> Rational
forall a. Num a => a -> a -> a
- Double -> Rational
forall a. Real a => a -> Rational
toRational Double
ay) Rational -> Rational -> Rational
forall a. Num a => a -> a -> a
* (Double -> Rational
forall a. Real a => a -> Rational
toRational Double
cx Rational -> Rational -> Rational
forall a. Num a => a -> a -> a
- Double -> Rational
forall a. Real a => a -> Rational
toRational Double
ax)

{- | Compare orientExact determinant with zero, returning GT for counterclockwise, EQ for
collinear, LT for clockwise. Inputs must already be finite.
-}
orient :: Point2 -> Point2 -> Point2 -> Ordering
orient :: Point2 -> Point2 -> Point2 -> Ordering
orient Point2
a Point2
b Point2
c = Rational -> Rational -> Ordering
forall a. Ord a => a -> a -> Ordering
compare (Point2 -> Point2 -> Point2 -> Rational
orientExact Point2
a Point2
b Point2
c) Rational
0

{- | Given endpoints a,b then point p, test exact collinearity and inclusive coordinate
bounds. Finite input validation belongs to the checked caller.
-}
onSegment :: Point2 -> Point2 -> Point2 -> Bool
onSegment :: Point2 -> Point2 -> Point2 -> Bool
onSegment a :: Point2
a@(P2 Double
ax Double
ay) b :: Point2
b@(P2 Double
bx Double
by) p :: Point2
p@(P2 Double
x Double
y) = Point2 -> Point2 -> Point2 -> Ordering
orient Point2
a Point2
b Point2
p Ordering -> Ordering -> Bool
forall a. Eq a => a -> a -> Bool
== Ordering
EQ Bool -> Bool -> Bool
&& Double
x Double -> Double -> Bool
forall a. Ord a => a -> a -> Bool
>= Double -> Double -> Double
forall a. Ord a => a -> a -> a
min Double
ax Double
bx Bool -> Bool -> Bool
&& Double
x Double -> Double -> Bool
forall a. Ord a => a -> a -> Bool
<= Double -> Double -> Double
forall a. Ord a => a -> a -> a
max Double
ax Double
bx Bool -> Bool -> Bool
&& Double
y Double -> Double -> Bool
forall a. Ord a => a -> a -> Bool
>= Double -> Double -> Double
forall a. Ord a => a -> a -> a
min Double
ay Double
by Bool -> Bool -> Bool
&& Double
y Double -> Double -> Bool
forall a. Ord a => a -> a -> Bool
<= Double -> Double -> Double
forall a. Ord a => a -> a -> a
max Double
ay Double
by

{- | Validate a simple polygon with 3..256 bounded finite vertices, no adjacent duplicates,
nonzero area and no nonadjacent edge intersection. Return validated vertices or
DomainError.
-}
checkPolygon :: Polygon -> Either MathError [Point2]
checkPolygon :: Polygon -> Either MathError [Point2]
checkPolygon (Polygon [Point2]
ps) = do
    Bool -> String -> Either MathError ()
require ([Point2] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Point2]
ps Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
3 Bool -> Bool -> Bool
&& [Point2] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Point2]
ps Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
256) String
"polygon requires 3..256 vertices"
    (Point2 -> Either MathError ()) -> [Point2] -> Either MathError ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ Point2 -> Either MathError ()
check2 [Point2]
ps
    Bool -> String -> Either MathError ()
require (((Point2, Point2) -> Bool) -> [(Point2, Point2)] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all ((Point2 -> Point2 -> Bool) -> (Point2, Point2) -> Bool
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry Point2 -> Point2 -> Bool
forall a. Eq a => a -> a -> Bool
(/=)) ([Point2] -> [(Point2, Point2)]
forall a. [a] -> [(a, a)]
edges [Point2]
ps)) String
"polygon has duplicate adjacent vertices"
    let es :: [(Int, (Point2, Point2))]
es = [Int] -> [(Point2, Point2)] -> [(Int, (Point2, Point2))]
forall a b. [a] -> [b] -> [(a, b)]
zip [Int
0 :: Int ..] ([Point2] -> [(Point2, Point2)]
forall a. [a] -> [(a, a)]
edges [Point2]
ps)
        n :: Int
n = [Point2] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Point2]
ps
        hit :: (Point2, Point2) -> (Point2, Point2) -> Bool
hit (Point2
a, Point2
b) (Point2
c, Point2
d) =
            (Point2 -> Point2 -> Point2 -> Ordering
orient Point2
a Point2
b Point2
c Ordering -> Ordering -> Bool
forall a. Eq a => a -> a -> Bool
/= Point2 -> Point2 -> Point2 -> Ordering
orient Point2
a Point2
b Point2
d Bool -> Bool -> Bool
&& Point2 -> Point2 -> Point2 -> Ordering
orient Point2
c Point2
d Point2
a Ordering -> Ordering -> Bool
forall a. Eq a => a -> a -> Bool
/= Point2 -> Point2 -> Point2 -> Ordering
orient Point2
c Point2
d Point2
b)
                Bool -> Bool -> Bool
|| Point2 -> Point2 -> Point2 -> Bool
onSegment Point2
a Point2
b Point2
c
                Bool -> Bool -> Bool
|| Point2 -> Point2 -> Point2 -> Bool
onSegment Point2
a Point2
b Point2
d
                Bool -> Bool -> Bool
|| Point2 -> Point2 -> Point2 -> Bool
onSegment Point2
c Point2
d Point2
a
                Bool -> Bool -> Bool
|| Point2 -> Point2 -> Point2 -> Bool
onSegment Point2
c Point2
d Point2
b
    Bool -> String -> Either MathError ()
require
        ([Bool] -> Bool
forall (t :: * -> *). Foldable t => t Bool -> Bool
and [Bool -> Bool
not ((Point2, Point2) -> (Point2, Point2) -> Bool
hit (Point2, Point2)
e (Point2, Point2)
f) | (Int
i, (Point2, Point2)
e) <- [(Int, (Point2, Point2))]
es, (Int
j, (Point2, Point2)
f) <- [(Int, (Point2, Point2))]
es, Int
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
j, Int
j Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
/= Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1, Bool -> Bool
not (Int
i Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0 Bool -> Bool -> Bool
&& Int
j Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1)])
        String
"polygon self-intersects"
    Bool -> String -> Either MathError ()
require ([Point2] -> Double
signedArea [Point2]
ps Double -> Double -> Bool
forall a. Eq a => a -> a -> Bool
/= Double
0) String
"polygon has zero area"
    [Point2] -> Either MathError [Point2]
forall a b. b -> Either a b
Right [Point2]
ps

{- | Return oriented shoelace area using exact Rational intermediate arithmetic on finite
Double coordinates. Positive means counterclockwise. This helper does not validate
polygon simplicity.
-}
signedArea :: [Point2] -> Double
signedArea :: [Point2] -> Double
signedArea [Point2]
ps =
    Rational -> Double
forall a. Fractional a => Rational -> a
fromRational
        ( [Rational] -> Rational
forall a. Num a => [a] -> a
forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
sum
            [Double -> Rational
forall a. Real a => a -> Rational
toRational Double
ax Rational -> Rational -> Rational
forall a. Num a => a -> a -> a
* Double -> Rational
forall a. Real a => a -> Rational
toRational Double
by Rational -> Rational -> Rational
forall a. Num a => a -> a -> a
- Double -> Rational
forall a. Real a => a -> Rational
toRational Double
ay Rational -> Rational -> Rational
forall a. Num a => a -> a -> a
* Double -> Rational
forall a. Real a => a -> Rational
toRational Double
bx | (P2 Double
ax Double
ay, P2 Double
bx Double
by) <- [Point2] -> [(Point2, Point2)]
forall a. [a] -> [(a, a)]
edges [Point2]
ps]
            Rational -> Rational -> Rational
forall a. Fractional a => a -> a -> a
/ Rational
2
        )

{- | Return polygon vertices in counterclockwise order by reversing negative signed area;
zero-area input remains unchanged. Validation is the caller's responsibility.
-}
ccw :: [Point2] -> [Point2]
ccw :: [Point2] -> [Point2]
ccw [Point2]
ps = if [Point2] -> Double
signedArea [Point2]
ps Double -> Double -> Bool
forall a. Ord a => a -> a -> Bool
< Double
0 then [Point2] -> [Point2]
forall a. [a] -> [a]
reverse [Point2]
ps else [Point2]
ps

{- | Given valid simple polygon vertices then finite Point2, return Boundary for an edge
point, otherwise Inside/Outside by ray parity. This helper performs no constructor
validation.
-}
locateUnchecked :: [Point2] -> Point2 -> Location
locateUnchecked :: [Point2] -> Point2 -> Location
locateUnchecked [Point2]
ps p :: Point2
p@(P2 Double
x Double
y)
    | ((Point2, Point2) -> Bool) -> [(Point2, Point2)] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (\(Point2
a, Point2
b) -> Point2 -> Point2 -> Point2 -> Bool
onSegment Point2
a Point2
b Point2
p) ([Point2] -> [(Point2, Point2)]
forall a. [a] -> [(a, a)]
edges [Point2]
ps) = Location
Boundary
    | Int -> Bool
forall a. Integral a => a -> Bool
odd
        ( [()] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length
            [ ()
            | (P2 Double
ax Double
ay, P2 Double
bx Double
by) <- [Point2] -> [(Point2, Point2)]
forall a. [a] -> [(a, a)]
edges [Point2]
ps
            , (Double
ay Double -> Double -> Bool
forall a. Ord a => a -> a -> Bool
> Double
y) Bool -> Bool -> Bool
forall a. Eq a => a -> a -> Bool
/= (Double
by Double -> Double -> Bool
forall a. Ord a => a -> a -> Bool
> Double
y)
            , Double
x Double -> Double -> Bool
forall a. Ord a => a -> a -> Bool
< (Double
bx Double -> Double -> Double
forall a. Num a => a -> a -> a
- Double
ax) Double -> Double -> Double
forall a. Num a => a -> a -> a
* (Double
y Double -> Double -> Double
forall a. Num a => a -> a -> a
- Double
ay) Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ (Double
by Double -> Double -> Double
forall a. Num a => a -> a -> a
- Double
ay) Double -> Double -> Double
forall a. Num a => a -> a -> a
+ Double
ax
            ]
        ) =
        Location
Inside
    | Bool
otherwise = Location
Outside

{- | Given fallback then list, return its first element or the fallback for empty input.
Example: firstOr 0 [] == 0.
-}
firstOr :: a -> [a] -> a
firstOr :: forall a. a -> [a] -> a
firstOr a
fallback [] = a
fallback
firstOr a
_ (a
x : [a]
_) = a
x