ctrl while drawing moves previous control point

This commit is contained in:
sheaf 2020-08-17 01:02:34 +02:00
parent 596821222f
commit 0f2eddab80

View file

@ -99,7 +99,7 @@ handleEvents
-- Mouse events -- Mouse events
_ <- GTK.onWidgetMotionNotifyEvent viewportDrawingArea _ <- GTK.onWidgetMotionNotifyEvent viewportDrawingArea
( handleMotionEvent activeDocumentTVar openDocumentsTVar mousePosTVar mouseHoldTVar toolTVar viewportDrawingArea infoBar ) ( handleMotionEvent activeDocumentTVar openDocumentsTVar mousePosTVar pressedKeysTVar toolTVar partialPathTVar viewportDrawingArea infoBar )
_ <- GTK.onWidgetScrollEvent viewportDrawingArea _ <- GTK.onWidgetScrollEvent viewportDrawingArea
( handleScrollEvent activeDocumentTVar openDocumentsTVar mousePosTVar mouseHoldTVar pressedKeysTVar toolTVar viewportDrawingArea infoBar ) ( handleScrollEvent activeDocumentTVar openDocumentsTVar mousePosTVar mouseHoldTVar pressedKeysTVar toolTVar viewportDrawingArea infoBar )
_ <- GTK.onWidgetButtonPressEvent viewportDrawingArea _ <- GTK.onWidgetButtonPressEvent viewportDrawingArea
@ -108,7 +108,7 @@ handleEvents
( handleMouseButtonRelease uniqueSupply activeDocumentTVar openDocumentsTVar mousePosTVar mouseHoldTVar pressedKeysTVar toolTVar partialPathTVar viewportDrawingArea ) ( handleMouseButtonRelease uniqueSupply activeDocumentTVar openDocumentsTVar mousePosTVar mouseHoldTVar pressedKeysTVar toolTVar partialPathTVar viewportDrawingArea )
-- Keyboard events -- 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 ) _ <- GTK.onWidgetKeyReleaseEvent window ( handleKeyboardReleaseEvent pressedKeysTVar )
-- Window quit -- Window quit
@ -142,15 +142,17 @@ data PartialPath
handleMotionEvent handleMotionEvent
:: STM.TVar ( Maybe Int ) -> STM.TVar ( IntMap Document ) :: 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 Tool
-> STM.TVar ( Maybe PartialPath )
-> GTK.DrawingArea -> InfoBar -> GTK.DrawingArea -> InfoBar
-> GDK.EventMotion -> GDK.EventMotion
-> IO Bool -> IO Bool
handleMotionEvent handleMotionEvent
activeDocumentTVar openDocumentsTVar activeDocumentTVar openDocumentsTVar
mousePosTVar _mouseHoldTVar mousePosTVar pressedKeysTVar
_toolTVar toolTVar
partialPathTVar
viewportDrawingArea infoBar viewportDrawingArea infoBar
eventMotion eventMotion
= do = do
@ -183,6 +185,18 @@ handleMotionEvent
updateInfoBar infoBar infoData updateInfoBar infoBar infoData
STM.atomically do STM.atomically do
STM.writeTVar mousePosTVar ( Just pos ) 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 GTK.widgetQueueDraw viewportDrawingArea
pure True pure True
@ -522,14 +536,14 @@ handleMouseButtonRelease
handleKeyboardPressEvent handleKeyboardPressEvent
:: STM.TVar ( Maybe Int ) -> STM.TVar ( IntMap Document ) :: 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 ) -> STM.TVar Tool -> STM.TVar ( Maybe PartialPath )
-> GTK.DrawingArea -> GTK.DrawingArea
-> GDK.EventKey -> GDK.EventKey
-> IO Bool -> IO Bool
handleKeyboardPressEvent handleKeyboardPressEvent
activeDocumentTVar openDocumentsTVar activeDocumentTVar openDocumentsTVar
pressedKeysTVar mousePosTVar pressedKeysTVar
toolTVar partialPathTVar toolTVar partialPathTVar
viewportDrawingArea viewportDrawingArea
evt = do evt = do
@ -564,6 +578,23 @@ handleKeyboardPressEvent
STM.atomically $ STM.writeTVar openDocumentsTVar newDocs STM.atomically $ STM.writeTVar openDocumentsTVar newDocs
GTK.widgetQueueDraw viewportDrawingArea GTK.widgetQueueDraw viewportDrawingArea
_ -> pure () _ -> 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 F1 -> do
mbActiveDoc <- STM.readTVarIO activeDocumentTVar mbActiveDoc <- STM.readTVarIO activeDocumentTVar
for_ mbActiveDoc \ i -> do for_ mbActiveDoc \ i -> do