mirror of
https://gitlab.com/sheaf/metabrush.git
synced 2024-11-05 14:53:37 +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*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
|
||||
:: forall roundedBrushFields
|
||||
|
|
|
@ -108,12 +108,12 @@ import qualified Math.Bezier.Quadratic as Quadratic
|
|||
import Math.Epsilon
|
||||
( epsilon )
|
||||
import Math.Module
|
||||
( Module((*^)), Inner((^.^))
|
||||
( Module(..), Inner((^.^))
|
||||
, lerp, squaredNorm, cross
|
||||
, convexCombination, strictlyParallel
|
||||
)
|
||||
import Math.Orientation
|
||||
( Orientation(..), convexOrientation, splineOrientation
|
||||
( Orientation(..), splineOrientation
|
||||
, between
|
||||
)
|
||||
import Math.Roots
|
||||
|
@ -198,10 +198,10 @@ computeStrokeOutline fitParams ptParams brushFn spline@( Spline { splineStart =
|
|||
-- Open brush path with at least one segment.
|
||||
-- Need to add caps at both ends of the path.
|
||||
SOpen
|
||||
| ( firstOutlineFwd, firstOutlineBwd ) :<| _ <- outlineFns
|
||||
, _ :|> ( lastOutlineFwd, lastOutlineBwd ) <- outlineFns
|
||||
, firstCurve :<| _ <- openCurves $ splineCurves spline
|
||||
| firstCurve :<| _ <- openCurves $ splineCurves spline
|
||||
, prevCurves :|> lastCurve <- openCurves $ splineCurves spline
|
||||
, ( firstOutlineFwd, firstOutlineBwd ) :<| _ <- outlineFns
|
||||
, _ :|> ( lastOutlineFwd, lastOutlineBwd ) <- outlineFns
|
||||
, let
|
||||
endPt :: ptData
|
||||
endPt = openCurveEnd lastCurve
|
||||
|
@ -221,18 +221,18 @@ computeStrokeOutline fitParams ptParams brushFn spline@( Spline { splineStart =
|
|||
Empty -> endTangent spt0 spt0 lastCurve
|
||||
_ :|> lastPrev -> endTangent spt0 ( openCurveEnd lastPrev ) lastCurve
|
||||
startTestTgt, endTestTgt :: Vector2D Double
|
||||
( startTestTgt, endTestTgt ) =
|
||||
case brushOrientation of
|
||||
CCW -> ( Vector2D sty (-stx), Vector2D ety (-etx) )
|
||||
CW -> ( Vector2D (-sty) stx , Vector2D (-ety) etx )
|
||||
startTestTgt = Vector2D sty (-stx)
|
||||
where
|
||||
stx, sty, etx, ety :: Double
|
||||
stx, sty :: Double
|
||||
Vector2D stx sty = startTgt
|
||||
endTestTgt = Vector2D ety (-etx)
|
||||
where
|
||||
etx, ety :: Double
|
||||
Vector2D etx ety = endTgt
|
||||
|
||||
startCap, endCap :: SplinePts Open
|
||||
startCap
|
||||
| isJust $ between brushOrientation startTgtBwd startTgtFwd startTestTgt
|
||||
| isJust $ between CCW startTgtBwd startTgtFwd startTestTgt
|
||||
= fmap ( MkVector2D ( coords spt0 ) • )
|
||||
$ joinWithBrush startBrush startTgtBwd startTgtFwd
|
||||
| otherwise
|
||||
|
@ -240,15 +240,16 @@ computeStrokeOutline fitParams ptParams brushFn spline@( Spline { splineStart =
|
|||
. reverseSpline
|
||||
$ joinWithBrush startBrush startTgtFwd startTgtBwd
|
||||
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 ) • )
|
||||
. reverseSpline
|
||||
$ joinWithBrush endBrush endTgtBwd endTgtFwd
|
||||
| otherwise
|
||||
= fmap ( MkVector2D ( coords endPt ) • )
|
||||
$ joinWithBrush endBrush endTgtFwd endTgtBwd
|
||||
|
||||
-> do
|
||||
TwoSided ( fwdPts, fwdFits ) ( bwdPts, bwdFits ) <- updateSpline ( startTgtFwd, startTgtBwd )
|
||||
TwoSided ( fwdPts, fwdFits ) ( bwdPts, bwdFits ) <- updateSpline ( startTgt, startTgtFwd, startTgtBwd )
|
||||
pure
|
||||
( Left ( adjustSplineType @Closed $ startCap <> fwdPts <> endCap <> bwdPts )
|
||||
, fwdFits <> bwdFits
|
||||
|
@ -256,10 +257,17 @@ computeStrokeOutline fitParams ptParams brushFn spline@( Spline { splineStart =
|
|||
-- Closed brush path with at least one segment.
|
||||
-- Add forward and backward caps at the start.
|
||||
SClosed
|
||||
| ( firstOutlineFwd, firstOutlineBwd ) :<| _ <- outlineFns
|
||||
| ClosedCurves prevCurves lastCurve <- splineCurves spline
|
||||
, ( firstOutlineFwd, firstOutlineBwd ) :<| _ <- outlineFns
|
||||
, _ :|> ( lastOutlineFwd, lastOutlineBwd ) <- outlineFns
|
||||
, 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 )
|
||||
startTgtBwd = (-1) *^ snd ( firstOutlineBwd 1 )
|
||||
endTgtFwd = snd ( lastOutlineFwd 1 )
|
||||
|
@ -267,9 +275,9 @@ computeStrokeOutline fitParams ptParams brushFn spline@( Spline { splineStart =
|
|||
fwdStartCap, bwdStartCap :: SplinePts Open
|
||||
TwoSided fwdStartCap bwdStartCap
|
||||
= fmap fst . snd . runWriter
|
||||
$ tellBrushJoin ( endTgtFwd, endTgtBwd ) spt0 ( startTgtFwd, startTgtBwd )
|
||||
$ tellBrushJoin ( endTgt, endTgtFwd, endTgtBwd ) spt0 ( startTgt, startTgtFwd, startTgtBwd )
|
||||
-> do
|
||||
TwoSided ( fwdPts, fwdFits ) ( bwdPts, bwdFits ) <- updateSpline ( endTgtFwd, endTgtBwd )
|
||||
TwoSided ( fwdPts, fwdFits ) ( bwdPts, bwdFits ) <- updateSpline ( endTgt, endTgtFwd, endTgtBwd )
|
||||
pure
|
||||
( Right ( adjustSplineType @Closed ( fwdStartCap <> fwdPts ), adjustSplineType @Closed ( bwdPts <> bwdStartCap ) )
|
||||
, fwdFits <> bwdFits
|
||||
|
@ -282,9 +290,6 @@ computeStrokeOutline fitParams ptParams brushFn spline@( Spline { splineStart =
|
|||
)
|
||||
where
|
||||
|
||||
brushOrientation :: Orientation
|
||||
brushOrientation = splineOrientation @Double ( brushShape spt0 )
|
||||
|
||||
outlineFns
|
||||
:: Seq
|
||||
( Double -> ( Point2D Double, Vector2D Double )
|
||||
|
@ -306,24 +311,26 @@ computeStrokeOutline fitParams ptParams brushFn spline@( Spline { splineStart =
|
|||
brushShape :: ptData -> SplinePts Closed
|
||||
brushShape pt = brushFn ( ptParams pt )
|
||||
|
||||
updateSpline :: ( Vector2D Double, Vector2D Double ) -> ST s OutlineData
|
||||
updateSpline ( lastTgtFwd, lastTgtBwd )
|
||||
updateSpline :: ( Vector2D Double, Vector2D Double, Vector2D Double ) -> ST s OutlineData
|
||||
updateSpline ( lastTgt, lastTgtFwd, lastTgtBwd )
|
||||
= execWriterT
|
||||
. ( `evalStateT` ( lastTgtFwd, lastTgtBwd ) )
|
||||
. ( `evalStateT` ( lastTgt, lastTgtFwd, lastTgtBwd ) )
|
||||
$ bifoldSpline
|
||||
( \ ptData curve -> do
|
||||
( prev_tgtFwd, prev_tgtBwd ) <- get
|
||||
( prevTgt, prev_tgtFwd, prev_tgtBwd ) <- get
|
||||
let
|
||||
fwd, bwd :: Double -> ( Point2D Double, Vector2D Double )
|
||||
( 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 )
|
||||
tgtBwd = (-1) *^ snd ( bwd 1 )
|
||||
next_tgtFwd = snd ( fwd 1 )
|
||||
tgtBwd = (-1) *^ snd ( bwd 1 )
|
||||
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
|
||||
put ( next_tgtFwd, next_tgtBwd )
|
||||
put ( next_tgt, next_tgtFwd, next_tgtBwd )
|
||||
)
|
||||
( const ( pure () ) )
|
||||
( 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).
|
||||
tellBrushJoin
|
||||
:: Monad m
|
||||
=> ( Vector2D Double, Vector2D Double )
|
||||
=> ( Vector2D Double, Vector2D Double, Vector2D Double )
|
||||
-> ptData
|
||||
-> ( Vector2D Double, Vector2D Double )
|
||||
-> ( Vector2D Double, Vector2D Double, Vector2D Double )
|
||||
-> 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
|
||||
ptOffset :: Vector2D Double
|
||||
ptOffset = Point2D 0 0 --> coords sp0
|
||||
brush0 :: SplinePts Closed
|
||||
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
|
||||
| tgtFwd `strictlyParallel` prevTgtFwd
|
||||
= Spline { splineStart = coords sp0, splineCurves = OpenCurves Empty }
|
||||
| brushOrientation == convexOrientation [ prevTgtFwd, tgtFwd ]
|
||||
| fwdCond
|
||||
= fmap ( ptOffset • )
|
||||
$ joinWithBrush brush0 prevTgtFwd tgtFwd
|
||||
| otherwise
|
||||
|
@ -381,15 +413,13 @@ computeStrokeOutline fitParams ptParams brushFn spline@( Spline { splineStart =
|
|||
bwdJoin
|
||||
| tgtBwd `strictlyParallel` prevTgtBwd
|
||||
= Spline { splineStart = coords sp0, splineCurves = OpenCurves Empty }
|
||||
| brushOrientation == convexOrientation [ tgtBwd, prevTgtBwd ]
|
||||
| bwdCond
|
||||
= fmap ( ptOffset • )
|
||||
$ joinWithBrush brush0 tgtBwd prevTgtBwd
|
||||
$ joinWithBrush brush0 prevTgtBwd tgtBwd
|
||||
| otherwise
|
||||
= fmap ( ptOffset • )
|
||||
. reverseSpline
|
||||
$ joinWithBrush brush0 prevTgtBwd tgtBwd
|
||||
brushJoin :: OutlineData
|
||||
brushJoin = TwoSided ( fwdJoin, Empty ) ( bwdJoin, Empty )
|
||||
$ joinWithBrush brush0 tgtBwd prevTgtBwd
|
||||
|
||||
-- | Computes the forward and backward stroke outline functions for a single curve.
|
||||
outlineFunctions
|
||||
|
|
Loading…
Reference in a new issue