add backend implementation of curve dragging

This commit is contained in:
sheaf 2020-09-17 05:47:53 +02:00
parent 2e9c437bd4
commit 40d10b6a8e
3 changed files with 57 additions and 27 deletions

View file

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

View file

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

View file

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