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

rejigging

Browse source
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
Show stats Download patch file Download diff file Expand all files Collapse all files

1
MetaBrush.cabal
View file

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

18
src/splines/Math/Bezier/Stroke.hs
View file

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