prefer point drag over curve drag

src/metabrushes/MetaBrush/Action.hs

@@ -34,7 +34,7 @@ import Data.Kind
   ( Type )
 import qualified Data.List.NonEmpty as NE
 import Data.Maybe
-  ( fromMaybe, isNothing, listToMaybe )
+  ( fromMaybe, isJust, isNothing, listToMaybe )
 import Data.Ratio
 import Data.Semigroup
   ( Arg(..), Min(..) )
@@ -319,8 +319,7 @@ selectAt selMode c doc@( Document { documentContent, documentMetadata } ) =
 -- | Checks whether a mouse click can initiate a drag move event.
 dragMoveSelect :: ℝ 2 -> Document -> Maybe DragMoveSelect
 dragMoveSelect c ( Document { documentContent, documentMetadata } ) =
-  ( \case { Left drag -> Just drag; Right {} -> Nothing } ) $
-  Except.runExcept $
+  ( `State.execState` Nothing ) $
     forStrokeHierarchy
       ( layerMetadata documentMetadata )
       ( strokeHierarchy documentContent )
@@ -333,7 +332,7 @@ dragMoveSelect c ( Document { documentContent, documentMetadata } ) =
     inSelectionRange p =
       squaredNorm ( c --> p :: T ( ℝ 2 ) ) * zoomFactor ^ ( 2 :: Int ) < 16
 
-    dragSelect :: WithinParent Unique -> Stroke -> StrokeMetadata -> Except DragMoveSelect UpdateStroke
+    dragSelect :: WithinParent Unique -> Stroke -> StrokeMetadata -> State ( Maybe DragMoveSelect ) UpdateStroke
     dragSelect ( WithinParent _ strokeUnique ) ( Stroke { strokeSpline } ) ( StrokeMetadata { strokeVisible, strokeLocked } ) = do
       when ( strokeVisible && not strokeLocked ) $
         ibifoldSpline
@@ -349,14 +348,25 @@ dragMoveSelect c ( Document { documentContent, documentMetadata } ) =
       -> PointData brushParams
       -> Int
       -> PointData brushParams -> Curve clo' ( CurveData RealWorld ) ( PointData brushParams )
-      -> Except DragMoveSelect ()
-    dragSelectSplineCurve uniq start i sp0 = \case
+      -> State ( Maybe DragMoveSelect ) ()
+    dragSelectSplineCurve uniq start i sp0 crv = do
+      mbPrevDrag <- State.get
+      case mbPrevDrag of
+        -- If we've clicked on a point, don't try anything further.
+        Just ( ClickedOnPoint {} ) -> return ()
+        _notPointDrag -> do
+          -- 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
@@ -372,7 +382,7 @@ dragMoveSelect c ( Document { documentContent, documentMetadata } ) =
                       , dragCurveIndex     = i
                       , dragCurveParameter = t
                       }
-        for_ mbCurveDrag Except.throwE
+              for_ mbCurveDrag $ State.put . Just
             Bezier2To sp1 sp2 ( CurveData { curveIndex } ) -> do
               -- Check endpoints first.
               dragSelectSplinePoint uniq ( PointIndex curveIndex ( ControlPoint Bez2Cp ) ) sp1
@@ -380,6 +390,7 @@ dragMoveSelect c ( Document { documentContent, documentMetadata } ) =
               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 )
@@ -395,7 +406,7 @@ dragMoveSelect c ( Document { documentContent, documentMetadata } ) =
                       , dragCurveIndex     = i
                       , dragCurveParameter = t
                       }
-        for_ mbCurveDrag Except.throwE
+              for_ mbCurveDrag $ State.put . Just
             Bezier3To sp1 sp2 sp3 ( CurveData { curveIndex } ) -> do
               -- Check endpoints first.
               dragSelectSplinePoint uniq ( PointIndex curveIndex ( ControlPoint Bez3Cp1 ) ) sp1
@@ -404,6 +415,7 @@ dragMoveSelect c ( Document { documentContent, documentMetadata } ) =
               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 )
@@ -419,11 +431,15 @@ dragMoveSelect c ( Document { documentContent, documentMetadata } ) =
                       , dragCurveIndex     = i
                       , dragCurveParameter = t
                       }
-        for_ mbCurveDrag Except.throwE
+              for_ mbCurveDrag $ State.put . Just
 
-    dragSelectSplinePoint :: Unique -> PointIndex -> PointData brushParams -> Except DragMoveSelect ()
+    dragSelectSplinePoint :: Unique -> PointIndex -> PointData brushParams -> State ( Maybe DragMoveSelect ) ()
     dragSelectSplinePoint u ptIx pt =
       when ( inSelectionRange ( coords pt ) ) do
+      mbPrevDrag <- State.get
+      case mbPrevDrag of
+        Just ( ClickedOnPoint {} ) -> return ()
+        _ -> do
           let
             drag :: DragMoveSelect
             drag = ClickedOnPoint
@@ -431,7 +447,7 @@ dragMoveSelect c ( Document { documentContent, documentMetadata } ) =
               , dragPointWasSelected =
                   elemStrokePoint u ptIx ( selectedPoints documentMetadata )
               }
-      Except.throwE drag
+          State.put $ Just drag
 
 
 addOrRemove :: SelectionMode