mirror of
https://gitlab.com/sheaf/metabrush.git
synced 2024-11-23 15:34:06 +00:00
fix brush join orientations
This commit is contained in:
parent
570a593f4f
commit
9f16cff978
|
@ -59,6 +59,26 @@ circle uniqueSupply = mkBrush @circleBrushFields uniqueSupply name code
|
||||||
\ -- (-r ,-r*c) -- (-r*c,-r ) -> ( 0,-r)\n\
|
\ -- (-r ,-r*c) -- (-r*c,-r ) -> ( 0,-r)\n\
|
||||||
\ -- ( r*c,-r ) -- ( r ,-r*c) -> . ]"
|
\ -- ( r*c,-r ) -- ( r ,-r*c) -> . ]"
|
||||||
|
|
||||||
|
circleCW
|
||||||
|
:: forall circleBrushFields
|
||||||
|
. ( circleBrushFields ~ '[ "r" SuperRecord.:= Double ] )
|
||||||
|
=> UniqueSupply -> IO ( Brush circleBrushFields )
|
||||||
|
circleCW uniqueSupply = mkBrush @circleBrushFields uniqueSupply name code
|
||||||
|
where
|
||||||
|
name, code :: Text
|
||||||
|
name = "Circle CW"
|
||||||
|
code =
|
||||||
|
"with\n\
|
||||||
|
\ r = 1\n\
|
||||||
|
\satisfying\n\
|
||||||
|
\ r > 0\n\
|
||||||
|
\define\n\
|
||||||
|
\ let c = kappa in\n\
|
||||||
|
\ [ (r,0) -- ( r ,-r*c) -- ( r*c,-r ) -> ( 0,-r)\n\
|
||||||
|
\ -- (-r*c,-r ) -- (-r ,-r*c) -> (-r, 0)\n\
|
||||||
|
\ -- (-r , r*c) -- (-r*c, r ) -> ( 0, r)\n\
|
||||||
|
\ -- ( r*c, r ) -- ( r , r*c) -> . ]"
|
||||||
|
|
||||||
{-
|
{-
|
||||||
rounded
|
rounded
|
||||||
:: forall roundedBrushFields
|
:: forall roundedBrushFields
|
||||||
|
|
|
@ -108,12 +108,12 @@ import qualified Math.Bezier.Quadratic as Quadratic
|
||||||
import Math.Epsilon
|
import Math.Epsilon
|
||||||
( epsilon )
|
( epsilon )
|
||||||
import Math.Module
|
import Math.Module
|
||||||
( Module((*^)), Inner((^.^))
|
( Module(..), Inner((^.^))
|
||||||
, lerp, squaredNorm, cross
|
, lerp, squaredNorm, cross
|
||||||
, convexCombination, strictlyParallel
|
, convexCombination, strictlyParallel
|
||||||
)
|
)
|
||||||
import Math.Orientation
|
import Math.Orientation
|
||||||
( Orientation(..), convexOrientation, splineOrientation
|
( Orientation(..), splineOrientation
|
||||||
, between
|
, between
|
||||||
)
|
)
|
||||||
import Math.Roots
|
import Math.Roots
|
||||||
|
@ -198,10 +198,10 @@ computeStrokeOutline fitParams ptParams brushFn spline@( Spline { splineStart =
|
||||||
-- Open brush path with at least one segment.
|
-- Open brush path with at least one segment.
|
||||||
-- Need to add caps at both ends of the path.
|
-- Need to add caps at both ends of the path.
|
||||||
SOpen
|
SOpen
|
||||||
| ( firstOutlineFwd, firstOutlineBwd ) :<| _ <- outlineFns
|
| firstCurve :<| _ <- openCurves $ splineCurves spline
|
||||||
, _ :|> ( lastOutlineFwd, lastOutlineBwd ) <- outlineFns
|
|
||||||
, firstCurve :<| _ <- openCurves $ splineCurves spline
|
|
||||||
, prevCurves :|> lastCurve <- openCurves $ splineCurves spline
|
, prevCurves :|> lastCurve <- openCurves $ splineCurves spline
|
||||||
|
, ( firstOutlineFwd, firstOutlineBwd ) :<| _ <- outlineFns
|
||||||
|
, _ :|> ( lastOutlineFwd, lastOutlineBwd ) <- outlineFns
|
||||||
, let
|
, let
|
||||||
endPt :: ptData
|
endPt :: ptData
|
||||||
endPt = openCurveEnd lastCurve
|
endPt = openCurveEnd lastCurve
|
||||||
|
@ -221,18 +221,18 @@ computeStrokeOutline fitParams ptParams brushFn spline@( Spline { splineStart =
|
||||||
Empty -> endTangent spt0 spt0 lastCurve
|
Empty -> endTangent spt0 spt0 lastCurve
|
||||||
_ :|> lastPrev -> endTangent spt0 ( openCurveEnd lastPrev ) lastCurve
|
_ :|> lastPrev -> endTangent spt0 ( openCurveEnd lastPrev ) lastCurve
|
||||||
startTestTgt, endTestTgt :: Vector2D Double
|
startTestTgt, endTestTgt :: Vector2D Double
|
||||||
( startTestTgt, endTestTgt ) =
|
startTestTgt = Vector2D sty (-stx)
|
||||||
case brushOrientation of
|
|
||||||
CCW -> ( Vector2D sty (-stx), Vector2D ety (-etx) )
|
|
||||||
CW -> ( Vector2D (-sty) stx , Vector2D (-ety) etx )
|
|
||||||
where
|
where
|
||||||
stx, sty, etx, ety :: Double
|
stx, sty :: Double
|
||||||
Vector2D stx sty = startTgt
|
Vector2D stx sty = startTgt
|
||||||
|
endTestTgt = Vector2D ety (-etx)
|
||||||
|
where
|
||||||
|
etx, ety :: Double
|
||||||
Vector2D etx ety = endTgt
|
Vector2D etx ety = endTgt
|
||||||
|
|
||||||
startCap, endCap :: SplinePts Open
|
startCap, endCap :: SplinePts Open
|
||||||
startCap
|
startCap
|
||||||
| isJust $ between brushOrientation startTgtBwd startTgtFwd startTestTgt
|
| isJust $ between CCW startTgtBwd startTgtFwd startTestTgt
|
||||||
= fmap ( MkVector2D ( coords spt0 ) • )
|
= fmap ( MkVector2D ( coords spt0 ) • )
|
||||||
$ joinWithBrush startBrush startTgtBwd startTgtFwd
|
$ joinWithBrush startBrush startTgtBwd startTgtFwd
|
||||||
| otherwise
|
| otherwise
|
||||||
|
@ -240,15 +240,16 @@ computeStrokeOutline fitParams ptParams brushFn spline@( Spline { splineStart =
|
||||||
. reverseSpline
|
. reverseSpline
|
||||||
$ joinWithBrush startBrush startTgtFwd startTgtBwd
|
$ joinWithBrush startBrush startTgtFwd startTgtBwd
|
||||||
endCap
|
endCap
|
||||||
| not . isJust $ between brushOrientation endTgtBwd endTgtFwd endTestTgt
|
| isJust $ between CCW endTgtBwd endTgtFwd endTestTgt
|
||||||
|
= fmap ( MkVector2D ( coords endPt ) • )
|
||||||
|
$ joinWithBrush endBrush endTgtFwd endTgtBwd
|
||||||
|
| otherwise
|
||||||
= fmap ( MkVector2D ( coords endPt ) • )
|
= fmap ( MkVector2D ( coords endPt ) • )
|
||||||
. reverseSpline
|
. reverseSpline
|
||||||
$ joinWithBrush endBrush endTgtBwd endTgtFwd
|
$ joinWithBrush endBrush endTgtBwd endTgtFwd
|
||||||
| otherwise
|
|
||||||
= fmap ( MkVector2D ( coords endPt ) • )
|
|
||||||
$ joinWithBrush endBrush endTgtFwd endTgtBwd
|
|
||||||
-> do
|
-> do
|
||||||
TwoSided ( fwdPts, fwdFits ) ( bwdPts, bwdFits ) <- updateSpline ( startTgtFwd, startTgtBwd )
|
TwoSided ( fwdPts, fwdFits ) ( bwdPts, bwdFits ) <- updateSpline ( startTgt, startTgtFwd, startTgtBwd )
|
||||||
pure
|
pure
|
||||||
( Left ( adjustSplineType @Closed $ startCap <> fwdPts <> endCap <> bwdPts )
|
( Left ( adjustSplineType @Closed $ startCap <> fwdPts <> endCap <> bwdPts )
|
||||||
, fwdFits <> bwdFits
|
, fwdFits <> bwdFits
|
||||||
|
@ -256,10 +257,17 @@ computeStrokeOutline fitParams ptParams brushFn spline@( Spline { splineStart =
|
||||||
-- Closed brush path with at least one segment.
|
-- Closed brush path with at least one segment.
|
||||||
-- Add forward and backward caps at the start.
|
-- Add forward and backward caps at the start.
|
||||||
SClosed
|
SClosed
|
||||||
| ( firstOutlineFwd, firstOutlineBwd ) :<| _ <- outlineFns
|
| ClosedCurves prevCurves lastCurve <- splineCurves spline
|
||||||
|
, ( firstOutlineFwd, firstOutlineBwd ) :<| _ <- outlineFns
|
||||||
, _ :|> ( lastOutlineFwd, lastOutlineBwd ) <- outlineFns
|
, _ :|> ( lastOutlineFwd, lastOutlineBwd ) <- outlineFns
|
||||||
, let
|
, let
|
||||||
startTgtFwd, startTgtBwd, endTgtFwd, endTgtBwd :: Vector2D Double
|
startTgt, endTgt, startTgtFwd, startTgtBwd, endTgtFwd, endTgtBwd :: Vector2D Double
|
||||||
|
startTgt = case prevCurves of
|
||||||
|
Empty -> startTangent spt0 spt0 lastCurve
|
||||||
|
firstCrv :<| _ -> startTangent spt0 spt0 firstCrv
|
||||||
|
endTgt = case prevCurves of
|
||||||
|
Empty -> endTangent spt0 spt0 lastCurve
|
||||||
|
_ :|> lastPrev -> endTangent spt0 ( openCurveEnd lastPrev ) lastCurve
|
||||||
startTgtFwd = snd ( firstOutlineFwd 0 )
|
startTgtFwd = snd ( firstOutlineFwd 0 )
|
||||||
startTgtBwd = (-1) *^ snd ( firstOutlineBwd 1 )
|
startTgtBwd = (-1) *^ snd ( firstOutlineBwd 1 )
|
||||||
endTgtFwd = snd ( lastOutlineFwd 1 )
|
endTgtFwd = snd ( lastOutlineFwd 1 )
|
||||||
|
@ -267,9 +275,9 @@ computeStrokeOutline fitParams ptParams brushFn spline@( Spline { splineStart =
|
||||||
fwdStartCap, bwdStartCap :: SplinePts Open
|
fwdStartCap, bwdStartCap :: SplinePts Open
|
||||||
TwoSided fwdStartCap bwdStartCap
|
TwoSided fwdStartCap bwdStartCap
|
||||||
= fmap fst . snd . runWriter
|
= fmap fst . snd . runWriter
|
||||||
$ tellBrushJoin ( endTgtFwd, endTgtBwd ) spt0 ( startTgtFwd, startTgtBwd )
|
$ tellBrushJoin ( endTgt, endTgtFwd, endTgtBwd ) spt0 ( startTgt, startTgtFwd, startTgtBwd )
|
||||||
-> do
|
-> do
|
||||||
TwoSided ( fwdPts, fwdFits ) ( bwdPts, bwdFits ) <- updateSpline ( endTgtFwd, endTgtBwd )
|
TwoSided ( fwdPts, fwdFits ) ( bwdPts, bwdFits ) <- updateSpline ( endTgt, endTgtFwd, endTgtBwd )
|
||||||
pure
|
pure
|
||||||
( Right ( adjustSplineType @Closed ( fwdStartCap <> fwdPts ), adjustSplineType @Closed ( bwdPts <> bwdStartCap ) )
|
( Right ( adjustSplineType @Closed ( fwdStartCap <> fwdPts ), adjustSplineType @Closed ( bwdPts <> bwdStartCap ) )
|
||||||
, fwdFits <> bwdFits
|
, fwdFits <> bwdFits
|
||||||
|
@ -282,9 +290,6 @@ computeStrokeOutline fitParams ptParams brushFn spline@( Spline { splineStart =
|
||||||
)
|
)
|
||||||
where
|
where
|
||||||
|
|
||||||
brushOrientation :: Orientation
|
|
||||||
brushOrientation = splineOrientation @Double ( brushShape spt0 )
|
|
||||||
|
|
||||||
outlineFns
|
outlineFns
|
||||||
:: Seq
|
:: Seq
|
||||||
( Double -> ( Point2D Double, Vector2D Double )
|
( Double -> ( Point2D Double, Vector2D Double )
|
||||||
|
@ -306,24 +311,26 @@ computeStrokeOutline fitParams ptParams brushFn spline@( Spline { splineStart =
|
||||||
brushShape :: ptData -> SplinePts Closed
|
brushShape :: ptData -> SplinePts Closed
|
||||||
brushShape pt = brushFn ( ptParams pt )
|
brushShape pt = brushFn ( ptParams pt )
|
||||||
|
|
||||||
updateSpline :: ( Vector2D Double, Vector2D Double ) -> ST s OutlineData
|
updateSpline :: ( Vector2D Double, Vector2D Double, Vector2D Double ) -> ST s OutlineData
|
||||||
updateSpline ( lastTgtFwd, lastTgtBwd )
|
updateSpline ( lastTgt, lastTgtFwd, lastTgtBwd )
|
||||||
= execWriterT
|
= execWriterT
|
||||||
. ( `evalStateT` ( lastTgtFwd, lastTgtBwd ) )
|
. ( `evalStateT` ( lastTgt, lastTgtFwd, lastTgtBwd ) )
|
||||||
$ bifoldSpline
|
$ bifoldSpline
|
||||||
( \ ptData curve -> do
|
( \ ptData curve -> do
|
||||||
( prev_tgtFwd, prev_tgtBwd ) <- get
|
( prevTgt, prev_tgtFwd, prev_tgtBwd ) <- get
|
||||||
let
|
let
|
||||||
fwd, bwd :: Double -> ( Point2D Double, Vector2D Double )
|
fwd, bwd :: Double -> ( Point2D Double, Vector2D Double )
|
||||||
( fwd, bwd ) = outlineFunctions @diffParams ptParams brushFn ptData curve
|
( fwd, bwd ) = outlineFunctions @diffParams ptParams brushFn ptData curve
|
||||||
tgtFwd, tgtBwd, next_tgtFwd, next_tgtBwd :: Vector2D Double
|
tgt, next_tgt, tgtFwd, next_tgtFwd, tgtBwd, next_tgtBwd :: Vector2D Double
|
||||||
|
tgt = startTangent spt0 ptData curve
|
||||||
|
next_tgt = endTangent spt0 ptData curve
|
||||||
tgtFwd = snd ( fwd 0 )
|
tgtFwd = snd ( fwd 0 )
|
||||||
tgtBwd = (-1) *^ snd ( bwd 1 )
|
|
||||||
next_tgtFwd = snd ( fwd 1 )
|
next_tgtFwd = snd ( fwd 1 )
|
||||||
|
tgtBwd = (-1) *^ snd ( bwd 1 )
|
||||||
next_tgtBwd = (-1) *^ snd ( bwd 0 )
|
next_tgtBwd = (-1) *^ snd ( bwd 0 )
|
||||||
lift $ tellBrushJoin ( prev_tgtFwd, prev_tgtBwd ) ptData ( tgtFwd, tgtBwd )
|
lift $ tellBrushJoin ( prevTgt, prev_tgtFwd, tgtBwd ) ptData ( tgt, tgtFwd, prev_tgtBwd )
|
||||||
lift $ updateCurveData ( curveData curve ) fwd bwd
|
lift $ updateCurveData ( curveData curve ) fwd bwd
|
||||||
put ( next_tgtFwd, next_tgtBwd )
|
put ( next_tgt, next_tgtFwd, next_tgtBwd )
|
||||||
)
|
)
|
||||||
( const ( pure () ) )
|
( const ( pure () ) )
|
||||||
( adjustSplineType @Open spline )
|
( adjustSplineType @Open spline )
|
||||||
|
@ -357,21 +364,46 @@ computeStrokeOutline fitParams ptParams brushFn spline@( Spline { splineStart =
|
||||||
-- This happens at corners of the brush path (including endpoints of an open brush path, where the tangent flips direction).
|
-- This happens at corners of the brush path (including endpoints of an open brush path, where the tangent flips direction).
|
||||||
tellBrushJoin
|
tellBrushJoin
|
||||||
:: Monad m
|
:: Monad m
|
||||||
=> ( Vector2D Double, Vector2D Double )
|
=> ( Vector2D Double, Vector2D Double, Vector2D Double )
|
||||||
-> ptData
|
-> ptData
|
||||||
-> ( Vector2D Double, Vector2D Double )
|
-> ( Vector2D Double, Vector2D Double, Vector2D Double )
|
||||||
-> WriterT OutlineData m ()
|
-> WriterT OutlineData m ()
|
||||||
tellBrushJoin ( prevTgtFwd, prevTgtBwd ) sp0 ( tgtFwd, tgtBwd ) = tell brushJoin
|
tellBrushJoin ( prevTgt, prevTgtFwd, prevTgtBwd ) sp0 ( tgt, tgtFwd, tgtBwd ) =
|
||||||
|
tell $ TwoSided ( fwdJoin, Empty ) ( bwdJoin, Empty )
|
||||||
where
|
where
|
||||||
ptOffset :: Vector2D Double
|
ptOffset :: Vector2D Double
|
||||||
ptOffset = Point2D 0 0 --> coords sp0
|
ptOffset = Point2D 0 0 --> coords sp0
|
||||||
brush0 :: SplinePts Closed
|
brush0 :: SplinePts Closed
|
||||||
brush0 = brushShape sp0
|
brush0 = brushShape sp0
|
||||||
|
|
||||||
|
-- Figure out which part of the brush to use for the join.
|
||||||
|
ori :: Orientation
|
||||||
|
ori = splineOrientation @Double brush0
|
||||||
|
fwdCond, bwdCond :: Bool
|
||||||
|
( fwdCond, bwdCond )
|
||||||
|
| prevTgt `cross` tgt < 0 && prevTgt ^.^ tgt < 0
|
||||||
|
= ( isJust $ between ori prevTgtFwd tgtFwd testTgt1
|
||||||
|
, isJust $ between ori prevTgtBwd tgtBwd ( (-1) *^ testTgt1 )
|
||||||
|
)
|
||||||
|
| otherwise
|
||||||
|
= ( not . isJust $ between ori prevTgtFwd tgtFwd testTgt2
|
||||||
|
, not . isJust $ between ori prevTgtBwd tgtBwd ( (-1) *^ testTgt2 )
|
||||||
|
)
|
||||||
|
testTgt1, testTgt2 :: Vector2D Double
|
||||||
|
testTgt1 = Vector2D (-ty) tx
|
||||||
|
where
|
||||||
|
tx, ty :: Double
|
||||||
|
Vector2D tx ty = tgt ^-^ prevTgt
|
||||||
|
testTgt2
|
||||||
|
| prevTgt ^.^ tgt < 0
|
||||||
|
= testTgt1
|
||||||
|
| otherwise
|
||||||
|
= (-1) *^ ( tgt ^+^ prevTgt )
|
||||||
fwdJoin, bwdJoin :: SplinePts Open
|
fwdJoin, bwdJoin :: SplinePts Open
|
||||||
fwdJoin
|
fwdJoin
|
||||||
| tgtFwd `strictlyParallel` prevTgtFwd
|
| tgtFwd `strictlyParallel` prevTgtFwd
|
||||||
= Spline { splineStart = coords sp0, splineCurves = OpenCurves Empty }
|
= Spline { splineStart = coords sp0, splineCurves = OpenCurves Empty }
|
||||||
| brushOrientation == convexOrientation [ prevTgtFwd, tgtFwd ]
|
| fwdCond
|
||||||
= fmap ( ptOffset • )
|
= fmap ( ptOffset • )
|
||||||
$ joinWithBrush brush0 prevTgtFwd tgtFwd
|
$ joinWithBrush brush0 prevTgtFwd tgtFwd
|
||||||
| otherwise
|
| otherwise
|
||||||
|
@ -381,15 +413,13 @@ computeStrokeOutline fitParams ptParams brushFn spline@( Spline { splineStart =
|
||||||
bwdJoin
|
bwdJoin
|
||||||
| tgtBwd `strictlyParallel` prevTgtBwd
|
| tgtBwd `strictlyParallel` prevTgtBwd
|
||||||
= Spline { splineStart = coords sp0, splineCurves = OpenCurves Empty }
|
= Spline { splineStart = coords sp0, splineCurves = OpenCurves Empty }
|
||||||
| brushOrientation == convexOrientation [ tgtBwd, prevTgtBwd ]
|
| bwdCond
|
||||||
= fmap ( ptOffset • )
|
= fmap ( ptOffset • )
|
||||||
$ joinWithBrush brush0 tgtBwd prevTgtBwd
|
$ joinWithBrush brush0 prevTgtBwd tgtBwd
|
||||||
| otherwise
|
| otherwise
|
||||||
= fmap ( ptOffset • )
|
= fmap ( ptOffset • )
|
||||||
. reverseSpline
|
. reverseSpline
|
||||||
$ joinWithBrush brush0 prevTgtBwd tgtBwd
|
$ joinWithBrush brush0 tgtBwd prevTgtBwd
|
||||||
brushJoin :: OutlineData
|
|
||||||
brushJoin = TwoSided ( fwdJoin, Empty ) ( bwdJoin, Empty )
|
|
||||||
|
|
||||||
-- | Computes the forward and backward stroke outline functions for a single curve.
|
-- | Computes the forward and backward stroke outline functions for a single curve.
|
||||||
outlineFunctions
|
outlineFunctions
|
||||||
|
|
Loading…
Reference in a new issue