rejigging

This commit is contained in:
sheaf 2023-01-28 01:26:47 +01:00
parent 1ae84fec97
commit 4174d9b5b6
2 changed files with 13 additions and 6 deletions

View file

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

View file

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