From 40d10b6a8e938654e56c26073457acafd39932ff Mon Sep 17 00:00:00 2001 From: sheaf Date: Thu, 17 Sep 2020 05:47:53 +0200 Subject: [PATCH] add backend implementation of curve dragging --- src/app/MetaBrush/Render/Document.hs | 27 +++---------------- src/lib/Math/Bezier/Cubic.hs | 40 +++++++++++++++++++++++++--- src/lib/Math/Bezier/Quadratic.hs | 17 +++++++++++- 3 files changed, 57 insertions(+), 27 deletions(-) diff --git a/src/app/MetaBrush/Render/Document.hs b/src/app/MetaBrush/Render/Document.hs index 388efe5..2e8c1b0 100644 --- a/src/app/MetaBrush/Render/Document.hs +++ b/src/app/MetaBrush/Render/Document.hs @@ -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 diff --git a/src/lib/Math/Bezier/Cubic.hs b/src/lib/Math/Bezier/Cubic.hs index 17f074d..0256b96 100644 --- a/src/lib/Math/Bezier/Cubic.hs +++ b/src/lib/Math/Bezier/Cubic.hs @@ -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 diff --git a/src/lib/Math/Bezier/Quadratic.hs b/src/lib/Math/Bezier/Quadratic.hs index b7e26ef..aca0caa 100644 --- a/src/lib/Math/Bezier/Quadratic.hs +++ b/src/lib/Math/Bezier/Quadratic.hs @@ -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