diff --git a/.gitignore b/.gitignore index 19a8f47..b3e6502 100644 --- a/.gitignore +++ b/.gitignore @@ -1,12 +1,12 @@ dist-newstyle/ cabal.project.local -assets/*.svg -assets/*/ -files/ -img/examples -math/ -refs/ +/assets/*.svg +/assets/*/ +/files/ +/img/examples +/math +/refs/ *.txt *.md diff --git a/MetaBrush.cabal b/MetaBrush.cabal index 313cdbf..5797aec 100644 --- a/MetaBrush.cabal +++ b/MetaBrush.cabal @@ -89,6 +89,7 @@ library , Math.Epsilon , Math.Linear.Solve , Math.Module + , Math.Orientation , Math.Roots , Math.Vector2D diff --git a/src/lib/Math/Bezier/Spline.hs b/src/lib/Math/Bezier/Spline.hs index 516733b..07e6feb 100644 --- a/src/lib/Math/Bezier/Spline.hs +++ b/src/lib/Math/Bezier/Spline.hs @@ -259,9 +259,13 @@ 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 - prev :<| next -> Just $ Spline { splineStart = openCurveEnd prev, splineCurves = OpenCurves next } - _ -> Nothing +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 splitSplineAt :: Int -> Spline Open crvData ptData -> ( Spline Open crvData ptData, Spline Open crvData ptData ) splitSplineAt i ( Spline { splineStart, splineCurves = OpenCurves curves } ) = case Seq.splitAt i curves of diff --git a/src/lib/Math/Bezier/Stroke.hs b/src/lib/Math/Bezier/Stroke.hs index 55012fe..1552065 100644 --- a/src/lib/Math/Bezier/Stroke.hs +++ b/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,24 +203,34 @@ computeStrokeOutline fitParams ptParams brushFn spline@( Spline { splineStart = endPt :: ptData endPt = openCurveEnd lastCurve startTgtFwd, startTgtBwd, endTgtFwd, endTgtBwd :: Vector2D Double - startTgtFwd = snd $ firstOutlineFwd 0 - startTgtBwd = snd $ firstOutlineBwd 1 - endTgtFwd = snd $ lastOutlineFwd 1 - endTgtBwd = snd $ lastOutlineBwd 0 + startTgtFwd = snd ( firstOutlineFwd 0 ) + startTgtBwd = (-1) *^ snd ( firstOutlineBwd 1 ) + endTgtFwd = snd ( lastOutlineFwd 1 ) + 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 - ( Left ( adjustSplineType @Closed $ startCap <> fwdPts <> endCap <> bwdPts ) + ( Left ( adjustSplineType @Closed $ startCap <> fwdPts <> endCap <> bwdPts ) , fwdFits <> bwdFits ) -- Closed brush path with at least one segment. @@ -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 - startTgtBwd = snd $ firstOutlineBwd 1 - endTgtFwd = snd $ lastOutlineFwd 1 - endTgtBwd = snd $ lastOutlineBwd 0 + startTgtFwd = snd ( firstOutlineFwd 0 ) + startTgtBwd = (-1) *^ snd ( firstOutlineBwd 1 ) + endTgtFwd = snd ( lastOutlineFwd 1 ) + 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 ) @@ -282,10 +297,10 @@ computeStrokeOutline fitParams ptParams brushFn spline@( Spline { splineStart = fwd, bwd :: Double -> ( Point2D Double, Vector2D Double ) ( fwd, bwd ) = outlineFunctions @diffParams ptParams brushFn ptData curve tgtFwd, tgtBwd, next_tgtFwd, next_tgtBwd :: Vector2D Double - tgtFwd = snd ( fwd 0 ) - tgtBwd = snd ( bwd 1 ) - next_tgtFwd = snd ( fwd 1 ) - next_tgtBwd = snd ( bwd 0 ) + tgtFwd = snd ( fwd 0 ) + tgtBwd = (-1) *^ snd ( bwd 1 ) + next_tgtFwd = snd ( fwd 1 ) + 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 } + | brushOrientation == convexOrientation [ prevTgtFwd, tgtFwd ] + = fmap ( ptOffset • ) + $ joinWithBrush ( withTangent prevTgtFwd brush0 ) ( withTangent tgtFwd brush0 ) brush0 | otherwise = fmap ( ptOffset • ) - $ joinWithBrush ( withTangent prevTgtFwd brush0 ) ( withTangent tgtFwd brush0 ) brush0 + . 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 ) diff --git a/src/lib/Math/Orientation.hs b/src/lib/Math/Orientation.hs new file mode 100644 index 0000000..16fd8c3 --- /dev/null +++ b/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 diff --git a/src/lib/Math/Roots.hs b/src/lib/Math/Roots.hs index 1c7dc49..e26894c 100644 --- a/src/lib/Math/Roots.hs +++ b/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