mirror of
https://gitlab.com/sheaf/metabrush.git
synced 2024-11-05 14:53:37 +00:00
improve offset tangent calculation
This commit is contained in:
sheaf
parent
808e37b1b3
commit
1c6f751a2b
|
|
@ -200,7 +200,7 @@ main = do
|
|||
-- Initialise state
|
||||
|
||||
uniqueSupply <- newUniqueSupply
|
||||
activeDocumentTVar <- STM.newTVarIO @( Maybe Unique ) Nothing
|
||||
activeDocumentTVar <- STM.newTVarIO @( Maybe Unique ) Nothing
|
||||
openDocumentsTVar <- STM.newTVarIO @( Map Unique DocumentHistory ) testDocuments
|
||||
mousePosTVar <- STM.newTVarIO @( Maybe ( Point2D Double ) ) Nothing
|
||||
mouseHoldTVar <- STM.newTVarIO @( Maybe HoldAction ) Nothing
|
||||
|
|
@ -214,8 +214,8 @@ main = do
|
|||
maxHistorySizeTVar <- STM.newTVarIO @Int 1000
|
||||
fitParametersTVar <- STM.newTVarIO @FitParameters
|
||||
( FitParameters
|
||||
{ maxSubdiv = 3
|
||||
, nbSegments = 13
|
||||
{ maxSubdiv = 5
|
||||
, nbSegments = 12
|
||||
, dist_tol = 5e-3
|
||||
, t_tol = 1e-4
|
||||
, maxIters = 100
|
||||
|
|
|
|||
|
|
@ -157,7 +157,7 @@ modifyingCurrentDocument uiElts@( UIElements { viewport = Viewport {..}, .. } )
|
|||
coerce ( updateUIAction uiElts vars )
|
||||
SaveDocument Nothing -> do
|
||||
STM.modifyTVar' openDocumentsTVar ( Map.adjust affirmPresent unique )
|
||||
pure ( pure () )
|
||||
coerce ( updateUIAction uiElts vars )
|
||||
SaveDocument ( Just newFilePath ) -> do
|
||||
STM.modifyTVar' openDocumentsTVar
|
||||
( Map.adjust
|
||||
|
|
@ -167,7 +167,7 @@ modifyingCurrentDocument uiElts@( UIElements { viewport = Viewport {..}, .. } )
|
|||
)
|
||||
unique
|
||||
)
|
||||
pure ( pure () )
|
||||
coerce ( updateUIAction uiElts vars )
|
||||
UpdateDocumentTo ( TrivialChange { newDocument } ) -> do
|
||||
STM.modifyTVar' openDocumentsTVar
|
||||
( Map.adjust ( set ( field' @"present" ) newDocument ) unique )
|
||||
|
|
|
|||
|
|
@ -430,21 +430,31 @@ drawStroke
|
|||
:: Colours -> Bool -> Double
|
||||
-> ( Either ( Seq ( StrokePoint () ) ) ( Seq ( StrokePoint () ), Seq ( StrokePoint () ) ), Seq FitPoint )
|
||||
-> Cairo.Render ()
|
||||
drawStroke cols@( Colours { brushStroke } ) debug zoom strokeData = do
|
||||
drawStroke cols@( Colours {..} ) debug zoom strokeData = do
|
||||
Cairo.save
|
||||
withRGBA brushStroke Cairo.setSourceRGBA
|
||||
case strokeData of
|
||||
( Left outline, fitPts ) -> do
|
||||
go outline
|
||||
Cairo.fill
|
||||
when debug do
|
||||
( `evalStateT` 0 ) $ traverse_ ( drawFitPoint cols zoom ) fitPts
|
||||
case debug of
|
||||
False -> Cairo.fill
|
||||
True -> do
|
||||
Cairo.fillPreserve
|
||||
withRGBA brushCenter Cairo.setSourceRGBA
|
||||
Cairo.setLineWidth ( 2 / zoom )
|
||||
Cairo.stroke
|
||||
( `evalStateT` 0 ) $ traverse_ ( drawFitPoint cols zoom ) fitPts
|
||||
( Right ( fwd, bwd ), fitPts ) -> do
|
||||
go fwd
|
||||
go bwd
|
||||
Cairo.fill
|
||||
when debug do
|
||||
( `evalStateT` 0 ) $ traverse_ ( drawFitPoint cols zoom ) fitPts
|
||||
case debug of
|
||||
False -> Cairo.fill
|
||||
True -> do
|
||||
Cairo.fillPreserve
|
||||
withRGBA brushCenter Cairo.setSourceRGBA
|
||||
Cairo.setLineWidth ( 2 / zoom )
|
||||
Cairo.stroke
|
||||
( `evalStateT` 0 ) $ traverse_ ( drawFitPoint cols zoom ) fitPts
|
||||
Cairo.restore
|
||||
|
||||
where
|
||||
|
|
@ -478,7 +488,7 @@ drawFitPoint :: Colours -> Double -> FitPoint -> StateT Double Cairo.Render ()
|
|||
drawFitPoint ( Colours {..} ) zoom ( FitPoint { fitPoint = Point2D x y } ) = do
|
||||
|
||||
hue <- get
|
||||
put ( hue + 0.01 )
|
||||
put ( hue + 0.002 )
|
||||
let
|
||||
r, g, b :: Double
|
||||
( r, g, b ) = hsl2rgb hue 0.9 0.4
|
||||
|
|
@ -493,7 +503,7 @@ drawFitPoint ( Colours {..} ) zoom ( FitPoint { fitPoint = Point2D x y } ) = do
|
|||
drawFitPoint ( Colours {..} ) zoom ( FitTangent { fitPoint = Point2D x y, fitTangent = Vector2D tx ty } ) = do
|
||||
|
||||
hue <- get
|
||||
put ( hue + 0.01 )
|
||||
put ( hue + 0.002 )
|
||||
let
|
||||
r, g, b :: Double
|
||||
( r, g, b ) = hsl2rgb hue 0.9 0.4
|
||||
|
|
|
|||
|
|
@ -91,10 +91,10 @@ data FitParameters
|
|||
|
||||
data FitPoint
|
||||
= FitPoint
|
||||
{ fitPoint :: Point2D Double }
|
||||
{ fitPoint :: !( Point2D Double ) }
|
||||
| FitTangent
|
||||
{ fitPoint :: Point2D Double
|
||||
, fitTangent :: Vector2D Double
|
||||
{ fitPoint :: !( Point2D Double )
|
||||
, fitTangent :: !( Vector2D Double )
|
||||
}
|
||||
deriving stock ( Show, Generic )
|
||||
deriving anyclass NFData
|
||||
|
|
@ -138,9 +138,14 @@ fitSpline ( FitParameters {..} ) = go 0
|
|||
| subdiv >= maxSubdiv
|
||||
|| sq_d <= dist_tol ^ ( 2 :: Int )
|
||||
-> ( Seq.singleton bez, ( FitTangent p tp :<| Seq.fromList ( map FitPoint qs ) ) :|> FitTangent r tr )
|
||||
| otherwise
|
||||
-> go ( subdiv + 1 ) ( \ t -> curve $ t * t_split )
|
||||
<> go ( subdiv + 1 ) ( \ t -> curve $ t_split + t * ( 1 - t_split ) )
|
||||
| let
|
||||
t_split_eff :: Double
|
||||
t_split_eff
|
||||
| t_split < 0.2 = 0.2
|
||||
| t_split > 0.8 = 0.8
|
||||
| otherwise = t_split
|
||||
-> go ( subdiv + 1 ) ( \ t -> curve $ t * t_split_eff )
|
||||
<> go ( subdiv + 1 ) ( \ t -> curve $ t_split_eff + t * ( 1 - t_split_eff ) )
|
||||
|
||||
-- | Fits a single cubic Bézier curve to the given data.
|
||||
--
|
||||
|
|
@ -246,11 +251,13 @@ fitPiece dist_tol t_tol maxIters p tp qs r tr =
|
|||
| isNaN x
|
||||
|| isNaN y
|
||||
|| abs y > epsilon
|
||||
|| x < -epsilon
|
||||
|| x > 1 + epsilon
|
||||
-> modify' ( first ( const True ) ) $> ti
|
||||
| otherwise
|
||||
-> when ( abs ( x - ti ) > t_tol )
|
||||
( modify' ( first ( const True ) ) )
|
||||
$> x
|
||||
$> ( min 1 $ max 0 x )
|
||||
let
|
||||
sq_dist :: Double
|
||||
sq_dist = quadrance @( Vector2D Double ) q ( Cubic.bezier @( Vector2D Double ) bez ti' )
|
||||
|
|
|
|||
|
|
@ -74,7 +74,9 @@ import qualified Math.Bezier.Quadratic as Quadratic
|
|||
import Math.Epsilon
|
||||
( epsilon )
|
||||
import Math.Module
|
||||
( Module((^-^), (*^)), Inner((^.^)), lerp )
|
||||
( Module((^-^), (*^)), Inner((^.^))
|
||||
, lerp, squaredNorm
|
||||
)
|
||||
import Math.Roots
|
||||
( realRoots )
|
||||
import Math.Vector2D
|
||||
|
|
@ -227,18 +229,33 @@ stroke params allPts@( spt0 :<| spt1 :<| spts )
|
|||
brush t = lerpBrush t ( brushShape @x sp0 ) ( brushShape @x sp1 )
|
||||
fwd, bwd :: Double -> ( Point2D Double, Vector2D Double )
|
||||
fwd t
|
||||
= ( offset ( withTangent tgt ( brush t ) )
|
||||
• lerp @( Vector2D Double ) t p0 p1
|
||||
, tgt -- wrong
|
||||
= ( off t
|
||||
, if squaredNorm offTgt < epsilon then tgt else offTgt
|
||||
)
|
||||
where
|
||||
off :: Double -> Point2D Double
|
||||
off x = offset ( withTangent tgt ( brush x ) ) • lerp @( Vector2D Double ) x p0 p1
|
||||
offTgt :: Vector2D Double
|
||||
offTgt
|
||||
| t < 0.5
|
||||
= 1e9 *^ ( off t --> off (t + 1e-9) )
|
||||
| otherwise
|
||||
= 1e9 *^ ( off (t - 1e-9) --> off t )
|
||||
bwd t
|
||||
= ( offset ( withTangent ( (-1) *^ tgt ) ( brush s ) )
|
||||
• lerp @( Vector2D Double ) s p0 p1
|
||||
, (-1) *^ tgt -- wrong
|
||||
= ( off s
|
||||
, if squaredNorm offTgt < epsilon then (-1) *^ tgt else offTgt
|
||||
)
|
||||
where
|
||||
s :: Double
|
||||
s = 1 - t
|
||||
off :: Double -> Point2D Double
|
||||
off x = offset ( withTangent ( (-1) *^ tgt ) ( brush x ) ) • lerp @( Vector2D Double ) x p0 p1
|
||||
offTgt :: Vector2D Double
|
||||
offTgt
|
||||
| s < 0.5
|
||||
= 1e9 *^ ( off s --> off (s + 1e-9) )
|
||||
| otherwise
|
||||
= 1e9 *^ ( off (s - 1e-9) --> off s )
|
||||
= do
|
||||
fwdIVar <- Par.spawnP ( fitCurve fwd )
|
||||
bwdIVar <- Par.spawnP ( fitCurve bwd )
|
||||
|
|
@ -265,18 +282,33 @@ stroke params allPts@( spt0 :<| spt1 :<| spts )
|
|||
( Quadratic.Bezier ( brushShape @x sp0 ) ( brushShape @x sp1 ) ( brushShape @x sp2 ) )
|
||||
fwd, bwd :: Double -> ( Point2D Double, Vector2D Double )
|
||||
fwd t
|
||||
= ( offset ( withTangent ( Quadratic.bezier' bez t ) ( brush t ) )
|
||||
• Quadratic.bezier @( Vector2D Double ) bez t
|
||||
, Quadratic.bezier' bez t -- wrong
|
||||
= ( off t
|
||||
, if squaredNorm offTgt < epsilon then Quadratic.bezier' bez t else offTgt
|
||||
)
|
||||
where
|
||||
off :: Double -> Point2D Double
|
||||
off x = offset ( withTangent ( Quadratic.bezier' bez x ) ( brush x ) ) • Quadratic.bezier @( Vector2D Double ) bez x
|
||||
offTgt :: Vector2D Double
|
||||
offTgt
|
||||
| t < 0.5
|
||||
= 1e9 *^ ( off t --> off (t + 1e-9) )
|
||||
| otherwise
|
||||
= 1e9 *^ ( off (t - 1e-9) --> off t )
|
||||
bwd t
|
||||
= ( offset ( withTangent ( (-1) *^ Quadratic.bezier' bez s ) ( brush s ) )
|
||||
• Quadratic.bezier @( Vector2D Double ) bez s
|
||||
, (-1) *^ Quadratic.bezier' bez s -- wrong
|
||||
= ( off s
|
||||
, if squaredNorm offTgt < epsilon then (-1) *^ Quadratic.bezier' bez s else offTgt
|
||||
)
|
||||
where
|
||||
s :: Double
|
||||
s = 1 - t
|
||||
off :: Double -> Point2D Double
|
||||
off x = offset ( withTangent ( (-1) *^ Quadratic.bezier' bez x ) ( brush x ) ) • Quadratic.bezier @( Vector2D Double ) bez x
|
||||
offTgt :: Vector2D Double
|
||||
offTgt
|
||||
| s < 0.5
|
||||
= 1e9 *^ ( off s --> off (s + 1e-9) )
|
||||
| otherwise
|
||||
= 1e9 *^ ( off (s - 1e-9) --> off s )
|
||||
= do
|
||||
fwdIVar <- Par.spawnP ( fitCurve fwd )
|
||||
bwdIVar <- Par.spawnP ( fitCurve bwd )
|
||||
|
|
@ -305,18 +337,33 @@ stroke params allPts@( spt0 :<| spt1 :<| spts )
|
|||
( Cubic.Bezier ( brushShape @x sp0 ) ( brushShape @x sp1 ) ( brushShape @x sp2 ) ( brushShape @x sp3 ) )
|
||||
fwd, bwd :: Double -> ( Point2D Double, Vector2D Double )
|
||||
fwd t
|
||||
= ( offset ( withTangent ( Cubic.bezier' bez t ) ( brush t ) )
|
||||
• Cubic.bezier @( Vector2D Double ) bez t
|
||||
, Cubic.bezier' bez t -- wrong
|
||||
= ( off t
|
||||
, if squaredNorm offTgt < epsilon then Cubic.bezier' bez t else offTgt
|
||||
)
|
||||
where
|
||||
off :: Double -> Point2D Double
|
||||
off x = offset ( withTangent ( Cubic.bezier' bez x ) ( brush x ) ) • Cubic.bezier @( Vector2D Double ) bez x
|
||||
offTgt :: Vector2D Double
|
||||
offTgt
|
||||
| t < 0.5
|
||||
= 1e9 *^ ( off t --> off (t + 1e-9) )
|
||||
| otherwise
|
||||
= 1e9 *^ ( off (t - 1e-9) --> off t )
|
||||
bwd t
|
||||
= ( offset ( withTangent ( (-1) *^ Cubic.bezier' bez s ) ( brush s ) )
|
||||
• Cubic.bezier @( Vector2D Double ) bez s
|
||||
, (-1) *^ Cubic.bezier' bez s -- wrong
|
||||
= ( off s
|
||||
, if squaredNorm offTgt < epsilon then (-1) *^ Cubic.bezier' bez s else offTgt
|
||||
)
|
||||
where
|
||||
s :: Double
|
||||
s = 1 - t
|
||||
off :: Double -> Point2D Double
|
||||
off x = offset ( withTangent ( (-1) *^ Cubic.bezier' bez x ) ( brush x ) ) • Cubic.bezier @( Vector2D Double ) bez x
|
||||
offTgt :: Vector2D Double
|
||||
offTgt
|
||||
| s < 0.5
|
||||
= 1e9 *^ ( off s --> off (s + 1e-9) )
|
||||
| otherwise
|
||||
= 1e9 *^ ( off (s - 1e-9) --> off s )
|
||||
= do
|
||||
fwdIVar <- Par.spawnP ( fitCurve fwd )
|
||||
bwdIVar <- Par.spawnP ( fitCurve bwd )
|
||||
|
|
|
|||
Loading…
Reference in a new issue