mirror of
https://gitlab.com/sheaf/metabrush.git
synced 2024-11-05 23:03:38 +00:00
add backend implementation of curve dragging
This commit is contained in:
parent
2e9c437bd4
commit
40d10b6a8e
|
@ -69,7 +69,7 @@ import Control.Monad.Trans.State.Strict
|
||||||
|
|
||||||
-- MetaBrush
|
-- MetaBrush
|
||||||
import qualified Math.Bezier.Cubic as Cubic
|
import qualified Math.Bezier.Cubic as Cubic
|
||||||
( Bezier(..) )
|
( Bezier(..), fromQuadratic )
|
||||||
import Math.Bezier.Cubic.Fit
|
import Math.Bezier.Cubic.Fit
|
||||||
( FitPoint(..), FitParameters )
|
( FitPoint(..), FitParameters )
|
||||||
import qualified Math.Bezier.Quadratic as Quadratic
|
import qualified Math.Bezier.Quadratic as Quadratic
|
||||||
|
@ -381,28 +381,9 @@ drawLine ( Colours { path, controlPoint } ) zoom p1 p2 = do
|
||||||
Cairo.restore
|
Cairo.restore
|
||||||
|
|
||||||
drawQuadraticBezier :: Colours -> Double -> Quadratic.Bezier ( Point2D Double ) -> Cairo.Render ()
|
drawQuadraticBezier :: Colours -> Double -> Quadratic.Bezier ( Point2D Double ) -> Cairo.Render ()
|
||||||
drawQuadraticBezier ( Colours { path } ) zoom
|
drawQuadraticBezier cols zoom bez =
|
||||||
( Quadratic.Bezier
|
drawCubicBezier cols zoom
|
||||||
{ p0 = Point2D x0 y0
|
( Cubic.fromQuadratic @( Vector2D Double ) bez )
|
||||||
, p1 = Point2D x1 y1
|
|
||||||
, p2 = Point2D x2 y2
|
|
||||||
}
|
|
||||||
)
|
|
||||||
= do
|
|
||||||
|
|
||||||
Cairo.save
|
|
||||||
|
|
||||||
Cairo.moveTo x0 y0
|
|
||||||
Cairo.curveTo
|
|
||||||
( ( 2 * x1 + x0 ) / 3 ) ( ( 2 * y1 + y0 ) / 3 )
|
|
||||||
( ( 2 * x1 + x2 ) / 3 ) ( ( 2 * y1 + y2 ) / 3 )
|
|
||||||
x2 y2
|
|
||||||
|
|
||||||
Cairo.setLineWidth ( 6 / zoom )
|
|
||||||
withRGBA path Cairo.setSourceRGBA
|
|
||||||
Cairo.stroke
|
|
||||||
|
|
||||||
Cairo.restore
|
|
||||||
|
|
||||||
drawCubicBezier :: Colours -> Double -> Cubic.Bezier ( Point2D Double ) -> Cairo.Render ()
|
drawCubicBezier :: Colours -> Double -> Cubic.Bezier ( Point2D Double ) -> Cairo.Render ()
|
||||||
drawCubicBezier ( Colours { path } ) zoom
|
drawCubicBezier ( Colours { path } ) zoom
|
||||||
|
|
|
@ -5,6 +5,8 @@
|
||||||
{-# LANGUAGE DerivingVia #-}
|
{-# LANGUAGE DerivingVia #-}
|
||||||
{-# LANGUAGE FlexibleInstances #-}
|
{-# LANGUAGE FlexibleInstances #-}
|
||||||
{-# LANGUAGE MultiParamTypeClasses #-}
|
{-# LANGUAGE MultiParamTypeClasses #-}
|
||||||
|
{-# LANGUAGE NamedFieldPuns #-}
|
||||||
|
{-# LANGUAGE NegativeLiterals #-}
|
||||||
{-# LANGUAGE RecordWildCards #-}
|
{-# LANGUAGE RecordWildCards #-}
|
||||||
{-# LANGUAGE ScopedTypeVariables #-}
|
{-# LANGUAGE ScopedTypeVariables #-}
|
||||||
{-# LANGUAGE StandaloneDeriving #-}
|
{-# LANGUAGE StandaloneDeriving #-}
|
||||||
|
@ -13,10 +15,12 @@
|
||||||
|
|
||||||
module Math.Bezier.Cubic
|
module Math.Bezier.Cubic
|
||||||
( Bezier(..)
|
( Bezier(..)
|
||||||
|
, fromQuadratic
|
||||||
, bezier, bezier', bezier''
|
, bezier, bezier', bezier''
|
||||||
, curvature, squaredCurvature
|
, curvature, squaredCurvature
|
||||||
, subdivide
|
, subdivide
|
||||||
, ddist, closestPoint
|
, ddist, closestPoint
|
||||||
|
, drag
|
||||||
)
|
)
|
||||||
where
|
where
|
||||||
|
|
||||||
|
@ -55,7 +59,7 @@ import Data.Group.Generics
|
||||||
|
|
||||||
-- MetaBrush
|
-- MetaBrush
|
||||||
import qualified Math.Bezier.Quadratic as Quadratic
|
import qualified Math.Bezier.Quadratic as Quadratic
|
||||||
( Bezier(Bezier), bezier )
|
( Bezier(..), bezier )
|
||||||
import Math.Epsilon
|
import Math.Epsilon
|
||||||
( epsilon )
|
( epsilon )
|
||||||
import Math.Module
|
import Math.Module
|
||||||
|
@ -82,7 +86,16 @@ data Bezier p
|
||||||
deriving anyclass ( NFData, NFData1 )
|
deriving anyclass ( NFData, NFData1 )
|
||||||
|
|
||||||
deriving via Ap Bezier p
|
deriving via Ap Bezier p
|
||||||
instance Act v p => Act v ( Bezier p )
|
instance {-# OVERLAPPING #-} Act v p => Act v ( Bezier p )
|
||||||
|
|
||||||
|
-- | Degree raising: convert a quadratic Bézier curve to a cubic Bézier curve.
|
||||||
|
fromQuadratic :: forall v r p. ( Torsor v p, Module r v, Fractional r ) => Quadratic.Bezier p -> Bezier p
|
||||||
|
fromQuadratic ( Quadratic.Bezier { p0 = q0, p1 = q1, p2 = q2 } ) = Bezier {..}
|
||||||
|
where
|
||||||
|
p0 = q0
|
||||||
|
p1 = lerp @v (2/3) q0 q1
|
||||||
|
p2 = lerp @v (1/3) q1 q2
|
||||||
|
p3 = q2
|
||||||
|
|
||||||
-- | Cubic Bézier curve.
|
-- | Cubic Bézier curve.
|
||||||
bezier :: forall v r p. ( Torsor v p, Module r v ) => Bezier p -> r -> p
|
bezier :: forall v r p. ( Torsor v p, Module r v ) => Bezier p -> r -> p
|
||||||
|
@ -91,7 +104,6 @@ bezier ( Bezier {..} ) t =
|
||||||
( Quadratic.bezier @v ( Quadratic.Bezier p0 p1 p2 ) t )
|
( Quadratic.bezier @v ( Quadratic.Bezier p0 p1 p2 ) t )
|
||||||
( Quadratic.bezier @v ( Quadratic.Bezier p1 p2 p3 ) t )
|
( Quadratic.bezier @v ( Quadratic.Bezier p1 p2 p3 ) t )
|
||||||
|
|
||||||
|
|
||||||
-- | Derivative of cubic Bézier curve.
|
-- | Derivative of cubic Bézier curve.
|
||||||
bezier' :: forall v r p. ( Torsor v p, Module r v ) => Bezier p -> r -> v
|
bezier' :: forall v r p. ( Torsor v p, Module r v ) => Bezier p -> r -> v
|
||||||
bezier' ( Bezier {..} ) t
|
bezier' ( Bezier {..} ) t
|
||||||
|
@ -181,3 +193,25 @@ closestPoint pts@( Bezier {..} ) c = pickClosest ( 0 :| 1 : roots ) -- todo: als
|
||||||
p' = bezier @v pts t'
|
p' = bezier @v pts t'
|
||||||
nm' :: r
|
nm' :: r
|
||||||
nm' = squaredNorm ( c --> p' :: v )
|
nm' = squaredNorm ( c --> p' :: v )
|
||||||
|
|
||||||
|
-- | Drag a cubic Bézier curve to pass through a given point.
|
||||||
|
--
|
||||||
|
-- Given a cubic Bézier curve, a time \( 0 < t < 1 \) and a point `q`,
|
||||||
|
-- modifies the control points to make the curve pass through `q` at time `t`.
|
||||||
|
--
|
||||||
|
-- Affects the two control points depending on how far along the dragged point is.
|
||||||
|
-- For instance, dragging near the middle moves both control points equally,
|
||||||
|
-- while dragging near an endpoint will mostly affect the control point associated with that endpoint.
|
||||||
|
drag :: forall v r p. ( Torsor v p, Module r v, Fractional r ) => Bezier p -> r -> p -> Bezier p
|
||||||
|
drag ( Bezier {..} ) t q = Bezier { p0, p1 = p1', p2 = p2', p3 }
|
||||||
|
where
|
||||||
|
v0, v1, v2, v3, delta :: v
|
||||||
|
v0 = q --> p0
|
||||||
|
v1 = q --> p1
|
||||||
|
v2 = q --> p2
|
||||||
|
v3 = q --> p3
|
||||||
|
delta = ( recip $ t * ( -3 + t * ( 9 + t * ( -12 + 6 * t ) ) ) )
|
||||||
|
*^ bezier @v ( Bezier v0 v1 v2 v3 ) t
|
||||||
|
p1', p2' :: p
|
||||||
|
p1' = ( ( 1 - t ) *^ delta ) • p1
|
||||||
|
p2' = ( t *^ delta ) • p2
|
||||||
|
|
|
@ -17,6 +17,7 @@ module Math.Bezier.Quadratic
|
||||||
, curvature, squaredCurvature
|
, curvature, squaredCurvature
|
||||||
, subdivide
|
, subdivide
|
||||||
, ddist, closestPoint
|
, ddist, closestPoint
|
||||||
|
, interpolate
|
||||||
)
|
)
|
||||||
where
|
where
|
||||||
|
|
||||||
|
@ -80,7 +81,7 @@ data Bezier p
|
||||||
deriving anyclass ( NFData, NFData1 )
|
deriving anyclass ( NFData, NFData1 )
|
||||||
|
|
||||||
deriving via Ap Bezier p
|
deriving via Ap Bezier p
|
||||||
instance Act v p => Act v ( Bezier p )
|
instance {-# OVERLAPPING #-} Act v p => Act v ( Bezier p )
|
||||||
|
|
||||||
-- | Quadratic Bézier curve.
|
-- | Quadratic Bézier curve.
|
||||||
bezier :: forall v r p. ( Torsor v p, Module r v ) => Bezier p -> r -> p
|
bezier :: forall v r p. ( Torsor v p, Module r v ) => Bezier p -> r -> p
|
||||||
|
@ -160,3 +161,17 @@ closestPoint pts@( Bezier {..} ) c = pickClosest ( 0 :| 1 : roots )
|
||||||
p' = bezier @v pts t'
|
p' = bezier @v pts t'
|
||||||
nm' :: r
|
nm' :: r
|
||||||
nm' = squaredNorm ( c --> p' :: v )
|
nm' = squaredNorm ( c --> p' :: v )
|
||||||
|
|
||||||
|
-- | Interpolation of a quadratic Bézier control point, given path points and Bézier parameter.
|
||||||
|
--
|
||||||
|
-- That is, given points `p0`, `p2`, and `q`, and parameter \( 0 < t < 1 \),
|
||||||
|
-- this function finds the unique control point `p1` such that
|
||||||
|
-- the quadratic Bézier curve with parameters `p0`, `p1`, `p2` passes through
|
||||||
|
-- the point `q` at time `t`.
|
||||||
|
interpolate :: forall v r p. ( Torsor v p, Module r v, Fractional r ) => p -> p -> r -> p -> Bezier p
|
||||||
|
interpolate p0 p2 t q = Bezier {..}
|
||||||
|
where
|
||||||
|
p1 :: p
|
||||||
|
p1 = ( ( 0.5 * ( t - 1 ) / t ) *^ ( q --> p0 :: v )
|
||||||
|
^+^ ( 0.5 * t / ( t - 1 ) ) *^ ( q --> p2 :: v )
|
||||||
|
) • q
|
||||||
|
|
Loading…
Reference in a new issue