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