{-# LANGUAGE DataKinds           #-}
{-# LANGUAGE ScopedTypeVariables #-}
module Data.Geometry.Polygon.Bezier
  ( PathJoin(..)
  , fromBeziers
  , approximate
  , approximateSome
  ) where

import           Control.Lens
import           Data.Ext
import           Data.Geometry.BezierSpline (BezierSpline, lineApproximate, pattern Bezier3)
import           Data.Geometry.Point
import           Data.Geometry.Polygon
import qualified Data.Vector.Circular       as CV

data PathJoin r
  = JoinLine
  | JoinCurve (Point 2 r) (Point 2 r)
  deriving (Int -> PathJoin r -> ShowS
[PathJoin r] -> ShowS
PathJoin r -> String
(Int -> PathJoin r -> ShowS)
-> (PathJoin r -> String)
-> ([PathJoin r] -> ShowS)
-> Show (PathJoin r)
forall r. Show r => Int -> PathJoin r -> ShowS
forall r. Show r => [PathJoin r] -> ShowS
forall r. Show r => PathJoin r -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [PathJoin r] -> ShowS
$cshowList :: forall r. Show r => [PathJoin r] -> ShowS
show :: PathJoin r -> String
$cshow :: forall r. Show r => PathJoin r -> String
showsPrec :: Int -> PathJoin r -> ShowS
$cshowsPrec :: forall r. Show r => Int -> PathJoin r -> ShowS
Show, PathJoin r -> PathJoin r -> Bool
(PathJoin r -> PathJoin r -> Bool)
-> (PathJoin r -> PathJoin r -> Bool) -> Eq (PathJoin r)
forall r. Eq r => PathJoin r -> PathJoin r -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PathJoin r -> PathJoin r -> Bool
$c/= :: forall r. Eq r => PathJoin r -> PathJoin r -> Bool
== :: PathJoin r -> PathJoin r -> Bool
$c== :: forall r. Eq r => PathJoin r -> PathJoin r -> Bool
Eq, Eq (PathJoin r)
Eq (PathJoin r)
-> (PathJoin r -> PathJoin r -> Ordering)
-> (PathJoin r -> PathJoin r -> Bool)
-> (PathJoin r -> PathJoin r -> Bool)
-> (PathJoin r -> PathJoin r -> Bool)
-> (PathJoin r -> PathJoin r -> Bool)
-> (PathJoin r -> PathJoin r -> PathJoin r)
-> (PathJoin r -> PathJoin r -> PathJoin r)
-> Ord (PathJoin r)
PathJoin r -> PathJoin r -> Bool
PathJoin r -> PathJoin r -> Ordering
PathJoin r -> PathJoin r -> PathJoin r
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 r. Ord r => Eq (PathJoin r)
forall r. Ord r => PathJoin r -> PathJoin r -> Bool
forall r. Ord r => PathJoin r -> PathJoin r -> Ordering
forall r. Ord r => PathJoin r -> PathJoin r -> PathJoin r
min :: PathJoin r -> PathJoin r -> PathJoin r
$cmin :: forall r. Ord r => PathJoin r -> PathJoin r -> PathJoin r
max :: PathJoin r -> PathJoin r -> PathJoin r
$cmax :: forall r. Ord r => PathJoin r -> PathJoin r -> PathJoin r
>= :: PathJoin r -> PathJoin r -> Bool
$c>= :: forall r. Ord r => PathJoin r -> PathJoin r -> Bool
> :: PathJoin r -> PathJoin r -> Bool
$c> :: forall r. Ord r => PathJoin r -> PathJoin r -> Bool
<= :: PathJoin r -> PathJoin r -> Bool
$c<= :: forall r. Ord r => PathJoin r -> PathJoin r -> Bool
< :: PathJoin r -> PathJoin r -> Bool
$c< :: forall r. Ord r => PathJoin r -> PathJoin r -> Bool
compare :: PathJoin r -> PathJoin r -> Ordering
$ccompare :: forall r. Ord r => PathJoin r -> PathJoin r -> Ordering
$cp1Ord :: forall r. Ord r => Eq (PathJoin r)
Ord)

-- | Construct a polygon from a closed set of bezier curves. Each curve must be connected to
--   its neighbours.
fromBeziers :: (Eq r, Num r) => [BezierSpline 3 2 r] -> SimplePolygon (PathJoin r) r
fromBeziers :: [BezierSpline 3 2 r] -> SimplePolygon (PathJoin r) r
fromBeziers [BezierSpline 3 2 r]
curves
  | Polygon 'Simple () r -> Bool
forall r (t :: PolygonType) p.
(Eq r, Num r) =>
Polygon t p r -> Bool
isCounterClockwise Polygon 'Simple () r
expanded = SimplePolygon (PathJoin r) r
p
  | Bool
otherwise = SimplePolygon (PathJoin r) r
p'
  where
    p :: SimplePolygon (PathJoin r) r
p = [Point 2 r :+ PathJoin r] -> SimplePolygon (PathJoin r) r
forall r p. [Point 2 r :+ p] -> SimplePolygon p r
unsafeFromPoints
      [ Point 2 r
a Point 2 r -> PathJoin r -> Point 2 r :+ PathJoin r
forall core extra. core -> extra -> core :+ extra
:+ Point 2 r -> Point 2 r -> PathJoin r
forall r. Point 2 r -> Point 2 r -> PathJoin r
JoinCurve Point 2 r
b Point 2 r
c
      | Bezier3 Point 2 r
a Point 2 r
b Point 2 r
c Point 2 r
_d <- [BezierSpline 3 2 r]
curves ]
    p' :: SimplePolygon (PathJoin r) r
p' = [Point 2 r :+ PathJoin r] -> SimplePolygon (PathJoin r) r
forall r p. [Point 2 r :+ p] -> SimplePolygon p r
unsafeFromPoints
      [ Point 2 r
d Point 2 r -> PathJoin r -> Point 2 r :+ PathJoin r
forall core extra. core -> extra -> core :+ extra
:+ Point 2 r -> Point 2 r -> PathJoin r
forall r. Point 2 r -> Point 2 r -> PathJoin r
JoinCurve Point 2 r
c Point 2 r
b
      | Bezier3 Point 2 r
_a Point 2 r
b Point 2 r
c Point 2 r
d <- [BezierSpline 3 2 r] -> [BezierSpline 3 2 r]
forall a. [a] -> [a]
reverse [BezierSpline 3 2 r]
curves ]
    expanded :: Polygon 'Simple () r
expanded = [Point 2 r :+ ()] -> Polygon 'Simple () r
forall r p. [Point 2 r :+ p] -> SimplePolygon p r
unsafeFromPoints ([Point 2 r :+ ()] -> Polygon 'Simple () r)
-> [Point 2 r :+ ()] -> Polygon 'Simple () r
forall a b. (a -> b) -> a -> b
$ [[Point 2 r :+ ()]] -> [Point 2 r :+ ()]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat
      [ (Point 2 r -> Point 2 r :+ ()) -> [Point 2 r] -> [Point 2 r :+ ()]
forall a b. (a -> b) -> [a] -> [b]
map Point 2 r -> Point 2 r :+ ()
forall a. a -> a :+ ()
ext [Point 2 r
a, Point 2 r
b, Point 2 r
c]
      | Bezier3 Point 2 r
a Point 2 r
b Point 2 r
c Point 2 r
_d <- [BezierSpline 3 2 r]
curves ]

approximate :: forall t r. (Ord r, Fractional r) => r -> Polygon t (PathJoin r) r -> Polygon t () r
approximate :: r -> Polygon t (PathJoin r) r -> Polygon t () r
approximate r
eps Polygon t (PathJoin r) r
p =
  case Polygon t (PathJoin r) r
p of
    SimplePolygon{}  ->
      let vs :: CircularVector (Point 2 r :+ PathJoin r)
vs = Polygon t (PathJoin r) r
pPolygon t (PathJoin r) r
-> Getting
     (CircularVector (Point 2 r :+ PathJoin r))
     (Polygon t (PathJoin r) r)
     (CircularVector (Point 2 r :+ PathJoin r))
-> CircularVector (Point 2 r :+ PathJoin r)
forall s a. s -> Getting a s a -> a
^.Getting
  (CircularVector (Point 2 r :+ PathJoin r))
  (Polygon t (PathJoin r) r)
  (CircularVector (Point 2 r :+ PathJoin r))
forall (t :: PolygonType) p r.
Getter (Polygon t p r) (CircularVector (Point 2 r :+ p))
outerBoundaryVector
      in CircularVector (Point 2 r :+ ()) -> SimplePolygon () r
forall r p. CircularVector (Point 2 r :+ p) -> SimplePolygon p r
unsafeFromCircularVector (CircularVector (Point 2 r :+ ()) -> SimplePolygon () r)
-> CircularVector (Point 2 r :+ ()) -> SimplePolygon () r
forall a b. (a -> b) -> a -> b
$ ((Point 2 r :+ PathJoin r, Point 2 r :+ PathJoin r)
 -> CircularVector (Point 2 r :+ ()))
-> CircularVector
     (Point 2 r :+ PathJoin r, Point 2 r :+ PathJoin r)
-> CircularVector (Point 2 r :+ ())
forall a b.
(a -> CircularVector b) -> CircularVector a -> CircularVector b
CV.concatMap (Point 2 r :+ PathJoin r, Point 2 r :+ PathJoin r)
-> CircularVector (Point 2 r :+ ())
f (CircularVector (Point 2 r :+ PathJoin r, Point 2 r :+ PathJoin r)
 -> CircularVector (Point 2 r :+ ()))
-> CircularVector
     (Point 2 r :+ PathJoin r, Point 2 r :+ PathJoin r)
-> CircularVector (Point 2 r :+ ())
forall a b. (a -> b) -> a -> b
$ CircularVector (Point 2 r :+ PathJoin r)
-> CircularVector (Point 2 r :+ PathJoin r)
-> CircularVector
     (Point 2 r :+ PathJoin r, Point 2 r :+ PathJoin r)
forall a b.
CircularVector a -> CircularVector b -> CircularVector (a, b)
CV.zip CircularVector (Point 2 r :+ PathJoin r)
vs (Int
-> CircularVector (Point 2 r :+ PathJoin r)
-> CircularVector (Point 2 r :+ PathJoin r)
forall a. Int -> CircularVector a -> CircularVector a
CV.rotateRight Int
1 CircularVector (Point 2 r :+ PathJoin r)
vs)
    MultiPolygon SimplePolygon (PathJoin r) r
v [SimplePolygon (PathJoin r) r]
hs -> SimplePolygon () r -> [SimplePolygon () r] -> MultiPolygon () r
forall p r.
SimplePolygon p r -> [SimplePolygon p r] -> MultiPolygon p r
MultiPolygon (r -> SimplePolygon (PathJoin r) r -> SimplePolygon () r
forall (t :: PolygonType) r.
(Ord r, Fractional r) =>
r -> Polygon t (PathJoin r) r -> Polygon t () r
approximate r
eps SimplePolygon (PathJoin r) r
v) ((SimplePolygon (PathJoin r) r -> SimplePolygon () r)
-> [SimplePolygon (PathJoin r) r] -> [SimplePolygon () r]
forall a b. (a -> b) -> [a] -> [b]
map (r -> SimplePolygon (PathJoin r) r -> SimplePolygon () r
forall (t :: PolygonType) r.
(Ord r, Fractional r) =>
r -> Polygon t (PathJoin r) r -> Polygon t () r
approximate r
eps) [SimplePolygon (PathJoin r) r]
hs)
  where
    f :: (Point 2 r :+ PathJoin r, Point 2 r :+ PathJoin r) -> CV.CircularVector (Point 2 r :+ ())
    f :: (Point 2 r :+ PathJoin r, Point 2 r :+ PathJoin r)
-> CircularVector (Point 2 r :+ ())
f (Point 2 r
a :+ PathJoin r
JoinLine, Point 2 r :+ PathJoin r
_) = (Point 2 r :+ ()) -> CircularVector (Point 2 r :+ ())
forall a. a -> CircularVector a
CV.singleton (Point 2 r -> Point 2 r :+ ()
forall a. a -> a :+ ()
ext Point 2 r
a)
    f (Point 2 r
a :+ JoinCurve Point 2 r
b Point 2 r
c, Point 2 r
d :+ PathJoin r
_) =
      [Point 2 r :+ ()] -> CircularVector (Point 2 r :+ ())
forall a. [a] -> CircularVector a
CV.unsafeFromList ([Point 2 r :+ ()] -> CircularVector (Point 2 r :+ ()))
-> [Point 2 r :+ ()] -> CircularVector (Point 2 r :+ ())
forall a b. (a -> b) -> a -> b
$ (Point 2 r -> Point 2 r :+ ()) -> [Point 2 r] -> [Point 2 r :+ ()]
forall a b. (a -> b) -> [a] -> [b]
map Point 2 r -> Point 2 r :+ ()
forall a. a -> a :+ ()
ext ([Point 2 r] -> [Point 2 r :+ ()])
-> [Point 2 r] -> [Point 2 r :+ ()]
forall a b. (a -> b) -> a -> b
$ [Point 2 r] -> [Point 2 r]
forall a. [a] -> [a]
init (r -> BezierSpline 3 2 r -> [Point 2 r]
forall r.
(Ord r, Fractional r) =>
r -> BezierSpline 3 2 r -> [Point 2 r]
lineApproximate r
eps (Point 2 r
-> Point 2 r -> Point 2 r -> Point 2 r -> BezierSpline 3 2 r
forall (d :: Nat) r.
Point d r
-> Point d r -> Point d r -> Point d r -> BezierSpline 3 d r
Bezier3 Point 2 r
a Point 2 r
b Point 2 r
c Point 2 r
d))

approximateSome :: (Ord r, Fractional r) => r -> SomePolygon (PathJoin r) r -> SomePolygon () r
approximateSome :: r -> SomePolygon (PathJoin r) r -> SomePolygon () r
approximateSome r
eps (Left Polygon 'Simple (PathJoin r) r
p)  = Polygon 'Simple () r -> SomePolygon () r
forall a b. a -> Either a b
Left (Polygon 'Simple () r -> SomePolygon () r)
-> Polygon 'Simple () r -> SomePolygon () r
forall a b. (a -> b) -> a -> b
$ r -> Polygon 'Simple (PathJoin r) r -> Polygon 'Simple () r
forall (t :: PolygonType) r.
(Ord r, Fractional r) =>
r -> Polygon t (PathJoin r) r -> Polygon t () r
approximate r
eps Polygon 'Simple (PathJoin r) r
p
approximateSome r
eps (Right Polygon 'Multi (PathJoin r) r
p) = Polygon 'Multi () r -> SomePolygon () r
forall a b. b -> Either a b
Right (Polygon 'Multi () r -> SomePolygon () r)
-> Polygon 'Multi () r -> SomePolygon () r
forall a b. (a -> b) -> a -> b
$ r -> Polygon 'Multi (PathJoin r) r -> Polygon 'Multi () r
forall (t :: PolygonType) r.
(Ord r, Fractional r) =>
r -> Polygon t (PathJoin r) r -> Polygon t () r
approximate r
eps Polygon 'Multi (PathJoin r) r
p