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