mirror of
https://gitlab.com/sheaf/metabrush.git
synced 2024-11-05 14:53:37 +00:00
rejigging
This commit is contained in:
parent
1ae84fec97
commit
4174d9b5b6
|
@ -102,6 +102,7 @@ common common
|
|||
-fwarn-incomplete-uni-patterns
|
||||
-fwarn-missing-deriving-strategies
|
||||
-fno-warn-unticked-promoted-constructors
|
||||
-rtsopts
|
||||
|
||||
if flag(asserts)
|
||||
cpp-options:
|
||||
|
|
|
@ -45,6 +45,7 @@ import Data.Maybe
|
|||
import GHC.Exts
|
||||
( newMutVar#, runRW#
|
||||
, Proxy#, proxy#
|
||||
, inline
|
||||
)
|
||||
import GHC.STRef
|
||||
( STRef(..), readSTRef, writeSTRef )
|
||||
|
@ -363,6 +364,9 @@ computeStrokeOutline fitParams ptParams toBrushParams brushFn spline@( Spline {
|
|||
)
|
||||
where
|
||||
|
||||
outlineInfo :: ptData -> Curve Open crvData ptData -> OutlineInfo
|
||||
outlineInfo = inline ( outlineFunction ptParams toBrushParams brushFn )
|
||||
|
||||
outlineFns :: Seq OutlineInfo
|
||||
outlineFns = go spt0 ( openCurves $ splineCurves ( adjustSplineType @Open spline ) )
|
||||
where
|
||||
|
@ -372,7 +376,7 @@ computeStrokeOutline fitParams ptParams toBrushParams brushFn spline@( Spline {
|
|||
-> Seq OutlineInfo
|
||||
go _ Empty = Empty
|
||||
go p0 ( crv :<| crvs ) =
|
||||
outlineFunction ptParams toBrushParams brushFn p0 crv :<| go ( openCurveEnd crv ) crvs
|
||||
outlineInfo p0 crv :<| go ( openCurveEnd crv ) crvs
|
||||
|
||||
brushShape :: ptData -> SplinePts Closed
|
||||
brushShape pt = fun @Double ( brushFn @Point proxy# id ) $ toBrushParams $ ptParams pt
|
||||
|
@ -386,7 +390,7 @@ computeStrokeOutline fitParams ptParams toBrushParams brushFn spline@( Spline {
|
|||
( prevTgt, prev_tgtFwd, prev_tgtBwd ) <- get
|
||||
let
|
||||
fwdBwd :: OutlineInfo
|
||||
fwdBwd = outlineFunction ptParams toBrushParams brushFn ptData curve
|
||||
fwdBwd = outlineInfo ptData curve
|
||||
tgt, next_tgt, tgtFwd, next_tgtFwd, tgtBwd, next_tgtBwd :: T ( ℝ 2 )
|
||||
tgt = startTangent spt0 ptData curve
|
||||
next_tgt = endTangent spt0 ptData curve
|
||||
|
@ -493,6 +497,7 @@ computeStrokeOutline fitParams ptParams toBrushParams brushFn spline@( Spline {
|
|||
= fmap ( ptOffset • )
|
||||
. reverseSpline
|
||||
$ joinWithBrush brush0 tgtBwd prevTgtBwd
|
||||
{-# INLINEABLE computeStrokeOutline #-}
|
||||
|
||||
-- | Computes the forward and backward stroke outline functions for a single curve.
|
||||
outlineFunction
|
||||
|
@ -526,7 +531,7 @@ outlineFunction
|
|||
-> ptData
|
||||
-> Curve Open crvData ptData
|
||||
-> OutlineInfo
|
||||
outlineFunction ptParams toBrushParams brushFromParams sp0 crv =
|
||||
outlineFunction ptParams toBrushParams brushFromParams = \ sp0 crv ->
|
||||
let
|
||||
pathAndUsedParams :: forall i k arr
|
||||
. ( k ~ ExtentOrder i, CurveOrder k
|
||||
|
@ -597,7 +602,7 @@ outlineFunction ptParams toBrushParams brushFromParams sp0 crv =
|
|||
$ runD ( brushFromParams @Point proxy# id )
|
||||
$ toBrushParams params_t
|
||||
|
||||
( newtDunno, newtSols ) = intervalNewtonGS InverseMidJacobian 0.0001 curvesI
|
||||
--( newtDunno, newtSols ) = intervalNewtonGS InverseMidJacobian 0.0001 curvesI
|
||||
|
||||
in --trace
|
||||
-- ( unlines $
|
||||
|
@ -612,9 +617,10 @@ outlineFunction ptParams toBrushParams brushFromParams sp0 crv =
|
|||
-- ) $
|
||||
OutlineInfo
|
||||
{ outlineFn = fwdBwd
|
||||
, outlineDefiniteCusps = map ( cuspCoords curves ) newtSols
|
||||
, outlinePotentialCusps = map ( cuspCoords curves ) newtDunno
|
||||
, outlineDefiniteCusps = [] -- map ( cuspCoords curves ) newtSols
|
||||
, outlinePotentialCusps = [] -- map ( cuspCoords curves ) newtDunno
|
||||
}
|
||||
{-# INLINEABLE outlineFunction #-}
|
||||
|
||||
-----------------------------------
|
||||
-- Various utility functions
|
||||
|
|
Loading…
Reference in a new issue