mirror of
https://gitlab.com/sheaf/metabrush.git
synced 2024-11-05 14:53:37 +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
|
||||
import qualified Math.Bezier.Cubic as Cubic
|
||||
( Bezier(..) )
|
||||
( Bezier(..), fromQuadratic )
|
||||
import Math.Bezier.Cubic.Fit
|
||||
( FitPoint(..), FitParameters )
|
||||
import qualified Math.Bezier.Quadratic as Quadratic
|
||||
|
@ -381,28 +381,9 @@ drawLine ( Colours { path, controlPoint } ) zoom p1 p2 = do
|
|||
Cairo.restore
|
||||
|
||||
drawQuadraticBezier :: Colours -> Double -> Quadratic.Bezier ( Point2D Double ) -> Cairo.Render ()
|
||||
drawQuadraticBezier ( Colours { path } ) zoom
|
||||
( Quadratic.Bezier
|
||||
{ p0 = Point2D x0 y0
|
||||
, 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
|
||||
drawQuadraticBezier cols zoom bez =
|
||||
drawCubicBezier cols zoom
|
||||
( Cubic.fromQuadratic @( Vector2D Double ) bez )
|
||||
|
||||
drawCubicBezier :: Colours -> Double -> Cubic.Bezier ( Point2D Double ) -> Cairo.Render ()
|
||||
drawCubicBezier ( Colours { path } ) zoom
|
||||
|
|
|
@ -5,6 +5,8 @@
|
|||
{-# LANGUAGE DerivingVia #-}
|
||||
{-# LANGUAGE FlexibleInstances #-}
|
||||
{-# LANGUAGE MultiParamTypeClasses #-}
|
||||
{-# LANGUAGE NamedFieldPuns #-}
|
||||
{-# LANGUAGE NegativeLiterals #-}
|
||||
{-# LANGUAGE RecordWildCards #-}
|
||||
{-# LANGUAGE ScopedTypeVariables #-}
|
||||
{-# LANGUAGE StandaloneDeriving #-}
|
||||
|
@ -13,10 +15,12 @@
|
|||
|
||||
module Math.Bezier.Cubic
|
||||
( Bezier(..)
|
||||
, fromQuadratic
|
||||
, bezier, bezier', bezier''
|
||||
, curvature, squaredCurvature
|
||||
, subdivide
|
||||
, ddist, closestPoint
|
||||
, drag
|
||||
)
|
||||
where
|
||||
|
||||
|
@ -55,7 +59,7 @@ import Data.Group.Generics
|
|||
|
||||
-- MetaBrush
|
||||
import qualified Math.Bezier.Quadratic as Quadratic
|
||||
( Bezier(Bezier), bezier )
|
||||
( Bezier(..), bezier )
|
||||
import Math.Epsilon
|
||||
( epsilon )
|
||||
import Math.Module
|
||||
|
@ -82,7 +86,16 @@ data Bezier p
|
|||
deriving anyclass ( NFData, NFData1 )
|
||||
|
||||
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.
|
||||
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 p1 p2 p3 ) t )
|
||||
|
||||
|
||||
-- | Derivative of cubic Bézier curve.
|
||||
bezier' :: forall v r p. ( Torsor v p, Module r v ) => Bezier p -> r -> v
|
||||
bezier' ( Bezier {..} ) t
|
||||
|
@ -181,3 +193,25 @@ closestPoint pts@( Bezier {..} ) c = pickClosest ( 0 :| 1 : roots ) -- todo: als
|
|||
p' = bezier @v pts t'
|
||||
nm' :: r
|
||||
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
|
||||
, subdivide
|
||||
, ddist, closestPoint
|
||||
, interpolate
|
||||
)
|
||||
where
|
||||
|
||||
|
@ -80,7 +81,7 @@ data Bezier p
|
|||
deriving anyclass ( NFData, NFData1 )
|
||||
|
||||
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.
|
||||
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'
|
||||
nm' :: r
|
||||
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