start reworking brush stroking

MetaBrush.cabal

@@ -61,6 +61,8 @@ common common
         -fspecialise-aggressively
         -optc-O3
         -optc-ffast-math
+        -- work around a laziness bug involving runRW# in GHC 9.0.1
+        -fno-full-laziness
         -Wall
         -Wcompat
         -fwarn-missing-local-signatures

src/app/MetaBrush/Action.hs

@@ -181,7 +181,7 @@ instance HandleAction () where
 -- New file --
 --------------
 
-data NewFile = NewFile TabLocation
+data NewFile = NewFile !TabLocation
   deriving stock Show
 
 instance HandleAction NewFile where
@@ -192,7 +192,7 @@ instance HandleAction NewFile where
 -- Open file --
 ---------------
 
-data OpenFile = OpenFile TabLocation
+data OpenFile = OpenFile !TabLocation
   deriving stock Show
 
 instance HandleAction OpenFile where
@@ -252,7 +252,7 @@ warningDialog window filePath errMess = do
 -- Open folder --
 -----------------
 
-data OpenFolder = OpenFolder TabLocation
+data OpenFolder = OpenFolder !TabLocation
   deriving stock Show
 
 instance HandleAction OpenFolder where
@@ -671,7 +671,7 @@ instance HandleAction About where
 -- Mouse movement --
 --------------------
 
-data MouseMove = MouseMove ( Point2D Double )
+data MouseMove = MouseMove !( Point2D Double )
   deriving stock Show
 
 instance HandleAction MouseMove where
@@ -714,7 +714,7 @@ instance HandleAction MouseMove where
 
 data ActionOrigin
   = ViewportOrigin
-  | RulerOrigin Ruler
+  | RulerOrigin !Ruler
   deriving stock Show
 
 data MouseClickType
@@ -722,7 +722,7 @@ data MouseClickType
   | DoubleClick
   deriving stock Show
 
-data MouseClick = MouseClick ActionOrigin MouseClickType Word32 ( Point2D Double )
+data MouseClick = MouseClick !ActionOrigin !MouseClickType !Word32 !( Point2D Double )
   deriving stock Show
 
 instance HandleAction MouseClick where
@@ -860,7 +860,7 @@ instance HandleAction MouseClick where
 -- Mouse release --
 -------------------
 
-data MouseRelease = MouseRelease Word32 ( Point2D Double )
+data MouseRelease = MouseRelease !Word32 !( Point2D Double )
   deriving stock Show
 
 instance HandleAction MouseRelease where
@@ -1053,7 +1053,7 @@ instance HandleAction MouseRelease where
 -- Scrolling --
 ---------------
 
-data Scroll = Scroll ( Maybe ( Point2D Double ) ) ( Vector2D Double )
+data Scroll = Scroll !( Maybe ( Point2D Double ) ) !( Vector2D Double )
   deriving stock Show
 
 instance HandleAction Scroll where
@@ -1108,7 +1108,7 @@ instance HandleAction Scroll where
 -- Keyboard press --
 --------------------
 
-data KeyboardPress = KeyboardPress Word32
+data KeyboardPress = KeyboardPress !Word32
   deriving stock Show
 
 instance HandleAction KeyboardPress where
@@ -1153,7 +1153,7 @@ instance HandleAction KeyboardPress where
 -- Keyboard release --
 ----------------------
 
-data KeyboardRelease = KeyboardRelease Word32
+data KeyboardRelease = KeyboardRelease !Word32
   deriving stock Show
 
 instance HandleAction KeyboardRelease where

src/app/MetaBrush/Action.hs-boot

@@ -45,13 +45,13 @@ class HandleAction action where
 
 instance HandleAction ()
 
-data NewFile = NewFile TabLocation
+data NewFile = NewFile !TabLocation
 instance HandleAction NewFile
 
-data OpenFile = OpenFile TabLocation
+data OpenFile = OpenFile !TabLocation
 instance HandleAction OpenFile
 
-data OpenFolder = OpenFolder TabLocation
+data OpenFolder = OpenFolder !TabLocation
 instance HandleAction OpenFolder
 
 data Save = Save
@@ -107,26 +107,26 @@ instance HandleAction Confirm
 data About = About
 instance HandleAction About
 
-data MouseMove = MouseMove ( Point2D Double )
+data MouseMove = MouseMove !( Point2D Double )
 instance HandleAction MouseMove
 
 data ActionOrigin
   = ViewportOrigin
-  | RulerOrigin Ruler
+  | RulerOrigin !Ruler
 data MouseClickType
   = SingleClick
   | DoubleClick
-data MouseClick = MouseClick ActionOrigin MouseClickType Word32 ( Point2D Double )
+data MouseClick = MouseClick !ActionOrigin !MouseClickType !Word32 !( Point2D Double )
 instance HandleAction MouseClick
 
-data MouseRelease = MouseRelease Word32 ( Point2D Double )
+data MouseRelease = MouseRelease !Word32 !( Point2D Double )
 instance HandleAction MouseRelease
 
-data Scroll = Scroll ( Maybe ( Point2D Double ) ) ( Vector2D Double )
+data Scroll = Scroll !( Maybe ( Point2D Double ) ) !( Vector2D Double )
 instance HandleAction Scroll
 
-data KeyboardPress = KeyboardPress Word32
+data KeyboardPress = KeyboardPress !Word32
 instance HandleAction KeyboardPress
 
-data KeyboardRelease = KeyboardRelease Word32
+data KeyboardRelease = KeyboardRelease !Word32
 instance HandleAction KeyboardRelease

src/app/MetaBrush/Application.hs

@@ -184,9 +184,9 @@ runApplication application = do
               Spline
                 { splineStart  = mkPoint ( Point2D 10 -20 ) 2
                 , splineCurves = OpenCurves $ Seq.fromList
-                  [ LineTo { curveEnd = NextPoint ( mkPoint ( Point2D  10  10 ) 5 ), curveData = invalidateCache undefined }
+                  [ LineTo { curveEnd = NextPoint ( mkPoint ( Point2D  10  10 ) 10 ), curveData = invalidateCache undefined }
-                  , LineTo { curveEnd = NextPoint ( mkPoint ( Point2D -10  10 ) 5 ), curveData = invalidateCache undefined }
+                  , LineTo { curveEnd = NextPoint ( mkPoint ( Point2D -10  10 )  5 ), curveData = invalidateCache undefined }
-                  , LineTo { curveEnd = NextPoint ( mkPoint ( Point2D -10 -20 ) 2 ), curveData = invalidateCache undefined }
+                  , LineTo { curveEnd = NextPoint ( mkPoint ( Point2D -10 -20 ) 15 ), curveData = invalidateCache undefined }
                   ]
                 }
             }

src/app/MetaBrush/Brush.hs

@@ -81,7 +81,7 @@ import Math.Module
 import Math.Vector2D
   ( Point2D )
 import {-# SOURCE #-} MetaBrush.Document.Serialise
-  ( Serialisable, Workaround(..) )
+  ( Serialisable, Workaround(..), workaround )
 import MetaBrush.MetaParameter.AST
   ( SType(..), STypeI(..), SomeSType(..), STypes(..), STypesI(..), someSTypes
   , Adapted, BrushFunction
@@ -93,7 +93,7 @@ import MetaBrush.MetaParameter.Interpolation
 --------------------------------------------------------------------------------
 
 whatever :: Int
-whatever = case Workaround of
+whatever = case workaround Workaround of
   Workaround -> 0
 
 data Brush brushFields where

src/app/MetaBrush/Document/Serialise.hs

@@ -14,7 +14,8 @@
 {-# LANGUAGE UndecidableInstances #-}
 
 module MetaBrush.Document.Serialise
-  ( Workaround(..), Serialisable(..)
+  ( Workaround(..), workaround
+  , Serialisable(..)
   , documentToJSON, documentFromJSON
   , saveDocument, loadDocument
   )
@@ -201,6 +202,8 @@ import qualified Paths_MetaBrush as Cabal
 
 -- | Dummy data-type that helps workaround a GHC bug with hs-boot files.
 data Workaround = Workaround
+workaround :: Workaround -> Workaround
+workaround Workaround = Workaround
 
 -- | Serialise a document to JSON (in the form of a lazy bytestring).
 documentToJSON :: Document -> Lazy.ByteString

src/app/MetaBrush/Document/Serialise.hs-boot

@@ -2,7 +2,7 @@
 {-# LANGUAGE UndecidableInstances #-}
 
 module MetaBrush.Document.Serialise
-  ( Workaround(..), Serialisable(..) )
+  ( Workaround(..), workaround, Serialisable(..) )
   where
 
 -- base
@@ -31,6 +31,8 @@ import Math.Vector2D
 
 data Workaround = Workaround
 
+workaround :: Workaround -> Workaround
+
 class Serialisable a where
   encoder :: Monad f => JSON.Encoder f a
   decoder :: Monad m => JSON.Decoder m a

src/app/MetaBrush/MetaParameter/AST.hs

@@ -516,7 +516,10 @@ type BrushFunction brushFields = AdaptableFunction brushFields ( SplinePts Close
 newtype AdaptableFunction brushFields a
   = AdaptableFunction
       ( forall givenFields usedFields
-      .  Adapted brushFields givenFields usedFields
+      .  ( Adapted brushFields givenFields usedFields
+         -- Debugging.
+         , Show ( Super.Rec givenFields )
+         )
       => ( Super.Rec givenFields -> Super.Rec usedFields
          , Super.Rec usedFields  -> a
          )

src/app/MetaBrush/Render/Document.hs

@@ -303,12 +303,12 @@ strokeRenderData fitParams
     = Just $ case strokeBrush of
         Just ( AdaptedBrush ( brush :: Brush brushFields ) )
           | ( _ :: Proxy# usedFields ) <- ( proxy# :: Proxy# ( brushFields `SuperRecord.Intersect` pointFields ) )
+          -- Get the adaptable brush shape (function),
+          -- specialising it to the type we are using.
           , let
               toUsedParams :: Super.Rec pointFields -> Super.Rec usedFields
               brushShapeFn :: Super.Rec usedFields -> SplinePts Closed
               AdaptableFunction ( toUsedParams, brushShapeFn ) = brushFunction brush
-              -- Get the adaptable brush shape (function),
-              -- specialising it to the type we are using.
           -> do
             -- Compute the outline using the brush function.
             ( outline, fitPts ) <-

src/lib/Math/Bezier/Stroke.hs

@@ -101,10 +101,9 @@ import Math.Bezier.Spline
   , ssplineType, adjustSplineType
   , NextPoint(..), fromNextPoint
   , KnownSplineType
-    ( bifoldSpline, ibifoldSpline, bimapSpline )
+    ( bifoldSpline, ibifoldSpline )
   , Spline(..), SplinePts, Curves(..), Curve(..)
-  , openCurveStart, openCurveEnd
+  , openCurveEnd, splitSplineAt, dropCurves
-  , splitSplineAt, dropCurves
   )
 import qualified Math.Bezier.Quadratic as Quadratic
 import Math.Epsilon
@@ -180,6 +179,8 @@ computeStrokeOutline ::
      , HasType ( Point2D Double ) ptData
      , HasType ( CachedStroke s ) crvData
      , NFData ptData, NFData crvData
+     -- Debugging.
+     , Show ptData
      )
   => FitParameters
   -> ( ptData -> brushParams )
@@ -189,53 +190,54 @@ computeStrokeOutline ::
         ( Either ( SplinePts Closed ) ( SplinePts Closed, SplinePts Closed )
         , Seq FitPoint
         )
-computeStrokeOutline fitParams ptParams brushFn spline@( Spline { splineStart = spt0, splineCurves } ) = case ssplineType @clo of
+computeStrokeOutline fitParams ptParams brushFn spline@( Spline { splineStart = spt0 } ) = case ssplineType @clo of
   -- Open brush path with at least one segment.
+  -- Need to add caps at both ends of the path.
   SOpen
-    | OpenCurves curves <- splineCurves
+    | ( firstOutlineFwd, firstOutlineBwd ) :<| _ <- outlineFns
-    , firstCurve :<| _ <- curves
+    , _ :|> ( lastOutlineFwd, lastOutlineBwd )   <- outlineFns
-    , prevCurves :|> lastCurve <- curves
+    , _ :|> lastCurve <- openCurves $ splineCurves spline
     , let
         endPt :: ptData
         endPt = openCurveEnd lastCurve
-        startTgt, endTgt :: Vector2D Double
+        startTgtFwd, startTgtBwd, endTgtFwd, endTgtBwd :: Vector2D Double
-        startTgt = coords spt0 --> coords ( openCurveStart firstCurve )
+        startTgtFwd = snd $ firstOutlineFwd 0
-        endTgt = case prevCurves of
+        startTgtBwd = snd $ firstOutlineBwd 1
-          Empty          -> endTangent spt0 spt0                      lastCurve
+        endTgtFwd   = snd $  lastOutlineFwd 1
-          _ :|> lastPrev -> endTangent spt0 ( openCurveEnd lastPrev ) lastCurve
+        endTgtBwd   = snd $  lastOutlineBwd 0
         startBrush, endBrush :: SplinePts Closed
         startBrush = brushShape spt0
         endBrush = brushShape endPt
         startCap, endCap :: SplinePts Open
         startCap
           = fmap ( MkVector2D ( coords spt0 ) • )
-          $ joinWithBrush ( withTangent ( (-1) *^ startTgt ) startBrush ) ( withTangent startTgt startBrush ) startBrush
+          $ joinWithBrush ( withTangent ( (-1) *^ startTgtBwd ) startBrush ) ( withTangent startTgtFwd startBrush ) startBrush
         endCap
           = fmap ( MkVector2D ( coords endPt ) • )
-          $ joinWithBrush ( withTangent endTgt endBrush ) ( withTangent ( (-1) *^ endTgt ) endBrush ) endBrush
+          $ joinWithBrush ( withTangent endTgtFwd endBrush ) ( withTangent ( (-1) *^ endTgtBwd ) endBrush ) endBrush
     -> do
-      TwoSided ( fwdPts, fwdFits ) ( bwdPts, bwdFits ) <- updateSpline startTgt
+      TwoSided ( fwdPts, fwdFits ) ( bwdPts, bwdFits ) <- updateSpline ( startTgtFwd, startTgtBwd )
       pure
         ( Left  ( adjustSplineType @Closed $ startCap <> fwdPts <> endCap <> bwdPts  )
         , fwdFits <> bwdFits
         )
   -- Closed brush path with at least one segment.
+  -- Add forward and backward caps at the start.
   SClosed
-    | ClosedCurves prevCurves lastCurve <- splineCurves
+    | ( firstOutlineFwd, firstOutlineBwd ) :<| _ <- outlineFns
+    , _ :|> ( lastOutlineFwd, lastOutlineBwd )   <- outlineFns
     , let
-        startTgt, endTgt :: Vector2D Double
+        startTgtFwd, startTgtBwd, endTgtFwd, endTgtBwd :: Vector2D Double
-        startTgt = case prevCurves of
+        startTgtFwd = snd $ firstOutlineFwd 0
-          Empty          -> startTangent spt0 spt0 lastCurve
+        startTgtBwd = snd $ firstOutlineBwd 1
-          firstCrv :<| _ -> startTangent spt0 spt0 firstCrv
+        endTgtFwd   = snd $  lastOutlineFwd 1
-        endTgt = case prevCurves of
+        endTgtBwd   = snd $  lastOutlineBwd 0
-          Empty          -> endTangent spt0 spt0                      lastCurve
-          _ :|> lastPrev -> endTangent spt0 ( openCurveEnd lastPrev ) lastCurve
         fwdStartCap, bwdStartCap :: SplinePts Open
         TwoSided fwdStartCap bwdStartCap
           = fmap fst . snd . runWriter
-          $ tellBrushJoin endTgt spt0 startTgt
+          $ tellBrushJoin ( endTgtFwd, endTgtBwd ) spt0 ( startTgtFwd, startTgtBwd )
     -> do
-      TwoSided ( fwdPts, fwdFits ) ( bwdPts, bwdFits ) <- updateSpline endTgt
+      TwoSided ( fwdPts, fwdFits ) ( bwdPts, bwdFits ) <- updateSpline ( endTgtFwd, endTgtBwd )
       pure
         ( Right ( adjustSplineType @Closed ( fwdStartCap <> fwdPts ), adjustSplineType @Closed ( bwdPts <> bwdStartCap ) )
         , fwdFits <> bwdFits
@@ -243,160 +245,54 @@ computeStrokeOutline fitParams ptParams brushFn spline@( Spline { splineStart =
   -- Single point.
   _ ->
     pure
-      ( Left $ bimapSpline ( const id ) ( MkVector2D ( coords spt0 ) • ) ( brushShape spt0 )
+      ( Left $ fmap ( MkVector2D ( coords spt0 ) • ) ( brushShape spt0 )
       , Empty
       )
   where
 
+    outlineFns
+      :: Seq
+          ( Double -> ( Point2D Double, Vector2D Double )
+          , Double -> ( Point2D Double, Vector2D Double )
+          )
+    outlineFns = go spt0 ( openCurves $ splineCurves ( adjustSplineType @Open spline ) )
+      where
+        go
+          :: ptData
+          -> Seq ( Curve Open crvData ptData )
+          -> Seq
+              ( Double -> ( Point2D Double, Vector2D Double )
+              , Double -> ( Point2D Double, Vector2D Double )
+              )
+        go _ Empty = Empty
+        go p0 ( crv :<| crvs ) =
+          outlineFunctions @diffParams ptParams brushFn p0 crv :<| go ( openCurveEnd crv ) crvs
+
     brushShape :: ptData -> SplinePts Closed
     brushShape pt = brushFn ( ptParams pt )
 
-    updateSpline :: Vector2D Double -> ST s OutlineData
+    updateSpline :: ( Vector2D Double, Vector2D Double ) -> ST s OutlineData
-    updateSpline lastTgt
+    updateSpline ( lastTgtFwd, lastTgtBwd )
       = execWriterT
-      . ( `evalStateT` lastTgt )
+      . ( `evalStateT` ( lastTgtFwd, lastTgtBwd ) )
       $ bifoldSpline
           ( \ ptData curve -> do
-            prev_tgt <- get
+            ( prev_tgtFwd, prev_tgtBwd ) <- get
             let
-              tgt :: Vector2D Double
+              fwd, bwd :: Double -> ( Point2D Double, Vector2D Double )
-              tgt = startTangent spt0 ptData curve
+              ( fwd, bwd ) = outlineFunctions @diffParams ptParams brushFn ptData curve
-            lift $ tellBrushJoin prev_tgt ptData tgt
+              tgtFwd, tgtBwd, next_tgtFwd, next_tgtBwd :: Vector2D Double
-            lift $ strokeOutline ptData curve
+              tgtFwd = snd ( fwd 0 )
-            put ( endTangent spt0 ptData curve )
+              tgtBwd = snd ( bwd 1 )
+              next_tgtFwd = snd ( fwd 1 )
+              next_tgtBwd = snd ( bwd 0 )
+            lift $ tellBrushJoin ( prev_tgtFwd, prev_tgtBwd ) ptData ( tgtFwd, tgtBwd )
+            lift $ updateCurveData ( curveData curve ) fwd bwd
+            put ( next_tgtFwd, next_tgtBwd )
           )
           ( const ( pure () ) )
           ( adjustSplineType @Open spline )
 
-    strokeOutline
-      :: ptData -> Curve Open crvData ptData
-      -> WriterT OutlineData ( ST s ) ()
-    strokeOutline sp0 ( LineTo { curveEnd = NextPoint sp1, curveData } ) =
-      let
-        p0, p1 :: Point2D Double
-        p0 = coords sp0
-        p1 = coords sp1
-        tgt :: Vector2D Double
-        tgt = p0 --> p1
-        brush :: Double -> SplinePts Closed
-        brush t = brushFn ( lerp @diffParams t ( ptParams sp0 ) ( ptParams sp1 ) )
-        fwd, bwd :: Double -> ( Point2D Double, Vector2D Double )
-        fwd t
-          = ( off t
-            , if squaredNorm offTgt < epsilon then tgt else offTgt
-            )
-          where
-            off :: Double -> Point2D Double
-            off x = offset ( withTangent tgt ( brush x ) ) • lerp @( Vector2D Double ) x p0 p1
-            offTgt :: Vector2D Double
-            offTgt
-              | t < 0.5
-              = 1e9 *^ ( off t --> off (t + 1e-9) )
-              | otherwise
-              = 1e9 *^ ( off (t - 1e-9) --> off t )
-        bwd t
-          = ( off s
-            , if squaredNorm offTgt < epsilon then (-1) *^ tgt else offTgt
-            )
-          where
-            s :: Double
-            s = 1 - t
-            off :: Double -> Point2D Double
-            off x = offset ( withTangent ( (-1) *^ tgt ) ( brush x ) ) • lerp @( Vector2D Double ) x p0 p1
-            offTgt :: Vector2D Double
-            offTgt
-              | s < 0.5
-              = 1e9 *^ ( off s --> off (s + 1e-9) )
-              | otherwise
-              = 1e9 *^ ( off (s - 1e-9) --> off s )
-      in
-        updateCurveData curveData fwd bwd
-    strokeOutline sp0 ( Bezier2To { controlPoint = sp1, curveEnd = NextPoint sp2, curveData } ) =
-      let
-        p0, p1, p2 :: Point2D Double
-        p0 = coords sp0
-        p1 = coords sp1
-        p2 = coords sp2
-        bez :: Quadratic.Bezier ( Point2D Double )
-        bez = Quadratic.Bezier {..}
-        brush :: Double -> SplinePts Closed
-        brush t = brushFn
-                $ Quadratic.bezier @diffParams
-                ( Quadratic.Bezier ( ptParams sp0 ) ( ptParams sp1 ) ( ptParams sp2 ) ) t
-        fwd, bwd :: Double -> ( Point2D Double, Vector2D Double )
-        fwd t
-          = ( off t
-            , if squaredNorm offTgt < epsilon then Quadratic.bezier' bez t else offTgt
-            )
-          where
-            off :: Double -> Point2D Double
-            off x = offset ( withTangent ( Quadratic.bezier' bez x ) ( brush x ) ) • Quadratic.bezier @( Vector2D Double ) bez x
-            offTgt :: Vector2D Double
-            offTgt
-              | t < 0.5
-              = 1e9 *^ ( off t --> off (t + 1e-9) )
-              | otherwise
-              = 1e9 *^ ( off (t - 1e-9) --> off t )
-        bwd t
-          = ( off s
-            , if squaredNorm offTgt < epsilon then (-1) *^ Quadratic.bezier' bez s else offTgt
-            )
-          where
-            s :: Double
-            s = 1 - t
-            off :: Double -> Point2D Double
-            off x = offset ( withTangent ( (-1) *^ Quadratic.bezier' bez x ) ( brush x ) ) • Quadratic.bezier @( Vector2D Double ) bez x
-            offTgt :: Vector2D Double
-            offTgt
-              | s < 0.5
-              = 1e9 *^ ( off s --> off (s + 1e-9) )
-              | otherwise
-              = 1e9 *^ ( off (s - 1e-9) --> off s )
-      in updateCurveData curveData fwd bwd
-    strokeOutline sp0 ( Bezier3To { controlPoint1 = sp1, controlPoint2 = sp2, curveEnd = NextPoint sp3, curveData } ) =
-      let
-        p0, p1, p2, p3 :: Point2D Double
-        p0 = coords sp0
-        p1 = coords sp1
-        p2 = coords sp2
-        p3 = coords sp3
-        bez :: Cubic.Bezier ( Point2D Double )
-        bez = Cubic.Bezier {..}
-        brush :: Double -> SplinePts Closed
-        brush t = brushFn
-                $ Cubic.bezier @diffParams
-                ( Cubic.Bezier ( ptParams sp0 ) ( ptParams sp1 ) ( ptParams sp2 ) ( ptParams sp3 ) ) t
-        fwd, bwd :: Double -> ( Point2D Double, Vector2D Double )
-        fwd t
-          = ( off t
-            , if squaredNorm offTgt < epsilon then Cubic.bezier' bez t else offTgt
-            )
-          where
-            off :: Double -> Point2D Double
-            off x = offset ( withTangent ( Cubic.bezier' bez x ) ( brush x ) ) • Cubic.bezier @( Vector2D Double ) bez x
-            offTgt :: Vector2D Double
-            offTgt
-              | t < 0.5
-              = 1e9 *^ ( off t --> off (t + 1e-9) )
-              | otherwise
-              = 1e9 *^ ( off (t - 1e-9) --> off t )
-        bwd t
-          = ( off s
-            , if squaredNorm offTgt < epsilon then (-1) *^ Cubic.bezier' bez s else offTgt
-            )
-          where
-            s :: Double
-            s = 1 - t
-            off :: Double -> Point2D Double
-            off x = offset ( withTangent ( (-1) *^ Cubic.bezier' bez x ) ( brush x ) ) • Cubic.bezier @( Vector2D Double ) bez x
-            offTgt :: Vector2D Double
-            offTgt
-              | s < 0.5
-              = 1e9 *^ ( off s --> off (s + 1e-9) )
-              | otherwise
-              = 1e9 *^ ( off (s - 1e-9) --> off s )
-      in updateCurveData curveData fwd bwd
-
     updateCurveData
       :: crvData
       -> ( Double -> ( Point2D Double, Vector2D Double ) )
@@ -426,29 +322,122 @@ computeStrokeOutline fitParams ptParams brushFn spline@( Spline { splineStart =
     -- This happens at corners of the brush path (including endpoints of an open brush path, where the tangent flips direction).
     tellBrushJoin
       :: Monad m
-      => Vector2D Double
+      => ( Vector2D Double, Vector2D Double )
       -> ptData
-      -> Vector2D Double
+      -> ( Vector2D Double, Vector2D Double )
       -> WriterT OutlineData m ()
-    tellBrushJoin prevTgt sp0 tgt
+    tellBrushJoin ( prevTgtFwd, prevTgtBwd ) sp0 ( tgtFwd, tgtBwd ) = tell brushJoin
-      | tgt `parallel` prevTgt
+      where
-      = pure ()
+        ptOffset :: Vector2D Double
-      | otherwise
+        ptOffset = Point2D 0 0 --> coords sp0
-      = tell brushJoin
+        brush0 :: SplinePts Closed
-        where
+        brush0 = brushShape sp0
-          ptOffset :: Vector2D Double
+        fwdJoin, bwdJoin :: SplinePts Open
-          ptOffset = Point2D 0 0 --> coords sp0
+        fwdJoin
-          brush0 :: SplinePts Closed
+          | tgtFwd `parallel` prevTgtFwd
-          brush0 = brushShape sp0
+          = Spline { splineStart = coords sp0, splineCurves = OpenCurves Empty }
-          fwdJoin, bwdJoin :: SplinePts Open
+          | otherwise
-          fwdJoin
+          = fmap ( ptOffset • )
-            = fmap ( ptOffset • )
+          $ joinWithBrush ( withTangent       prevTgtFwd   brush0 ) ( withTangent               tgtFwd   brush0 ) brush0 
-            $ joinWithBrush ( withTangent       prevTgt   brush0 ) ( withTangent               tgt   brush0 ) brush0 
+        bwdJoin
-          bwdJoin
+          | tgtBwd `parallel` prevTgtBwd
-            = fmap ( ptOffset • )
+          = Spline { splineStart = coords sp0, splineCurves = OpenCurves Empty }
-            $ joinWithBrush ( withTangent ( (-1) *^ tgt ) brush0 ) ( withTangent ( (-1) *^ prevTgt ) brush0 ) brush0
+          | otherwise
-          brushJoin :: OutlineData
+          = fmap ( ptOffset • )
-          brushJoin = TwoSided ( fwdJoin, Empty ) ( bwdJoin, Empty )
+          $ joinWithBrush ( withTangent ( (-1) *^ tgtBwd ) brush0 ) ( withTangent ( (-1) *^ prevTgtBwd ) brush0 ) brush0
+        brushJoin :: OutlineData
+        brushJoin = TwoSided ( fwdJoin, Empty ) ( bwdJoin, Empty )
+
+-- | Computes the forward and backward stroke outline functions for a single curve.
+outlineFunctions
+  :: forall diffParams brushParams crvData ptData
+  .  ( Group  diffParams, Module Double diffParams
+     , Torsor diffParams brushParams
+     , HasType ( Point2D Double ) ptData
+     -- Debugging.
+     , Show ptData
+     )
+  => ( ptData -> brushParams )
+  -> ( brushParams -> SplinePts Closed )
+  -> ptData
+  -> Curve Open crvData ptData
+  -> ( Double -> ( Point2D Double, Vector2D Double )
+     , Double -> ( Point2D Double, Vector2D Double )
+     )
+outlineFunctions ptParams brushFn sp0 crv =
+  let
+    p0 :: Point2D Double
+    p0 = coords sp0
+    brush :: Double -> SplinePts Closed
+    f  :: Double -> Point2D  Double
+    f' :: Double -> Vector2D Double 
+    ( brush, f, f' ) = case crv of
+      LineTo    { curveEnd = NextPoint sp1 }
+        | let
+            p1 :: Point2D Double
+            p1 = coords sp1
+            tgt :: Vector2D Double
+            tgt = p0 --> p1
+            brush1 :: Double -> SplinePts Closed
+            brush1 t = brushFn ( lerp @diffParams t ( ptParams sp0 ) ( ptParams sp1 ) )
+        -> ( brush1, \ t -> lerp @( Vector2D Double ) t p0 p1, const tgt )
+      Bezier2To { controlPoint = sp1, curveEnd = NextPoint sp2 }
+        | let
+            p1, p2 :: Point2D Double
+            p1 = coords sp1
+            p2 = coords sp2
+            bez :: Quadratic.Bezier ( Point2D Double )
+            bez = Quadratic.Bezier {..}
+            brush2 :: Double -> SplinePts Closed
+            brush2 t =
+              brushFn $
+                Quadratic.bezier @diffParams
+                  ( Quadratic.Bezier ( ptParams sp0 ) ( ptParams sp1 ) ( ptParams sp2 ) ) t
+        -> ( brush2, Quadratic.bezier @( Vector2D Double ) bez, Quadratic.bezier' bez )
+      Bezier3To { controlPoint1 = sp1, controlPoint2 = sp2, curveEnd = NextPoint sp3 }
+        | let
+            p1, p2, p3 :: Point2D Double
+            p1 = coords sp1
+            p2 = coords sp2
+            p3 = coords sp3
+            bez :: Cubic.Bezier ( Point2D Double )
+            bez = Cubic.Bezier {..}
+            brush3 :: Double -> SplinePts Closed
+            brush3 t =
+              brushFn $
+                Cubic.bezier @diffParams
+                  ( Cubic.Bezier ( ptParams sp0 ) ( ptParams sp1 ) ( ptParams sp2 ) ( ptParams sp3 ) ) t
+        -> ( brush3, Cubic.bezier @( Vector2D Double ) bez, Cubic.bezier' bez )
+    fwd, bwd :: Double -> ( Point2D Double, Vector2D Double )
+    fwd t
+      = ( off t
+        , if squaredNorm offTgt < epsilon then f' t else offTgt
+        )
+      where
+        off :: Double -> Point2D Double
+        off u = offset ( withTangent ( f' u ) ( brush u ) ) • f u
+        offTgt :: Vector2D Double
+        offTgt
+          | t < 0.5
+          = 1e9 *^ ( off t --> off (t + 1e-9) )
+          | otherwise
+          = 1e9 *^ ( off (t - 1e-9) --> off t )
+    bwd t
+      = ( off s
+        , if squaredNorm offTgt < epsilon then (-1) *^ f' s else offTgt
+        )
+      where
+        s :: Double
+        s = 1 - t
+        off :: Double -> Point2D Double
+        off u = offset ( withTangent ( (-1) *^ f' u ) ( brush u ) ) • f u
+        offTgt :: Vector2D Double
+        offTgt
+          | s < 0.5
+          = 1e9 *^ ( off s --> off (s + 1e-9) )
+          | otherwise
+          = 1e9 *^ ( off (s - 1e-9) --> off s )
+  in ( fwd, bwd )
 
 -----------------------------------
 -- Various utility functions