hashirama/metabrush
1
0
Fork 0
mirror of https://gitlab.com/sheaf/metabrush.git synced 2024-11-23 15:34:06 +00:00
Code Issues Actions Projects Releases Wiki Activity

fix orientation of brush joins

Browse source
This commit is contained in:
sheaf 2021-05-10 23:51:05 +02:00
parent b46dc2a140
commit c64a4140c4
6 changed files with 154 additions and 28 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

12
.gitignore vendored
View file

@ -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

1
MetaBrush.cabal
View file

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

10
src/lib/Math/Bezier/Spline.hs
View file

@ -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

59
src/lib/Math/Bezier/Stroke.hs
View file

@ -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 )

91
src/lib/Math/Orientation.hs Normal file
View file

@ -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

9
src/lib/Math/Roots.hs
View file

@ -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