fixup curve drag code

brush-strokes/src/lib/Math/Bezier/Stroke.hs

@@ -50,9 +50,8 @@ import Data.List
 import Data.List.NonEmpty
   ( NonEmpty )
 import qualified Data.List.NonEmpty as NE
-  ( cons, singleton )
 import Data.Maybe
-  ( fromMaybe, isJust, listToMaybe, mapMaybe )
+  ( catMaybes, fromMaybe, isJust, listToMaybe, mapMaybe )
 import Data.Proxy
   ( Proxy(..) )
 import Data.Semigroup
@@ -82,7 +81,6 @@ import qualified Data.IntMap.Strict as IntMap
 import Data.Sequence
   ( Seq(..) )
 import qualified Data.Sequence as Seq
-  ( empty, index, length, reverse, singleton, zipWith )
 
 -- deepseq
 import Control.DeepSeq
@@ -732,8 +730,8 @@ joinWithBrush brush startTgt endTgt = joinBetweenOffsets brush startOffset endOf
 joinBetweenOffsets :: forall crvData ptData. HasType ( ℝ 2 ) ptData => Spline Closed crvData ptData -> Offset -> Offset -> SplinePts Open
 joinBetweenOffsets
   spline
-  ( Offset { offsetIndex = i1, offsetParameter = mb_t1 } )
+  ( Offset { offsetIndex = i1, offsetParameter = fromMaybe 1 -> t1 } )
-  ( Offset { offsetIndex = i2, offsetParameter = mb_t2 } )
+  ( Offset { offsetIndex = i2, offsetParameter = fromMaybe 0 -> t2 } )
     | i2 > i1
     = let
         pcs, lastAndRest :: Maybe ( SplinePts Open )
@@ -749,13 +747,16 @@ joinBetweenOffsets
             , dropFirstPiece =<< pcs
             , fst <$> ( splitFirstPiece t2 =<< lastAndRest )
             ]
-    | i2 == i1 && mb_t2 >= mb_t1
+    | i2 == i1 && t2 >= t1
     = let
         pcs :: Maybe ( SplinePts Open )
         pcs = discardCurveData <$> dropCurves i1 openSpline
       in
         maybe empty fst
-          ( splitFirstPiece t2 . snd =<< ( splitFirstPiece t1 =<< pcs ) )
+          ( splitFirstPiece ( ( t2 - t1 ) / ( 1 - t1 ) ) . snd =<< ( splitFirstPiece t1 =<< pcs ) )
+            -- NB: we want to split: 0 -- t1 -- t2 -- 1
+            -- First split at t1, then split again but after rescaling
+            -- using t |-> ( t - t1 ) / ( 1 - t1 ).
     | otherwise
     = let
         start, middle, end :: SplinePts Open
@@ -764,21 +765,17 @@ joinBetweenOffsets
           $ first ( splitSplineAt i2 )
           $ splitSplineAt i1 openSpline
       in
-        fromMaybe empty $
+        sconcat $ NE.fromList $ catMaybes $
-          mconcat
+          [ snd <$> splitFirstPiece t1 start
-            [ snd <$> splitFirstPiece t1 start
+          , dropFirstPiece start
-            , dropFirstPiece start
+          , Just middle
-            , Just middle
+          , fst <$> splitFirstPiece t2 ( if i1 == i2 then start else end )
-            , fst <$> splitFirstPiece t2 end
+          ]
-            ]
   where
     empty :: SplinePts Open
     empty = Spline { splineStart = ℝ2 0 0, splineCurves = OpenCurves Empty }
     openSpline :: Spline Open crvData ptData
     openSpline = adjustSplineType spline
-    t1, t2 :: Double
-    t1 = fromMaybe 0.5 mb_t1
-    t2 = fromMaybe 0.5 mb_t2
 
 
 discardCurveData

src/metabrushes/MetaBrush/Action.hs

@@ -23,7 +23,7 @@ module MetaBrush.Action
 import Control.Arrow
   ( second )
 import Control.Monad
-  ( guard, when )
+  ( guard, when, unless )
 import Control.Monad.ST
   ( RealWorld )
 import Data.Foldable
@@ -349,105 +349,101 @@ dragMoveSelect c ( Document { documentContent, documentMetadata } ) =
       -> Int
       -> PointData brushParams -> Curve clo' ( CurveData RealWorld ) ( PointData brushParams )
       -> State ( Maybe DragMoveSelect ) ()
-    dragSelectSplineCurve uniq start i sp0 crv = do
+    dragSelectSplineCurve uniq start i sp0 = \case
+      LineTo sp1 ( CurveData { curveIndex } ) -> do
+        traverse_ ( dragSelectSplinePoint uniq ( PointIndex curveIndex PathPoint ) ) sp1
+        unlessPrevDrag $ do
+          let
+            mbCurveDrag :: Maybe DragMoveSelect
+            mbCurveDrag = do
+              let
+                t :: Double
+                p :: ℝ 2
+                ( t, p ) =
+                  closestPointOnSegment @( T ( ℝ 2 ) )
+                    c
+                    ( Segment ( coords sp0 ) ( coords $ fromNextPoint start sp1 ) )
+              guard ( inSelectionRange p )
+              pure $
+                ClickedOnCurve
+                  { dragStrokeUnique   = uniq
+                  , dragCurve          = curveIndex
+                  , dragCurveIndex     = i
+                  , dragCurveParameter = t
+                  }
+          for_ mbCurveDrag $ State.put . Just
+      Bezier2To sp1 sp2 ( CurveData { curveIndex } ) -> do
+        dragSelectSplinePoint uniq ( PointIndex curveIndex ( ControlPoint Bez2Cp ) ) sp1
+        traverse_ ( dragSelectSplinePoint uniq ( PointIndex curveIndex PathPoint ) ) sp2
+        unlessPrevDrag $ do
+          let
+            mbCurveDrag :: Maybe DragMoveSelect
+            mbCurveDrag = do
+              let
+                bez :: Quadratic.Bezier ( ℝ 2 )
+                bez = Quadratic.Bezier ( coords sp0 ) ( coords sp1 ) ( coords $ fromNextPoint start sp2 )
+                sq_d :: Double
+                t :: Double
+                Min ( Arg sq_d (t, _) ) =
+                  Quadratic.closestPoint @( T ( ℝ 2 ) ) bez c
+              guard ( t > 0 && t < 1 && sq_d * zoomFactor ^ ( 2 :: Int ) < 16 )
+              pure $
+                ClickedOnCurve
+                  { dragStrokeUnique   = uniq
+                  , dragCurve          = curveIndex
+                  , dragCurveIndex     = i
+                  , dragCurveParameter = t
+                  }
+          for_ mbCurveDrag $ State.put . Just
+      Bezier3To sp1 sp2 sp3 ( CurveData { curveIndex } ) -> do
+        dragSelectSplinePoint uniq ( PointIndex curveIndex ( ControlPoint Bez3Cp1 ) ) sp1
+        dragSelectSplinePoint uniq ( PointIndex curveIndex ( ControlPoint Bez3Cp2 ) ) sp2
+        traverse_ ( dragSelectSplinePoint uniq ( PointIndex curveIndex PathPoint ) ) sp3
+        unlessPrevDrag $ do
+          let
+            mbCurveDrag :: Maybe DragMoveSelect
+            mbCurveDrag = do
+              let
+                bez :: Cubic.Bezier ( ℝ 2 )
+                bez = Cubic.Bezier ( coords sp0 ) ( coords sp1 ) ( coords sp2 ) ( coords $ fromNextPoint start sp3 )
+                sq_d :: Double
+                t :: Double
+                Min ( Arg sq_d (t, _) ) =
+                  Cubic.closestPoint @( T ( ℝ 2 ) ) bez c
+              guard ( t > 0 && t < 1 && sq_d * zoomFactor ^ ( 2 :: Int ) < 16 )
+              pure $
+                ClickedOnCurve
+                  { dragStrokeUnique   = uniq
+                  , dragCurve          = curveIndex
+                  , dragCurveIndex     = i
+                  , dragCurveParameter = t
+                  }
+          for_ mbCurveDrag $ State.put . Just
+
+    unlessPrevDrag :: State ( Maybe DragMoveSelect ) () -> State ( Maybe DragMoveSelect ) ()
+    unlessPrevDrag action = do
+      mbPrevDrag <- State.get
+      unless ( isJust mbPrevDrag ) $
+        action
+
+    unlessPrevPointDrag :: State ( Maybe DragMoveSelect ) () -> State ( Maybe DragMoveSelect ) ()
+    unlessPrevPointDrag action = do
       mbPrevDrag <- State.get
       case mbPrevDrag of
-        -- If we've clicked on a point, don't try anything further.
         Just ( ClickedOnPoint {} ) -> return ()
-        _notPointDrag -> do
+        _ -> action
-          -- If we've already initiated a curve drag, don't try
-          -- another curve drag. However, we allow overridding a curve drag
-          -- by a point drag.
-          let clickedOnCurve = isJust mbPrevDrag
-          case crv of
-            LineTo sp1 ( CurveData { curveIndex } ) -> do
-              -- Check endpoints first.
-              traverse_ ( dragSelectSplinePoint uniq ( PointIndex curveIndex PathPoint ) ) sp1
-              let
-                mbCurveDrag :: Maybe DragMoveSelect
-                mbCurveDrag = do
-                  guard ( not clickedOnCurve )
-                  let
-                    t :: Double
-                    p :: ℝ 2
-                    ( t, p ) =
-                      closestPointOnSegment @( T ( ℝ 2 ) )
-                        c
-                        ( Segment ( coords sp0 ) ( coords $ fromNextPoint start sp1 ) )
-                  guard ( inSelectionRange p )
-                  pure $
-                    ClickedOnCurve
-                      { dragStrokeUnique   = uniq
-                      , dragCurve          = curveIndex
-                      , dragCurveIndex     = i
-                      , dragCurveParameter = t
-                      }
-              for_ mbCurveDrag $ State.put . Just
-            Bezier2To sp1 sp2 ( CurveData { curveIndex } ) -> do
-              -- Check endpoints first.
-              dragSelectSplinePoint uniq ( PointIndex curveIndex ( ControlPoint Bez2Cp ) ) sp1
-              traverse_ ( dragSelectSplinePoint uniq ( PointIndex curveIndex PathPoint ) ) sp2
-              let
-                mbCurveDrag :: Maybe DragMoveSelect
-                mbCurveDrag = do
-                  guard ( not clickedOnCurve )
-                  let
-                    bez :: Quadratic.Bezier ( ℝ 2 )
-                    bez = Quadratic.Bezier ( coords sp0 ) ( coords sp1 ) ( coords $ fromNextPoint start sp2 )
-                    sq_d :: Double
-                    t :: Double
-                    Min ( Arg sq_d (t, _) ) =
-                      Quadratic.closestPoint @( T ( ℝ 2 ) ) bez c
-                  guard ( t > 0 && t < 1 && sq_d * zoomFactor ^ ( 2 :: Int ) < 16 )
-                  pure $
-                    ClickedOnCurve
-                      { dragStrokeUnique   = uniq
-                      , dragCurve          = curveIndex
-                      , dragCurveIndex     = i
-                      , dragCurveParameter = t
-                      }
-              for_ mbCurveDrag $ State.put . Just
-            Bezier3To sp1 sp2 sp3 ( CurveData { curveIndex } ) -> do
-              -- Check endpoints first.
-              dragSelectSplinePoint uniq ( PointIndex curveIndex ( ControlPoint Bez3Cp1 ) ) sp1
-              dragSelectSplinePoint uniq ( PointIndex curveIndex ( ControlPoint Bez3Cp2 ) ) sp2
-              traverse_ ( dragSelectSplinePoint uniq ( PointIndex curveIndex PathPoint ) ) sp3
-              let
-                mbCurveDrag :: Maybe DragMoveSelect
-                mbCurveDrag = do
-                  guard ( not clickedOnCurve )
-                  let
-                    bez :: Cubic.Bezier ( ℝ 2 )
-                    bez = Cubic.Bezier ( coords sp0 ) ( coords sp1 ) ( coords sp2 ) ( coords $ fromNextPoint start sp3 )
-                    sq_d :: Double
-                    t :: Double
-                    Min ( Arg sq_d (t, _) ) =
-                      Cubic.closestPoint @( T ( ℝ 2 ) ) bez c
-                  guard ( t > 0 && t < 1 && sq_d * zoomFactor ^ ( 2 :: Int ) < 16 )
-                  pure $
-                    ClickedOnCurve
-                      { dragStrokeUnique   = uniq
-                      , dragCurve          = curveIndex
-                      , dragCurveIndex     = i
-                      , dragCurveParameter = t
-                      }
-              for_ mbCurveDrag $ State.put . Just
 
     dragSelectSplinePoint :: Unique -> PointIndex -> PointData brushParams -> State ( Maybe DragMoveSelect ) ()
     dragSelectSplinePoint u ptIx pt =
-      when ( inSelectionRange ( coords pt ) ) do
+      unlessPrevPointDrag $ when ( inSelectionRange ( coords pt ) ) do
-      mbPrevDrag <- State.get
+        let
-      case mbPrevDrag of
+          drag :: DragMoveSelect
-        Just ( ClickedOnPoint {} ) -> return ()
+          drag = ClickedOnPoint
-        _ -> do
+            { dragPoint = ( u, ptIx )
-          let
+            , dragPointWasSelected =
-            drag :: DragMoveSelect
+                elemStrokePoint u ptIx ( selectedPoints documentMetadata )
-            drag = ClickedOnPoint
+            }
-              { dragPoint = ( u, ptIx )
+        State.put $ Just drag
-              , dragPointWasSelected =
-                  elemStrokePoint u ptIx ( selectedPoints documentMetadata )
-              }
-          State.put $ Just drag
 
 
 addOrRemove :: SelectionMode