{-# LANGUAGE TypeFamilies #-}

module Geometry where

import Control.Monad
import Data.Bits (unsafeShiftR)
import Data.EPS (EPS (..))
import qualified Data.Vector.Generic as G
import qualified Data.Vector.Generic.Mutable as GM
import qualified Data.Vector.Unboxed as U
import qualified Data.Vector.Unboxed.Mutable as UM

data Point a = P !a !a deriving (Point a -> Point a -> Bool
(Point a -> Point a -> Bool)
-> (Point a -> Point a -> Bool) -> Eq (Point a)
forall a. Eq a => Point a -> Point a -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: forall a. Eq a => Point a -> Point a -> Bool
== :: Point a -> Point a -> Bool
$c/= :: forall a. Eq a => Point a -> Point a -> Bool
/= :: Point a -> Point a -> Bool
Eq, Eq (Point a)
Eq (Point a) =>
(Point a -> Point a -> Ordering)
-> (Point a -> Point a -> Bool)
-> (Point a -> Point a -> Bool)
-> (Point a -> Point a -> Bool)
-> (Point a -> Point a -> Bool)
-> (Point a -> Point a -> Point a)
-> (Point a -> Point a -> Point a)
-> Ord (Point a)
Point a -> Point a -> Bool
Point a -> Point a -> Ordering
Point a -> Point a -> Point a
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
forall a. Ord a => Eq (Point a)
forall a. Ord a => Point a -> Point a -> Bool
forall a. Ord a => Point a -> Point a -> Ordering
forall a. Ord a => Point a -> Point a -> Point a
$ccompare :: forall a. Ord a => Point a -> Point a -> Ordering
compare :: Point a -> Point a -> Ordering
$c< :: forall a. Ord a => Point a -> Point a -> Bool
< :: Point a -> Point a -> Bool
$c<= :: forall a. Ord a => Point a -> Point a -> Bool
<= :: Point a -> Point a -> Bool
$c> :: forall a. Ord a => Point a -> Point a -> Bool
> :: Point a -> Point a -> Bool
$c>= :: forall a. Ord a => Point a -> Point a -> Bool
>= :: Point a -> Point a -> Bool
$cmax :: forall a. Ord a => Point a -> Point a -> Point a
max :: Point a -> Point a -> Point a
$cmin :: forall a. Ord a => Point a -> Point a -> Point a
min :: Point a -> Point a -> Point a
Ord)

instance (Show a) => Show (Point a) where
  show :: Point a -> String
show (P a
x a
y) = a -> ShowS
forall a. Show a => a -> ShowS
shows a
x ShowS -> ShowS
forall a b. (a -> b) -> a -> b
$ Char
' ' Char -> ShowS
forall a. a -> [a] -> [a]
: a -> String
forall a. Show a => a -> String
show a
y

instance Functor Point where
  fmap :: forall a b. (a -> b) -> Point a -> Point b
fmap a -> b
f (P a
x a
y) = b -> b -> Point b
forall a. a -> a -> Point a
P (a -> b
f a
x) (a -> b
f a
y)

instance (Num a) => Num (Point a) where
  {-# SPECIALIZE instance Num (Point Int) #-}
  {-# SPECIALIZE instance Num (Point Integer) #-}
  {-# SPECIALIZE instance Num (Point Double) #-}
  {-# SPECIALIZE instance Num (Point (EPS Double)) #-}
  (P a
x0 a
y0) + :: Point a -> Point a -> Point a
+ (P a
x1 a
y1) = a -> a -> Point a
forall a. a -> a -> Point a
P (a
x0 a -> a -> a
forall a. Num a => a -> a -> a
+ a
x1) (a
y0 a -> a -> a
forall a. Num a => a -> a -> a
+ a
y1)
  (P a
x0 a
y0) - :: Point a -> Point a -> Point a
- (P a
x1 a
y1) = a -> a -> Point a
forall a. a -> a -> Point a
P (a
x0 a -> a -> a
forall a. Num a => a -> a -> a
- a
x1) (a
y0 a -> a -> a
forall a. Num a => a -> a -> a
- a
y1)
  (P a
x0 a
y0) * :: Point a -> Point a -> Point a
* (P a
x1 a
y1) = a -> a -> Point a
forall a. a -> a -> Point a
P (a
x0 a -> a -> a
forall a. Num a => a -> a -> a
* a
x1 a -> a -> a
forall a. Num a => a -> a -> a
- a
y0 a -> a -> a
forall a. Num a => a -> a -> a
* a
y1) (a
x0 a -> a -> a
forall a. Num a => a -> a -> a
* a
y1 a -> a -> a
forall a. Num a => a -> a -> a
+ a
x1 a -> a -> a
forall a. Num a => a -> a -> a
* a
y0)
  negate :: Point a -> Point a
negate = (a -> a) -> Point a -> Point a
forall a b. (a -> b) -> Point a -> Point b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> a
forall a. Num a => a -> a
negate
  abs :: Point a -> Point a
abs = Point a -> Point a
forall a. a -> a
id
  signum :: Point a -> Point a
signum Point a
_ = a -> a -> Point a
forall a. a -> a -> Point a
P a
1 a
0
  fromInteger :: Integer -> Point a
fromInteger Integer
n = a -> a -> Point a
forall a. a -> a -> Point a
P (Integer -> a
forall a. Num a => Integer -> a
fromInteger Integer
n) a
0

dot :: (Num a) => Point a -> Point a -> a
dot :: forall a. Num a => Point a -> Point a -> a
dot (P a
x0 a
y0) (P a
x1 a
y1) = a
x0 a -> a -> a
forall a. Num a => a -> a -> a
* a
x1 a -> a -> a
forall a. Num a => a -> a -> a
+ a
y0 a -> a -> a
forall a. Num a => a -> a -> a
* a
y1
{-# INLINE dot #-}

cross :: (Num a) => Point a -> Point a -> a
cross :: forall a. Num a => Point a -> Point a -> a
cross (P a
x0 a
y0) (P a
x1 a
y1) = a
x0 a -> a -> a
forall a. Num a => a -> a -> a
* a
y1 a -> a -> a
forall a. Num a => a -> a -> a
- a
y0 a -> a -> a
forall a. Num a => a -> a -> a
* a
x1
{-# INLINE cross #-}

conjugate :: (Num a) => Point a -> Point a
conjugate :: forall a. Num a => Point a -> Point a
conjugate (P a
x a
y) = a -> a -> Point a
forall a. a -> a -> Point a
P a
x (-a
y)
{-# INLINE conjugate #-}

area :: (Num a) => Point a -> Point a -> Point a -> a
area :: forall a. Num a => Point a -> Point a -> Point a -> a
area Point a
o Point a
u Point a
v = Point a -> Point a -> a
forall a. Num a => Point a -> Point a -> a
cross (Point a
u Point a -> Point a -> Point a
forall a. Num a => a -> a -> a
- Point a
o) (Point a
v Point a -> Point a -> Point a
forall a. Num a => a -> a -> a
- Point a
o)
{-# INLINE area #-}

compareCCW :: (Num a, Ord a) => Point a -> Point a -> Point a -> Ordering
compareCCW :: forall a.
(Num a, Ord a) =>
Point a -> Point a -> Point a -> Ordering
compareCCW Point a
o = \Point a
u Point a
v -> a -> a -> Ordering
forall a. Ord a => a -> a -> Ordering
compare a
0 (Point a -> Point a -> Point a -> a
forall a. Num a => Point a -> Point a -> Point a -> a
area Point a
o Point a
u Point a
v)
{-# INLINE compareCCW #-}

compareCW :: (Num a, Ord a) => Point a -> Point a -> Point a -> Ordering
compareCW :: forall a.
(Num a, Ord a) =>
Point a -> Point a -> Point a -> Ordering
compareCW Point a
o = (Point a -> Point a -> Ordering) -> Point a -> Point a -> Ordering
forall a b c. (a -> b -> c) -> b -> a -> c
flip (Point a -> Point a -> Point a -> Ordering
forall a.
(Num a, Ord a) =>
Point a -> Point a -> Point a -> Ordering
compareCCW Point a
o)
{-# INLINE compareCW #-}

sqrNorm :: (Num a) => Point a -> a
sqrNorm :: forall a. Num a => Point a -> a
sqrNorm Point a
v = Point a -> Point a -> a
forall a. Num a => Point a -> Point a -> a
dot Point a
v Point a
v
{-# INLINE sqrNorm #-}

norm :: (Floating a) => Point a -> a
norm :: forall a. Floating a => Point a -> a
norm = a -> a
forall a. Floating a => a -> a
sqrt (a -> a) -> (Point a -> a) -> Point a -> a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Point a -> a
forall a. Num a => Point a -> a
sqrNorm
{-# INLINE norm #-}

newtype instance UM.MVector s (Point a) = MV_Point (UM.MVector s a)
newtype instance U.Vector (Point a) = V_Point (U.Vector a)

instance (U.Unbox a) => U.Unbox (Point a)

instance (U.Unbox a) => GM.MVector UM.MVector (Point a) where
  basicLength :: forall s. MVector s (Point a) -> Int
basicLength (MV_Point MVector s a
v) = Int -> Int -> Int
forall a. Bits a => a -> Int -> a
unsafeShiftR (MVector s a -> Int
forall s. MVector s a -> Int
forall (v :: * -> * -> *) a s. MVector v a => v s a -> Int
GM.basicLength MVector s a
v) Int
1
  {-# INLINE basicLength #-}
  basicUnsafeSlice :: forall s. Int -> Int -> MVector s (Point a) -> MVector s (Point a)
basicUnsafeSlice Int
i Int
n (MV_Point MVector s a
v) = MVector s a -> MVector s (Point a)
forall s a. MVector s a -> MVector s (Point a)
MV_Point (MVector s a -> MVector s (Point a))
-> MVector s a -> MVector s (Point a)
forall a b. (a -> b) -> a -> b
$ Int -> Int -> MVector s a -> MVector s a
forall s. Int -> Int -> MVector s a -> MVector s a
forall (v :: * -> * -> *) a s.
MVector v a =>
Int -> Int -> v s a -> v s a
GM.basicUnsafeSlice (Int
2 Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
i) (Int
2 Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
n) MVector s a
v
  {-# INLINE basicUnsafeSlice #-}
  basicOverlaps :: forall s. MVector s (Point a) -> MVector s (Point a) -> Bool
basicOverlaps (MV_Point MVector s a
v1) (MV_Point MVector s a
v2) = MVector s a -> MVector s a -> Bool
forall s. MVector s a -> MVector s a -> Bool
forall (v :: * -> * -> *) a s.
MVector v a =>
v s a -> v s a -> Bool
GM.basicOverlaps MVector s a
v1 MVector s a
v2
  {-# INLINE basicOverlaps #-}
  basicUnsafeNew :: forall s. Int -> ST s (MVector s (Point a))
basicUnsafeNew Int
n = MVector s a -> MVector s (Point a)
forall s a. MVector s a -> MVector s (Point a)
MV_Point (MVector s a -> MVector s (Point a))
-> ST s (MVector s a) -> ST s (MVector s (Point a))
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
`liftM` Int -> ST s (MVector s a)
forall s. Int -> ST s (MVector s a)
forall (v :: * -> * -> *) a s. MVector v a => Int -> ST s (v s a)
GM.basicUnsafeNew (Int
2 Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
n)
  {-# INLINE basicUnsafeNew #-}
  basicInitialize :: forall s. MVector s (Point a) -> ST s ()
basicInitialize (MV_Point MVector s a
v) = MVector s a -> ST s ()
forall s. MVector s a -> ST s ()
forall (v :: * -> * -> *) a s. MVector v a => v s a -> ST s ()
GM.basicInitialize MVector s a
v
  {-# INLINE basicInitialize #-}
  basicUnsafeRead :: forall s. MVector s (Point a) -> Int -> ST s (Point a)
basicUnsafeRead (MV_Point MVector s a
v) Int
i = a -> a -> Point a
forall a. a -> a -> Point a
P (a -> a -> Point a) -> ST s a -> ST s (a -> Point a)
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
`liftM` MVector s a -> Int -> ST s a
forall s. MVector s a -> Int -> ST s a
forall (v :: * -> * -> *) a s.
MVector v a =>
v s a -> Int -> ST s a
GM.basicUnsafeRead MVector s a
v (Int
2 Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
i) ST s (a -> Point a) -> ST s a -> ST s (Point a)
forall (m :: * -> *) a b. Monad m => m (a -> b) -> m a -> m b
`ap` MVector s a -> Int -> ST s a
forall s. MVector s a -> Int -> ST s a
forall (v :: * -> * -> *) a s.
MVector v a =>
v s a -> Int -> ST s a
GM.basicUnsafeRead MVector s a
v (Int
2 Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1)
  {-# INLINE basicUnsafeRead #-}
  basicUnsafeWrite :: forall s. MVector s (Point a) -> Int -> Point a -> ST s ()
basicUnsafeWrite (MV_Point MVector s a
v) Int
i (P a
x a
y) = MVector s a -> Int -> a -> ST s ()
forall s. MVector s a -> Int -> a -> ST s ()
forall (v :: * -> * -> *) a s.
MVector v a =>
v s a -> Int -> a -> ST s ()
GM.basicUnsafeWrite MVector s a
v (Int
2 Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
i) a
x ST s () -> ST s () -> ST s ()
forall a b. ST s a -> ST s b -> ST s b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> MVector s a -> Int -> a -> ST s ()
forall s. MVector s a -> Int -> a -> ST s ()
forall (v :: * -> * -> *) a s.
MVector v a =>
v s a -> Int -> a -> ST s ()
GM.basicUnsafeWrite MVector s a
v (Int
2 Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) a
y
  {-# INLINE basicUnsafeWrite #-}
  basicClear :: forall s. MVector s (Point a) -> ST s ()
basicClear (MV_Point MVector s a
v) = MVector s a -> ST s ()
forall s. MVector s a -> ST s ()
forall (v :: * -> * -> *) a s. MVector v a => v s a -> ST s ()
GM.basicClear MVector s a
v
  {-# INLINE basicClear #-}
  basicUnsafeCopy :: forall s. MVector s (Point a) -> MVector s (Point a) -> ST s ()
basicUnsafeCopy (MV_Point MVector s a
v1) (MV_Point MVector s a
v2) = MVector s a -> MVector s a -> ST s ()
forall s. MVector s a -> MVector s a -> ST s ()
forall (v :: * -> * -> *) a s.
MVector v a =>
v s a -> v s a -> ST s ()
GM.basicUnsafeCopy MVector s a
v1 MVector s a
v2
  {-# INLINE basicUnsafeCopy #-}
  basicUnsafeMove :: forall s. MVector s (Point a) -> MVector s (Point a) -> ST s ()
basicUnsafeMove (MV_Point MVector s a
v1) (MV_Point MVector s a
v2) = MVector s a -> MVector s a -> ST s ()
forall s. MVector s a -> MVector s a -> ST s ()
forall (v :: * -> * -> *) a s.
MVector v a =>
v s a -> v s a -> ST s ()
GM.basicUnsafeMove MVector s a
v1 MVector s a
v2
  {-# INLINE basicUnsafeMove #-}
  basicUnsafeGrow :: forall s. MVector s (Point a) -> Int -> ST s (MVector s (Point a))
basicUnsafeGrow (MV_Point MVector s a
v) Int
n = MVector s a -> MVector s (Point a)
forall s a. MVector s a -> MVector s (Point a)
MV_Point (MVector s a -> MVector s (Point a))
-> ST s (MVector s a) -> ST s (MVector s (Point a))
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
`liftM` MVector s a -> Int -> ST s (MVector s a)
forall s. MVector s a -> Int -> ST s (MVector s a)
forall (v :: * -> * -> *) a s.
MVector v a =>
v s a -> Int -> ST s (v s a)
GM.basicUnsafeGrow MVector s a
v (Int
2 Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
n)
  {-# INLINE basicUnsafeGrow #-}

instance (U.Unbox a) => G.Vector U.Vector (Point a) where
  basicUnsafeFreeze :: forall s. Mutable Vector s (Point a) -> ST s (Vector (Point a))
basicUnsafeFreeze (MV_Point MVector s a
v) = Vector a -> Vector (Point a)
forall a. Vector a -> Vector (Point a)
V_Point (Vector a -> Vector (Point a))
-> ST s (Vector a) -> ST s (Vector (Point a))
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
`liftM` Mutable Vector s a -> ST s (Vector a)
forall s. Mutable Vector s a -> ST s (Vector a)
forall (v :: * -> *) a s. Vector v a => Mutable v s a -> ST s (v a)
G.basicUnsafeFreeze MVector s a
Mutable Vector s a
v
  {-# INLINE basicUnsafeFreeze #-}
  basicUnsafeThaw :: forall s. Vector (Point a) -> ST s (Mutable Vector s (Point a))
basicUnsafeThaw (V_Point Vector a
v) = MVector s a -> MVector s (Point a)
forall s a. MVector s a -> MVector s (Point a)
MV_Point (MVector s a -> MVector s (Point a))
-> ST s (MVector s a) -> ST s (MVector s (Point a))
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
`liftM` Vector a -> ST s (Mutable Vector s a)
forall s. Vector a -> ST s (Mutable Vector s a)
forall (v :: * -> *) a s. Vector v a => v a -> ST s (Mutable v s a)
G.basicUnsafeThaw Vector a
v
  {-# INLINE basicUnsafeThaw #-}
  basicLength :: Vector (Point a) -> Int
basicLength (V_Point Vector a
v) = Int -> Int -> Int
forall a. Bits a => a -> Int -> a
unsafeShiftR (Vector a -> Int
forall (v :: * -> *) a. Vector v a => v a -> Int
G.basicLength Vector a
v) Int
1
  {-# INLINE basicLength #-}
  basicUnsafeSlice :: Int -> Int -> Vector (Point a) -> Vector (Point a)
basicUnsafeSlice Int
i Int
n (V_Point Vector a
v) = Vector a -> Vector (Point a)
forall a. Vector a -> Vector (Point a)
V_Point (Vector a -> Vector (Point a)) -> Vector a -> Vector (Point a)
forall a b. (a -> b) -> a -> b
$ Int -> Int -> Vector a -> Vector a
forall (v :: * -> *) a. Vector v a => Int -> Int -> v a -> v a
G.basicUnsafeSlice (Int
2 Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
i) (Int
2 Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
n) Vector a
v
  {-# INLINE basicUnsafeSlice #-}
  basicUnsafeIndexM :: Vector (Point a) -> Int -> Box (Point a)
basicUnsafeIndexM (V_Point Vector a
v) Int
i = a -> a -> Point a
forall a. a -> a -> Point a
P (a -> a -> Point a) -> Box a -> Box (a -> Point a)
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
`liftM` Vector a -> Int -> Box a
forall (v :: * -> *) a. Vector v a => v a -> Int -> Box a
G.basicUnsafeIndexM Vector a
v (Int
2 Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
i) Box (a -> Point a) -> Box a -> Box (Point a)
forall (m :: * -> *) a b. Monad m => m (a -> b) -> m a -> m b
`ap` Vector a -> Int -> Box a
forall (v :: * -> *) a. Vector v a => v a -> Int -> Box a
G.basicUnsafeIndexM Vector a
v (Int
2 Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1)
  {-# INLINE basicUnsafeIndexM #-}
  basicUnsafeCopy :: forall s. Mutable Vector s (Point a) -> Vector (Point a) -> ST s ()
basicUnsafeCopy (MV_Point MVector s a
mv) (V_Point Vector a
v) = Mutable Vector s a -> Vector a -> ST s ()
forall s. Mutable Vector s a -> Vector a -> ST s ()
forall (v :: * -> *) a s.
Vector v a =>
Mutable v s a -> v a -> ST s ()
G.basicUnsafeCopy MVector s a
Mutable Vector s a
mv Vector a
v
  elemseq :: forall b. Vector (Point a) -> Point a -> b -> b
elemseq Vector (Point a)
_ = Point a -> b -> b
forall a b. a -> b -> b
seq
  {-# INLINE elemseq #-}