{-# LANGUAGE ScopedTypeVariables  #-}
{-# LANGUAGE UndecidableInstances #-}
--------------------------------------------------------------------------------
-- |
-- Module      :  Data.Geometry.Point
-- Copyright   :  (C) Frank Staals
-- License     :  see the LICENSE file
-- Maintainer  :  Frank Staals
--
-- \(d\)-dimensional points.
--
--------------------------------------------------------------------------------
module Data.Geometry.Point( Point(.., Point1, Point2, Point3)
                          , origin, vector
                          , pointFromList
                          , projectPoint

                          , xCoord, yCoord, zCoord

                          , PointFunctor(..)

                          , CCW, ccw, ccw', isCoLinear
                          , pattern CCW, pattern CW, pattern CoLinear

                          , ccwCmpAround, ccwCmpAround'
                          , cwCmpAround, cwCmpAround'
                          , ccwCmpAroundWith, ccwCmpAroundWith'
                          , cwCmpAroundWith, cwCmpAroundWith'
                          , sortAround, sortAround'
                          , insertIntoCyclicOrder

                          , Quadrant(..), quadrantWith, quadrant, partitionIntoQuadrants

                          , cmpByDistanceTo, cmpByDistanceTo', cmpInDirection

                          , squaredEuclideanDist, euclideanDist
                          , HasSquaredEuclideanDistance(..)

                          , coord, unsafeCoord
                          ) where

import Data.Geometry.Point.Class
import Data.Geometry.Point.Internal hiding (coord, unsafeCoord)
import Data.Geometry.Point.Orientation.Degenerate
import Data.Geometry.Point.Quadrants
import Data.Geometry.Line.Internal
import Data.Geometry.Vector

--------------------------------------------------------------------------------

-- | Compare the points with respect to the direction given by the
-- vector, i.e. by taking planes whose normal is the given vector.
--
-- >>> cmpInDirection (Vector2 1 0) (Point2 5 0) (Point2 10 0)
-- LT
-- >>> cmpInDirection (Vector2 1 1) (Point2 5 0) (Point2 10 0)
-- LT
-- >>> cmpInDirection (Vector2 1 1) (Point2 5 0) (Point2 10 10)
-- LT
-- >>> cmpInDirection (Vector2 1 1) (Point2 15 15) (Point2 10 10)
-- GT
-- >>> cmpInDirection (Vector2 1 0) (Point2 15 15) (Point2 15 10)
-- EQ
cmpInDirection       :: (Ord r, Num r) => Vector 2 r -> Point 2 r -> Point 2 r -> Ordering
cmpInDirection :: Vector 2 r -> Point 2 r -> Point 2 r -> Ordering
cmpInDirection Vector 2 r
n Point 2 r
p Point 2 r
q = case Point 2 r
p Point 2 r -> Line 2 r -> SideTest
forall r. (Ord r, Num r) => Point 2 r -> Line 2 r -> SideTest
`onSide` Line 2 r -> Line 2 r
forall r. Num r => Line 2 r -> Line 2 r
perpendicularTo (Point 2 r -> Vector 2 r -> Line 2 r
forall (d :: Nat) r. Point d r -> Vector d r -> Line d r
Line Point 2 r
q Vector 2 r
n) of
                         SideTest
LeftSide  -> Ordering
LT
                         SideTest
OnLine    -> Ordering
EQ
                         SideTest
RightSide -> Ordering
GT
  -- TODO: Generalize to arbitrary dimension