diff --git a/src/metabrushes/MetaBrush/Action.hs b/src/metabrushes/MetaBrush/Action.hs
index e2f079d..4657c6c 100644
--- a/src/metabrushes/MetaBrush/Action.hs
+++ b/src/metabrushes/MetaBrush/Action.hs
@@ -31,6 +31,7 @@ import Data.Functor
 import qualified Data.List.NonEmpty as NE
 import Data.Maybe
   ( fromMaybe, isNothing, listToMaybe )
+import Data.Ratio
 import Data.Semigroup
   ( Arg(..), Min(..) )
 import Data.Traversable
@@ -66,11 +67,13 @@ import Control.Monad.Trans.Except
   ( Except )
 import qualified Control.Monad.Trans.Except as Except
 import Control.Monad.Trans.State.Strict
-  ( State )
+  ( State, StateT )
 import qualified Control.Monad.Trans.State.Strict as State
 import Control.Monad.Trans.Writer.CPS
   ( Writer )
 import qualified Control.Monad.Trans.Writer.CPS as Writer
+import Control.Monad.Trans.Class
+  ( lift )
 
 -- brush-strokes
 import qualified Math.Bezier.Cubic as Cubic
@@ -131,11 +134,12 @@ subdivide c doc@( Document { documentMetadata, documentContent }) =
     subdivideStroke u stroke0@( Stroke { strokeSpline = strokeSpline :: StrokeSpline clo brushParams } ) ( StrokeMetadata { strokeVisible, strokeLocked } ) = do
       mbPrevSubdivision <- State.get
       let ( curves', subdivs ) =
-            Writer.runWriter $
-              bifoldSpline @Open
-                ( subdivideCurve ( V2 0 0 ) )
-                ( const $ pure Seq.Empty )
-                ( adjustSplineType @Open strokeSpline )
+              Writer.runWriter $
+                ( `State.evalStateT` Nothing ) $
+                bifoldSpline @Open
+                  ( subdivideCurve ( V2 0 0 ) )
+                  ( const $ pure Seq.Empty )
+                  ( adjustSplineType @Open strokeSpline )
       if | strokeVisible
          , not strokeLocked
          , Nothing <- mbPrevSubdivision
@@ -156,11 +160,17 @@ subdivide c doc@( Document { documentMetadata, documentContent }) =
           :: T ( ℝ 2 )
           -> PointData brushParams
           -> Curve Open ( CurveData RealWorld ) ( PointData brushParams )
-          -> Writer [ ( Curve Open () (), Double ) ]
+          -> StateT ( Maybe Rational )
+              ( Writer [ ( Curve Open () (), Double ) ] )
               ( Seq ( Curve Open ( CurveData RealWorld ) ( PointData brushParams ) ) )
-        subdivideCurve offset sp0 crv =
+        subdivideCurve offset sp0 crv = do
+          mbPrevCrvIx <- State.get
+          let i = curveIndex ( curveData crv )
+              i' = case mbPrevCrvIx of { Nothing -> i - 1
+                                       ; Just i0 -> fareySum i0 i }
+          State.put ( Just i )
           case crv of
-            LineTo ( NextPoint sp1 ) dat -> do
+            LineTo ( NextPoint sp1 ) ( CurveData _ dat ) -> do
               let
                 p0, p1, s :: ℝ 2
                 t :: Double
@@ -171,16 +181,16 @@ subdivide c doc@( Document { documentMetadata, documentContent }) =
                 sqDist = quadrance @( T ( ℝ 2 ) ) c ( offset • s )
               if t > 0 && t < 1 && sqDist * zoomFactor ^ ( 2 :: Int ) < 16
               then do
-                Writer.tell [ ( stripData crv, t ) ]
+                lift $ Writer.tell [ ( stripData crv, t ) ]
                 let
                   subdiv :: PointData brushParams
                   subdiv = lerp @( DiffPointData ( T brushParams ) ) t sp0 sp1
                 return $
-                          LineTo ( NextPoint subdiv ) ( invalidateCache dat )
-                  Seq.:<| LineTo ( NextPoint sp1    ) ( invalidateCache dat )
+                          LineTo ( NextPoint subdiv ) ( CurveData i' $ invalidateCache dat )
+                  Seq.:<| LineTo ( NextPoint sp1    ) ( CurveData i  $ invalidateCache dat )
                   Seq.:<| Seq.Empty
               else return $ Seq.singleton crv
-            Bezier2To sp1 ( NextPoint sp2 ) dat -> do
+            Bezier2To sp1 ( NextPoint sp2 ) ( CurveData _ dat ) -> do
               let
                 p0, p1, p2 :: ℝ 2
                 p0 = coords sp0
@@ -193,14 +203,14 @@ subdivide c doc@( Document { documentMetadata, documentContent }) =
               then
                 case Quadratic.subdivide @( DiffPointData ( T brushParams ) ) ( Quadratic.Bezier sp0 sp1 sp2 ) t of
                   ( Quadratic.Bezier _ q1 subdiv, Quadratic.Bezier _ r1 _ ) -> do
-                    Writer.tell [ ( stripData crv, t ) ]
+                    lift $ Writer.tell [ ( stripData crv, t ) ]
                     let
                       bez_start, bez_end :: Curve Open ( CurveData RealWorld ) ( PointData brushParams )
-                      bez_start = Bezier2To q1 ( NextPoint subdiv ) ( invalidateCache dat )
-                      bez_end   = Bezier2To r1 ( NextPoint sp2    ) ( invalidateCache dat )
+                      bez_start = Bezier2To q1 ( NextPoint subdiv ) ( CurveData i' $ invalidateCache dat )
+                      bez_end   = Bezier2To r1 ( NextPoint sp2    ) ( CurveData i  $ invalidateCache dat )
                     return ( bez_start Seq.:<| bez_end Seq.:<| Seq.Empty )
               else return $ Seq.singleton crv
-            Bezier3To sp1 sp2 ( NextPoint sp3 ) dat -> do
+            Bezier3To sp1 sp2 ( NextPoint sp3 ) ( CurveData _ dat ) -> do
               let
                   p0, p1, p2, p3 :: ℝ 2
                   p0 = coords sp0
@@ -213,15 +223,21 @@ subdivide c doc@( Document { documentMetadata, documentContent }) =
               then do
                 case Cubic.subdivide @( DiffPointData ( T brushParams ) ) ( Cubic.Bezier sp0 sp1 sp2 sp3 ) t of
                   ( Cubic.Bezier _ q1 q2 subdiv, Cubic.Bezier _ r1 r2 _ ) -> do
-                    Writer.tell [ ( stripData crv, t ) ]
+                    lift $ Writer.tell [ ( stripData crv, t ) ]
                     let
                       bez_start, bez_end :: Curve Open ( CurveData RealWorld ) ( PointData brushParams )
-                      bez_start = Bezier3To q1 q2 ( NextPoint subdiv ) ( invalidateCache dat )
-                      bez_end   = Bezier3To r1 r2 ( NextPoint sp3    ) ( invalidateCache dat )
+                      bez_start = Bezier3To q1 q2 ( NextPoint subdiv ) ( CurveData i' $ invalidateCache dat )
+                      bez_end   = Bezier3To r1 r2 ( NextPoint sp3    ) ( CurveData i  $ invalidateCache dat )
                     return ( bez_start Seq.:<| bez_end Seq.:<| Seq.Empty )
               else
                 return $ Seq.singleton crv
 
+-- | Stroke subdivision is the key reason why we index curves with 'Rational'
+-- rather than 'Integer'.
+fareySum :: Rational -> Rational -> Rational
+fareySum a b = ( numerator a + numerator b )
+             % ( denominator a + denominator b )
+
 --------------------------------------------------------------------------------
 -- Selection.