module Data.Geometry.Point.Orientation.Degenerate(
CCW(..)
, pattern CCW, pattern CW, pattern CoLinear
, ccw, ccw'
, sortAround
, ccwCmpAroundWith, cwCmpAroundWith
, ccwCmpAround, cwCmpAround
, insertIntoCyclicOrder
) where
import Control.Lens
import qualified Data.CircularList as C
import qualified Data.CircularList.Util as CU
import Data.Ext
import Data.Geometry.Point.Internal
import Data.Geometry.Vector
import qualified Data.List as L
newtype CCW = CCWWrap Ordering deriving Eq
pattern CCW :: CCW
pattern CCW = CCWWrap GT
pattern CW :: CCW
pattern CW = CCWWrap LT
pattern CoLinear :: CCW
pattern CoLinear = CCWWrap EQ
{-# COMPLETE CCW, CW, CoLinear #-}
instance Show CCW where
show = \case
CCW -> "CCW"
CW -> "CW"
CoLinear -> "CoLinear"
ccw :: (Ord r, Num r) => Point 2 r -> Point 2 r -> Point 2 r -> CCW
ccw p q r = CCWWrap $ z `compare` 0
where
Vector2 ux uy = q .-. p
Vector2 vx vy = r .-. p
z = ux * vy - uy * vx
ccw' :: (Ord r, Num r) => Point 2 r :+ a -> Point 2 r :+ b -> Point 2 r :+ c -> CCW
ccw' p q r = ccw (p^.core) (q^.core) (r^.core)
sortAround :: (Ord r, Num r)
=> Point 2 r :+ q -> [Point 2 r :+ p] -> [Point 2 r :+ p]
sortAround c = L.sortBy (ccwCmpAround c <> cmpByDistanceTo c)
ccwCmpAroundWith :: (Ord r, Num r)
=> Vector 2 r
-> Point 2 r :+ c
-> Point 2 r :+ a -> Point 2 r :+ b
-> Ordering
ccwCmpAroundWith z@(Vector2 zx zy) (c :+ _) (q :+ _) (r :+ _) =
case (ccw c a q, ccw c a r) of
(CCW,CCW) -> cmp
(CCW,CW) -> LT
(CCW,CoLinear) | onZero r -> GT
| otherwise -> LT
(CW, CCW) -> GT
(CW, CW) -> cmp
(CW, CoLinear) -> GT
(CoLinear, CCW) | onZero q -> LT
| otherwise -> GT
(CoLinear, CW) -> LT
(CoLinear,CoLinear) -> case (onZero q, onZero r) of
(True, True) -> EQ
(False, False) -> EQ
(True, False) -> LT
(False, True) -> GT
where
a = c .+^ z
b = c .+^ Vector2 (-zy) zx
onZero d = case ccw c b d of
CCW -> False
CW -> True
CoLinear -> True
cmp = case ccw c q r of
CCW -> LT
CW -> GT
CoLinear -> EQ
cwCmpAroundWith :: (Ord r, Num r)
=> Vector 2 r
-> Point 2 r :+ a
-> Point 2 r :+ b -> Point 2 r :+ c
-> Ordering
cwCmpAroundWith z c = flip (ccwCmpAroundWith z c)
ccwCmpAround :: (Num r, Ord r)
=> Point 2 r :+ qc -> Point 2 r :+ p -> Point 2 r :+ q -> Ordering
ccwCmpAround = ccwCmpAroundWith (Vector2 1 0)
cwCmpAround :: (Num r, Ord r)
=> Point 2 r :+ qc -> Point 2 r :+ p -> Point 2 r :+ q -> Ordering
cwCmpAround = cwCmpAroundWith (Vector2 1 0)
insertIntoCyclicOrder :: (Ord r, Num r)
=> Point 2 r :+ q -> Point 2 r :+ p
-> C.CList (Point 2 r :+ p) -> C.CList (Point 2 r :+ p)
insertIntoCyclicOrder c = CU.insertOrdBy (ccwCmpAround c <> cmpByDistanceTo c)