update render & select for new brush manipulation

assets/theme.css

@@ -53,7 +53,7 @@
   color: rgb(184,80,80);
 }
 .brush {
-  color: rgb(235,118,219);
+  color: rgb(106,63,222);
 }
 .brushStroke {
   color: rgba(235,118,219,0.66);

cabal.project

@@ -5,7 +5,7 @@ constraints:
 
 allow-newer:
     waargonaut:*,
-    *:haskell-gi-base, *:haskell-gi,
+    *:haskell-gi-base, *:haskell-gi
 
 -- various fixes for 'hmatrix'
 source-repository-package

installation_notes.md

@@ -3,8 +3,7 @@
 
 On Windows, we need to install an up-to-date MinGW/MSYS2 toolchain, 
 together with the packages required by the `haskell-gi` libraries (for `GTK`),
-as well as the `hmatrix` library.
+the `hmatrix` library, as well as `flint` and `msolve`.
-
 
 With an `MSYS2` installation, the following environment variables will need to be set (with `MSYS2` installed at `C:\msys64`):
 
@@ -16,9 +15,22 @@ With an `MSYS2` installation, the following environment variables will need to b
 Then we install some necessary packages using the following command:
 
 ```bash
-pacman -S -q --noconfirm mingw64/mingw-w64-x86_64-pkg-config mingw64/mingw-w64-x86_64-gobject-introspection mingw64/mingw-w64-x86_64-gtksourceview3 mingw64/mingw-w64-x86_64-openblas
+pacman -S -q --noconfirm mingw64/mingw-w64-x86_64-pkg-config mingw64/mingw-w64-x86_64-gobject-introspection mingw64/mingw-w64-x86_64-openblas
 ```
 
+Next, `flint`, which `msolve` depends on. 
+
+Build `flint` by downloading it and running the configure script. On Windows (MINGW64):
+
+```bash
+./configure ABI=64 --build=${MINGW_CHOST} --prefix=${MINGW_PREFIX} --enable-static --disable-shared --with-gmp=${MINGW_PREFIX} --with-mpfr=${MINGW_PREFIX}
+make && make install
+```
+
+`flint` needs `gmp`, `mpfr`, but these should already be present.
+
+For `msolve`, the default installation directions (`./autogen.sh`, `./configure`, `make && make install`) seem to work (without having to set any additional options), as of `msolve` version `0.1.3`.
+
 ## Possible errors
 
 ### pkg-config could not be found

src/app/MetaBrush/Action.hs

@@ -103,7 +103,7 @@ import Math.Bezier.Spline
 import Math.Bezier.Stroke
   ( CachedStroke(..), invalidateCache )
 import Math.Module
-  ( Module((*^)) )
+  ( Module((*^)), quadrance )
 import Math.Vector2D
   ( Point2D(..), Vector2D(..) )
 import MetaBrush.Context
@@ -722,7 +722,13 @@ data MouseClickType
   | DoubleClick
   deriving stock Show
 
-data MouseClick = MouseClick !ActionOrigin !MouseClickType !Word32 !( Point2D Double )
+data MouseClick =
+  MouseClick
+    { clickOrigin :: !ActionOrigin
+    , clickType   :: !MouseClickType
+    , clickButton :: !Word32
+    , clickCoords :: !( Point2D Double )
+    }
   deriving stock Show
 
 instance HandleAction MouseClick where
@@ -744,9 +750,6 @@ instance HandleAction MouseClick where
             pos = toViewport mouseClickCoords
           STM.writeTVar mousePosTVar ( Just pos )
           mode <- STM.readTVar modeTVar
-          case mode of
-            BrushMode -> pure Don'tModifyDoc -- TODO: brush parameter modification UI
-            _ ->
           case actionOrigin of
 
             ViewportOrigin -> case ty of
@@ -766,7 +769,8 @@ instance HandleAction MouseClick where
                     case selectionMode modifiers of
                       -- Drag move: not holding shift or alt, click has selected something.
                       New
-                            | Just ( dragMove, newDoc ) <- dragMoveSelect pos doc
+                        | PathMode <- mode
+                        , Just ( dragMove, newDoc ) <- dragMoveSelect pos doc
                         -> do
                           STM.writeTVar mouseHoldTVar ( Just $ DragMoveHold pos dragMove )
                           case dragMove of
@@ -782,7 +786,7 @@ instance HandleAction MouseClick where
                           pure Don'tModifyDoc
 
                   -- Pen tool: start or continue a drawing operation.
-                      Pen -> do
+                  Pen | PathMode <- mode -> do
                     mbPartialPath <- STM.readTVar partialPathTVar
                     STM.writeTVar mouseHoldTVar ( Just $ DrawHold pos )
                     case mbPartialPath of
@@ -811,6 +815,8 @@ instance HandleAction MouseClick where
                         STM.writeTVar partialPathTVar ( Just $ pp { firstPoint = False } )
                         pure Don'tModifyDoc
 
+                  _ -> pure Don'tModifyDoc
+
               DoubleClick -> do
                 tool   <- STM.readTVar toolTVar
                 modifs <- STM.readTVar modifiersTVar
@@ -940,9 +946,6 @@ instance HandleAction MouseRelease where
             _ -> do
               tool <- STM.readTVar toolTVar
               mode <- STM.readTVar modeTVar
-              case mode of
-                BrushMode -> pure Don'tModifyDoc -- TODO: brush parameter modification UI
-                _ ->
               case tool of
 
                 Selection -> do
@@ -951,8 +954,9 @@ instance HandleAction MouseRelease where
                     selMode = selectionMode modifiers
                   case mbHoldPos of
                     Just hold
-                          | DragMoveHold { holdStartPos = pos0, dragAction } <- hold
+                      | PathMode <- mode
-                          , pos0 /= pos
+                      , DragMoveHold { holdStartPos = pos0, dragAction } <- hold
+                      , quadrance @( Vector2D Double ) pos0 pos * zoomFactor ^ ( 2 :: Int ) >= 16
                       -> let
                             alternateMode :: Bool
                             alternateMode = any ( \case { Alt _ -> True; _ -> False } ) modifiers
@@ -960,10 +964,13 @@ instance HandleAction MouseRelease where
                             Just upd -> pure $ UpdateDoc ( UpdateDocumentTo upd )
                             Nothing  -> pure Don'tModifyDoc
                       | SelectionHold pos0 <- hold
+                      , quadrance @( Vector2D Double ) pos0 pos * zoomFactor ^ ( 2 :: Int ) >= 16
                       -> pure ( UpdateDoc . UpdateDocumentTo . TrivialChange $ selectRectangle selMode pos0 pos doc )
                     _ -> pure ( UpdateDoc . UpdateDocumentTo . TrivialChange $ selectAt selMode pos doc )
 
-                    Pen -> do
+                Pen 
+                  | PathMode <- mode
+                  -> do
                     mbPartialPath <- STM.readTVar partialPathTVar
                     case mbPartialPath of
                       -- Normal pen mode mouse click should have created an anchor.
@@ -1046,6 +1053,8 @@ instance HandleAction MouseRelease where
                               changeText = "Continue stroke"
                             pure ( UpdateDoc . UpdateDocumentTo $ HistoryChange {..} )
 
+                _ -> pure Don'tModifyDoc
+
       -- Other mouse buttons: ignored (for the moment at least).
       _ -> pure ()
 

src/app/MetaBrush/Action.hs-boot

@@ -116,7 +116,13 @@ data ActionOrigin
 data MouseClickType
   = SingleClick
   | DoubleClick
-data MouseClick = MouseClick !ActionOrigin !MouseClickType !Word32 !( Point2D Double )
+data MouseClick =
+  MouseClick
+    { clickOrigin :: !ActionOrigin
+    , clickType   :: !MouseClickType
+    , clickButton :: !Word32
+    , clickCoords :: !( Point2D Double )
+    }
 instance HandleAction MouseClick
 
 data MouseRelease = MouseRelease !Word32 !( Point2D Double )

src/app/MetaBrush/Document/Selection.hs

@@ -177,8 +177,7 @@ selectAt selMode c doc@( Document { zoomFactor } ) =
             .  ( KnownSplineType clo )
             => StrokeSpline clo brushParams -> State Bool ( StrokeSpline clo brushParams )
           updateSpline oldSpline =
-            bitraverseSpline
+            traverse
-              ( const pure )
               ( updateSplinePoint strokeVisible )
               oldSpline
 

src/app/MetaBrush/Render/Document.hs

@@ -159,6 +159,11 @@ compositeRenders = sequenceA_
 toAll :: Cairo.Render () -> Compose Renders Cairo.Render ()
 toAll action = Compose ( pure action )
 
+data RenderMode
+  = RenderingPath
+  | RenderingBrush
+  deriving stock ( Show, Eq )
+
 --------------------------------------------------------------------------------
 
 blankRender :: Colours -> Cairo.Render ()
@@ -251,7 +256,7 @@ getDocumentRender
           Cairo.scale zoomFactor zoomFactor
           Cairo.translate ( -cx ) ( -cy )
           for_ strokesRenderData
-            ( compositeRenders . getCompose . renderStroke cols mbHoverContext mode debug zoomFactor )
+            ( compositeRenders . getCompose . renderStroke cols mbHoverContext mode RenderingPath debug zoomFactor )
           renderSelectionRect
           Cairo.restore
       
@@ -327,16 +332,16 @@ strokeRenderData fitParams
   = Nothing
 
 renderStroke
-  :: Colours -> Maybe HoverContext -> Mode -> Bool -> Double 
+  :: Colours -> Maybe HoverContext -> Mode -> RenderMode -> Bool -> Double 
   -> StrokeRenderData
   -> Compose Renders Cairo.Render ()
-renderStroke cols@( Colours { brush } ) mbHoverContext mode debug zoom = \case
+renderStroke cols@( Colours { brush } ) mbHoverContext mode rdrMode debug zoom = \case
   StrokeRenderData { strokeDataSpline } ->
-    renderStrokeSpline cols mode mbHoverContext zoom ( const ( pure () ) ) strokeDataSpline
+    renderStrokeSpline cols mode rdrMode mbHoverContext zoom ( const ( pure () ) ) strokeDataSpline
   StrokeWithOutlineRenderData strokeDataSpline strokeOutlineData strokeBrushFunction ->
-    renderStrokeSpline cols mode mbHoverContext zoom
+    renderStrokeSpline cols mode rdrMode mbHoverContext zoom
       ( when ( mode == BrushMode )
-      . renderBrushShape ( cols { path = brush } ) mbHoverContext ( 1.5 * zoom ) strokeBrushFunction
+      . renderBrushShape ( cols { path = brush } ) mbHoverContext ( 2 * zoom ) strokeBrushFunction
       )
       strokeDataSpline
     *> Compose blank { renderStrokes = drawOutline cols debug zoom strokeOutlineData }
@@ -348,17 +353,21 @@ renderStroke cols@( Colours { brush } ) mbHoverContext mode debug zoom = \case
 renderStrokeSpline
   :: forall clo crvData pointData
   .  ( Show pointData, KnownSplineType clo )
-  => Colours -> Mode -> Maybe HoverContext -> Double
+  => Colours -> Mode -> RenderMode -> Maybe HoverContext -> Double
   -> ( PointData pointData -> Compose Renders Cairo.Render () )
   -> Spline clo crvData ( PointData pointData )
   -> Compose Renders Cairo.Render ()
-renderStrokeSpline cols mode mbHover zoom renderSubcontent spline =
+renderStrokeSpline cols mode rdrMode mbHover zoom renderSubcontent spline =
   bifoldSpline ( renderSplineCurve ( splineStart spline ) ) renderSplinePoint spline
 
   where
     renderSplinePoint :: PointData pointData -> Compose Renders Cairo.Render ()
     renderSplinePoint sp0
-      =  Compose blank { renderPPts = when ( mode == PathMode ) $ drawPoint cols mbHover zoom PathPoint sp0 }
+      = Compose blank
+          { renderPPts =
+            when ( rdrMode == RenderingPath ) do
+              drawPoint cols mbHover zoom PathPoint sp0
+          }
       *> renderSubcontent sp0
     renderSplineCurve
       :: forall clo'
@@ -366,8 +375,7 @@ renderStrokeSpline cols mode mbHover zoom renderSubcontent spline =
       => PointData pointData -> PointData pointData -> Curve clo' crvData ( PointData pointData ) -> Compose Renders Cairo.Render ()
     renderSplineCurve start p0 ( LineTo np1 _ )
       = Compose blank
-          { renderPPts =
+          { renderPPts = when ( rdrMode == RenderingPath ) do
-            when   ( mode == PathMode ) $
             for_ np1 \ p1 ->
               drawPoint cols mbHover zoom PathPoint p1
           , renderPath =
@@ -378,36 +386,39 @@ renderStrokeSpline cols mode mbHover zoom renderSubcontent spline =
     renderSplineCurve start p0 ( Bezier2To p1 np2 _ )
       = Compose blank
           { renderCLines
-            = when   ( mode == PathMode ) do
+            = when ( rdrMode == RenderingPath ) do
               drawLine cols zoom ControlPoint p0 p1
               drawLine cols zoom ControlPoint p1 ( fromNextPoint start np2 )
           , renderCPts
-            = when   ( mode == PathMode ) $ drawPoint cols mbHover zoom ControlPoint p1
+            = when ( rdrMode == RenderingPath ) do
+              drawPoint cols mbHover zoom ControlPoint p1
           , renderPPts
-            = when   ( mode == PathMode ) $
+            = when ( rdrMode == RenderingPath ) do
                 for_ np2 \ p2 ->
                   drawPoint cols mbHover zoom PathPoint p2
           , renderPath
-            = unless ( mode == MetaMode ) $ drawQuadraticBezier cols zoom ( coords <$> Quadratic.Bezier { p0, p1, p2 = fromNextPoint start np2 } )
+            = unless ( mode == MetaMode ) do
+              drawQuadraticBezier cols zoom ( coords <$> Quadratic.Bezier { p0, p1, p2 = fromNextPoint start np2 } )
           }
       *> renderSubcontent p1
       *> for_ np2 \ p2 -> renderSubcontent p2
     renderSplineCurve start p0 ( Bezier3To p1 p2 np3 _ )
       = Compose blank
           { renderCLines
-            = when   ( mode == PathMode ) do
+            = when ( rdrMode == RenderingPath ) do
               drawLine cols zoom ControlPoint p0 p1
               drawLine cols zoom ControlPoint p2 ( fromNextPoint start np3 )
           , renderCPts
-            = when   ( mode == PathMode ) do
+            = when ( rdrMode == RenderingPath ) do
               drawPoint cols mbHover zoom ControlPoint p1
               drawPoint cols mbHover zoom ControlPoint p2
           , renderPPts
-            = when   ( mode == PathMode ) $
+            = when ( rdrMode == RenderingPath ) do
                 for_ np3 \ p3 ->
                   drawPoint cols mbHover zoom PathPoint p3
           , renderPath
-            = unless ( mode == MetaMode ) $ drawCubicBezier cols zoom ( coords <$> Cubic.Bezier { p0, p1, p2, p3 = fromNextPoint start np3 } )
+            = unless ( mode == MetaMode ) do
+                drawCubicBezier cols zoom ( coords <$> Cubic.Bezier { p0, p1, p2, p3 = fromNextPoint start np3 } )
           }
       *> renderSubcontent p1
       *> renderSubcontent p2
@@ -430,9 +441,8 @@ renderBrushShape cols mbHoverContext zoom brushFn pt =
     toAll do
       Cairo.save
       Cairo.translate x y
-    *> renderStrokeSpline cols PathMode mbHoverContext' zoom ( const $ pure () )
+    *> renderStrokeSpline cols BrushMode RenderingBrush mbHoverContext' zoom ( const $ pure () )
         ( fmap ( \ p -> PointData p Normal () ) brushPts )
-    *> Compose blank { renderPPts = drawCross cols zoom }
     *> toAll Cairo.restore
 
 drawPoint :: Colours -> Maybe HoverContext -> Double -> PointType -> PointData brushData -> Cairo.Render ()
@@ -659,6 +669,7 @@ drawSelectionRectangle ( Colours {..} ) zoom ( Point2D x0 y0 ) ( Point2D x1 y1 )
 
   Cairo.restore
 
+{-
 drawCross :: Colours -> Double -> Cairo.Render ()
 drawCross ( Colours {..} ) zoom = do
   Cairo.save
@@ -677,7 +688,7 @@ drawCross ( Colours {..} ) zoom = do
   Cairo.stroke
 
   Cairo.restore
-
+-}
 
 hsl2rgb :: Double -> Double -> Double -> ( Double, Double, Double )
 hsl2rgb h s l = case hc2rgb h c of

src/lib/Math/Bezier/Envelope.hs

@@ -1,3 +1,7 @@
+{-# LANGUAGE DataKinds             #-}
+{-# LANGUAGE DerivingStrategies    #-}
+{-# LANGUAGE NamedFieldPuns        #-}
+{-# LANGUAGE PartialTypeSignatures #-}
 {-# LANGUAGE ScopedTypeVariables   #-}
 {-# LANGUAGE TypeApplications      #-}
 
@@ -29,6 +33,163 @@ import Math.Vector2D
 
 --------------------------------------------------------------------------------
 
+{-
+data StrokePolynomialData
+  = StrokePolynomialData
+  { envelope  :: !Poly
+  , envelope' :: !Poly
+  , tangent   :: !( Poly, Poly )
+  , type1Cusps :: [ ( Double, Double ) ]
+  , type2Cusps :: [ ( Double, Double ) ]
+  }
+  deriving stock Show
+
+validRoot :: Sized 2 ( Complex Double ) -> Maybe ( Double, Double )
+validRoot r 
+  |  any isNaN [a,b,c,d]
+  || any isInfinite [a,b,c,d]
+  || any ( not . nearZero ) [b,d]
+  || any ( < 0 ) [ a, c ]
+  || any ( > 1 ) [ a, c ]
+  = Nothing
+  | otherwise
+  = Just ( a, c )
+  where
+    a, b, c, d :: Double
+    a :+ b = r %!! 0
+    c :+ d = r %!! 1
+
+{-
+:seti -XNegativeLiterals -XFlexibleInstances -XRebindableSyntax
+:m Math.Vector2D Math.Bezier.Envelope
+import qualified Math.Bezier.Cubic as Cubic
+import Prelude hiding ( fromInteger )
+import AlgebraicPrelude ( fromInteger )
+
+:{
+let
+  path :: Cubic.Bezier ( Point2D AlgebraicPrelude.Rational )
+  path = Cubic.Bezier
+    (Point2D p0_x p0_y) (Point2D p1_x p1_y) (Point2D p2_x p2_y) (Point2D p3_x p3_y)
+  brush :: Cubic.Bezier ( Cubic.Bezier ( Point2D AlgebraicPrelude.Rational ) )
+  brush = Cubic.Bezier
+    ( Cubic.Bezier (Point2D b00_x b00_y) (Point2D b01_x b01_y) (Point2D b02_x b02_y) (Point2D b03_x b03_y) )
+    ( Cubic.Bezier (Point2D b10_x b10_y) (Point2D b11_x b11_y) (Point2D b12_x b12_y) (Point2D b13_x b13_y) )
+    ( Cubic.Bezier (Point2D b20_x b20_y) (Point2D b21_x b21_y) (Point2D b22_x b22_y) (Point2D b23_x b23_y) )
+    ( Cubic.Bezier (Point2D b30_x b30_y) (Point2D b31_x b31_y) (Point2D b32_x b32_y) (Point2D b33_x b33_y) )
+:}
+
+:{
+let
+  path :: Cubic.Bezier ( Point2D AlgebraicPrelude.Rational )
+  path = Cubic.Bezier
+    (Point2D 0.5 0.5) (Point2D 0.5 4) (Point2D 1 4) (Point2D 6 2)
+  brush :: Cubic.Bezier ( Cubic.Bezier ( Point2D AlgebraicPrelude.Rational ) )
+  brush = Cubic.Bezier
+    ( Cubic.Bezier (Point2D 0   -0.5) (Point2D  1  1  ) (Point2D -1  1  ) (Point2D 0 -0.5) )
+    ( Cubic.Bezier (Point2D 0.5 -0.5) (Point2D  5  1  ) (Point2D -5  1  ) (Point2D 0 -0.5) )
+    ( Cubic.Bezier (Point2D 0   -0.5) (Point2D  1  1  ) (Point2D -1  1  ) (Point2D 0 -0.5) )
+    ( Cubic.Bezier (Point2D 1   -0.2) (Point2D -3 -0.8) (Point2D -1 -0.2) (Point2D 1 -0.2) )
+:}
+
+strokePolynomialData33 path brush
+
+-}
+
+-- c(t,u) = p(t) + b(t,u) = ( x(t,u), y(t,u) )
+strokePolynomialData33
+  :: Cubic.Bezier ( Point2D CA.Rational )
+  -> Cubic.Bezier ( Cubic.Bezier ( Point2D CA.Rational ) )
+  -> StrokePolynomialData
+strokePolynomialData33 ( Cubic.Bezier (Point2D p0_x p0_y) (Point2D p1_x p1_y) (Point2D p2_x p2_y) (Point2D p3_x p3_y) )
+  ( Cubic.Bezier
+    ( Cubic.Bezier (Point2D b00_x b00_y) (Point2D b01_x b01_y) (Point2D b02_x b02_y) (Point2D b03_x b03_y) )
+    ( Cubic.Bezier (Point2D b10_x b10_y) (Point2D b11_x b11_y) (Point2D b12_x b12_y) (Point2D b13_x b13_y) )
+    ( Cubic.Bezier (Point2D b20_x b20_y) (Point2D b21_x b21_y) (Point2D b22_x b22_y) (Point2D b23_x b23_y) )
+    ( Cubic.Bezier (Point2D b30_x b30_y) (Point2D b31_x b31_y) (Point2D b32_x b32_y) (Point2D b33_x b33_y) )
+  ) = StrokePolynomialData
+        { envelope
+        , envelope'  = pepu
+        , tangent    = ( dxdt, dydt )
+        , type1Cusps = trace ( show "grobner = " <> show grobner ) [] --mapMaybe validRoot $ unsafePerformIO . evalRandIO $ CA.solveM ( CA.toIdeal [ envelope, pepu ]  )
+        , type2Cusps = [] --mapMaybe validRoot $ unsafePerformIO . evalRandIO $ CA.solveM ( CA.toIdeal [ dxdt, dydt ] )
+        }
+    where
+
+      grobner = CA.f4 ( CA.toIdeal [ envelope, dxdt, dydt ] )
+
+      -- Computation of ∂c/∂t: partial derivatives ∂x/∂t and ∂y/∂t.
+
+      t, u :: Poly
+      t = CA.fromMonomial $ ( CA.varMonom ( Data.Type.Natural.sNat @2 ) 0 )
+      u = CA.fromMonomial $ ( CA.varMonom ( Data.Type.Natural.sNat @2 ) 1 )
+
+      bez3Pol :: Poly -> Poly -> Poly -> Poly -> Poly -> Poly
+      bez3Pol v a0 a1 a2 a3
+        = a0 * ( 1 - v ) ^ ( 3 :: Int )
+        + 3 * a1 * v * ( 1 - v ) ^ ( 2 :: Int )
+        + 3 * a2 * ( 1 - v ) * v ^ ( 2 :: Int )
+        + a3 * v ^ ( 3 :: Int )
+
+      bez3'Pol :: Poly -> Poly -> Poly -> Poly -> Poly -> Poly
+      bez3'Pol v a0 a1 a2 a3
+        = 3 * 
+        ( a1 - a0
+        + 2 * ( a0 + a2 - 2 * a1 ) * v
+        + ( a3 - 3 * a2 + 3 * a1 - a0 ) * v ^ ( 2 :: Int )
+        )
+
+      f0_x, f1_x, f2_x, f3_x, f0_y, f1_y, f2_y, f3_y :: Poly
+      f0_x = bez3'Pol t ( CA.injectCoeff b00_x ) ( CA.injectCoeff b10_x ) ( CA.injectCoeff b20_x ) ( CA.injectCoeff b30_x )
+      f1_x = bez3'Pol t ( CA.injectCoeff b01_x ) ( CA.injectCoeff b11_x ) ( CA.injectCoeff b21_x ) ( CA.injectCoeff b31_x )
+      f2_x = bez3'Pol t ( CA.injectCoeff b02_x ) ( CA.injectCoeff b12_x ) ( CA.injectCoeff b22_x ) ( CA.injectCoeff b32_x )
+      f3_x = bez3'Pol t ( CA.injectCoeff b03_x ) ( CA.injectCoeff b13_x ) ( CA.injectCoeff b23_x ) ( CA.injectCoeff b33_x )
+      f0_y = bez3'Pol t ( CA.injectCoeff b00_y ) ( CA.injectCoeff b10_y ) ( CA.injectCoeff b20_y ) ( CA.injectCoeff b30_y )
+      f1_y = bez3'Pol t ( CA.injectCoeff b01_y ) ( CA.injectCoeff b11_y ) ( CA.injectCoeff b21_y ) ( CA.injectCoeff b31_y )
+      f2_y = bez3'Pol t ( CA.injectCoeff b02_y ) ( CA.injectCoeff b12_y ) ( CA.injectCoeff b22_y ) ( CA.injectCoeff b32_y )
+      f3_y = bez3'Pol t ( CA.injectCoeff b03_y ) ( CA.injectCoeff b13_y ) ( CA.injectCoeff b23_y ) ( CA.injectCoeff b33_y )
+
+      pxpt, pypt :: Poly
+      pxpt = trace "pxpt = " . traceShowId $ bez3'Pol t ( CA.injectCoeff p0_x ) ( CA.injectCoeff p1_x ) ( CA.injectCoeff p2_x ) ( CA.injectCoeff p3_x ) + bez3Pol u f0_x f1_x f2_x f3_x
+      pypt = trace "pypt = " . traceShowId $ bez3'Pol t ( CA.injectCoeff p0_y ) ( CA.injectCoeff p1_y ) ( CA.injectCoeff p2_y ) ( CA.injectCoeff p3_y ) + bez3Pol u f0_y f1_y f2_y f3_y
+
+      -- Computation of ∂c/∂u: partial derivatives ∂x/∂u and ∂y/∂u.
+
+      g0_x, g1_x, g2_x, g3_x, g0_y, g1_y, g2_y, g3_y :: Poly
+      g0_x = bez3Pol t ( CA.injectCoeff b00_x ) ( CA.injectCoeff b10_x ) ( CA.injectCoeff b20_x ) ( CA.injectCoeff b30_x )
+      g1_x = bez3Pol t ( CA.injectCoeff b01_x ) ( CA.injectCoeff b11_x ) ( CA.injectCoeff b21_x ) ( CA.injectCoeff b31_x )
+      g2_x = bez3Pol t ( CA.injectCoeff b02_x ) ( CA.injectCoeff b12_x ) ( CA.injectCoeff b22_x ) ( CA.injectCoeff b32_x )
+      g3_x = bez3Pol t ( CA.injectCoeff b03_x ) ( CA.injectCoeff b13_x ) ( CA.injectCoeff b23_x ) ( CA.injectCoeff b33_x )
+      g0_y = bez3Pol t ( CA.injectCoeff b00_y ) ( CA.injectCoeff b10_y ) ( CA.injectCoeff b20_y ) ( CA.injectCoeff b30_y )
+      g1_y = bez3Pol t ( CA.injectCoeff b01_y ) ( CA.injectCoeff b11_y ) ( CA.injectCoeff b21_y ) ( CA.injectCoeff b31_y )
+      g2_y = bez3Pol t ( CA.injectCoeff b02_y ) ( CA.injectCoeff b12_y ) ( CA.injectCoeff b22_y ) ( CA.injectCoeff b32_y )
+      g3_y = bez3Pol t ( CA.injectCoeff b03_y ) ( CA.injectCoeff b13_y ) ( CA.injectCoeff b23_y ) ( CA.injectCoeff b33_y )
+
+      pxpu, pypu :: Poly
+      pxpu = bez3'Pol u g0_x g1_x g2_x g3_x
+      pypu = bez3'Pol u g0_y g1_y g2_y g3_y
+
+      -- Envelope equation.
+      envelope :: Poly
+      envelope = pxpt * pypu - pypt * pxpu
+
+      -- Computation of total derivative dc/dt = ( dx/dt, dy/dt ).
+      -- Rather, we are clearing denominators:
+      -- dc/dt = ∂c/∂t + ∂c/∂u ∂u/dt
+      -- ∂u/∂t = - ( ∂ envelope / ∂ t ) / ( ∂ envelope / ∂ u )
+      --
+      -- So we compute instead:
+      -- ( ∂ envelope / ∂ u ) dc/dt = ( ∂ envelope / ∂ u ) ∂c/∂t - ( ∂ envelope / ∂ t ) ∂c/∂u.
+
+      pepu, pept :: Poly
+      pept = CA.diff 0 envelope
+      pepu = CA.diff 1 envelope
+
+      dxdt, dydt :: Poly
+      dxdt = pxpt * pepu - pxpu * pept
+      dydt = pypt * pepu - pypu * pept
+
+-}
 -- | Find the roots of the envelope equation for a family of cubic Bézier curves
 -- varying along a cubic Bézier path.
 --

src/lib/Math/Bezier/Stroke.hs

@@ -483,7 +483,7 @@ outlineFunctions ptParams brushFn sp0 crv =
         -> ( brush3, Cubic.bezier @( Vector2D Double ) bez, Cubic.bezier' bez )
     fwd, bwd :: Double -> ( Point2D Double, Vector2D Double )
     fwd t
-      = ( offset ( withTangent ( fwd' t ) ( brush t ) ) • f t
+      = ( off t --offset ( withTangent ( fwd' t ) ( brush t ) ) • f t
         , fwd' t
         )
       where
@@ -502,7 +502,7 @@ outlineFunctions ptParams brushFn sp0 crv =
           | otherwise
           = offTgt u
     bwd t
-      = ( offset ( withTangent ( (-1) *^ bwd' s ) ( brush s ) ) • f s
+      = ( off s --offset ( withTangent ( (-1) *^ bwd' s ) ( brush s ) ) • f s
         , bwd' s
         )
       where