fix orientation of brush joins

.gitignore

@@ -1,12 +1,12 @@
 dist-newstyle/
 cabal.project.local
 
-assets/*.svg
+/assets/*.svg
-assets/*/
+/assets/*/
-files/
+/files/
-img/examples
+/img/examples
-math/
+/math
-refs/
+/refs/
 
 *.txt
 *.md

MetaBrush.cabal

@@ -89,6 +89,7 @@ library
       , Math.Epsilon
       , Math.Linear.Solve
       , Math.Module
+      , Math.Orientation
       , Math.Roots
       , Math.Vector2D
 

src/lib/Math/Bezier/Spline.hs

@@ -259,7 +259,11 @@ bitraverseCurve f g ( Bezier2To p1 p2    d ) = Bezier2To <$> g ControlPoint p1 <
 bitraverseCurve f g ( Bezier3To p1 p2 p3 d ) = Bezier3To <$> g ControlPoint p1 <*> g ControlPoint p2 <*> traverse ( g PathPoint ) p3 <*> f d
 
 dropCurves :: Int -> Spline Open crvData ptData -> Maybe ( Spline Open crvData ptData )
-dropCurves i ( Spline { splineCurves = OpenCurves curves } ) = case Seq.drop ( i - 1 ) curves of
+dropCurves i spline@( Spline { splineCurves = OpenCurves curves } )
+  | i < 1
+  = Just spline
+  | otherwise
+  = case Seq.drop ( i - 1 ) curves of
     prev :<| next -> Just $ Spline { splineStart = openCurveEnd prev, splineCurves = OpenCurves next }
     _             -> Nothing
 

src/lib/Math/Bezier/Stroke.hs

@@ -98,7 +98,7 @@ import Math.Bezier.Cubic.Fit
   ( FitPoint, FitParameters, fitSpline )
 import Math.Bezier.Spline
   ( SplineType(..), SSplineType(..), SplineTypeI
-  , ssplineType, adjustSplineType
+  , ssplineType, adjustSplineType, reverseSpline
   , NextPoint(..), fromNextPoint
   , KnownSplineType
     ( bifoldSpline, ibifoldSpline )
@@ -112,6 +112,8 @@ import Math.Module
   ( Module((^-^), (*^)), Inner((^.^))
   , lerp, squaredNorm, cross
   )
+import Math.Orientation
+  ( Orientation(..), convexOrientation, splineOrientation )
 import Math.Roots
   ( solveQuadratic )
 import Math.Vector2D
@@ -201,20 +203,30 @@ computeStrokeOutline fitParams ptParams brushFn spline@( Spline { splineStart =
         endPt :: ptData
         endPt = openCurveEnd lastCurve
         startTgtFwd, startTgtBwd, endTgtFwd, endTgtBwd :: Vector2D Double
-        startTgtFwd = snd $ firstOutlineFwd 0
+        startTgtFwd =         snd ( firstOutlineFwd 0 )
-        startTgtBwd = snd $ firstOutlineBwd 1
+        startTgtBwd = (-1) *^ snd ( firstOutlineBwd 1 )
-        endTgtFwd   = snd $  lastOutlineFwd 1
+        endTgtFwd   =         snd (  lastOutlineFwd 1 )
-        endTgtBwd   = snd $  lastOutlineBwd 0
+        endTgtBwd   = (-1) *^ snd (  lastOutlineBwd 0 )
         startBrush, endBrush :: SplinePts Closed
         startBrush = brushShape spt0
         endBrush = brushShape endPt
         startCap, endCap :: SplinePts Open
         startCap
+          | brushOrientation == convexOrientation [ startTgtBwd, startTgtFwd ]
           = fmap ( MkVector2D ( coords spt0 ) • )
-          $ joinWithBrush ( withTangent ( (-1) *^ startTgtBwd ) startBrush ) ( withTangent startTgtFwd startBrush ) startBrush
+          $ joinWithBrush ( withTangent startTgtBwd startBrush ) ( withTangent startTgtFwd startBrush ) startBrush
+          | otherwise
+          = fmap ( MkVector2D ( coords spt0 ) • )
+          . reverseSpline
+          $ joinWithBrush ( withTangent startTgtFwd startBrush ) ( withTangent startTgtBwd startBrush )startBrush
         endCap
+          | brushOrientation == convexOrientation [ endTgtFwd, endTgtBwd ]
           = fmap ( MkVector2D ( coords endPt ) • )
-          $ joinWithBrush ( withTangent endTgtFwd endBrush ) ( withTangent ( (-1) *^ endTgtBwd ) endBrush ) endBrush
+          . reverseSpline
+          $ joinWithBrush ( withTangent endTgtBwd endBrush ) ( withTangent endTgtFwd endBrush ) endBrush
+          | otherwise
+          = fmap ( MkVector2D ( coords endPt ) • )
+          $ joinWithBrush ( withTangent endTgtFwd endBrush ) ( withTangent endTgtBwd endBrush ) endBrush
     -> do
       TwoSided ( fwdPts, fwdFits ) ( bwdPts, bwdFits ) <- updateSpline ( startTgtFwd, startTgtBwd )
       pure
@@ -228,10 +240,10 @@ computeStrokeOutline fitParams ptParams brushFn spline@( Spline { splineStart =
     , _ :|> ( lastOutlineFwd, lastOutlineBwd )   <- outlineFns
     , let
         startTgtFwd, startTgtBwd, endTgtFwd, endTgtBwd :: Vector2D Double
-        startTgtFwd = snd $ firstOutlineFwd 0
+        startTgtFwd =         snd ( firstOutlineFwd 0 )
-        startTgtBwd = snd $ firstOutlineBwd 1
+        startTgtBwd = (-1) *^ snd ( firstOutlineBwd 1 )
-        endTgtFwd   = snd $  lastOutlineFwd 1
+        endTgtFwd   =         snd (  lastOutlineFwd 1 )
-        endTgtBwd   = snd $  lastOutlineBwd 0
+        endTgtBwd   = (-1) *^ snd (  lastOutlineBwd 0 )
         fwdStartCap, bwdStartCap :: SplinePts Open
         TwoSided fwdStartCap bwdStartCap
           = fmap fst . snd . runWriter
@@ -250,6 +262,9 @@ computeStrokeOutline fitParams ptParams brushFn spline@( Spline { splineStart =
       )
   where
 
+    brushOrientation :: Orientation
+    brushOrientation = splineOrientation ( brushShape spt0 )
+
     outlineFns
       :: Seq
           ( Double -> ( Point2D Double, Vector2D Double )
@@ -283,9 +298,9 @@ computeStrokeOutline fitParams ptParams brushFn spline@( Spline { splineStart =
               ( fwd, bwd ) = outlineFunctions @diffParams ptParams brushFn ptData curve
               tgtFwd, tgtBwd, next_tgtFwd, next_tgtBwd :: Vector2D Double
               tgtFwd      =         snd ( fwd 0 )
-              tgtBwd = snd ( bwd 1 )
+              tgtBwd      = (-1) *^ snd ( bwd 1 )
               next_tgtFwd =         snd ( fwd 1 )
-              next_tgtBwd = snd ( bwd 0 )
+              next_tgtBwd = (-1) *^ snd ( bwd 0 )
             lift $ tellBrushJoin ( prev_tgtFwd, prev_tgtBwd ) ptData ( tgtFwd, tgtBwd )
             lift $ updateCurveData ( curveData curve ) fwd bwd
             put ( next_tgtFwd, next_tgtBwd )
@@ -336,15 +351,23 @@ computeStrokeOutline fitParams ptParams brushFn spline@( Spline { splineStart =
         fwdJoin
           | tgtFwd `parallel` prevTgtFwd
           = Spline { splineStart = coords sp0, splineCurves = OpenCurves Empty }
-          | otherwise
+          | brushOrientation == convexOrientation [ prevTgtFwd, tgtFwd ]
           = fmap ( ptOffset • )
           $ joinWithBrush ( withTangent prevTgtFwd brush0 ) ( withTangent     tgtFwd brush0 ) brush0
+          | otherwise
+          = fmap ( ptOffset • )
+          . reverseSpline
+          $ joinWithBrush ( withTangent     tgtFwd brush0 ) ( withTangent prevTgtFwd brush0 ) brush0
         bwdJoin
           | tgtBwd `parallel` prevTgtBwd
           = Spline { splineStart = coords sp0, splineCurves = OpenCurves Empty }
+          | brushOrientation == convexOrientation [ tgtBwd, prevTgtBwd ]
+          = fmap ( ptOffset • )
+          $ joinWithBrush ( withTangent     tgtBwd brush0 ) ( withTangent prevTgtBwd brush0 ) brush0
           | otherwise
           = fmap ( ptOffset • )
-          $ joinWithBrush ( withTangent ( (-1) *^ tgtBwd ) brush0 ) ( withTangent ( (-1) *^ prevTgtBwd ) brush0 ) brush0
+          . reverseSpline
+          $ joinWithBrush ( withTangent prevTgtBwd brush0 ) ( withTangent     tgtBwd brush0 ) brush0
         brushJoin :: OutlineData
         brushJoin = TwoSided ( fwdJoin, Empty ) ( bwdJoin, Empty )
 

src/lib/Math/Orientation.hs

@@ -0,0 +1,91 @@
+{-# LANGUAGE DataKinds           #-}
+{-# LANGUAGE DerivingStrategies  #-}
+{-# LANGUAGE GADTs               #-}
+{-# LANGUAGE ScopedTypeVariables #-}
+{-# LANGUAGE TypeApplications    #-}
+
+module Math.Orientation
+  ( Orientation(..), reverseOrientation
+  , convexOrientation, splineOrientation, splineTangents
+  )
+  where
+
+-- acts
+import Data.Act
+  ( Torsor((-->)) )
+
+-- containers
+import Data.Sequence
+  ( Seq(..) )
+
+-- MetaBrush
+import Math.Epsilon
+  ( nearZero )
+import Math.Module
+  ( cross )
+import Math.Bezier.Spline
+  ( Spline(..), Curves(..), Curve(..), NextPoint(..)
+  , SplineType(..), KnownSplineType(..), SSplineType(..)
+  , ssplineType
+  )
+import Math.Vector2D
+  ( Point2D, Vector2D )
+
+--------------------------------------------------------------------------------
+
+-- | An orientation in the plane: counter-clockwise or clockwise.
+data Orientation = CCW | CW
+  deriving stock ( Show, Eq, Ord )
+
+-- | Reverse an orientation, turning counter-clockwise into clockwise and vice-versa.
+reverseOrientation :: Orientation -> Orientation
+reverseOrientation CCW = CW
+reverseOrientation CW  = CCW
+
+-- | Compute an orientation from a sequence of tangent vectors (assumed to have monotone angle).
+convexOrientation :: forall r. RealFloat r => [ Vector2D r ] -> Orientation
+convexOrientation ( v1 : v2 : vs )
+  | nearZero crossProduct
+  = convexOrientation ( v2 : vs )
+  | crossProduct > 0
+  = CCW
+  | otherwise
+  = CW
+  where
+    crossProduct :: r
+    crossProduct = v1 `cross` v2
+convexOrientation _ = CCW -- default
+
+-- | Compute the orientation of a spline, assuming tangent vectors have a monotone angle.
+splineOrientation
+  :: ( KnownSplineType clo, RealFloat r )
+  => Spline clo crvData ( Point2D r )
+  -> Orientation
+splineOrientation = convexOrientation . splineTangents
+
+-- | Compute the sequence of tangent vectors given by the control points of a Bézier spline.
+splineTangents
+  :: forall clo crvData r
+  .  ( Num r, KnownSplineType clo )
+  => Spline clo crvData ( Point2D r )
+  -> [ Vector2D r ]
+splineTangents spline@( Spline { splineStart = p0, splineCurves = curves } ) =
+  case ssplineType @clo of
+    SOpen
+      | OpenCurves { openCurves = cs } <- curves
+      -> go p0 cs
+    SClosed
+      | OpenCurves cs@( c :<| _ ) <- splineCurves $ adjustSplineType @Open spline
+      -> go p0 ( cs :|> c )
+    _ -> []
+  where
+    go :: Point2D r -> Seq ( Curve Open crvData ( Point2D r ) ) -> [ Vector2D r ]
+    go _ Empty = []
+    go p ( crv :<| crvs ) =
+      case crv of
+        LineTo { curveEnd = NextPoint q } ->
+          ( p --> q ) : go q crvs
+        Bezier2To { controlPoint = cp, curveEnd = NextPoint q } ->
+          ( p --> cp ) : ( cp --> q ) : go q crvs
+        Bezier3To { controlPoint1 = cp1, controlPoint2 = cp2, curveEnd = NextPoint q } ->
+          ( p --> cp1 ) : ( cp2 --> q ) : go q crvs

src/lib/Math/Roots.hs

@@ -46,7 +46,14 @@ import Math.Epsilon
 --------------------------------------------------------------------------------
 
 -- | Real solutions to a quadratic equation.
-solveQuadratic :: forall a. RealFloat a => a -> a -> a -> [ a ]
+--
+-- Coefficients are given in order of increasing degree.
+solveQuadratic
+  :: forall a. RealFloat a
+  => a -- ^ constant coefficient
+  -> a -- ^ linear coefficient
+  -> a -- ^ quadratic coefficient
+  -> [ a ]
 solveQuadratic a0 a1 a2
   | nearZero a1 && nearZero a2
   = if   nearZero a0