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
_ <- 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