-- | Offsetting bezier curves and stroking curves.

module Geom2D.CubicBezier.Outline
       (bezierOffset, bezierOffsetPoint)
       where
import Geom2D
import Geom2D.CubicBezier.Basic
import Geom2D.CubicBezier.Approximate

offsetPoint :: (Floating a) =>  a -> Point a -> Point a -> Point a
offsetPoint :: forall a. Floating a => a -> Point a -> Point a -> Point a
offsetPoint a
dist Point a
start Point a
tangent =
  Point a
start forall v. AdditiveGroup v => v -> v -> v
^+^ (forall s. Floating s => Transform s
rotate90L forall a b. AffineTransform a b => Transform b -> a -> a
$* a
dist forall v. VectorSpace v => Scalar v -> v -> v
*^ forall a. Floating a => Point a -> Point a
normVector Point a
tangent)

bezierOffsetPoint :: CubicBezier Double -> Double -> Double -> (DPoint, DPoint)
bezierOffsetPoint :: CubicBezier Double -> Double -> Double -> (DPoint, DPoint)
bezierOffsetPoint CubicBezier Double
cb Double
dist Double
t = (forall a. Floating a => a -> Point a -> Point a -> Point a
offsetPoint Double
dist DPoint
p DPoint
p', DPoint
p')
  where (DPoint
p, DPoint
p') = forall a (b :: * -> *).
(Unbox a, Fractional a, GenericBezier b) =>
b a -> a -> (Point a, Point a)
evalBezierDeriv CubicBezier Double
cb Double
t

-- | Calculate an offset path from the bezier curve to within
-- tolerance.  If the distance is positive offset to the left,
-- otherwise to the right. A smaller tolerance may require more bezier
-- curves in the path to approximate the offset curve
bezierOffset :: CubicBezier Double -- ^ The curve
             -> Double      -- ^ Offset distance.
             -> Maybe Int   -- ^ maximum subcurves
             -> Double      -- ^ Tolerance.
             -> [CubicBezier Double]        -- ^ The offset curve
bezierOffset :: CubicBezier Double
-> Double -> Maybe Int -> Double -> [CubicBezier Double]
bezierOffset CubicBezier Double
cb Double
dist (Just Int
m) Double
tol =
  forall a.
(Unbox a, Floating a, Ord a) =>
Int
-> (a -> (Point a, Point a))
-> Int
-> a
-> a
-> a
-> Bool
-> [CubicBezier a]
approximatePathMax Int
m (CubicBezier Double -> Double -> Double -> (DPoint, DPoint)
bezierOffsetPoint CubicBezier Double
cb Double
dist) Int
15 Double
tol Double
0 Double
1 Bool
False

bezierOffset CubicBezier Double
cb Double
dist Maybe Int
Nothing Double
tol =
  forall a.
(Unbox a, Ord a, Floating a) =>
(a -> (Point a, Point a))
-> Int -> a -> a -> a -> Bool -> [CubicBezier a]
approximatePath (CubicBezier Double -> Double -> Double -> (DPoint, DPoint)
bezierOffsetPoint CubicBezier Double
cb Double
dist) Int
15 Double
tol Double
0 Double
1 Bool
False