ctrl while drawing moves previous control point

src/app/MetaBrush/Event.hs

@@ -99,7 +99,7 @@ handleEvents
 
     -- Mouse events
     _ <- GTK.onWidgetMotionNotifyEvent  viewportDrawingArea
-          ( handleMotionEvent activeDocumentTVar openDocumentsTVar mousePosTVar mouseHoldTVar toolTVar viewportDrawingArea infoBar )
+          ( handleMotionEvent activeDocumentTVar openDocumentsTVar mousePosTVar pressedKeysTVar toolTVar partialPathTVar viewportDrawingArea infoBar )
     _ <- GTK.onWidgetScrollEvent        viewportDrawingArea
           ( handleScrollEvent activeDocumentTVar openDocumentsTVar mousePosTVar mouseHoldTVar pressedKeysTVar toolTVar viewportDrawingArea infoBar )
     _ <- GTK.onWidgetButtonPressEvent   viewportDrawingArea
@@ -108,7 +108,7 @@ handleEvents
           ( handleMouseButtonRelease uniqueSupply activeDocumentTVar openDocumentsTVar mousePosTVar mouseHoldTVar pressedKeysTVar toolTVar partialPathTVar viewportDrawingArea )
 
     -- Keyboard events
-    _ <- GTK.onWidgetKeyPressEvent   window ( handleKeyboardPressEvent   activeDocumentTVar openDocumentsTVar pressedKeysTVar toolTVar partialPathTVar viewportDrawingArea )
+    _ <- GTK.onWidgetKeyPressEvent   window ( handleKeyboardPressEvent   activeDocumentTVar openDocumentsTVar mousePosTVar pressedKeysTVar toolTVar partialPathTVar viewportDrawingArea )
     _ <- GTK.onWidgetKeyReleaseEvent window ( handleKeyboardReleaseEvent pressedKeysTVar )
 
     -- Window quit
@@ -142,15 +142,17 @@ data PartialPath
 
 handleMotionEvent
   :: STM.TVar ( Maybe Int ) -> STM.TVar ( IntMap Document )
-  -> STM.TVar ( Maybe ( Point2D Double ) ) -> STM.TVar ( Maybe HoldEvent )
+  -> STM.TVar ( Maybe ( Point2D Double ) ) -> STM.TVar [ Word32 ]
   -> STM.TVar Tool
+  -> STM.TVar ( Maybe PartialPath )
   -> GTK.DrawingArea -> InfoBar
   -> GDK.EventMotion
   -> IO Bool
 handleMotionEvent
   activeDocumentTVar openDocumentsTVar
-  mousePosTVar _mouseHoldTVar
-  _toolTVar
+  mousePosTVar pressedKeysTVar
+  toolTVar
+  partialPathTVar
   viewportDrawingArea infoBar
   eventMotion
   = do
@@ -183,6 +185,18 @@ handleMotionEvent
         updateInfoBar infoBar infoData
         STM.atomically do
           STM.writeTVar mousePosTVar ( Just pos )
+          ----------------------------------------------------------
+          -- With the pen tool, keeping control pressed while moving the mouse
+          -- moves the partial control point (if one exists).
+          tool <- STM.readTVar toolTVar
+          pressedKeys <- STM.readTVar pressedKeysTVar
+          mbPartialPath <- STM.readTVar partialPathTVar
+          case tool of
+            Pen
+              | any ( \ key -> key == Control_L || key == Control_R ) pressedKeys
+              , Just pp <- mbPartialPath
+              -> STM.writeTVar partialPathTVar ( Just $ pp { partialControlPoint = Just pos } )
+            _ -> pure ()
         GTK.widgetQueueDraw viewportDrawingArea
 
     pure True
@@ -522,14 +536,14 @@ handleMouseButtonRelease
 
 handleKeyboardPressEvent
   :: STM.TVar ( Maybe Int ) -> STM.TVar ( IntMap Document )
-  -> STM.TVar [ Word32 ]
+  -> STM.TVar ( Maybe ( Point2D Double ) ) -> STM.TVar [ Word32 ]
   -> STM.TVar Tool -> STM.TVar ( Maybe PartialPath )
   -> GTK.DrawingArea
   -> GDK.EventKey
   -> IO Bool
 handleKeyboardPressEvent
   activeDocumentTVar openDocumentsTVar
-  pressedKeysTVar
+  mousePosTVar pressedKeysTVar
   toolTVar partialPathTVar
   viewportDrawingArea
   evt = do
@@ -564,6 +578,23 @@ handleKeyboardPressEvent
                 STM.atomically $ STM.writeTVar openDocumentsTVar newDocs
                 GTK.widgetQueueDraw viewportDrawingArea
           _ -> pure ()
+      ctrl
+        | ctrl == Control_L || ctrl == Control_R
+        -> do
+          ----------------------------------------------------------
+          -- With the pen tool, pressing control moves
+          -- the partial point control point to the mouse position.
+          tool <- STM.readTVarIO toolTVar
+          mbMousePos <- STM.readTVarIO mousePosTVar
+          mbPartialPath <- STM.readTVarIO partialPathTVar
+          case tool of
+            Pen
+              | Just mp <- mbMousePos
+              , Just pp <- mbPartialPath
+              -> do
+                  STM.atomically $ STM.writeTVar partialPathTVar ( Just $ pp { partialControlPoint = Just mp } )
+                  GTK.widgetQueueDraw viewportDrawingArea
+            _ -> pure ()
       F1 -> do
         mbActiveDoc <- STM.readTVarIO activeDocumentTVar
         for_ mbActiveDoc \ i -> do