diff --git a/src/app/MetaBrush/Event.hs b/src/app/MetaBrush/Event.hs index 041cc1b..ee74901 100644 --- a/src/app/MetaBrush/Event.hs +++ b/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