From 3fe46fc029a186597ccd9015b341ccb5118889a5 Mon Sep 17 00:00:00 2001
From: sheaf <sam.derbyshire@gmail.com>
Date: Sat, 19 Oct 2024 16:14:33 +0200
Subject: [PATCH] don't deselect selection after brush widget update

---
 src/app/MetaBrush/Application/Action.hs | 33 ++++++++++++++++---------
 1 file changed, 22 insertions(+), 11 deletions(-)

diff --git a/src/app/MetaBrush/Application/Action.hs b/src/app/MetaBrush/Application/Action.hs
index 424fb83..a71c1cb 100644
--- a/src/app/MetaBrush/Application/Action.hs
+++ b/src/app/MetaBrush/Application/Action.hs
@@ -1022,9 +1022,10 @@ instance HandleAction MouseClick where
                                   then pure Don'tModifyDoc
                                   else do
                                     -- Clicked on an unselected point: only select that point.
-                                    let newDoc = set ( field' @"documentMetadata" . field' @"selectedPoints" )
-                                                 ( StrokePoints $ Map.singleton u ( Set.singleton i ) )
-                                                 doc
+                                    let newDoc =
+                                          set ( field' @"documentMetadata" . field' @"selectedPoints" )
+                                            ( StrokePoints $ Map.singleton u ( Set.singleton i ) )
+                                            doc
                                     pure ( UpdateDoc $ UpdateDocumentTo newDoc TrivialDiff )
                                 -- Clicked on curve: preserve old selection.
                                 ClickedOnCurve {} ->
@@ -1148,7 +1149,7 @@ instance HandleAction MouseRelease where
             toViewport = toViewportCoordinates zoom ( viewportWidth, viewportHeight ) viewportCenter
             pos :: ℝ 2
             pos = toViewport ( ℝ2 x y )
-          STM.writeTVar mousePosTVar  ( Just pos )
+          STM.writeTVar mousePosTVar ( Just pos )
           modifiers <- STM.readTVar modifiersTVar
           mbHoldPos <- STM.swapTVar mouseHoldTVar Nothing
 
@@ -1211,8 +1212,13 @@ instance HandleAction MouseRelease where
                     Just hold
                       | PathMode <- mode
                       , DragMoveHold { holdStartPos = pos0, dragAction } <- hold
-                      , not $ inPointClickRange zoom pos0 pos
-                      -> let
+                      ->
+                        if inPointClickRange zoom pos0 pos
+                        then
+                          let mbDoc' = fst <$> selectAt selMode pos doc
+                          in pure ( UpdateDoc $ UpdateDocumentTo ( fromMaybe doc mbDoc' ) TrivialDiff )
+                        else
+                          let
                             alternateMode :: Bool
                             alternateMode = any ( \case { Alt _ -> True; _ -> False } ) modifiers
                           in case dragUpdate pos0 pos dragAction alternateMode doc of
@@ -1226,12 +1232,17 @@ instance HandleAction MouseRelease where
                               in pure $ UpdateDoc ( UpdateDocumentTo doc' diff )
                             Nothing  -> pure Don'tModifyDoc
                       | SelectionHold pos0 <- hold
-                      , not $ inPointClickRange zoom pos0 pos
-                      , let mbDoc' = fst <$> selectRectangle selMode pos0 pos doc
-                      -> pure ( UpdateDoc $ UpdateDocumentTo ( fromMaybe doc mbDoc' ) TrivialDiff )
-                    _ ->
+                      -> let mbDoc'
+                                | inPointClickRange zoom pos0 pos
+                                = fst <$> selectAt selMode pos doc
+                                | otherwise
+                                = fst <$> selectRectangle selMode pos0 pos doc
+                          in pure ( UpdateDoc $ UpdateDocumentTo ( fromMaybe doc mbDoc' ) TrivialDiff )
+                      | otherwise
+                      -> pure Don'tModifyDoc
+                    Nothing -> do
                       let mbDoc' = fst <$> selectAt selMode pos doc
-                      in pure ( UpdateDoc $ UpdateDocumentTo ( fromMaybe doc mbDoc' ) TrivialDiff )
+                      pure ( UpdateDoc $ UpdateDocumentTo ( fromMaybe doc mbDoc' ) TrivialDiff )
 
                 Pen -> case mode of
                   PathMode -> do