handle brush corners

2024-11-05 14:53:37 +00:00 · 2024-11-02 10:57:04 +01:00 · 2024-11-02 10:57:04 +01:00 · 197adec8d0
parent 7a82470db9
commit 197adec8d0
13 changed files with 852 additions and 552 deletions
--- a/brush-strokes/src/lib/Calligraphy/Brushes.hs
+++ b/brush-strokes/src/lib/Calligraphy/Brushes.hs
@ -1,12 +1,13 @@
-{-# LANGUAGE AllowAmbiguousTypes #-}
+{-# LANGUAGE AllowAmbiguousTypes  #-}
-{-# LANGUAGE OverloadedStrings   #-}
+{-# LANGUAGE OverloadedStrings    #-}
-{-# LANGUAGE PolyKinds           #-}
+{-# LANGUAGE PolyKinds            #-}
-{-# LANGUAGE RebindableSyntax    #-}
+{-# LANGUAGE RebindableSyntax     #-}
-{-# LANGUAGE ScopedTypeVariables #-}
+{-# LANGUAGE ScopedTypeVariables  #-}
 {-# LANGUAGE UndecidableInstances #-}
 module Calligraphy.Brushes
-  ( BrushFn, Brush(..)
+  ( BrushFn, Brush(..), Corner(..)
  , circleBrush
  , ellipseBrush
  , tearDropBrush
@ -21,19 +22,25 @@ import Data.Kind
 import GHC.Exts
  ( Proxy#, proxy# )
 import GHC.TypeNats
-  ( Nat, type (<=) )
+  ( Nat )
 -- acts
 import Data.Act
  ( Torsor((-->)) )
 -- containers
 import Data.Sequence
  ( Seq )
 import qualified Data.Sequence as Seq
-  ( empty, fromList )
+  ( empty, fromList, singleton )
 -- brush-strokes
 import Math.Algebra.Dual
 import Math.Bezier.Spline
 import Math.Differentiable
-  ( I )
+  ( I, IVness(..), SingIVness (..) )
 import Math.Interval
-  ( 𝕀, singleton, point )
+  ( 𝕀ℝ, singleton, point )
 import Math.Linear
 import Math.Module
  ( Module((^+^), (*^)) )
@ -42,28 +49,43 @@ import Math.Ring
 --------------------------------------------------------------------------------
 -- | The shape of a brush (before applying any rotation).
-type BrushFn :: forall {kd}. kd -> Nat -> Nat -> Type
+type BrushFn :: IVness -> Nat -> Nat -> Type
 type BrushFn i k nbBrushParams
  = C k ( I i nbBrushParams )
        ( Spline Closed () ( I i 2 ) )
 -- | A corner of a brush.
 type Corner :: Type -> Type
 data Corner a
  = Corner
  { cornerPoint :: a
  , cornerStartTangent, cornerEndTangent :: !( T a )
  }
  deriving stock ( Eq, Show, Functor, Foldable, Traversable )
 -- | A brush, described as a base shape + an optional rotation.
 data Brush nbBrushParams
  = Brush
-  { -- | Base brush shape, before applying any rotation (if any).
+  { -- | Base brush shape, before applying rotation (if any).
-    brushBaseShape  :: BrushFn ℝ 2 nbBrushParams
+    brushBaseShape  :: BrushFn NonIV 2 nbBrushParams
-    -- | Base brush shape, before applying any rotation (if any).
+    -- | Base brush shape, before applying rotation (if any).
-  , brushBaseShapeI :: BrushFn 𝕀 3 nbBrushParams
+  , brushBaseShapeI :: BrushFn IsIV  3 nbBrushParams
    -- | Brush corners, before applying rotation (if any).
  , brushCorners   :: Seq ( C 2 ( ℝ nbBrushParams ) ( Corner ( I NonIV 2 ) ) )
    -- | Brush corners, before applying rotation (if any).
  , brushCornersI  :: Seq ( C 3 ( 𝕀ℝ nbBrushParams ) ( Corner ( I IsIV 2 ) ) )
    -- | Optional rotation angle function
    -- (assumed to be a linear function).
-  , mbRotation      :: Maybe ( ℝ nbBrushParams -> Double )
+  , mbRotation     :: Maybe ( ℝ nbBrushParams -> Double )
  }
 --------------------------------------------------------------------------------
 -- Brushes
 -- Some convenience type synonyms for brush types... a bit horrible
-type ParamsICt :: Nat -> k -> Nat -> Constraint
+type ParamsICt :: Nat -> IVness -> Nat -> Constraint
 type ParamsICt k i nbParams =
    ( Module
       ( D k nbParams ( I i Double ) )
@ -79,8 +101,10 @@ type ParamsICt k i nbParams =
 circleBrush :: Brush 1
 circleBrush =
  Brush
-    { brushBaseShape  = circleBrushFn @ℝ @2 @1 proxy# id id
+    { brushBaseShape  = circleBrushFn @2 SNonIV
-    , brushBaseShapeI = circleBrushFn @𝕀 @3 @1 proxy# singleton point
+    , brushBaseShapeI = circleBrushFn @3 SIsIV
    , brushCorners    = Seq.empty
    , brushCornersI   = Seq.empty
    , mbRotation      = Nothing
    }
@ -88,8 +112,10 @@ circleBrush =
 ellipseBrush :: Brush 3
 ellipseBrush =
  Brush
-    { brushBaseShape  = ellipseBrushFn @ℝ @2 @3 proxy# id id
+    { brushBaseShape  = ellipseBrushFn @2 SNonIV
-    , brushBaseShapeI = ellipseBrushFn @𝕀 @3 @3 proxy# singleton point
+    , brushBaseShapeI = ellipseBrushFn @3 SIsIV
    , brushCorners    = Seq.empty
    , brushCornersI   = Seq.empty
    , mbRotation      = Just ( `index` ( Fin 3 ) )
    }
@ -97,11 +123,24 @@ ellipseBrush =
 tearDropBrush :: Brush 3
 tearDropBrush =
  Brush
-    { brushBaseShape  = tearDropBrushFn @ℝ @2 @3 proxy# id id
+    { brushBaseShape  = tearDropBrushFn @2 SNonIV
-    , brushBaseShapeI = tearDropBrushFn @𝕀 @3 @3 proxy# singleton point
+    , brushBaseShapeI = tearDropBrushFn @3 SIsIV
    , brushCorners    = Seq.singleton $ tearDropCorner @2 proxy# SNonIV
    , brushCornersI   = Seq.singleton $ tearDropCorner @3 proxy# SIsIV
    , mbRotation      = Just ( `index` ( Fin 3 ) )
    }
 --------------------------------------------------------------------------------
 type SplineFn k i nbParams
  =  SingIVness i
  -> C k ( I i nbParams ) ( Spline 'Closed () ( I i 2 ) )
 type CornerFn k i nbParams
  =  Proxy# k
  -> SingIVness i
  -> C k ( I i nbParams ) ( Corner ( I i 2 ) )
 --------------------------------------------------------------------------------
 -- Circle & ellipse
@ -128,15 +167,24 @@ circleSpline p = sequenceA $
        Bezier3To ( p  κ -1 ) ( p  1 -κ ) BackToStart ()
 {-# INLINE circleSpline #-}
-circleBrushFn :: forall {t} (i :: t) k nbParams
+mkI1 :: SingIVness i -> Double -> I i Double
-              . ( 1 <= nbParams
+mkI1 = \case
-                , ParamsICt k i nbParams
+  SNonIV -> id
-                )
+  SIsIV  -> singleton
-              => Proxy# i
+{-# INLINE mkI1 #-}
-              -> ( Double -> I i Double )
+
-              -> ( I ℝ 2 -> I i 2 )
+mkI2 :: SingIVness i -> ℝ 2 -> I i 2
-              -> C k ( I i nbParams ) ( Spline 'Closed () ( I i 2 ) )
+mkI2 = \case
-circleBrushFn _ mkI1 mkI2 =
+  SNonIV -> id
  SIsIV  -> point
 {-# INLINE mkI2 #-}
 circleBrushFn :: forall k i nbParams
              .  ( nbParams ~ 1
                 , ParamsICt k i nbParams
                 )
              => SplineFn k i nbParams
 circleBrushFn ivness =
  D \ params ->
    let r :: D k nbParams ( I i Double )
        r = runD ( var @_ @k $ Fin 1 ) params
@ -147,22 +195,20 @@ circleBrushFn _ mkI1 mkI2 =
    in circleSpline mkPt
  where
    e_x, e_y :: D k nbParams ( I i 2 )
-    e_x = pure $ mkI2 $ ℝ2 1 0
+    e_x = pure $ mkI2 ivness $ ℝ2 1 0
-    e_y = pure $ mkI2 $ ℝ2 0 1
+    e_y = pure $ mkI2 ivness $ ℝ2 0 1
    scaledBy :: D k nbParams ( I i Double ) -> Double -> D k nbParams ( I i Double )
-    scaledBy d x = fmap ( mkI1 x * ) d
+    scaledBy d x = fmap ( mkI1 ivness x * ) d
-{-# INLINEABLE circleBrushFn #-}
+{-# SPECIALISE circleBrushFn :: SplineFn 2 NonIV 1 #-}
 {-# SPECIALISE circleBrushFn :: SplineFn 3 IsIV  1 #-}
-ellipseBrushFn :: forall {t} (i :: t) k nbParams
+ellipseBrushFn :: forall k i nbParams
-               . ( 3 <= nbParams
+               .  ( nbParams ~ 3
-                 , ParamsICt k i nbParams
+                  , ParamsICt k i nbParams
-                 )
+                  )
-                => Proxy# i
+               => SplineFn k i nbParams
-                -> ( Double -> I i Double )
+ellipseBrushFn ivness =
                -> ( I ℝ 2 -> I i 2 )
                -> C k ( I i nbParams ) ( Spline 'Closed () ( I i 2 ) )
 ellipseBrushFn _ mkI1 mkI2 =
  D \ params ->
    let a, b :: D k nbParams ( I i Double )
        a = runD ( var @_ @k $ Fin 1 ) params
@ -175,12 +221,13 @@ ellipseBrushFn _ mkI1 mkI2 =
    in circleSpline mkPt
  where
    e_x, e_y :: D k nbParams ( I i 2 )
-    e_x = pure $ mkI2 $ ℝ2 1 0
+    e_x = pure $ mkI2 ivness $ ℝ2 1 0
-    e_y = pure $ mkI2 $ ℝ2 0 1
+    e_y = pure $ mkI2 ivness $ ℝ2 0 1
    scaledBy :: D k nbParams ( I i Double ) -> Double -> D k nbParams ( I i Double )
-    scaledBy d x = fmap ( mkI1 x * ) d
+    scaledBy d x = fmap ( mkI1 ivness x * ) d
-{-# INLINEABLE ellipseBrushFn #-}
+{-# SPECIALISE ellipseBrushFn :: SplineFn 2 NonIV 3 #-}
 {-# SPECIALISE ellipseBrushFn :: SplineFn 3 IsIV  3 #-}
 --------------------------------------------------------------------------------
 -- Tear drop
@ -202,15 +249,12 @@ tearHeight = 3 * sqrt 3 / 8
 sqrt3_over_2 :: Double
 sqrt3_over_2 = 0.5 * sqrt 3
-tearDropBrushFn :: forall {t} (i :: t) k nbParams
+tearDropBrushFn :: forall k i nbParams
-                . ( 3 <= nbParams
+                .  ( nbParams ~ 3
-                  , ParamsICt k i nbParams
+                   , ParamsICt k i nbParams
-                  )
+                   )
-                 => Proxy# i
+                => SplineFn k i nbParams
-                 -> ( Double -> I i Double )
+tearDropBrushFn ivness =
                 -> ( I ℝ 2 -> I i 2 )
                 -> C k ( I i nbParams ) ( Spline 'Closed () ( I i 2 ) )
 tearDropBrushFn _ mkI1 mkI2 =
  D \ params ->
    let w, h :: D k nbParams ( I i Double )
        w = 2 * runD ( var @_ @k ( Fin 1 ) ) params
@ -233,9 +277,41 @@ tearDropBrushFn _ mkI1 mkI2 =
                    BackToStart () }
  where
    e_x, e_y :: D k nbParams ( I i 2 )
-    e_x = pure $ mkI2 $ ℝ2 1 0
+    e_x = pure $ mkI2 ivness $ ℝ2 1 0
-    e_y = pure $ mkI2 $ ℝ2 0 1
+    e_y = pure $ mkI2 ivness $ ℝ2 0 1
    scaledBy :: D k nbParams ( I i Double ) -> Double -> D k nbParams ( I i Double )
-    scaledBy d x = fmap ( mkI1 x * ) d
+    scaledBy d x = fmap ( mkI1 ivness x * ) d
-{-# INLINEABLE tearDropBrushFn #-}
+{-# SPECIALISE tearDropBrushFn :: SplineFn 2 NonIV 3 #-}
 {-# SPECIALISE tearDropBrushFn :: SplineFn 3 IsIV  3 #-}
 tearDropCorner :: forall k i nbParams. ( nbParams ~ 3, ParamsICt k i nbParams, Torsor ( T ( I i 2 ) ) ( I i 2 ) ) => CornerFn k i nbParams
 tearDropCorner _ ivness =
  D \ params ->
    let w, h :: D k nbParams ( I i Double )
        w = 2 * runD ( var @_ @k ( Fin 1 ) ) params
        h = 2 * runD ( var @_ @k ( Fin 2 ) ) params
        mkPt :: Double -> Double -> D k nbParams ( I i 2 )
        mkPt x y
          -- 1. translate the teardrop so that the centre of mass is at the origin
          -- 2. scale the teardrop so that it has the requested width/height
          -- 3. rotate (done separately)
          = let !x' = w `scaledBy` ( x / tearWidth )
                !y' = h `scaledBy` ( ( y - tearCenter ) / tearHeight )
            in x' *^ e_x ^+^ y' *^ e_y
        !cornerPoint = mkPt 0 0
    in sequenceA $
         Corner
          { cornerPoint
          , cornerStartTangent = T $ liftA2 ( \ x y -> unT $ x --> y ) ( mkPt -0.5 sqrt3_over_2 ) cornerPoint
          , cornerEndTangent   = T $ liftA2 ( \ x y -> unT $ x --> y ) cornerPoint ( mkPt 0.5 sqrt3_over_2 )
          }
  where
    e_x, e_y :: D k nbParams ( I i 2 )
    e_x = pure $ mkI2 ivness $ ℝ2 1 0
    e_y = pure $ mkI2 ivness $ ℝ2 0 1
    scaledBy :: D k nbParams ( I i Double ) -> Double -> D k nbParams ( I i Double )
    scaledBy d x = fmap ( mkI1 ivness x * ) d
 {-# SPECIALISE tearDropCorner :: CornerFn 2 NonIV 3 #-}
 {-# SPECIALISE tearDropCorner :: CornerFn 3 IsIV  3 #-}
--- a/brush-strokes/src/lib/Math/Algebra/Dual.hs
+++ b/brush-strokes/src/lib/Math/Algebra/Dual.hs
@ -9,12 +9,15 @@
 module Math.Algebra.Dual
  ( C(..), D, Dim
  , Differential(..)
  , HasChainRule(..), chainRule
  , uncurryD2, uncurryD3
  , linear, fun, var
  , chainRuleN1Q, chainRule1NQ
  , DiffModule(..)
  , D𝔸0(..)
  , D1𝔸1(..), D2𝔸1(..), D3𝔸1(..)
  , D1𝔸2(..), D2𝔸2(..), D3𝔸2(..)
@ -30,7 +33,7 @@ import Prelude
 import Data.Coerce
  ( coerce )
 import Data.Kind
-  ( Type )
+  ( Constraint, Type )
 import GHC.TypeNats
  ( Nat )
@ -94,18 +97,27 @@ instance ( Applicative ( D k ( Dim u ) ), Module r ( T v ) )
  T ( D f ) ^-^ T ( D g ) = T $ D \ t -> liftA2 ( coerce $ (^-^) @r @( T v ) ) ( f t ) ( g t )
  a *^ T ( D f ) = T $ D \ t -> fmap ( coerce $ (*^) @r @( T v ) a ) $ f t
 newtype DiffModule k n v = DiffModule { getDiffModule :: D k n v }
 instance ( Applicative ( D k n ), Module r ( T v ) )
       => Module r ( T ( DiffModule k n v ) ) where
  origin = T $ DiffModule $ pure $ coerce $ origin @r @( T v )
  T ( DiffModule f ) ^+^ T ( DiffModule g ) = T $ DiffModule $ liftA2 ( coerce $ (^+^) @r @( T v ) ) f g
  T ( DiffModule f ) ^-^ T ( DiffModule g ) = T $ DiffModule $  liftA2 ( coerce $ (^-^) @r @( T v ) ) f g
  a *^ T ( DiffModule f ) = T $ DiffModule $ fmap ( coerce $ (*^) @r @( T v ) a ) f
 --------------------------------------------------------------------------------
-- TODO: split up this class into the chain rule operation
+type Differential :: Nat -> Nat -> Constraint
-- and all the other operations.
+class Differential k n where
  konst   :: AbelianGroup w => w -> D k n w
  value   :: D k n w -> w
 -- | @HasChainRule r k v@ means we have a chain rule
 -- with @D k v w@ in the middle, for any @r@-module @w@.
-class HasChainRule r k v where
+class Differential k ( Dim v ) => HasChainRule r k v where
  chain   :: Module r ( T w )
          => D k 1 v -> D k ( Dim v ) w -> D k 1 w
  konst   :: AbelianGroup w => w -> D k ( Dim v ) w
  value   :: D k ( Dim v ) w -> w
  linearD :: Module r ( T w ) => ( v -> w ) -> v -> D k ( Dim v ) w
 linear :: forall k r v w
@ -122,27 +134,24 @@ chainRule ( D df ) ( D dg ) =
  D \ x ->
    case df x of
      df_x ->
-        chain @r @k @v df_x ( dg $ value @r @k @u df_x )
+        chain @r @k @v df_x ( dg $ value @k @( Dim u ) df_x )
-
+uncurryD2 :: D 2 1 ( D 2 1 b ) -> D 2 2 b
-uncurryD2 :: Dim a ~ 1
+uncurryD2 ( D21 ( b_t0 ) ( T ( dbdt_t0 ) ) ( T ( d2bdt2_t0 ) ) ) =
-          => D 2 1 ( C 2 a b ) -> a -> D 2 2 b
+  let D21 b_t0s0      dbds_t0s0    d2bds2_t0s0 = b_t0
-uncurryD2 ( D21 ( D b_t0 ) ( T ( D dbdt_t0 ) ) ( T ( D d2bdt2_t0 ) ) ) s0 =
+      D21 dbdt_t0s0   d2bdtds_t0s0 _           = dbdt_t0
-  let D21 b_t0s0 dbds_t0s0 d2bds2_t0s0 = b_t0 s0
+      D21 d2bdt2_t0s0 _            _           = d2bdt2_t0
      D21 dbdt_t0s0 d2bdtds_t0s0 _ = dbdt_t0 s0
      D21 d2bdt2_t0s0 _ _ = d2bdt2_t0 s0
  in D22
       b_t0s0
       ( T dbdt_t0s0 ) dbds_t0s0
       ( T d2bdt2_t0s0 ) d2bdtds_t0s0 d2bds2_t0s0
-uncurryD3 :: Dim a ~ 1
+uncurryD3 :: D 3 1 ( D 3 1 b ) -> D 3 2 b
-          => D 3 1 ( C 3 a b ) -> a -> D 3 2 b
+uncurryD3 ( D31 b_t0 ( T dbdt_t0 ) ( T d2bdt2_t0 ) ( T d3bdt3_t0 ) ) =
-uncurryD3 ( D31 ( D b_t0 ) ( T ( D dbdt_t0 ) ) ( T ( D d2bdt2_t0 ) ) ( T ( D d3bdt3_t0 ) ) ) s0 =
+  let D31 b_t0s0      dbds_t0s0     d2bds2_t0s0   d3bds3_t0s0 = b_t0
-  let D31 b_t0s0 dbds_t0s0 d2bds2_t0s0 d3bds3_t0s0 = b_t0 s0
+      D31 dbdt_t0s0   d2bdtds_t0s0  d3bdtds2_t0s0 _           = dbdt_t0
-      D31 dbdt_t0s0 d2bdtds_t0s0 d3bdtds2_t0s0 _ = dbdt_t0 s0
+      D31 d2bdt2_t0s0 d3bdt2ds_t0s0 _             _           = d2bdt2_t0
-      D31 d2bdt2_t0s0 d3bdt2ds_t0s0 _ _ = d2bdt2_t0 s0
+      D31 d3bdt3_t0s0 _             _             _           = d3bdt3_t0
      D31 d3bdt3_t0s0 _ _ _ = d3bdt3_t0 s0
  in D32
       b_t0s0
       ( T dbdt_t0s0 ) dbds_t0s0
@ -150,8 +159,8 @@ uncurryD3 ( D31 ( D b_t0 ) ( T ( D dbdt_t0 ) ) ( T ( D d2bdt2_t0 ) ) ( T ( D d3b
       ( T d3bdt3_t0s0 ) d3bdt2ds_t0s0 d3bdtds2_t0s0 d3bds3_t0s0
 -- | Recover the underlying function, discarding all infinitesimal information.
-fun :: forall r k v w. HasChainRule r k v => C k v w -> ( v -> w )
+fun :: forall k v w. Differential k ( Dim v ) => C k v w -> ( v -> w )
-fun ( D df ) = value @r @k @v . df
+fun ( D df ) = value @k @( Dim v ) . df
 {-# INLINE fun #-}
 -- | The differentiable germ of a coordinate variable.
@ -216,7 +225,7 @@ instance ( Applicative ( D k ( Dim u ) )
  negate ( ApAp2 !x ) = ApAp2 $ fmap ( negate @r ) x
  -- DO NOT USE PURE!!
-  fromInteger !i = ApAp2 $ konst @Double @k @u ( fromInteger @r i )
+  fromInteger !i = ApAp2 $ konst @k @( Dim u ) ( fromInteger @r i )
 deriving newtype instance AbelianGroup r => AbelianGroup ( D𝔸0 r )
@ -498,7 +507,7 @@ deriving newtype instance Field r => Field ( D𝔸0 r )
 --instance Field r => Field ( D1𝔸3 r ) where
 --instance Field r => Field ( D1𝔸4 r ) where
 instance Field r => Field ( D2𝔸1 r ) where
-  fromRational q = konst @Double @2 @( ℝ 1 ) ( fromRational q )
+  fromRational q = konst @2 @1 ( fromRational q )
  recip df =
    let
      fromInt = fromInteger @r
@ -511,7 +520,7 @@ instance Field r => Field ( D2𝔸1 r ) where
  {-# SPECIALISE instance Field ( D2𝔸1 Double ) #-}
  {-# SPECIALISE instance Field ( D2𝔸1 𝕀 ) #-}
 instance Field r => Field ( D2𝔸2 r ) where
-  fromRational q = konst @Double @2 @( ℝ 2 ) ( fromRational q )
+  fromRational q = konst @2 @2 ( fromRational q )
  recip df =
    let
      fromInt = fromInteger @r
@ -524,7 +533,7 @@ instance Field r => Field ( D2𝔸2 r ) where
  {-# SPECIALISE instance Field ( D2𝔸2 Double ) #-}
  {-# SPECIALISE instance Field ( D2𝔸2 𝕀 ) #-}
 instance Field r => Field ( D2𝔸3 r ) where
-  fromRational q = konst @Double @2 @( ℝ 3 ) ( fromRational q )
+  fromRational q = konst @2 @3 ( fromRational q )
  recip df =
    let
      fromInt = fromInteger @r
@ -537,7 +546,7 @@ instance Field r => Field ( D2𝔸3 r ) where
  {-# SPECIALISE instance Field ( D2𝔸3 Double ) #-}
  {-# SPECIALISE instance Field ( D2𝔸3 𝕀 ) #-}
 instance Field r => Field ( D2𝔸4 r ) where
-  fromRational q = konst @Double @2 @( ℝ 4 ) ( fromRational q )
+  fromRational q = konst @2 @4 ( fromRational q )
  recip df =
    let
      fromInt = fromInteger @r
@ -550,7 +559,7 @@ instance Field r => Field ( D2𝔸4 r ) where
  {-# SPECIALISE instance Field ( D2𝔸4 Double ) #-}
  {-# SPECIALISE instance Field ( D2𝔸4 𝕀 ) #-}
 instance Field r => Field ( D3𝔸1 r ) where
-  fromRational q = konst @Double @3 @( ℝ 1 ) ( fromRational q )
+  fromRational q = konst @3 @1 ( fromRational q )
  recip df =
    let
      fromInt = fromInteger @r
@ -563,7 +572,7 @@ instance Field r => Field ( D3𝔸1 r ) where
  {-# SPECIALISE instance Field ( D3𝔸1 Double ) #-}
  {-# SPECIALISE instance Field ( D3𝔸1 𝕀 ) #-}
 instance Field r => Field ( D3𝔸2 r ) where
-  fromRational q = konst @Double @3 @( ℝ 2 ) ( fromRational q )
+  fromRational q = konst @3 @2 ( fromRational q )
  recip df =
    let
      fromInt = fromInteger @r
@ -576,7 +585,7 @@ instance Field r => Field ( D3𝔸2 r ) where
  {-# SPECIALISE instance Field ( D3𝔸2 Double ) #-}
  {-# SPECIALISE instance Field ( D3𝔸2 𝕀 ) #-}
 instance Field r => Field ( D3𝔸3 r ) where
-  fromRational q = konst @Double @3 @( ℝ 3 ) ( fromRational q )
+  fromRational q = konst @3 @3 ( fromRational q )
  recip df =
    let
      fromInt = fromInteger @r
@ -589,7 +598,7 @@ instance Field r => Field ( D3𝔸3 r ) where
  {-# SPECIALISE instance Field ( D3𝔸3 Double ) #-}
  {-# SPECIALISE instance Field ( D3𝔸3 𝕀 ) #-}
 instance Field r => Field ( D3𝔸4 r ) where
-  fromRational q = konst @Double @3 @( ℝ 4 ) ( fromRational q )
+  fromRational q = konst @3 @4 ( fromRational q )
  recip df =
    let
      fromInt = fromInteger @r
@ -786,7 +795,7 @@ deriving newtype instance Transcendental r => Transcendental ( D𝔸0 r )
 --instance Transcendental r => Transcendental ( D1𝔸3 r ) where
 --instance Transcendental r => Transcendental ( D1𝔸4 r ) where
 instance Transcendental r => Transcendental ( D2𝔸1 r ) where
-  pi = konst @Double @2 @( ℝ 1 ) pi
+  pi = konst @2 @1 pi
  sin df =
    let
      fromInt = fromInteger @r
@ -817,7 +826,7 @@ instance Transcendental r => Transcendental ( D2𝔸1 r ) where
  {-# SPECIALISE instance Transcendental ( D2𝔸1 Double ) #-}
  {-# SPECIALISE instance Transcendental ( D2𝔸1 𝕀 ) #-}
 instance Transcendental r => Transcendental ( D2𝔸2 r ) where
-  pi = konst @Double @2 @( ℝ 2 ) pi
+  pi = konst @2 @2 pi
  sin df =
    let
      fromInt = fromInteger @r
@ -848,7 +857,7 @@ instance Transcendental r => Transcendental ( D2𝔸2 r ) where
  {-# SPECIALISE instance Transcendental ( D2𝔸2 Double ) #-}
  {-# SPECIALISE instance Transcendental ( D2𝔸2 𝕀 ) #-}
 instance Transcendental r => Transcendental ( D2𝔸3 r ) where
-  pi = konst @Double @2 @( ℝ 3 ) pi
+  pi = konst @2 @3 pi
  sin df =
    let
      fromInt = fromInteger @r
@ -880,7 +889,7 @@ instance Transcendental r => Transcendental ( D2𝔸3 r ) where
  {-# SPECIALISE instance Transcendental ( D2𝔸3 𝕀 ) #-}
 instance Transcendental r => Transcendental ( D2𝔸4 r ) where
-  pi = konst @Double @2 @( ℝ 4 ) pi
+  pi = konst @2 @4 pi
  sin df =
    let
      fromInt = fromInteger @r
@ -912,7 +921,7 @@ instance Transcendental r => Transcendental ( D2𝔸4 r ) where
  {-# SPECIALISE instance Transcendental ( D2𝔸4 𝕀 ) #-}
 instance Transcendental r => Transcendental ( D3𝔸1 r ) where
-  pi = konst @Double @3 @( ℝ 1 ) pi
+  pi = konst @3 @1 pi
  sin df =
    let
      fromInt = fromInteger @r
@ -944,7 +953,7 @@ instance Transcendental r => Transcendental ( D3𝔸1 r ) where
  {-# SPECIALISE instance Transcendental ( D3𝔸1 𝕀 ) #-}
 instance Transcendental r => Transcendental ( D3𝔸2 r ) where
-  pi = konst @Double @3 @( ℝ 2 ) pi
+  pi = konst @3 @2 pi
  sin df =
    let
      fromInt = fromInteger @r
@ -976,7 +985,7 @@ instance Transcendental r => Transcendental ( D3𝔸2 r ) where
  {-# SPECIALISE instance Transcendental ( D3𝔸2 𝕀 ) #-}
 instance Transcendental r => Transcendental ( D3𝔸3 r ) where
-  pi = konst @Double @3 @( ℝ 3 ) pi
+  pi = konst @3 @3 pi
  sin df =
    let
      fromInt = fromInteger @r
@ -1008,7 +1017,7 @@ instance Transcendental r => Transcendental ( D3𝔸3 r ) where
  {-# SPECIALISE instance Transcendental ( D3𝔸3 𝕀 ) #-}
 instance Transcendental r => Transcendental ( D3𝔸4 r ) where
-  pi = konst @Double @3 @( ℝ 4 ) pi
+  pi = konst @3 @4 pi
  sin df =
    let
      fromInt = fromInteger @r
@ -1042,35 +1051,41 @@ instance Transcendental r => Transcendental ( D3𝔸4 r ) where
 --------------------------------------------------------------------------------
 -- HasChainRule instances.
 instance Differential 2 0 where
  konst w = D0 w
  value ( D0 v ) = v
  {-# INLINEABLE konst #-}
  {-# INLINEABLE value #-}
 instance HasChainRule Double 2 ( ℝ 0 ) where
  konst w = D0 w
  linearD f v = D0 ( f v )
  value ( D0 v ) = v
  chain _ ( D0 gfx ) = D21 gfx origin origin
  {-# INLINEABLE konst #-}
  {-# INLINEABLE linearD #-}
  {-# INLINEABLE value #-}
  {-# INLINEABLE chain #-}
-instance HasChainRule Double 3 ( ℝ 0 ) where
+instance Differential 3 0 where
  konst w = D0 w
-  linearD f v = D0 ( f v )
+
  value ( D0 v ) = v
  chain _ ( D0 gfx ) = D31 gfx origin origin origin
  {-# INLINEABLE konst #-}
-  {-# INLINEABLE linearD #-}
+
  {-# INLINEABLE value #-}
 instance HasChainRule Double 3 ( ℝ 0 ) where
  linearD f v = D0 ( f v )
  chain _ ( D0 gfx ) = D31 gfx origin origin origin
  {-# INLINEABLE linearD #-}
  {-# INLINEABLE chain #-}
-instance HasChainRule Double 2 ( ℝ 1 ) where
+instance Differential 2 1 where
  konst   :: forall w. AbelianGroup w => w -> D2𝔸1 w
  konst w =
    let !o = fromInteger @w 0
    in $$( monTabulateQ \ mon -> if isZeroMonomial mon then [|| w ||] else [|| o ||] )
  value df = $$( monIndexQ [|| df ||] zeroMonomial )
-
+  {-# INLINEABLE konst #-}
  {-# INLINEABLE value #-}
 instance HasChainRule Double 2 ( ℝ 1 ) where
  linearD :: forall w. Module Double ( T w ) => ( ℝ 1 -> w ) -> ℝ 1 -> D2𝔸1 w
  linearD f v =
    let !o = origin @Double @( T w )
@ -1087,7 +1102,6 @@ instance HasChainRule Double 2 ( ℝ 1 ) where
                 | otherwise
                 -> [|| unT o ||]
         )
  chain :: forall w. Module Double ( T w ) => D2𝔸1 ( ℝ 1 ) -> D2𝔸1 w -> D2𝔸1 w
  chain !df !dg =
    let !o = origin @Double @( T w )
@ -1096,20 +1110,28 @@ instance HasChainRule Double 2 ( ℝ 1 ) where
    in $$( chainRule1NQ
         [|| o ||] [|| p ||] [|| s ||]
         [|| df ||] [|| dg ||] )
  {-# INLINEABLE konst #-}
  {-# INLINEABLE linearD #-}
  {-# INLINEABLE value #-}
  {-# INLINEABLE chain #-}
-instance HasChainRule Double 3 ( ℝ 1 ) where
+instance Differential 3 1 where
  konst   :: forall w. AbelianGroup w => w -> D3𝔸1 w
  konst w =
    let !o = fromInteger @w 0
    in $$( monTabulateQ \ mon -> if isZeroMonomial mon then [|| w ||] else [|| o ||] )
  value df = $$( monIndexQ [|| df ||] zeroMonomial )
  {-# INLINEABLE konst #-}
  {-# INLINEABLE value #-}
 instance HasChainRule Double 3 ( ℝ 1 ) where
  chain :: forall w. Module Double ( T w ) => D3𝔸1 ( ℝ 1 ) -> D3𝔸1 w -> D3𝔸1 w
  chain !df !dg =
    let !o = origin @Double @( T w )
        !p = (^+^)  @Double @( T w )
        !s = (^*)   @Double @( T w )
    in $$( chainRule1NQ
         [|| o ||] [|| p ||] [|| s ||]
         [|| df ||] [|| dg ||] )
  linearD :: forall w. Module Double ( T w ) => ( ℝ 1 -> w ) -> ℝ 1 -> D3𝔸1 w
  linearD f v =
    let !o = origin @Double @( T w )
@ -1126,29 +1148,19 @@ instance HasChainRule Double 3 ( ℝ 1 ) where
                 | otherwise
                 -> [|| unT o ||]
         )
  chain :: forall w. Module Double ( T w ) => D3𝔸1 ( ℝ 1 ) -> D3𝔸1 w -> D3𝔸1 w
  chain !df !dg =
    let !o = origin @Double @( T w )
        !p = (^+^)  @Double @( T w )
        !s = (^*)   @Double @( T w )
    in $$( chainRule1NQ
         [|| o ||] [|| p ||] [|| s ||]
         [|| df ||] [|| dg ||] )
  {-# INLINEABLE konst #-}
  {-# INLINEABLE linearD #-}
  {-# INLINEABLE value #-}
  {-# INLINEABLE chain #-}
-instance HasChainRule Double 2 ( ℝ 2 ) where
+instance Differential 2 2 where
  konst   :: forall w. AbelianGroup w => w -> D2𝔸2 w
  konst w =
    let !o = fromInteger @w 0
    in $$( monTabulateQ \ mon -> if isZeroMonomial mon then [|| w ||] else [|| o ||] )
  value df = $$( monIndexQ [|| df ||] zeroMonomial )
-
+  {-# INLINEABLE konst #-}
  {-# INLINEABLE value #-}
 instance HasChainRule Double 2 ( ℝ 2 ) where
  linearD :: forall w. Module Double ( T w ) => ( ℝ 2 -> w ) -> ℝ 2 -> D2𝔸2 w
  linearD f v =
    let !o = origin @Double @( T w )
@ -1165,7 +1177,6 @@ instance HasChainRule Double 2 ( ℝ 2 ) where
                 | otherwise
                 -> [|| unT o ||]
         )
  chain :: forall w. Module Double ( T w ) => D2𝔸1 ( ℝ 2 ) -> D2𝔸2 w -> D2𝔸1 w
  chain !df !dg =
    let !o = origin @Double @( T w )
@ -1174,20 +1185,19 @@ instance HasChainRule Double 2 ( ℝ 2 ) where
    in $$( chainRule1NQ
         [|| o ||] [|| p ||] [|| s ||]
         [|| df ||] [|| dg ||] )
  {-# INLINEABLE konst #-}
  {-# INLINEABLE linearD #-}
  {-# INLINEABLE value #-}
  {-# INLINEABLE chain #-}
-instance HasChainRule Double 3 ( ℝ 2 ) where
+instance Differential 3 2 where
  konst   :: forall w. AbelianGroup w => w -> D3𝔸2 w
  konst w =
    let !o = fromInteger @w 0
    in $$( monTabulateQ \ mon -> if isZeroMonomial mon then [|| w ||] else [|| o ||] )
  value df = $$( monIndexQ [|| df ||] zeroMonomial )
-
+  {-# INLINEABLE konst #-}
  {-# INLINEABLE value #-}
 instance HasChainRule Double 3 ( ℝ 2 ) where
  linearD :: forall w. Module Double ( T w ) => ( ℝ 2 -> w ) -> ℝ 2 -> D3𝔸2 w
  linearD f v =
    let !o = origin @Double @( T w )
@ -1204,7 +1214,6 @@ instance HasChainRule Double 3 ( ℝ 2 ) where
                 | otherwise
                 -> [|| unT o ||]
         )
  chain :: forall w. Module Double ( T w ) => D3𝔸1 ( ℝ 2 ) -> D3𝔸2 w -> D3𝔸1 w
  chain !df !dg =
    let !o = origin @Double @( T w )
@ -1213,20 +1222,19 @@ instance HasChainRule Double 3 ( ℝ 2 ) where
    in $$( chainRule1NQ
         [|| o ||] [|| p ||] [|| s ||]
         [|| df ||] [|| dg ||] )
  {-# INLINEABLE konst #-}
  {-# INLINEABLE linearD #-}
  {-# INLINEABLE value #-}
  {-# INLINEABLE chain #-}
-instance HasChainRule Double 2 ( ℝ 3 ) where
+instance Differential 2 3 where
  konst   :: forall w. AbelianGroup w => w -> D2𝔸3 w
  konst w =
    let !o = fromInteger @w 0
    in $$( monTabulateQ \ mon -> if isZeroMonomial mon then [|| w ||] else [|| o ||] )
  value df = $$( monIndexQ [|| df ||] zeroMonomial )
-
+  {-# INLINEABLE konst #-}
  {-# INLINEABLE value #-}
 instance HasChainRule Double 2 ( ℝ 3 ) where
  linearD :: forall w. Module Double ( T w ) => ( ℝ 3 -> w ) -> ℝ 3 -> D2𝔸3 w
  linearD f v =
    let !o = origin @Double @( T w )
@ -1243,7 +1251,6 @@ instance HasChainRule Double 2 ( ℝ 3 ) where
                 | otherwise
                 -> [|| unT o ||]
         )
  chain :: forall w. Module Double ( T w ) => D2𝔸1 ( ℝ 3 ) -> D2𝔸3 w -> D2𝔸1 w
  chain !df !dg =
    let !o = origin @Double @( T w )
@ -1252,20 +1259,19 @@ instance HasChainRule Double 2 ( ℝ 3 ) where
    in $$( chainRule1NQ
         [|| o ||] [|| p ||] [|| s ||]
         [|| df ||] [|| dg ||] )
  {-# INLINEABLE konst #-}
  {-# INLINEABLE linearD #-}
  {-# INLINEABLE value #-}
  {-# INLINEABLE chain #-}
-instance HasChainRule Double 3 ( ℝ 3 ) where
+instance Differential 3 3 where
  konst   :: forall w. AbelianGroup w => w -> D3𝔸3 w
  konst w =
    let !o = fromInteger @w 0
    in $$( monTabulateQ \ mon -> if isZeroMonomial mon then [|| w ||] else [|| o ||] )
  value df = $$( monIndexQ [|| df ||] zeroMonomial )
-
+  {-# INLINEABLE konst #-}
  {-# INLINEABLE value #-}
 instance HasChainRule Double 3 ( ℝ 3 ) where
  linearD :: forall w. Module Double ( T w ) => ( ℝ 3 -> w ) -> ℝ 3 -> D3𝔸3 w
  linearD f v =
    let !o = origin @Double @( T w )
@ -1282,7 +1288,6 @@ instance HasChainRule Double 3 ( ℝ 3 ) where
                 | otherwise
                 -> [|| unT o ||]
         )
  chain :: forall w. Module Double ( T w ) => D3𝔸1 ( ℝ 3 ) -> D3𝔸3 w -> D3𝔸1 w
  chain !df !dg =
    let !o = origin @Double @( T w )
@ -1291,20 +1296,20 @@ instance HasChainRule Double 3 ( ℝ 3 ) where
    in $$( chainRule1NQ
         [|| o ||] [|| p ||] [|| s ||]
         [|| df ||] [|| dg ||] )
  {-# INLINEABLE konst #-}
  {-# INLINEABLE linearD #-}
  {-# INLINEABLE value #-}
  {-# INLINEABLE chain #-}
  {-# INLINEABLE linearD #-}
-instance HasChainRule Double 2 ( ℝ 4 ) where
+instance Differential 2 4 where
  konst   :: forall w. AbelianGroup w => w -> D2𝔸4 w
  konst w =
    let !o = fromInteger @w 0
    in $$( monTabulateQ \ mon -> if isZeroMonomial mon then [|| w ||] else [|| o ||] )
  value df = $$( monIndexQ [|| df ||] zeroMonomial )
  {-# INLINEABLE konst #-}
  {-# INLINEABLE value #-}
 instance HasChainRule Double 2 ( ℝ 4 ) where
  linearD :: forall w. Module Double ( T w ) => ( ℝ 4 -> w ) -> ℝ 4 -> D2𝔸4 w
  linearD f v =
    let !o = origin @Double @( T w )
@ -1321,7 +1326,6 @@ instance HasChainRule Double 2 ( ℝ 4 ) where
                 | otherwise
                 -> [|| unT o ||]
         )
  chain :: forall w. Module Double ( T w ) => D2𝔸1 ( ℝ 4 ) -> D2𝔸4 w -> D2𝔸1 w
  chain !df !dg =
    let !o = origin @Double @( T w )
@ -1330,20 +1334,19 @@ instance HasChainRule Double 2 ( ℝ 4 ) where
    in $$( chainRule1NQ
         [|| o ||] [|| p ||] [|| s ||]
         [|| df ||] [|| dg ||] )
  {-# INLINEABLE konst #-}
  {-# INLINEABLE linearD #-}
  {-# INLINEABLE value #-}
  {-# INLINEABLE chain #-}
-instance HasChainRule Double 3 ( ℝ 4 ) where
+instance Differential 3 4 where
  konst   :: forall w. AbelianGroup w => w -> D3𝔸4 w
  konst w =
    let !o = fromInteger @w 0
    in $$( monTabulateQ \ mon -> if isZeroMonomial mon then [|| w ||] else [|| o ||] )
  value df = $$( monIndexQ [|| df ||] zeroMonomial )
-
+  {-# INLINEABLE konst #-}
  {-# INLINEABLE value #-}
 instance HasChainRule Double 3 ( ℝ 4 ) where
  linearD :: forall w. Module Double ( T w ) => ( ℝ 4 -> w ) -> ℝ 4 -> D3𝔸4 w
  linearD f v =
    let !o = origin @Double @( T w )
@ -1360,7 +1363,6 @@ instance HasChainRule Double 3 ( ℝ 4 ) where
                 | otherwise
                 -> [|| unT o ||]
         )
  chain :: forall w. Module Double ( T w ) => D3𝔸1 ( ℝ 4 ) -> D3𝔸4 w -> D3𝔸1 w
  chain !df !dg =
    let !o = origin @Double @( T w )
@ -1369,7 +1371,5 @@ instance HasChainRule Double 3 ( ℝ 4 ) where
    in $$( chainRule1NQ
         [|| o ||] [|| p ||] [|| s ||]
         [|| df ||] [|| dg ||] )
  {-# INLINEABLE konst #-}
  {-# INLINEABLE linearD #-}
  {-# INLINEABLE value #-}
  {-# INLINEABLE chain #-}
--- a/brush-strokes/src/lib/Math/Algebra/Dual/Internal.hs
+++ b/brush-strokes/src/lib/Math/Algebra/Dual/Internal.hs
@ -312,6 +312,19 @@ instance MonomialBasisQ D1𝔸1 where
    Mon ( Vec [ 1 ] ) -> [|| unT $ _D11_dx   $$d ||]
    _                 -> [||       _D11_v    $$d ||]
 instance MonomialBasis D1𝔸1 where
  monTabulate f =
    let
      _D11_v    =     f $ Mon ( Vec [ 0 ] )
      _D11_dx   = T $ f $ Mon ( Vec [ 1 ] )
    in D11 { .. }
  {-# INLINE monTabulate #-}
  monIndex d = \ case
    Mon ( Vec [ 1 ] ) -> unT $ _D11_dx d
    _                 ->       _D11_v  d
  {-# INLINE monIndex #-}
 type instance Deg  D2𝔸1 = 2
 type instance Vars D2𝔸1 = 1
 instance MonomialBasisQ D2𝔸1 where
--- a/brush-strokes/src/lib/Math/Bezier/Cubic/Fit.hs
+++ b/brush-strokes/src/lib/Math/Bezier/Cubic/Fit.hs
@ -99,6 +99,8 @@ data FitPoint
    { fitPoint   :: !( ℝ 2 )
    , fitTangent :: !( T ( ℝ 2 ) )
    }
  | JoinPoint
    { joinPoint :: !( ℝ 2 ) }
  deriving stock    ( Show, Generic )
  deriving anyclass NFData
--- a/brush-strokes/src/lib/Math/Bezier/Stroke.hs
+++ b/brush-strokes/src/lib/Math/Bezier/Stroke.hs
@ -1,4 +1,5 @@
 {-# LANGUAGE AllowAmbiguousTypes   #-}
 {-# LANGUAGE PartialTypeSignatures #-}
 {-# LANGUAGE PolyKinds             #-}
 {-# LANGUAGE ScopedTypeVariables   #-}
@ -51,9 +52,9 @@ import Data.List.NonEmpty
  ( NonEmpty )
 import qualified Data.List.NonEmpty as NE
 import Data.Maybe
-  ( catMaybes, fromMaybe, isJust, listToMaybe, mapMaybe )
+  ( catMaybes, fromMaybe, isJust, isNothing, listToMaybe, mapMaybe )
-import Data.Proxy
+import Data.Monoid
-  ( Proxy(..) )
+  ( First(..) )
 import Data.Semigroup
  ( sconcat )
 import GHC.Exts
@ -108,35 +109,26 @@ import Control.Monad.Trans.Writer.CPS
 -- MetaBrush
 import Calligraphy.Brushes
-  ( Brush(..) )
+  ( Brush(..), Corner(..) )
 import Math.Algebra.Dual
-import qualified Math.Bezier.Cubic     as Cubic
+import qualified Math.Bezier.Cubic as Cubic
 import Math.Bezier.Cubic.Fit
-  ( FitPoint, FitParameters, fitSpline )
+  ( FitPoint (..), FitParameters, fitSpline )
 import Math.Bezier.Spline
  ( SplineType(..), SSplineType(..), SplineTypeI
  , ssplineType, adjustSplineType, reverseSpline
  , NextPoint(..), fromNextPoint
  , KnownSplineType
    ( bifoldSpline, ibifoldSpline )
  , Spline(..), SplinePts, Curves(..), Curve(..)
  , openCurveStart, openCurveEnd, splitSplineAt, dropCurves
  , showSplinePoints
  )
 import qualified Math.Bezier.Quadratic as Quadratic
 import Math.Bezier.Stroke.EnvelopeEquation
 import Math.Differentiable
-  ( Differentiable, DiffInterp, I )
+  ( I, IVness(..), SingIVness (..)
  , Differentiable, DiffInterp
  )
 import Math.Epsilon
  ( epsilon )
 import Math.Interval
 import Math.Linear
 import Math.Module
  ( Module(..), Inner((^.^)), Cross((×)), Interpolatable
  , lerp, convexCombination, strictlyParallel
  )
 import Math.Ring
  ( Transcendental )
 import qualified Math.Ring as Ring
 import Math.Orientation
  ( Orientation(..), splineOrientation
  , between
@ -240,9 +232,10 @@ computeStrokeOutline ::
     -- Differentiability.
     , Interpolatable Double ( ℝ nbUsedParams )
-     , DiffInterp 2 ℝ nbBrushParams
+     , DiffInterp 2 NonIV nbBrushParams
-     , DiffInterp 3 𝕀 nbBrushParams
+     , DiffInterp 3 IsIV  nbBrushParams
     , HasChainRule Double 2 ( ℝ nbUsedParams )
     , HasChainRule 𝕀 2 ( 𝕀ℝ nbBrushParams )
     , HasChainRule 𝕀 3 ( 𝕀ℝ nbUsedParams )
     , HasChainRule Double 2 ( ℝ nbBrushParams )
     , HasChainRule 𝕀 3 ( 𝕀ℝ nbBrushParams )
@ -254,13 +247,13 @@ computeStrokeOutline ::
     -- Debugging.
     , Show ptData, Show crvData, Show ( ℝ nbBrushParams )
     )
  => RootSolvingAlgorithm
-  -> Maybe ( RootIsolationOptions N 3 )
+  -> Maybe ( RootIsolationOptions 1 2, RootIsolationOptions 2 3 )
  -> FitParameters
  -> ( ptData -> ℝ nbUsedParams )
-  -> ( ℝ nbUsedParams -> ℝ nbBrushParams ) -- ^ assumed to be linear and non-decreasing
+  -> ( ℝ nbUsedParams -> ℝ nbBrushParams )
       -- ^ assumed to be linear and non-decreasing
  -> Brush nbBrushParams
  -> Spline clo crvData ptData
  -> ST s
@ -302,21 +295,29 @@ computeStrokeOutline rootAlgo mbCuspOptions fitParams ptParams toBrushParams bru
            etx, ety :: Double
            V2 etx ety = endTgt
-        startCap, endCap :: SplinePts Open
+        mbStartCap, mbEndCap :: Maybe ( SplinePts Open )
-        startCap
+        mbStartCap
          | startTgtBwd `strictlyParallel` startTgtFwd
          = Nothing
          | isJust $ between CCW startTgtBwd startTgtFwd startTestTgt
-          = fmap ( T ( coords spt0 ) • )
+          = Just
          . fmap ( T ( coords spt0 ) • )
          $ joinWithBrush startBrush startTgtBwd startTgtFwd
          | otherwise
-          = fmap ( T ( coords spt0 ) • )
+          = Just
          . fmap ( T ( coords spt0 ) • )
          . reverseSpline
          $ joinWithBrush startBrush startTgtFwd startTgtBwd
-        endCap
+        mbEndCap
          | endTgtBwd `strictlyParallel` endTgtFwd
          = Nothing
          | isJust $ between CCW endTgtBwd endTgtFwd endTestTgt
-          = fmap ( T ( coords endPt ) • )
+          = Just
          . fmap ( T ( coords endPt ) • )
          $ joinWithBrush endBrush endTgtFwd endTgtBwd
          | otherwise
-          = fmap ( T ( coords endPt ) • )
+          = Just
          . fmap ( T ( coords endPt ) • )
          . reverseSpline
          $ joinWithBrush endBrush endTgtBwd endTgtFwd
@ -326,8 +327,14 @@ computeStrokeOutline rootAlgo mbCuspOptions fitParams ptParams toBrushParams bru
        cusps
          <- updateSpline ( startTgt, startTgtFwd, startTgtBwd )
      pure
-        ( Left ( adjustSplineType @Closed $ startCap <> fwdPts <> endCap <> bwdPts )
+        ( Left ( adjustSplineType @Closed $ sconcat $ NE.fromList $ catMaybes [ mbStartCap, Just fwdPts, mbEndCap, Just bwdPts ] )
-        , fwdFits <> bwdFits
+        , ( Seq.fromList $ fmap JoinPoint $ catMaybes
              [ fmap splineEnd   mbStartCap
              , fmap splineStart mbEndCap
              , fmap splineEnd   mbEndCap
              , fmap splineStart mbStartCap ]
          )
           <> fwdFits <> bwdFits
        , cusps
        )
  -- Closed brush path with at least one segment.
@ -387,7 +394,7 @@ computeStrokeOutline rootAlgo mbCuspOptions fitParams ptParams toBrushParams bru
    brushShape pt =
      let Brush { brushBaseShape = shapeFn, mbRotation = mbRot } = brush
          brushParams = toBrushParams $ ptParams pt
-          shape = fun @Double shapeFn brushParams
+          shape = fun shapeFn brushParams
      in case mbRot of
           Nothing -> shape
           Just getθ ->
@ -463,7 +470,10 @@ computeStrokeOutline rootAlgo mbCuspOptions fitParams ptParams toBrushParams bru
      -> WriterT OutlineData m ()
    tellBrushJoin ( prevTgt, prevTgtFwd, prevTgtBwd ) sp0 ( tgt, tgtFwd, tgtBwd ) =
      tell $ OutlineData
-               ( TwoSided ( fwdJoin, Empty ) ( bwdJoin, Empty ) )
+               ( TwoSided
                 ( fwdJoin, Seq.fromList $ map JoinPoint [ splineStart fwdJoin, splineEnd fwdJoin ] )
                 ( bwdJoin, Seq.fromList $ map JoinPoint [ splineStart bwdJoin, splineEnd bwdJoin ] )
               )
               []
      where
        ptOffset :: T ( ℝ 2 )
@ -524,9 +534,10 @@ outlineFunction
     -- Differentiability.
     , Interpolatable Double ( ℝ nbUsedParams )
-     , DiffInterp 2 ℝ nbBrushParams
+     , DiffInterp 2 NonIV nbBrushParams
-     , DiffInterp 3 𝕀 nbBrushParams
+     , DiffInterp 3 IsIV nbBrushParams
     , HasChainRule Double 2 ( ℝ nbUsedParams )
     , HasChainRule 𝕀 2 ( 𝕀ℝ nbBrushParams )
     , HasChainRule 𝕀 3 ( 𝕀ℝ nbUsedParams )
     , HasChainRule Double 2 ( ℝ nbBrushParams )
     , HasChainRule 𝕀 3 ( 𝕀ℝ nbBrushParams )
@ -542,7 +553,7 @@ outlineFunction
     , Show ptData, Show crvData, Show ( ℝ nbBrushParams )
     )
  => RootSolvingAlgorithm
-  -> Maybe ( RootIsolationOptions N 3 )
+  -> Maybe ( RootIsolationOptions 1 2, RootIsolationOptions 2 3 )
  -> ( ptData -> ℝ nbUsedParams )
  -> ( ℝ nbUsedParams -> ℝ nbBrushParams ) -- ^ assumed to be linear and non-decreasing
  -> Brush nbBrushParams
@ -550,37 +561,42 @@ outlineFunction
  -> Curve Open crvData ptData
  -> OutlineInfo
 outlineFunction rootAlgo mbCuspOptions ptParams toBrushParams
-  ( Brush { brushBaseShape, brushBaseShapeI, mbRotation } ) = \ sp0 crv ->
+  ( Brush { brushBaseShape, brushBaseShapeI
          , brushCorners, brushCornersI
          , mbRotation } ) = \ sp0 crv ->
  let
    usedParams :: C 2 ( ℝ 1 ) ( ℝ nbUsedParams )
    path :: C 2 ( ℝ 1 ) ( ℝ 2 )
    ( path, usedParams )
-      = pathAndUsedParams @2 @ℝ @nbUsedParams coerce id id ptParams sp0 crv
+      = pathAndUsedParams @2 @NonIV @nbUsedParams coerce id id ptParams sp0 crv
    curves :: ℝ 1 -- t
-           -> Seq ( ℝ 1 {- s -} -> StrokeDatum 2 ℝ )
+           -> ( Seq ( CornerStrokeDatum 2 NonIV )
              , Seq ( ℝ 1 {- s -} -> StrokeDatum 2 NonIV ) )
    curves =
-      brushStrokeData @2 @nbBrushParams
+      brushStrokeData @2 @nbBrushParams SNonIV
        coerce coerce
        path
        ( fmap toBrushParams usedParams )
        brushBaseShape
        brushCorners
        mbRotation
    curvesI :: 𝕀ℝ 1 -- t
-            -> Seq ( 𝕀ℝ 1 {- s -} -> StrokeDatum 3 𝕀 )
+            -> ( Seq ( CornerStrokeDatum 3 IsIV )
               , Seq ( 𝕀ℝ 1 {- s -} -> StrokeDatum 3 IsIV )
               )
    curvesI =
-      brushStrokeData @3 @nbBrushParams
+      brushStrokeData @3 @nbBrushParams SIsIV
        coerce coerce
        pathI
        ( fmap ( nonDecreasing toBrushParams ) usedParamsI )
        brushBaseShapeI
        brushCornersI
        ( fmap ( \ rot -> un𝕀ℝ1 . nonDecreasing ( ℝ1 . rot ) ) mbRotation )
    usedParamsI :: C 3 ( 𝕀ℝ 1 ) ( 𝕀ℝ nbUsedParams )
    pathI :: C 3 ( 𝕀ℝ 1 ) ( 𝕀ℝ 2 )
-    ( pathI, usedParamsI ) = pathAndUsedParams @3 @𝕀 @nbUsedParams coerce point point ptParams sp0 crv
+    ( pathI, usedParamsI ) = pathAndUsedParams @3 @IsIV @nbUsedParams coerce point point ptParams sp0 crv
    fwdBwd :: OutlineFn
    fwdBwd t
@ -604,12 +620,12 @@ outlineFunction rootAlgo mbCuspOptions ptParams toBrushParams
                 in fmap ( unT . rotate cosθ sinθ . T )
          in
            applyRot $
-              value @Double @2 @( ℝ nbBrushParams ) $
+              value @2 @nbBrushParams $
                runD brushBaseShape brushParams
-    ( potentialCusps, definiteCusps ) =
+    ( potentialCusps :: [Cusp], definiteCusps :: [Cusp] ) =
      case mbCuspOptions of
-        Just cuspOptions
+        Just ( cusp1Opts, cusp2Opts )
          -- Don't try to compute cusps for a trivial curve
          -- (e.g. a line segment with identical start- and end-points),
          -- as the root isolation code chokes on this.
@ -617,19 +633,28 @@ outlineFunction rootAlgo mbCuspOptions ptParams toBrushParams
          -- TODO: introduce a maximum time budget for the cusp computation,
          -- and bail out if the computation exceeds the budget.
          -- (Record such bailing out and warn the user if this happens often.)
          , let ( cornerCusps, normalCusps ) = findCusps ( cusp1Opts, cusp2Opts ) curvesI
          ->
          foldMap
            ( \ ( i, ( _trees, DoneBoxes { doneSolBoxes = defCusps, doneGiveUpBoxes = potCusps } ) ) ->
-              ( map ( ( i , ) . fst ) potCusps, map ( i , ) defCusps )
+              ( map ( \ ( box, _ ) -> cornerCuspCoords ( fst . curves ) ( i, box ) ) potCusps
              , map ( \   box      -> cornerCuspCoords ( fst . curves ) ( i, box ) ) defCusps )
            )
-            ( IntMap.toList $ findCusps cuspOptions curvesI )
+            ( IntMap.toList cornerCusps )
            <>
          foldMap
            ( \ ( i, ( _trees, DoneBoxes { doneSolBoxes = defCusps, doneGiveUpBoxes = potCusps } ) ) ->
              ( map ( \ ( box, _ ) -> cuspCoords ( snd . curves ) ( i, box ) ) potCusps
              , map ( \   box      -> cuspCoords ( snd . curves ) ( i, box ) ) defCusps )
            )
            ( IntMap.toList normalCusps )
        _ ->
          ( [], [] )
  in OutlineInfo
       { outlineFn = fwdBwd
-       , outlineDefiniteCusps  = map ( cuspCoords curves ) definiteCusps
+       , outlineDefiniteCusps  = definiteCusps
-       , outlinePotentialCusps = map ( cuspCoords curves ) potentialCusps
+       , outlinePotentialCusps = potentialCusps
       }
 {-# INLINEABLE outlineFunction #-}
@ -648,15 +673,15 @@ pathAndUsedParams :: forall k i (nbUsedParams :: Nat) arr crvData ptData
                     , Torsor ( T ( I i 2 ) ) ( I i 2 )
                     , Module ( I i Double ) ( T ( I i nbUsedParams ) )
                     , Torsor ( T ( I i nbUsedParams ) ) ( I i nbUsedParams )
-                     , Module Double ( T ( I ℝ nbUsedParams ) )
+                     , Module Double ( T ( ℝ nbUsedParams ) )
-                     , Torsor ( T ( ( I ℝ nbUsedParams ) ) ) ( I ℝ nbUsedParams )
+                     , Torsor ( T ( ( ℝ nbUsedParams ) ) ) ( ℝ nbUsedParams )
                     , Representable Double ( ℝ nbUsedParams )
                     , Representable 𝕀 ( 𝕀ℝ nbUsedParams )
                     )
                  => ( I i 1 -> I i Double )
-                  -> ( I ℝ 2 -> I i 2 )
+                  -> ( ℝ 2 -> I i 2 )
-                  -> ( I ℝ nbUsedParams -> I i nbUsedParams )
+                  -> ( ℝ nbUsedParams -> I i nbUsedParams )
-                  -> ( ptData -> I ℝ nbUsedParams )
+                  -> ( ptData -> ℝ nbUsedParams )
                  -> ptData
                  -> Curve Open crvData ptData
                  -> ( I i 1 `arr` I i 2, I i 1 `arr` I i nbUsedParams )
@ -1004,15 +1029,19 @@ instance Applicative ZipSeq where
  liftA2 f ( ZipSeq xs ) ( ZipSeq ys ) = ZipSeq ( Seq.zipWith f xs ys )
  {-# INLINE liftA2 #-}
-brushStrokeData :: forall {kd} (k :: Nat) (nbBrushParams :: Nat) (i :: kd) arr
+brushStrokeData :: forall (k :: Nat) (nbBrushParams :: Nat) (i :: IVness) arr
                .  ( arr ~ C k
                   , HasBézier k i, HasEnvelopeEquation k
                   , Differentiable k i nbBrushParams
                   , HasChainRule ( I i Double ) k ( I i 1 )
                   , HasChainRule 𝕀 k ( 𝕀ℝ nbBrushParams )
                   , Applicative ( D k 1 )
                   , Dim ( I i 1 ) ~ 1
                   , Dim ( I i nbBrushParams ) ~ nbBrushParams
                   , Traversable ( D k nbBrushParams )
                   , Traversable ( D k 1 )
                   , Module ( D k 1 𝕀 ) ( D k 1 ( 𝕀ℝ 2 ) )
                   , Transcendental ( D k 1 𝕀 )
                   , Transcendental ( I i Double )
                   , Module ( I i Double ) ( T ( I i 1 ) )
@ -1020,88 +1049,161 @@ brushStrokeData :: forall {kd} (k :: Nat) (nbBrushParams :: Nat) (i :: kd) arr
                   , Torsor ( T ( I i 2 ) ) ( I i 2 )
                   , Show ( ℝ nbBrushParams )
                   , Show ( StrokeDatum k i )
                   , Show ( StrokeDatum k IsIV )
                   , Representable ( I i Double ) ( I i 2 ), RepDim ( I i 2 ) ~ 2
                   )
-                => ( I i Double -> I i 1 )
+                => SingIVness i
                -> ( I i 1 -> I i Double )
                -> ( I i 1 `arr` I i 2 )
                     -- ^ path
                -> ( I i 1 `arr` I i nbBrushParams )
                     -- ^ brush parameters
                -> ( I i nbBrushParams `arr` Spline Closed () ( I i 2 ) )
                     -- ^ brush from parameters
                -> ( Seq ( I i nbBrushParams `arr` Corner ( I i 2 ) ) )
                     -- ^ brush corners from parameters
                -> ( Maybe ( I i nbBrushParams -> I i Double ) )
                     -- ^ rotation parameter
-                -> ( I i 1 -> Seq ( I i 1 -> StrokeDatum k i ) )
+                -> ( I i 1 -> ( Seq ( CornerStrokeDatum k i ), Seq ( I i 1 -> StrokeDatum k i ) ) )
-brushStrokeData co1 co2 path params brush mbBrushRotation =
+brushStrokeData ivness path params brush brushCorners mbBrushRotation =
  \ t ->
    let
        dpath_t :: D k 1 ( I i 2 )
        !dpath_t = runD path t
        dparams_t :: D k 1 ( I i nbBrushParams )
        !dparams_t = runD params t
        dbrush_params :: D k nbBrushParams ( Spline Closed () ( I i 2 ) )
        !dbrush_params = runD brush $ value @( I i Double ) @k @( I i 1 ) dparams_t
        splines :: Seq ( D k nbBrushParams ( I i 1 `arr` I i 2 ) )
        !splines = getZipSeq $ traverse ( ZipSeq . splineCurveFns @k @i co2 ) dbrush_params
        dbrushes_t :: Seq ( I i 1 -> D k 2 ( I i 2 ) )
        !dbrushes_t = force $ fmap ( uncurryD @k . chain @( I i Double ) @k dparams_t ) splines
          -- This is the crucial use of the chain rule.
-    in fmap ( mkStrokeDatum dpath_t dparams_t ) dbrushes_t
+      co :: I i 1 -> I i Double
      !co = case ivness of
        SNonIV -> coerce
        SIsIV  -> coerce
      dpath_t :: D k 1 ( I i 2 )
      !dpath_t = runD path t
      dparams_t :: D k 1 ( I i nbBrushParams )
      !dparams_t = runD params t
      brushParams :: I i nbBrushParams
      !brushParams = value @k @1 dparams_t
      dbrush_params :: D k nbBrushParams ( Spline Closed () ( I i 2 ) )
      !dbrush_params = runD brush brushParams
      splines :: Seq ( D k nbBrushParams ( I i 1 `arr` I i 2 ) )
      !splines = getZipSeq $ traverse ( ZipSeq . splineCurveFns @k @i co ) dbrush_params
      dbrushes_t :: Seq ( I i 1 -> D k 2 ( I i 2 ) )
      !dbrushes_t =
        force $
          fmap
            ( fmap ( uncurryD @k )
            . ( \ db s -> fmap ( `runD` s ) db )
            . chain @( I i Double ) @k dparams_t
              -- This is the crucial use of the chain rule.
            )
            splines
    in ( brushCorners <&> \ cornerFn ->
          let !dcorner   = runD cornerFn brushParams
              !corner    = value @k @nbBrushParams dcorner
              !dcornerPt = chain @_ @k dparams_t $ fmap cornerPoint dcorner
          in mkCornerStrokeDatum dpath_t dparams_t corner dcornerPt
       , fmap ( mkStrokeDatum dpath_t dparams_t . ) dbrushes_t )
  where
    mkStrokeDatum :: D k 1 ( I i 2 )
                  -> D k 1 ( I i nbBrushParams )
-                  -> ( I i 1 -> D k 2 ( I i 2 ) )
+                  -> D k 2 ( I i 2 )
-                  -> ( I i 1 -> StrokeDatum k i )
+                  -> StrokeDatum k i
-    mkStrokeDatum dpath_t dparams_t dbrush_t s =
+    mkStrokeDatum dpath_t dparams_t dbrush_t =
-      let dbrush_t_s = dbrush_t s
+      let mbRotation = mbBrushRotation <&> \ getTheta -> fmap getTheta dparams_t
-          mbRotation = mbBrushRotation <&> \ getTheta -> fmap getTheta dparams_t
+      in  envelopeEquation @k ivness dpath_t dbrush_t mbRotation
      in  envelopeEquation @k @i Proxy co1 dpath_t dbrush_t_s mbRotation
 {-# INLINEABLE brushStrokeData #-}
-{-
+    mkCornerStrokeDatum :: D k 1 ( I i 2 )
-{-# SPECIALISE brushStrokeData
+                        -> D k 1 ( I i nbBrushParams )
-     :: ( 𝕀 -> ( 𝕀ℝ 1 ) )
+                        -> Corner ( I i 2 )
-     -> ( 𝕀ℝ 1 -> 𝕀 )
+                        -> D k 1 ( I i 2 )
-     -> ( C 3 ( 𝕀ℝ 1 ) ( 𝕀ℝ 2 ) )
+                        -> CornerStrokeDatum k i
-     -> ( C 3 ( 𝕀ℝ 1 ) ( 𝕀ℝ 1 ) )
+    mkCornerStrokeDatum dpath_t dparams_t corner dbrush_t =
-     -> ( C 3 ( 𝕀ℝ 1 ) ( Spline Closed () ( 𝕀ℝ 2 ) ) )
+      let mbRotation = mbBrushRotation <&> \ getTheta -> fmap getTheta dparams_t
-     -> ( Maybe ( 𝕀ℝ 1 -> 𝕀 ) )
+      in  CornerStrokeDatum
-     -> ( 𝕀ℝ 1 -> Seq ( 𝕀ℝ 1 -> StrokeDatum 3 𝕀 ) )
+           { dpath  = dpath_t
           , dbrush = dbrush_t
           , corner
           , stroke = unT $
                  T ( value @k @1 dpath_t  )
              ^+^   ( let b = T $ value @k @1 dbrush_t in case mbRotation of
                        Nothing -> b
                        Just dθ -> let { θ = value @k @1 dθ; cosθ = Ring.cos θ; sinθ = Ring.sin θ } in rotate cosθ sinθ b
                    )
           , mbRotation }
 {-# SPECIALISE INLINE brushStrokeData
  :: SingIVness NonIV
  -> ( C 2 ( ℝ 1 ) ( ℝ 2 ) )
  -> ( C 2 ( ℝ 1 ) ( ℝ 1 ) )
  -> ( C 2 ( ℝ 1 ) ( Spline Closed () ( ℝ 2 ) ) )
  -> ( Seq ( C 2 ( ℝ 1 ) ( Corner ( ℝ 2 ) ) ) )
  -> ( Maybe ( ℝ 1 -> Double ) )
  -> ( ℝ 1 -> ( Seq ( CornerStrokeDatum 2 NonIV ), Seq ( ℝ 1 -> StrokeDatum 2 NonIV ) ) )
  #-}
-{-# SPECIALISE brushStrokeData
+{-# SPECIALISE INLINE brushStrokeData
-     :: ( 𝕀 -> ( 𝕀ℝ 1 ) )
+  :: SingIVness NonIV
-     -> ( 𝕀ℝ 1 -> 𝕀 )
+  -> ( C 2 ( ℝ 1 ) ( ℝ 2 ) )
-     -> ( C 3 ( 𝕀ℝ 1 ) ( 𝕀ℝ 2 ) )
+  -> ( C 2 ( ℝ 1 ) ( ℝ 2 ) )
-     -> ( C 3 ( 𝕀ℝ 1 ) ( 𝕀ℝ 2 ) )
+  -> ( C 2 ( ℝ 2 ) ( Spline Closed () ( ℝ 2 ) ) )
-     -> ( C 3 ( 𝕀ℝ 2 ) ( Spline Closed () ( 𝕀ℝ 2 ) ) )
+  -> ( Seq ( C 2 ( ℝ 2 ) ( Corner ( ℝ 2 ) ) ) )
-     -> ( Maybe ( 𝕀ℝ 2 -> 𝕀) )
+  -> ( Maybe ( ℝ 2 -> Double ) )
-     -> ( 𝕀ℝ 1 -> Seq ( 𝕀ℝ 1 -> StrokeDatum 3 𝕀 ) )
+  -> ( ℝ 1 -> ( Seq ( CornerStrokeDatum 2 NonIV ), Seq ( ℝ 1 -> StrokeDatum 2 NonIV ) ) )
  #-}
-{-# SPECIALISE brushStrokeData
+{-# SPECIALISE INLINE brushStrokeData
-     :: ( 𝕀 -> ( 𝕀ℝ 1 ) )
+  :: SingIVness NonIV
-     -> ( 𝕀ℝ 1 -> 𝕀 )
+  -> ( C 2 ( ℝ 1 ) ( ℝ 2 ) )
-     -> ( C 3 ( 𝕀ℝ 1 ) ( 𝕀ℝ 2 ) )
+  -> ( C 2 ( ℝ 1 ) ( ℝ 3 ) )
-     -> ( C 3 ( 𝕀ℝ 1 ) ( 𝕀ℝ 3 ) )
+  -> ( C 2 ( ℝ 3 ) ( Spline Closed () ( ℝ 2 ) ) )
-     -> ( C 3 ( 𝕀ℝ 3 ) ( Spline Closed () ( 𝕀ℝ 2 ) ) )
+  -> ( Seq ( C 2 ( ℝ 3 ) ( Corner ( ℝ 2 ) ) ) )
-     -> ( Maybe ( 𝕀ℝ 3 -> 𝕀 ) )
+  -> ( Maybe ( ℝ 3 -> Double ) )
-     -> ( 𝕀ℝ 1 -> Seq ( 𝕀ℝ 1 -> StrokeDatum 3 𝕀 ) )
+  -> ( ℝ 1 -> ( Seq ( CornerStrokeDatum 2 NonIV ), Seq ( ℝ 1 -> StrokeDatum 2 NonIV ) ) )
  #-}
-{-# SPECIALISE brushStrokeData
+{-# SPECIALISE INLINE brushStrokeData
-     :: ( 𝕀 -> ( 𝕀ℝ 1 ) )
+  :: SingIVness NonIV
-     -> ( 𝕀ℝ 1 -> 𝕀 )
+  -> ( C 2 ( ℝ 1 ) ( ℝ 2 ) )
-     -> ( C 3 ( 𝕀ℝ 1 ) ( 𝕀ℝ 2 ) )
+  -> ( C 2 ( ℝ 1 ) ( ℝ 4 ) )
-     -> ( C 3 ( 𝕀ℝ 1 ) ( 𝕀ℝ 4 ) )
+  -> ( C 2 ( ℝ 4 ) ( Spline Closed () ( ℝ 2 ) ) )
-     -> ( C 3 ( 𝕀ℝ 4 ) ( Spline Closed () ( 𝕀ℝ 2 ) ) )
+  -> ( Seq ( C 2 ( ℝ 4 ) ( Corner ( ℝ 2 ) ) ) )
-     -> ( Maybe ( 𝕀ℝ 4 -> 𝕀 ) )
+  -> ( Maybe ( ℝ 4 -> Double ) )
-     -> ( 𝕀ℝ 1 -> Seq ( 𝕀ℝ 1 -> StrokeDatum 3 𝕀 ) )
+  -> ( ℝ 1 -> ( Seq ( CornerStrokeDatum 2 NonIV ), Seq ( ℝ 1 -> StrokeDatum 2 NonIV ) ) )
  #-}
-}
+{-# SPECIALISE INLINE brushStrokeData
-- TODO: these specialisations fire in the benchmarking code because
+  :: SingIVness IsIV
-- we instantiate brushParams with ( ℝ nbBrushParams ), but they won't fire
+  -> ( C 3 ( 𝕀ℝ 1 ) ( 𝕀ℝ 2 ) )
-- in the main app code because we are using types such as "Record EllipseBrushFields".
+  -> ( C 3 ( 𝕀ℝ 1 ) ( 𝕀ℝ 1 ) )
  -> ( C 3 ( 𝕀ℝ 1 ) ( Spline Closed () ( 𝕀ℝ 2 ) ) )
  -> ( Seq ( C 3 ( 𝕀ℝ 1 ) ( Corner ( 𝕀ℝ 2 ) ) ) )
  -> ( Maybe ( 𝕀ℝ 1 -> 𝕀 ) )
  -> ( 𝕀ℝ 1 -> ( Seq ( CornerStrokeDatum 3 IsIV ), Seq ( 𝕀ℝ 1 -> StrokeDatum 3 IsIV ) ) )
  #-}
 {-# SPECIALISE INLINE brushStrokeData
  :: SingIVness IsIV
  -> ( C 3 ( 𝕀ℝ 1 ) ( 𝕀ℝ 2 ) )
  -> ( C 3 ( 𝕀ℝ 1 ) ( 𝕀ℝ 2 ) )
  -> ( C 3 ( 𝕀ℝ 2 ) ( Spline Closed () ( 𝕀ℝ 2 ) ) )
  -> ( Seq ( C 3 ( 𝕀ℝ 2 ) ( Corner ( 𝕀ℝ 2 ) ) ) )
  -> ( Maybe ( 𝕀ℝ 2 -> 𝕀 ) )
  -> ( 𝕀ℝ 1 -> ( Seq ( CornerStrokeDatum 3 IsIV ), Seq ( 𝕀ℝ 1 -> StrokeDatum 3 IsIV ) ) )
  #-}
 {-# SPECIALISE INLINE brushStrokeData
  :: SingIVness IsIV
  -> ( C 3 ( 𝕀ℝ 1 ) ( 𝕀ℝ 2 ) )
  -> ( C 3 ( 𝕀ℝ 1 ) ( 𝕀ℝ 3 ) )
  -> ( C 3 ( 𝕀ℝ 3 ) ( Spline Closed () ( 𝕀ℝ 2 ) ) )
  -> ( Seq ( C 3 ( 𝕀ℝ 3 ) ( Corner ( 𝕀ℝ 2 ) ) ) )
  -> ( Maybe ( 𝕀ℝ 3 -> 𝕀 ) )
  -> ( 𝕀ℝ 1 -> ( Seq ( CornerStrokeDatum 3 IsIV ), Seq ( 𝕀ℝ 1 -> StrokeDatum 3 IsIV ) ) )
  #-}
 {-# SPECIALISE INLINE brushStrokeData
  :: SingIVness IsIV
  -> ( C 3 ( 𝕀ℝ 1 ) ( 𝕀ℝ 2 ) )
  -> ( C 3 ( 𝕀ℝ 1 ) ( 𝕀ℝ 4 ) )
  -> ( C 3 ( 𝕀ℝ 4 ) ( Spline Closed () ( 𝕀ℝ 2 ) ) )
  -> ( Seq ( C 3 ( 𝕀ℝ 4 ) ( Corner ( 𝕀ℝ 2 ) ) ) )
  -> ( Maybe ( 𝕀ℝ 4 -> 𝕀 ) )
  -> ( 𝕀ℝ 1 -> ( Seq ( CornerStrokeDatum 3 IsIV ), Seq ( 𝕀ℝ 1 -> StrokeDatum 3 IsIV ) ) )
  #-}
 --------------------------------------------------------------------------------
 -- Solving the envelolpe equation: root-finding.
@ -1113,6 +1215,11 @@ data RootSolvingAlgorithm
  -- | Use the modified Halley M2 method.
  | HalleyM2 { maxIters :: Word, precision :: Int }
 data FwdBwd
  = Fwd
  | Bwd
  deriving stock ( Eq, Show )
 -- | Solve the envelope equations at a given point \( t = t_0 \), to find
 -- \( s_0 \) such that \( c(t_0, s_0) \) is on the envelope of the brush stroke.
 solveEnvelopeEquations :: RootSolvingAlgorithm
@ -1120,39 +1227,44 @@ solveEnvelopeEquations :: RootSolvingAlgorithm
                       -> ℝ 2
                       -> T ( ℝ 2 )
                       -> ( Offset, Offset )
-                       -> Seq ( ℝ 1 -> StrokeDatum 2 ℝ )
+                       -> ( Seq ( CornerStrokeDatum 2 NonIV ), Seq ( ℝ 1 -> StrokeDatum 2 NonIV ) )
                       -> ( ( ℝ 2, T ( ℝ 2 ) ), ( ℝ 2, T ( ℝ 2 ) ) )
-solveEnvelopeEquations rootAlgo ( ℝ1 _t ) path_t path'_t ( fwdOffset, bwdOffset ) strokeData
+solveEnvelopeEquations rootAlgo ( ℝ1 _t ) path_t path'_t ( fwdOffset, bwdOffset ) ( corners, strokeData )
-  = ( fwdSol, ( bwdPt, -1 *^ bwdTgt ) )
+  = ( fromMaybe fwdSol mbFwdCornerSol
    , maybe ( bwdPt, -1 *^ bwdTgt ) ( \ ( pt, tgt ) -> ( pt, -1 *^ tgt ) ) mbBwdCornerSol
    )
  where
-    fwdSol            = findSolFrom "fwd" fwdOffset
+    fwdSol            = findSolFrom Fwd fwdOffset
-    ( bwdPt, bwdTgt ) = findSolFrom "bwd" bwdOffset
+    ( bwdPt, bwdTgt ) = findSolFrom Bwd bwdOffset
-    findSolFrom :: String -> Offset -> ( ℝ 2, T ( ℝ 2 ) )
+    mbFwdCornerSol = getFirst $ foldMap ( First . cornerSol Fwd ) corners
-    findSolFrom desc ( Offset { offsetIndex = i00, offsetParameter = s00, offset = off } )
+    mbBwdCornerSol = getFirst $ foldMap ( First . cornerSol Bwd ) corners
    findSolFrom :: FwdBwd -> Offset -> ( ℝ 2, T ( ℝ 2 ) )
    findSolFrom fwdOrBwd ( Offset { offsetIndex = i00, offsetParameter = s00, offset = off } )
      = go ( fromIntegral i00 + fromMaybe 0.5 s00 )
      where
        go :: Double -> ( ℝ 2, T ( ℝ 2 ) )
        go is0 =
-          case sol desc strokeData is0 of
+          case sol fwdOrBwd strokeData is0 of
            ( goodSoln, pt, tgt )
              | goodSoln
              -> ( pt, tgt )
              | otherwise
              -> ( off • path_t, path'_t )
-    sol :: String -> Seq ( ℝ 1 -> StrokeDatum 2 ℝ ) -> Double -> ( Bool, ℝ 2, T ( ℝ 2 ) )
+    sol :: FwdBwd -> Seq ( ℝ 1 -> StrokeDatum 2 NonIV ) -> Double -> ( Bool, ℝ 2, T ( ℝ 2 ) )
-    sol desc f is0 =
+    sol fwdOrBwd f is0 =
      let ( solRes, _solSteps ) = runSolveMethod ( eqn f ) is0
          ( good, is ) =
            case solRes of
              Nothing  -> ( False, is0 )
-              Just is1 -> ( if desc == "fwd"
+              Just is1 -> ( case fwdOrBwd of
-                            then sgn >= 0
+                              Fwd -> sgn >= 0
-                            else sgn <= 0
+                              Bwd -> sgn <= 0
                          , is1
                          )
          ( sgn, ds, dcdt ) = finish f is
@ -1164,7 +1276,7 @@ solveEnvelopeEquations rootAlgo ( ℝ1 _t ) path_t path'_t ( fwdOffset, bwdOffse
      NewtonRaphson { maxIters, precision } ->
        newtonRaphson maxIters precision domain
-    finish :: Seq ( ℝ 1 -> StrokeDatum 2 ℝ ) -> Double -> ( Double, ℝ 2, T ( ℝ 2 ) )
+    finish :: Seq ( ℝ 1 -> StrokeDatum 2 NonIV ) -> Double -> ( Double, ℝ 2, T ( ℝ 2 ) )
    finish fs is =
      let (i, s) = fromDomain is in
      case evalStrokeDatum fs is of -- TODO: a bit redundant to have to compute this again...
@ -1192,21 +1304,67 @@ solveEnvelopeEquations rootAlgo ( ℝ1 _t ) path_t path'_t ( fwdOffset, bwdOffse
                  let cosθ = cos θ
                      sinθ = sin θ
                  in rotate cosθ sinθ $ unrot_dcdt
              -- TODO: reduce duplication with 'cornerSol'.
          in ( T u ^.^ T v, stroke, dcdt )
             -- Compute the dot product of u and v (which are rotated versions of ∂c/∂t and ∂c/∂s).
             -- The sign of this quantity determines which side of the envelope
             -- we are on.
-    evalStrokeDatum :: Seq ( ℝ 1 -> StrokeDatum 2 ℝ ) -> ( Double -> StrokeDatum 2 ℝ )
+    evalStrokeDatum :: Seq ( ℝ 1 -> StrokeDatum 2 NonIV ) -> ( Double -> StrokeDatum 2 NonIV )
    evalStrokeDatum fs is =
      let (i, s) = fromDomain is
      in ( fs `Seq.index` i ) ( ℝ1 $ max 1e-6 $ min (1 - 1e-6) $ s )
-    eqn :: Seq ( ℝ 1 -> StrokeDatum 2 ℝ ) -> ( Double -> (# Double, Double #) )
+    eqn :: Seq ( ℝ 1 -> StrokeDatum 2 NonIV ) -> ( Double -> (# Double, Double #) )
    eqn fs is =
      case evalStrokeDatum fs is of
        StrokeDatum { ee = D12 ee _ ee_s } -> coerce (# ee, ee_s #)
    cornerSol :: FwdBwd -> CornerStrokeDatum 2 NonIV -> Maybe ( ℝ 2, T ( ℝ 2 ) )
    cornerSol fwdOrBwd
      cornerDatum@(
        CornerStrokeDatum
          { dpath = _dp@( D21 p _ _ )
          , dbrush = D21 b _b_t _b_tt
          , mbRotation
          , corner = Corner _ startTgt endTgt }
        )
        =
        let D11 u _u_t = cornerStrokeDatum cornerDatum
            flipWhenBwd =
              case fwdOrBwd of
                Fwd -> id
                Bwd -> ( -1 *^ )
            b_s  = flipWhenBwd ( T u )
            ori = CCW --case fwdOrBwd of { Fwd -> CCW ; Bwd -> CW }
            res@( _pt, _tgt ) = case mbRotation of
              Nothing -> ( unT $ T p ^+^ T b
                         , T u )
              Just ( D21 θ _ _ ) ->
                let cosθ = cos θ
                    sinθ = sin θ
                in ( unT $ T p ^+^ rotate cosθ sinθ ( T b )
                   , rotate cosθ sinθ ( T u ) )
         in
 {-
          trace (unlines
            [ "cornerSol"
            , "fwdOrBwd: " ++ show fwdOrBwd
            , "ori: " ++ show ori
            , "dp: " ++ show _dp
            , "startTgt: " ++ show startTgt
            , "endTgt: " ++ show endTgt
            , "u: " ++ show u
            , "b_s: " ++ show b_s
            , "ok: " ++ show ( between ori startTgt endTgt b_s )
            , "pt: " ++ show _pt
            , "tgt: " ++ show _tgt
            ]) $
 -}
          if isNothing $ between ori startTgt endTgt b_s
          then Nothing
          else Just res
    n :: Int
    n = Seq.length strokeData
    domain :: ( Double, Double )
@ -1222,42 +1380,69 @@ solveEnvelopeEquations rootAlgo ( ℝ1 _t ) path_t path'_t ( fwdOffset, bwdOffse
 -- | Computes the brush stroke coordinates of a cusp from
 -- the @(t,s)@ parameter values.
--
+cuspCoords :: ( ℝ 1 -> Seq ( ℝ 1 -> StrokeDatum 2 NonIV ) )
 -- TODO: use Newton's method starting at the midpoint of the box,
 -- instead of just taking the midpoint of the box.
 cuspCoords :: ( ℝ 1 -> Seq ( ℝ 1 -> StrokeDatum 2 ℝ ) )
           -> ( Int, Box N )
           -> Cusp
 -- TODO: use Newton's method starting at the midpoint of the box,
 -- instead of just taking the midpoint of the box.
 cuspCoords eqs ( i, box )
  | StrokeDatum
    { dpath, stroke }
      <- ( eqs ( ℝ1 t_mid ) `Seq.index` i ) ( ℝ1 s_mid )
  = Cusp
  { cuspParameters   = ℝ2 t_mid s_mid
-  , cuspPathCoords   = coerce dpath
+  , cuspPathCoords   = dpath
-  , cuspStrokeCoords = coerce stroke
+  , cuspStrokeCoords = stroke
  }
  where
-    𝕀 t_lo t_hi = box `index` Fin 1
+    t = box `index` Fin 1
-    𝕀 s_lo s_hi = box `index` Fin 2
+    s = box `index` Fin 2
-    t_mid = 0.5 * ( t_lo + t_hi )
+    t_mid = midpoint t
-    s_mid = 0.5 * ( s_lo + s_hi )
+    s_mid = midpoint s
 cornerCuspCoords :: ( ℝ 1 -> Seq ( CornerStrokeDatum 2 NonIV ) )
                 -> ( Int, Box 1 )
                 -> Cusp
 -- TODO: use Newton's method.
 cornerCuspCoords eqs ( i, box )
  | CornerStrokeDatum { dpath, stroke } <- eqs ( ℝ1 t_mid ) `Seq.index` i
  = Cusp
  { cuspParameters   = ℝ2 t_mid 0
  , cuspPathCoords   = dpath
  , cuspStrokeCoords = stroke
  }
  where
    t = box `index` Fin 1
    t_mid = midpoint t
 -- | Find cusps in the envelope for values of the parameters in
 -- \( 0 \leqslant t, s \leqslant 1 \), using interval arithmetic.
 --
 -- See 'isolateRootsIn' for details of the algorithms used.
 findCusps
-  :: RootIsolationOptions N 3
+  :: ( RootIsolationOptions 1 2, RootIsolationOptions 2 3 )
-  -> ( 𝕀ℝ 1 -> Seq ( 𝕀ℝ 1 -> StrokeDatum 3 𝕀 ) )
+  -> ( 𝕀ℝ 1 -> ( Seq ( CornerStrokeDatum 3 IsIV ), Seq ( 𝕀ℝ 1 -> StrokeDatum 3 IsIV ) ) )
-  -> IntMap ( [ ( Box N, RootIsolationTree ( Box N ) ) ], DoneBoxes N )
+  -> ( IntMap ( [ ( Box 1, RootIsolationTree ( Box 1 ) ) ], DoneBoxes 1 )
-findCusps opts boxStrokeData =
+     , IntMap ( [ ( Box 2, RootIsolationTree ( Box 2 ) ) ], DoneBoxes 2 )
-  findCuspsIn opts boxStrokeData $
+     )
-    IntMap.fromList
+findCusps ( opts1, opts2 ) boxStrokeData =
-      [ ( i, [ 𝕀ℝ2 ( 𝕀 zero one ) ( 𝕀 zero one ) ] )
+  ( findCornerCuspsIn opts1 ( fst . boxStrokeData )
-      | i <- [ 0 .. length ( boxStrokeData ( 𝕀ℝ1 ( 𝕀 zero one ) ) ) - 1 ]
+    ( IntMap.fromList
-      ]
+        [ ( i, [ 𝕀ℝ1 unit ] )
        | i <- [ 0 .. length ( fst $ boxStrokeData ( 𝕀ℝ1 unit ) ) - 1 ]
        ]
    )
  , findCuspsIn opts2 ( snd . boxStrokeData )
    ( IntMap.fromList
        [ ( i, [ 𝕀ℝ2 unit unit ] )
        | i <- [ 0 .. length ( snd $ boxStrokeData ( 𝕀ℝ1 unit ) ) - 1 ]
        ]
    )
  )
  where
    unit :: 𝕀
    unit = 𝕀 zero one
    {-# INLINE unit #-}
    zero, one :: Double
    zero = 1e-6
    one = 1 - zero
@ -1268,7 +1453,7 @@ findCusps opts boxStrokeData =
 -- root isolation method.
 findCuspsIn
  :: RootIsolationOptions N 3
-  -> ( 𝕀ℝ 1 -> Seq ( 𝕀ℝ 1 -> StrokeDatum 3 𝕀 ) )
+  -> ( 𝕀ℝ 1 -> Seq ( 𝕀ℝ 1 -> StrokeDatum 3 IsIV ) )
  -> IntMap [ Box 2 ]
  -> IntMap ( [ ( Box N, RootIsolationTree ( Box N ) ) ], DoneBoxes N )
 findCuspsIn opts boxStrokeData initBoxes =
@ -1289,95 +1474,58 @@ findCuspsIn opts boxStrokeData initBoxes =
               ( T $ 𝕀ℝ3 ee_t f_t g_t )
               ( T $ 𝕀ℝ3 ee_s f_s g_s )
-{-
+-- | Like 'findCuspsIn' but in the case that the envelope is traced out
-findCuspsIn
+-- by a brush corner.
-  :: RootIsolationOptions N 3
+findCornerCuspsIn
-  -> ( 𝕀ℝ 1 -> Seq ( 𝕀ℝ 1 -> StrokeDatum 3 𝕀 ) )
+  :: RootIsolationOptions 1 2
-  -> IntMap [ Box 2 ]
+  -> ( 𝕀ℝ 1 -> Seq ( CornerStrokeDatum 3 IsIV ) )
-  -> IntMap ( [ ( Box 3, RootIsolationTree ( Box 3 ) ) ], ( [ Box 3 ], [ Box 3 ] ) )
+  -> IntMap [ Box 1 ]
-findCuspsIn opts boxStrokeData initBoxes =
+  -> IntMap ( [ ( Box 1, RootIsolationTree ( Box 1 ) ) ], DoneBoxes 1 )
-  IntMap.mapWithKey ( \ i boxes -> foldMap ( isolateRootsIn opts ( eqnPiece i ) ) $ concatMap ( mkInitBox i ) boxes ) initBoxes
+findCornerCuspsIn opts boxStrokeData initBoxes =
  IntMap.mapWithKey ( \ i -> foldMap ( isolateRootsIn opts ( eqnPiece i ) ) ) initBoxes
    where
-      mkInitBox :: Int -> Box 2 -> [ Box 3 ]
+      eqnPiece i ( 𝕀ℝ1 t ) =
-      mkInitBox i ( 𝕀 ( ℝ2 t_lo s_lo ) ( ℝ2 t_hi s_hi ) ) =
+        let CornerStrokeDatum
-        let t = 𝕀 ( ℝ1 t_lo ) ( ℝ1 t_hi )
+              { dpath =
-            s = 𝕀 ( ℝ1 s_lo ) ( ℝ1 s_hi )
+                D31 { _D31_dx   = p'
-            StrokeDatum
+                    , _D31_dxdx = p''
-              { du =
+                    }
-                D22
+              , dbrush =
-                  { _D22_v = 𝕀 ( ℝ2 ux_lo uy_lo ) ( ℝ2 ux_hi uy_hi )}
+                D31 { _D31_v    = b
-              , dv =
+                    , _D31_dx   = b'
-                D22
+                    , _D31_dxdx = b''
-                  { _D22_v = 𝕀 ( ℝ2 vx_lo vy_lo ) ( ℝ2 vx_hi vy_hi ) }
+                    }
-              , ee =
+              , mbRotation
-                D22
+              } = ( boxStrokeData ( 𝕀ℝ1 t ) `Seq.index` i )
-                  { _D22_dx = T ( 𝕀 ( ℝ1 ee_t_lo ) ( ℝ1 ee_t_hi ) )
+        in case mbRotation of
-                  , _D22_dy = T ( 𝕀 ( ℝ1 ee_s_lo ) ( ℝ1 ee_s_hi ) ) }
+            Nothing ->
-              } = ( boxStrokeData t `Seq.index` i ) s
+              D11 ( unT $ p' ^+^ b' )
-        -- λ = ∂E/∂t / ∂E/∂s
+                  ( p'' ^+^ b'' )
-            λ1 = 𝕀 ee_t_lo ee_t_hi ⊘ 𝕀 ee_s_lo ee_s_hi
+            Just ( D31 { _D31_v = θ, _D31_dx = T θ', _D31_dxdx = T θ'' } ) ->
-        -- λ = u / v
+              let cosθ = Ring.cos θ
-            λ2 = 𝕀 ux_lo ux_hi ⊘ 𝕀 vx_lo vx_hi
+                  sinθ = Ring.sin θ
-            λ3 = 𝕀 uy_lo uy_hi ⊘ 𝕀 vy_lo vy_hi
+                  swap ( T ( 𝕀ℝ2 x y ) ) = T ( 𝕀ℝ2 -y x )
-            λ = [ 𝕀 ( recip -0 ) ( recip 0 ) ]
+                  rot = rotate cosθ sinθ
-                `intersectMany` λ1
+                  rot' = rot . swap
-                `intersectMany` λ2
+                  rot'' = rot . ( -1 *^ )
                `intersectMany` λ3
        in
          let boxes = [ 𝕀 ( ℝ3 t_lo s_lo λ_lo ) ( ℝ3 t_hi s_hi λ_hi )
                      | 𝕀 λ_lo' λ_hi' <- λ
                      , let λ_lo = max λ_lo' ( min ( λ_hi' - 10 ) -100 )
                            λ_hi = min λ_hi' ( max ( λ_lo' + 10 )  100 ) ]
          in boxes
      eqnPiece :: Int -> 𝕀 ( ℝ 3 ) -> D1𝔸3 ( 𝕀 ( ℝ 3 ) )
      eqnPiece i ( 𝕀 ( ℝ3 t_lo s_lo λ_lo ) ( ℝ3 t_hi s_hi λ_hi ) ) =
        let t = 𝕀 ( ℝ1 t_lo ) ( ℝ1 t_hi )
            s = 𝕀 ( ℝ1 s_lo ) ( ℝ1 s_hi )
            λ = 𝕀 λ_lo λ_hi
-            StrokeDatum
+              in
-              { du =
+                -- TODO: I shouldn't have to do this by hand.
-                 D22 { _D22_v = u
+                --
-                     , _D22_dx   = T u_t , _D22_dy   = T u_s }
+                -- c(t) = p(t) + rot(θ(t)) b(t)
-              , dv =
+                --
-                 D22 { _D22_v = v
+                -- abbreviate; let R = rot(θ(t)), R'=rot'(θ(t)), ...
-                     , _D22_dx   = T v_t , _D22_dy   = T v_s }
+                --
-              , ee =
+                -- c   = p   + R b
-                D22 { _D22_dx = T ee_t, _D22_dy = T ee_s
+                -- c'  = p'  + R b'  +   θ' R' b
-                    , _D22_dxdx = T ee_tt, _D22_dxdy = T ee_ts, _D22_dydy = T ee_ss }
+                -- c'' = p'' + R b'' + 2 θ' R' b' + θ'² R'' b + θ'' R' b
-              } = ( boxStrokeData t `Seq.index` i ) s
+                --
                D11 ( unT $ p' ^+^ rot b' ^+^ ( θ' *^ rot' ( T b ) ) )
                    ( p'' ^+^ rot b''
                          ^+^ ( 2 * θ' ) *^ rot' b'
                          ^+^ ( θ' Ring.^ 2 ) *^ rot'' ( T b )
                          ^+^ θ'' *^ rot' ( T b )
                    )
-            -- λ ∂E/∂s - ∂E/∂t = 0
+                  -- TODO: instead of c'(t) and c''(t), it might be simpler
-            𝕀 ( ℝ1 f1_lo   ) ( ℝ1 f1_hi   ) = unT $ λ *^ T ee_s  ^-^ T ee_t
+                  -- to compute g(t) = rot(-θ(t)) c'(t) and g'(t)?
            𝕀 ( ℝ1 f1_t_lo ) ( ℝ1 f1_t_hi ) = unT $ λ *^ T ee_ts ^-^ T ee_tt
            𝕀 ( ℝ1 f1_s_lo ) ( ℝ1 f1_s_hi ) = unT $ λ *^ T ee_ss ^-^ T ee_ts
            𝕀 ( ℝ1 f1_λ_lo ) ( ℝ1 f1_λ_hi ) = ee_s
            -- λ v - u = 0
            𝕀 ( ℝ2 f2_lo   f3_lo   ) ( ℝ2 f2_hi   f3_hi   ) = unT $ λ *^ T v   ^-^ T u
            𝕀 ( ℝ2 f2_t_lo f3_t_lo ) ( ℝ2 f2_t_hi f3_t_hi ) = unT $ λ *^ T v_t ^-^ T u_t
            𝕀 ( ℝ2 f2_s_lo f3_s_lo ) ( ℝ2 f2_s_hi f3_s_hi ) = unT $ λ *^ T v_s ^-^ T u_s
            𝕀 ( ℝ2 f2_λ_lo f3_λ_lo ) ( ℝ2 f2_λ_hi f3_λ_hi ) = v
        in D13 ( 𝕀 ( ℝ3 f1_lo f2_lo f3_lo ) ( ℝ3 f1_hi f2_hi f3_hi ) )
               ( T $ 𝕀 ( ℝ3 f1_t_lo f2_t_lo f3_t_lo ) ( ℝ3 f1_t_hi f2_t_hi f3_t_hi ) )
               ( T $ 𝕀 ( ℝ3 f1_s_lo f2_s_lo f3_s_lo ) ( ℝ3 f1_s_hi f2_s_hi f3_s_hi ) )
               ( T $ 𝕀 ( ℝ3 f1_λ_lo f2_λ_lo f3_λ_lo ) ( ℝ3 f1_λ_hi f2_λ_hi f3_λ_hi ) )
 intersectMany :: [𝕀] -> [𝕀] -> [𝕀]
 intersectMany _ [] = []
 intersectMany is (j : js) = intersectOne is j ++ intersectMany is js
 intersectOne :: [ 𝕀 ] -> 𝕀 -> [ 𝕀 ]
 intersectOne is i = concatMap ( intersect i ) is
 intersect :: 𝕀 -> 𝕀 -> [ 𝕀 ]
 intersect ( 𝕀 lo1 hi1 ) ( 𝕀 lo2 hi2 )
  | lo > hi
  = [ ]
  | otherwise
  = [ 𝕀 lo hi ]
  where
    lo = max lo1 lo2
    hi = min hi1 hi2
 -}
--- a/brush-strokes/src/lib/Math/Bezier/Stroke/EnvelopeEquation.hs
+++ b/brush-strokes/src/lib/Math/Bezier/Stroke/EnvelopeEquation.hs
@ -1,22 +1,25 @@
-{-# LANGUAGE AllowAmbiguousTypes #-}
+{-# LANGUAGE AllowAmbiguousTypes   #-}
-{-# LANGUAGE PolyKinds           #-}
+{-# LANGUAGE DuplicateRecordFields #-}
-{-# LANGUAGE RebindableSyntax    #-}
+{-# LANGUAGE PolyKinds             #-}
-{-# LANGUAGE ScopedTypeVariables #-}
+{-# LANGUAGE RebindableSyntax      #-}
 {-# LANGUAGE ScopedTypeVariables   #-}
 {-# LANGUAGE UndecidableInstances  #-}
 module Math.Bezier.Stroke.EnvelopeEquation
-  ( StrokeDatum(..)
+  ( StrokeDatum(..), CornerStrokeDatum(..)
  , HasBézier(..)
  , HasEnvelopeEquation(..)
  , cornerStrokeDatum
  ) where
 -- base
 import Prelude hiding ( Num(..), (^), pi, sin, cos )
 import Data.Coerce
  ( coerce )
 import Data.Kind
  ( Type, Constraint )
 import Data.List.NonEmpty
  ( NonEmpty(..) )
 import Data.Proxy
  ( Proxy(..) )
 import GHC.TypeNats
  ( Nat, type (-) )
@ -25,11 +28,13 @@ import Data.Act
  ( Torsor ((-->)) )
 -- brush-strokes
 import Calligraphy.Brushes
  ( Corner )
 import Math.Algebra.Dual
 import qualified Math.Bezier.Cubic     as Cubic
 import qualified Math.Bezier.Quadratic as Quadratic
 import Math.Differentiable
-  ( type I )
+  ( I, IVness(..), SingIVness (..) )
 import Math.Interval
 import Math.Linear
 import Math.Module
@ -41,7 +46,7 @@ import Math.Ring
 -- | The value and derivative of a brush stroke at a given coordinate
 -- \( (t, s) \), together with the value of the envelope equation at that
 -- point.
-type StrokeDatum :: Nat -> k -> Type
+type StrokeDatum :: Nat -> IVness -> Type
 data StrokeDatum k i
  = StrokeDatum
  { -- | Path \( p(t) \).
@ -62,7 +67,11 @@ data StrokeDatum k i
    -- | Envelope function
    --
-    -- \[ E(t_0,s_0) = \left ( \frac{\partial c}{\partial t} \times \frac{\partial c}{\partial s} \right )_{(t_0,s_0)}. \]
+    -- \[ \begin{align} E(t,s) &= \frac{\partial c}{\partial t} \times \frac{\partial c}{\partial s} \\
    --                         &= \left ( R(-\theta(t)) \frac{\partial c}{\partial t} \right ) \times \left ( R(-\theta(t)) \frac{\partial c}{\partial s} \right ) \\
    --                         &= \left ( R(-\theta(t)) p'(t) + \theta'(t) S b(t,s) + \frac{\partial b}{\partial t} \right ) \times \frac{\partial b}{\partial s} \]
    --
    -- where \( S \) denotes the 2D swap function \( S(x,y) = (y,x) \).
  , ee       :: D ( k - 1 ) 2 ( I i 1 )
   -- \[ \frac{\partial E}{\partial s} \frac{\mathrm{d} c}{\mathrm{d} t}, \]
@ -73,12 +82,43 @@ data StrokeDatum k i
  , 𝛿E𝛿sdcdt :: D ( k - 2 ) 2 ( T ( I i 2 ) )
  }
-deriving stock instance Show ( StrokeDatum 2 ℝ )
+deriving stock instance
-deriving stock instance Show ( StrokeDatum 3 𝕀 )
+    ( Show ( I i 2 )
    , Show ( D k 1 ( I i Double ) )
    , Show ( D k 1 ( I i 2 ) )
    , Show ( D k 2 ( I i 2 ) )
    , Show ( D ( k - 1 ) 2 ( I i 1 ) )
    , Show ( D ( k - 1 ) 2 ( I i 2 ) )
    , Show ( D ( k - 2 ) 2 ( T ( I i 2 ) ) )
    )
  => Show ( StrokeDatum k i )
 -- | A slimmed down version of 'StrokeDatum' for use at brush corners.
 type CornerStrokeDatum :: Nat -> IVness -> Type
 data CornerStrokeDatum k i
  = CornerStrokeDatum
  { -- | Path \( p(t) \).
    dpath      :: D k 1 ( I i 2 )
    -- | Brush shape \( b(t) \).
  , dbrush     :: D k 1 ( I i 2 )
    -- | (Optional) rotation angle \( \theta(t) \).
  , mbRotation :: Maybe ( D k 1 ( I i Double ) )
  , corner     :: Corner ( I i 2 )
  , stroke     :: I i 2
  }
 deriving stock instance
    ( Show ( I i Double )
    , Show ( I i 2 )
    , Show ( D k 1 ( I i Double ) )
    , Show ( D k 1 ( I i 2 ) )
    )
  => Show ( CornerStrokeDatum k i )
 --------------------------------------------------------------------------------
-type HasBézier :: forall {t}. Nat -> t -> Constraint
+type HasBézier :: Nat -> IVness -> Constraint
 class HasBézier k i where
  -- | Linear interpolation, as a differentiable function.
@ -112,8 +152,7 @@ class HasBézier k i where
 type HasEnvelopeEquation :: Nat -> Constraint
 class HasEnvelopeEquation k where
-  uncurryD :: Dim a ~ 1
+  uncurryD :: D k 1 ( D k 1 b ) -> D k 2 b
           => D k 1 ( C k a b ) -> a -> D k 2 b
  -- | The envelope function
  --
@ -135,14 +174,13 @@ class HasEnvelopeEquation k where
                      , Show ( StrokeDatum k i )
                      )
-                   => Proxy i
+                   => SingIVness i
                   -> ( I i Double -> I i 1 )
                   -> D k 1 ( I i 2 )
                   -> D k 2 ( I i 2 )
                   -> Maybe ( D k 1 ( I i Double ) )
                   -> StrokeDatum k i
-instance HasBézier 2 ℝ where
+instance HasBézier 2 NonIV where
  line co ( Segment a b :: Segment b ) =
    D \ ( co -> t ) ->
      D21 ( lerp @( T b ) t a b )
@ -169,7 +207,7 @@ instance HasEnvelopeEquation 2 where
  uncurryD = uncurryD2
  {-# INLINEABLE uncurryD #-}
-  envelopeEquation ( _ :: Proxy i ) co
+  envelopeEquation ( ivness :: SingIVness i )
    dp@( D21 ( T -> p ) p_t p_tt )
    db@( D22 ( T -> b ) b_t b_s
             b_tt b_ts b_ss )
@ -182,6 +220,10 @@ instance HasEnvelopeEquation 2 where
        , du, dv, ee, 𝛿E𝛿sdcdt
        }
      where
        co :: I i Double -> I i 1
        co = case ivness of
          SNonIV -> coerce
          SIsIV  -> coerce
        (ee, 𝛿E𝛿sdcdt) =
          let
            D12 (T -> u) u_t u_s = du
@ -250,7 +292,46 @@ instance HasEnvelopeEquation 2 where
               )
  {-# INLINEABLE envelopeEquation #-}
-instance HasBézier 3 ℝ where
+-- | Computes \( u \) and \( u_t \), where \( u \) is as in 'StrokeDatum'.
 cornerStrokeDatum
  :: CornerStrokeDatum 2 NonIV
  -> D 1 1 ( ℝ 2 )
 cornerStrokeDatum
  CornerStrokeDatum
    { dpath   = D21 _ p_t p_tt
    , dbrush  = D21 ( T -> b ) b_t b_tt
    , mbRotation } =
    case mbRotation of
      Nothing -> D11 ( unT $ p_t ^+^ b_t ) ( p_tt ^+^ b_tt )
      Just ( D21 θ ( T θ_t ) ( T θ_tt ) ) ->
        let
          rot, rot' :: T ( ℝ 2 ) -> T ( ℝ 2 )
          cosθ = cos θ
          sinθ = sin θ
          rot = rotate cosθ -sinθ
          rot' = rotate sinθ cosθ
          swap :: T ( ℝ 2 ) -> T ( ℝ 2 )
          swap ( T xy ) =
            let x = xy `index` Fin 1
                y = xy `index` Fin 2
            in T $ tabulate \ case
                  Fin 1 -> -y
                  _     ->  x
          u, u_t :: T ( ℝ 2 )
          u = rot p_t ^+^ θ_t *^ swap b ^+^ b_t
          u_t  = ( -θ_t *^ rot' p_t
                 ^+^ rot p_tt
                 )
               ^+^
                 (   θ_tt *^ swap b
                 ^+^ θ_t  *^ swap b_t
                 )
               ^+^ b_tt
        in D11 ( unT u ) u_t
 instance HasBézier 3 NonIV where
  line co ( Segment a b :: Segment b ) =
    D \ ( co -> t ) ->
@ -281,7 +362,7 @@ instance HasEnvelopeEquation 3 where
  uncurryD = uncurryD3
  {-# INLINEABLE uncurryD #-}
-  envelopeEquation ( _ :: Proxy i ) co
+  envelopeEquation ( ivness :: SingIVness i )
    dp@( D31 ( T -> p ) p_t p_tt p_ttt )
    db@( D32 ( T -> b ) b_t b_s
             b_tt b_ts b_ss
@ -295,6 +376,10 @@ instance HasEnvelopeEquation 3 where
        , du, dv, ee, 𝛿E𝛿sdcdt
        }
      where
        co :: I i Double -> I i 1
        co = case ivness of
          SNonIV -> coerce
          SIsIV  -> coerce
        (ee, 𝛿E𝛿sdcdt) =
          let
            D22 (T -> u) u_t u_s u_tt u_ts u_ss = du
@ -400,7 +485,7 @@ instance HasEnvelopeEquation 3 where
               )
  {-# INLINEABLE envelopeEquation #-}
-instance HasBézier 3 𝕀 where
+instance HasBézier 3 IsIV where
  line co ( Segment a b :: Segment b ) =
    D \ ( co -> t ) ->
--- a/brush-strokes/src/lib/Math/Differentiable.hs
+++ b/brush-strokes/src/lib/Math/Differentiable.hs
@ -2,7 +2,9 @@
 {-# LANGUAGE UndecidableInstances #-}
 module Math.Differentiable
-  ( I, Differentiable, DiffInterp )
+  ( IVness(..), SingIVness(..)
  , I, Differentiable, DiffInterp
  )
  where
 -- base
@ -23,17 +25,24 @@ import Math.Ring
 --------------------------------------------------------------------------------
 data IVness
  = NonIV
  | IsIV
 type SingIVness :: IVness -> Type
 data SingIVness iv where
  SNonIV :: SingIVness NonIV
  SIsIV  :: SingIVness IsIV
 -- | Type family to parametrise over both pointwise and interval computations.
--
+type I :: forall l. IVness -> l -> Type
 -- Use 'ℝ' parameter for points, and '𝕀' parameter for intervals.
 type I :: k -> l -> Type
 type family I i t
-type instance I @(Nat -> Type) @Type ℝ Double = Double
+type instance I @Type NonIV Double = Double
-type instance I @Type          @Type 𝕀 Double = 𝕀
+type instance I @Type IsIV  Double = 𝕀
-type instance I @(Nat -> Type) @Nat  ℝ n      = ℝ n
+type instance I @Nat  NonIV n      = ℝ n
-type instance I @Type          @Nat  𝕀 n      = 𝕀ℝ n
+type instance I @Nat  IsIV  n      = 𝕀ℝ n
-type Differentiable :: Nat -> k -> Nat -> Constraint
+type Differentiable :: Nat -> IVness -> Nat -> Constraint
 class
  ( Module ( I i Double ) ( T ( I i u ) )
  , HasChainRule ( I i Double ) k ( I i u )
@ -47,7 +56,7 @@ instance
  , Representable ( I i Double ) ( I i u )
  ) => Differentiable k i u
-type DiffInterp :: Nat -> k -> Nat -> Constraint
+type DiffInterp :: Nat -> IVness -> Nat -> Constraint
 class
  ( Differentiable k i u
  , Interpolatable ( I i Double ) ( I i u )
--- a/brush-strokes/src/lib/Math/Interval.hs
+++ b/brush-strokes/src/lib/Math/Interval.hs
@ -242,26 +242,15 @@ deriving via ( ViaModule 𝕀 ( 𝕀ℝ n ) )
 -- HasChainRule instances.
 instance HasChainRule 𝕀 2 ( 𝕀ℝ 0 ) where
  konst w = D0 w
  linearD f v = D0 ( f v )
  value ( D0 v ) = v
  chain _ ( D0 gfx ) = D21 gfx origin origin
 instance HasChainRule 𝕀 3 ( 𝕀ℝ 0 ) where
  konst w = D0 w
  linearD f v = D0 ( f v )
  value ( D0 v ) = v
  chain _ ( D0 gfx ) = D31 gfx origin origin origin
 instance HasChainRule 𝕀 2 ( 𝕀ℝ 1 ) where
  konst   :: forall w. AbelianGroup w => w -> D2𝔸1 w
  konst w =
    let !o = fromInteger @w 0
    in $$( monTabulateQ \ mon -> if isZeroMonomial mon then [|| w ||] else [|| o ||] )
  value df = $$( monIndexQ [|| df ||] zeroMonomial )
  linearD :: forall w. Module 𝕀 ( T w ) => ( 𝕀ℝ 1 -> w ) -> 𝕀ℝ 1 -> D2𝔸1 w
  linearD f v =
    let !o = origin @𝕀 @( T w )
@ -290,13 +279,6 @@ instance HasChainRule 𝕀 2 ( 𝕀ℝ 1 ) where
 instance HasChainRule 𝕀 3 ( 𝕀ℝ 1 ) where
  konst   :: forall w. AbelianGroup w => w -> D3𝔸1 w
  konst w =
    let !o = fromInteger @w 0
    in $$( monTabulateQ \ mon -> if isZeroMonomial mon then [|| w ||] else [|| o ||] )
  value df = $$( monIndexQ [|| df ||] zeroMonomial )
  linearD :: forall w. Module 𝕀 ( T w ) => ( 𝕀ℝ 1 -> w ) -> 𝕀ℝ 1 -> D3𝔸1 w
  linearD f v =
    let !o = origin @𝕀 @( T w )
@ -325,13 +307,6 @@ instance HasChainRule 𝕀 3 ( 𝕀ℝ 1 ) where
 instance HasChainRule 𝕀 2 ( 𝕀ℝ 2 ) where
  konst   :: forall w. AbelianGroup w => w -> D2𝔸2 w
  konst w =
    let !o = fromInteger @w 0
    in $$( monTabulateQ \ mon -> if isZeroMonomial mon then [|| w ||] else [|| o ||] )
  value df = $$( monIndexQ [|| df ||] zeroMonomial )
  linearD :: forall w. Module 𝕀 ( T w ) => ( 𝕀ℝ 2 -> w ) -> 𝕀ℝ 2 -> D2𝔸2 w
  linearD f v =
    let !o = origin @𝕀 @( T w )
@ -360,13 +335,6 @@ instance HasChainRule 𝕀 2 ( 𝕀ℝ 2 ) where
 instance HasChainRule 𝕀 3 ( 𝕀ℝ 2 ) where
  konst   :: forall w. AbelianGroup w => w -> D3𝔸2 w
  konst w =
    let !o = fromInteger @w 0
    in $$( monTabulateQ \ mon -> if isZeroMonomial mon then [|| w ||] else [|| o ||] )
  value df = $$( monIndexQ [|| df ||] zeroMonomial )
  linearD :: forall w. Module 𝕀 ( T w ) => ( 𝕀ℝ 2 -> w ) -> 𝕀ℝ 2 -> D3𝔸2 w
  linearD f v =
    let !o = origin @𝕀 @( T w )
@ -395,13 +363,6 @@ instance HasChainRule 𝕀 3 ( 𝕀ℝ 2 ) where
 instance HasChainRule 𝕀 2 ( 𝕀ℝ 3 ) where
  konst   :: forall w. AbelianGroup w => w -> D2𝔸3 w
  konst w =
    let !o = fromInteger @w 0
    in $$( monTabulateQ \ mon -> if isZeroMonomial mon then [|| w ||] else [|| o ||] )
  value df = $$( monIndexQ [|| df ||] zeroMonomial )
  linearD :: forall w. Module 𝕀 ( T w ) => ( 𝕀ℝ 3 -> w ) -> 𝕀ℝ 3 -> D2𝔸3 w
  linearD f v =
    let !o = origin @𝕀 @( T w )
@ -430,13 +391,6 @@ instance HasChainRule 𝕀 2 ( 𝕀ℝ 3 ) where
 instance HasChainRule 𝕀 3 ( 𝕀ℝ 3 ) where
  konst   :: forall w. AbelianGroup w => w -> D3𝔸3 w
  konst w =
    let !o = fromInteger @w 0
    in $$( monTabulateQ \ mon -> if isZeroMonomial mon then [|| w ||] else [|| o ||] )
  value df = $$( monIndexQ [|| df ||] zeroMonomial )
  linearD :: forall w. Module 𝕀 ( T w ) => ( 𝕀ℝ 3 -> w ) -> 𝕀ℝ 3 -> D3𝔸3 w
  linearD f v =
    let !o = origin @𝕀 @( T w )
@ -465,13 +419,6 @@ instance HasChainRule 𝕀 3 ( 𝕀ℝ 3 ) where
 instance HasChainRule 𝕀 2 ( 𝕀ℝ 4 ) where
  konst   :: forall w. AbelianGroup w => w -> D2𝔸4 w
  konst w =
    let !o = fromInteger @w 0
    in $$( monTabulateQ \ mon -> if isZeroMonomial mon then [|| w ||] else [|| o ||] )
  value df = $$( monIndexQ [|| df ||] zeroMonomial )
  linearD :: forall w. Module 𝕀 ( T w ) => ( 𝕀ℝ 4 -> w ) -> 𝕀ℝ 4 -> D2𝔸4 w
  linearD f v =
    let !o = origin @𝕀 @( T w )
@ -500,13 +447,6 @@ instance HasChainRule 𝕀 2 ( 𝕀ℝ 4 ) where
 instance HasChainRule 𝕀 3 ( 𝕀ℝ 4 ) where
  konst   :: forall w. AbelianGroup w => w -> D3𝔸4 w
  konst w =
    let !o = fromInteger @w 0
    in $$( monTabulateQ \ mon -> if isZeroMonomial mon then [|| w ||] else [|| o ||] )
  value df = $$( monIndexQ [|| df ||] zeroMonomial )
  linearD :: forall w. Module 𝕀 ( T w ) => ( 𝕀ℝ 4 -> w ) -> 𝕀ℝ 4 -> D3𝔸4 w
  linearD f v =
    let !o = origin @𝕀 @( T w )
--- a/src/app/MetaBrush/Application.hs
+++ b/src/app/MetaBrush/Application.hs
@ -232,7 +232,10 @@ runApplication application = do
                              NewtonRaphson
                                { maxIters = 20, precision = 8 }
  cuspFindingOptionsTVar <- STM.newTVarIO $
-                              Just defaultRootIsolationOptions
+                              Just
                                ( defaultRootIsolationOptions @1 @2
                                , defaultRootIsolationOptions @2 @3
                                )
  -- Put all these stateful variables in a record for conciseness.
  let
--- a/src/app/MetaBrush/Application/Context.hs
+++ b/src/app/MetaBrush/Application/Context.hs
@ -115,19 +115,19 @@ data Variables
  , selectedBrushTVar      :: !( STM.TVar ( Maybe SomeBrush ) )
-  , mousePosTVar           :: !( STM.TVar ( Maybe ( ℝ 2 ) )                       )
+  , mousePosTVar           :: !( STM.TVar ( Maybe ( ℝ 2 ) )         )
-  , mouseHoldTVar          :: !( STM.TVar ( Maybe HoldAction )                    )
+  , mouseHoldTVar          :: !( STM.TVar ( Maybe HoldAction )      )
-  , modifiersTVar          :: !( STM.TVar ( Set Modifier )                        )
+  , modifiersTVar          :: !( STM.TVar ( Set Modifier )          )
-  , toolTVar               :: !( STM.TVar Tool                                    )
+  , toolTVar               :: !( STM.TVar Tool                      )
-  , modeTVar               :: !( STM.TVar Mode                                    )
+  , modeTVar               :: !( STM.TVar Mode                      )
-  , debugTVar              :: !( STM.TVar Bool                                    )
+  , debugTVar              :: !( STM.TVar Bool                      )
-  , partialPathTVar        :: !( STM.TVar ( Maybe PartialPath )                   )
+  , partialPathTVar        :: !( STM.TVar ( Maybe PartialPath )     )
-  , fileBarTabsTVar        :: !( STM.TVar ( Map Unique FileBarTab )               )
+  , fileBarTabsTVar        :: !( STM.TVar ( Map Unique FileBarTab ) )
-  , showGuidesTVar         :: !( STM.TVar Bool                                    )
+  , showGuidesTVar         :: !( STM.TVar Bool                      )
-  , maxHistorySizeTVar     :: !( STM.TVar Int                                     )
+  , maxHistorySizeTVar     :: !( STM.TVar Int                       )
-  , fitParametersTVar      :: !( STM.TVar FitParameters                           )
+  , fitParametersTVar      :: !( STM.TVar FitParameters             )
-  , rootsAlgoTVar          :: !( STM.TVar RootSolvingAlgorithm                    )
+  , rootsAlgoTVar          :: !( STM.TVar RootSolvingAlgorithm      )
-  , cuspFindingOptionsTVar :: !( STM.TVar ( Maybe ( RootIsolationOptions 2 3 ) )  )
+  , cuspFindingOptionsTVar :: !( STM.TVar ( Maybe ( RootIsolationOptions 1 2, RootIsolationOptions 2 3 ) ) )
  }
 --------------------------------------------------------------------------------
--- a/src/app/MetaBrush/Render/Document.hs
+++ b/src/app/MetaBrush/Render/Document.hs
@ -148,7 +148,9 @@ blankRender _ = pure ()
 getDocumentRender
  :: Colours
-  -> RootSolvingAlgorithm -> Maybe ( RootIsolationOptions 2 3 ) -> FitParameters
+  -> RootSolvingAlgorithm
  -> Maybe ( RootIsolationOptions 1 2, RootIsolationOptions 2 3 )
  -> FitParameters
  -> Mode -> Bool
  -> Set Modifier -> Maybe ( ℝ 2 ) -> Maybe HoldAction -> Maybe PartialPath
  -> Document
@ -300,7 +302,7 @@ instance NFData StrokeRenderData where
 -- - Otherwise, this consists of the underlying spline path only.
 strokeRenderData
  :: RootSolvingAlgorithm
-  -> Maybe ( RootIsolationOptions 2 3 )
+  -> Maybe ( RootIsolationOptions 1 2, RootIsolationOptions 2 3 )
  -> FitParameters
  -> Stroke
  -> ST RealWorld StrokeRenderData
@ -325,6 +327,7 @@ strokeRenderData rootAlgo mbCuspOptions fitParams
                 -> do
                    let embedUsedParams = inject2 $ MkR brush_defaults
                  -- Compute the outline using the brush function.
                    ( outline, fitPts, cusps ) <-
                      computeStrokeOutline @clo rootAlgo mbCuspOptions fitParams
@ -337,7 +340,7 @@ strokeRenderData rootAlgo mbCuspOptions fitParams
                        , strokeBrushFunction =
                            \ params ->
                            let MkR brushParams = embedUsedParams $ toUsedParams params
-                                shape = fun @Double brushBaseShape brushParams
+                                shape = fun brushBaseShape brushParams
                                -- TODO: remove this logic which is duplicated
                                -- from elsewhere. The type should make it
                                -- impossible to forget to apply the rotation.
@ -703,6 +706,17 @@ drawFitPoint _ ( Zoom { zoomFactor } ) ( FitPoint { fitPoint = ℝ2 x y } ) = do
    Cairo.fill
    Cairo.restore
 drawFitPoint _ ( Zoom { zoomFactor } ) ( JoinPoint { joinPoint = ℝ2 x y } ) = lift do
  -- Draw a little white circle.
  Cairo.save
  Cairo.translate x y
  Cairo.arc 0 0 ( 3 / zoomFactor ) 0 ( 2 * pi )
  Cairo.setSourceRGBA 255 255 255 0.9
  Cairo.setLineWidth ( 1 / zoomFactor )
  Cairo.stroke
  Cairo.restore
 drawFitPoint _ ( Zoom { zoomFactor } )  ( FitTangent { fitPoint = ℝ2 x y, fitTangent = V2 tx ty } ) = do
  hue <- get
--- a/src/metabrushes/MetaBrush/Brush.hs
+++ b/src/metabrushes/MetaBrush/Brush.hs
@ -44,10 +44,12 @@ import qualified Data.Text as Text
 -- brush-strokes
 import Calligraphy.Brushes
  ( Brush(..) )
 import Math.Algebra.Dual
  ( HasChainRule )
 import Math.Differentiable
-  ( DiffInterp )
+  ( DiffInterp, IVness(..) )
 import Math.Interval
-  ( 𝕀 )
+  ( 𝕀, 𝕀ℝ )
 import Math.Linear
 -- MetaBrush
@ -78,13 +80,19 @@ type BrushFunction brushFields =
 type NamedBrush :: [ Symbol ] -> Type
 data NamedBrush brushFields where
  NamedBrush
-    :: forall brushFields
+    :: forall brushFields nbBrushFields
-    .  ( KnownSymbols brushFields
+    .  ( nbBrushFields ~ Length brushFields
-       , Representable Double ( ℝ ( Length brushFields ) )
+       , KnownSymbols brushFields
-       , DiffInterp 2 ℝ ( Length brushFields )
+       , Representable Double ( ℝ nbBrushFields )
-       , DiffInterp 3 𝕀 ( Length brushFields )
+       , DiffInterp 2 NonIV nbBrushFields
-       , Show ( ℝ ( Length brushFields ) )
+       , DiffInterp 3 IsIV  nbBrushFields
-       , NFData ( ℝ ( Length brushFields ) )
+
       -- TODO: clean up this constraint?
       , HasChainRule 𝕀 2 ( 𝕀ℝ nbBrushFields )
       , Show ( ℝ nbBrushFields )
       , NFData ( ℝ nbBrushFields )
       )
    => { brushName     :: !Text
       , brushFunction :: !( BrushFunction brushFields )
@ -122,8 +130,8 @@ class ( KnownSymbols pointFields, Typeable pointFields
      , NFData         ( Record pointFields )
      , Representable  Double   ( ℝ ( Length pointFields ) )
      , RepDim ( ℝ ( Length pointFields ) ) ~ Length pointFields
-      , DiffInterp 2 ℝ  ( Length pointFields )
+      , DiffInterp 2 NonIV ( Length pointFields )
-      , DiffInterp 3 𝕀  ( Length pointFields )
+      , DiffInterp 3 IsIV  ( Length pointFields )
      )
   => PointFields pointFields where { }
 instance ( KnownSymbols pointFields, Typeable pointFields
@ -133,8 +141,8 @@ instance ( KnownSymbols pointFields, Typeable pointFields
         , NFData         ( Record pointFields )
         , Representable  Double   ( ℝ ( Length pointFields ) )
         , RepDim ( ℝ ( Length pointFields ) ) ~ Length pointFields
-         , DiffInterp 2 ℝ ( Length pointFields )
+         , DiffInterp 2 NonIV ( Length pointFields )
-         , DiffInterp 3 𝕀 ( Length pointFields )
+         , DiffInterp 3 IsIV  ( Length pointFields )
         )
      => PointFields pointFields where { }
--- a/src/metabrushes/MetaBrush/Records.hs
+++ b/src/metabrushes/MetaBrush/Records.hs
@ -55,7 +55,6 @@ import qualified Data.Text as Text
 -- MetaBrush
 import Math.Differentiable
 import Math.Interval
 import Math.Linear
 import Math.Module
  ( Module )
@ -146,8 +145,9 @@ intersect :: forall r1 r2 l1 l2
            , Representable Double ( ℝ l2 )
            , Show ( ℝ l1 )
            , Show ( ℝ l2 )
-            , Differentiable 2 ℝ l2
+            , Differentiable 2 NonIV l2
-            , Differentiable 3 𝕀 l2
+            , Differentiable 2 IsIV  l2
            , Differentiable 3 IsIV  l2
            )
          => Intersection r1 r2
 intersect
@ -178,8 +178,9 @@ data Intersection r1 r2 where
       , KnownSymbols r1r2
       , Representable Double ( ℝ l12 )
       , Show ( ℝ l12 )
-       , Differentiable 2 ℝ l12
+       , Differentiable 2 NonIV l12
-       , Differentiable 3 𝕀 l12
+       , Differentiable 2 IsIV  l12
       , Differentiable 3 IsIV  l12
       )
    => { project1 :: Record r1 -> Record r1r2
          -- ^ project out fields present in both rows
@ -204,8 +205,9 @@ doIntersection
  => ( forall r1r2 l12.
        ( r1r2 ~ Intersect r1 r2
        , KnownSymbols r1r2, l12 ~ Length r1r2
-        , Differentiable 2 ℝ l12
+        , Differentiable 2 NonIV l12
-        , Differentiable 3 𝕀  l12
+        , Differentiable 2 IsIV  l12
        , Differentiable 3 IsIV  l12
        , Representable Double ( ℝ l12 )
        , Show ( ℝ l12 )
        )
@ -304,17 +306,17 @@ type family Elem k ks where
 data Union r1 r2 where
  Union
-    :: forall r1r2_rocky r1 r2 l12_rocky
+    :: forall r1r2 r1 r2 l12
-    .  ( l12_rocky ~ Length r1r2_rocky
+    .  ( l12 ~ Length r1r2
-       , KnownSymbols r1r2_rocky
+       , KnownSymbols r1r2
-       , Representable Double ( ℝ l12_rocky )
+       , Representable Double ( ℝ l12 )
-       , Show ( ℝ l12_rocky )
+       , Show ( ℝ l12 )
-       , NFData ( ℝ l12_rocky )
+       , NFData ( ℝ l12 )
-       , DiffInterp 2 ℝ l12_rocky
+       , DiffInterp 2 NonIV l12
-       , DiffInterp 3 𝕀 l12_rocky
+       , DiffInterp 3 IsIV l12
       )
    => { unionWith :: ( Double -> Double -> Double )
-                   -> Record r1 -> Record r2 -> Record r1r2_rocky
+                   -> Record r1 -> Record r2 -> Record r1r2
         -- ^ union of two records
       } -> Union r1 r2
@ -327,8 +329,8 @@ union :: forall r1 r2 l1 l2
            , Show ( ℝ l1 )
            , Show ( ℝ l2 )
            , NFData ( ℝ l2 )
-            , DiffInterp 2 ℝ l2
+            , DiffInterp 2 NonIV l2
-            , DiffInterp 3 𝕀 l2
+            , DiffInterp 3 IsIV  l2
            )
          => Union r1 r2
 union
@ -380,8 +382,8 @@ doUnion
     )
  => ( forall r1r2 l12.
        ( KnownSymbols r1r2, l12 ~ Length r1r2
-        , DiffInterp 2 ℝ l12
+        , DiffInterp 2 NonIV l12
-        , DiffInterp 3 𝕀  l12
+        , DiffInterp 3 IsIV  l12
        , Representable Double ( ℝ l12 )
        , Show ( ℝ l12 )
        , NFData ( ℝ l12 )