hashirama/metabrush
1
0
Fork 0
mirror of https://gitlab.com/sheaf/metabrush.git synced 2024-11-05 14:53:37 +00:00
Code Issues Actions Projects Releases Wiki Activity

fix brush join orientations

Browse source
This commit is contained in:
sheaf 2021-05-13 22:07:49 +02:00
parent 570a593f4f
commit 9f16cff978
2 changed files with 90 additions and 40 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

20
src/app/MetaBrush/Asset/Brushes.hs
View file

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

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

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