From 777b894c06afff9d567e40957e502875d301dce3 Mon Sep 17 00:00:00 2001
From: sheaf <sam.derbyshire@gmail.com>
Date: Sun, 6 Sep 2020 17:13:30 +0200
Subject: [PATCH] fix accelerator key handling

---
 src/app/MetaBrush/Action.hs | 34 +++++++++++++---------------------
 src/app/MetaBrush/Event.hs  | 24 ++++++++++++------------
 2 files changed, 25 insertions(+), 33 deletions(-)

diff --git a/src/app/MetaBrush/Action.hs b/src/app/MetaBrush/Action.hs
index 4cf9386..f72abf9 100644
--- a/src/app/MetaBrush/Action.hs
+++ b/src/app/MetaBrush/Action.hs
@@ -674,15 +674,18 @@ instance HandleAction MouseClick where
               DoubleClick -> do
                 tool <- STM.readTVar toolTVar
                 mode <- STM.readTVar modeTVar
+                modifs <- STM.readTVar modifiersTVar
                 case tool of
-                  Selection -> do
-                    STM.writeTVar mouseHoldTVar Nothing
-                    let
-                      mbSubdivide :: Maybe Document
-                      mbSubdivide = subdivide mode pos doc
-                    case mbSubdivide of
-                      Nothing     -> pure Don'tModifyDoc
-                      Just newDoc -> pure ( UpdateDocTo $ Just newDoc )
+                  Selection
+                    | null modifs
+                    -> do
+                      STM.writeTVar mouseHoldTVar Nothing
+                      let
+                        mbSubdivide :: Maybe Document
+                        mbSubdivide = subdivide mode pos doc
+                      case mbSubdivide of
+                        Nothing     -> pure Don'tModifyDoc
+                        Just newDoc -> pure ( UpdateDocTo $ Just newDoc )
 
                   -- Ignore double click event otherwise.
                   _ -> pure Don'tModifyDoc
@@ -951,11 +954,8 @@ instance HandleAction KeyboardPress where
     vars@( Variables {..} )
     ( KeyboardPress keyCode ) = do
 
-      modifiers <- STM.atomically do
-        !modifiers <- STM.readTVar modifiersTVar
-        for_ ( modifierKey keyCode ) \ modifier ->
-          ( STM.writeTVar modifiersTVar ( Set.insert modifier modifiers ) )
-        pure modifiers
+      for_ ( modifierKey keyCode ) \ modifier ->
+        STM.atomically $ STM.modifyTVar' modifiersTVar ( Set.insert modifier )
 
       case keyCode of
 
@@ -981,14 +981,6 @@ instance HandleAction KeyboardPress where
                     GTK.widgetQueueDraw viewportDrawingArea
               _ -> pure ()
 
-        -- todo: these should be handled by accelerator,
-        -- but those are not working currently
-        GDK.KEY_Delete -> handleAction uiElts vars Delete
-
-        GDK.KEY_s
-          | any ( \case { Control _ -> True; _ -> False } ) modifiers
-          -> handleAction uiElts vars Save
-
         _ -> pure ()
 
 ----------------------
diff --git a/src/app/MetaBrush/Event.hs b/src/app/MetaBrush/Event.hs
index dfc5bb6..acc6f5a 100644
--- a/src/app/MetaBrush/Event.hs
+++ b/src/app/MetaBrush/Event.hs
@@ -40,25 +40,25 @@ handleEvents :: UIElements -> Variables -> IO ()
 handleEvents elts@( UIElements { viewport = Viewport {..}, .. } ) vars = do
 
   -- Mouse events
-  onWidgetMouseEvent    viewportDrawingArea ViewportOrigin
-  onWidgetMouseEvent rulerCornerDrawingArea ( RulerOrigin RulerCorner )
-  onWidgetMouseEvent   leftRulerDrawingArea ( RulerOrigin LeftRuler   )
-  onWidgetMouseEvent    topRulerDrawingArea ( RulerOrigin TopRuler    )
+  afterWidgetMouseEvent    viewportDrawingArea ViewportOrigin
+  afterWidgetMouseEvent rulerCornerDrawingArea ( RulerOrigin RulerCorner )
+  afterWidgetMouseEvent   leftRulerDrawingArea ( RulerOrigin LeftRuler   )
+  afterWidgetMouseEvent    topRulerDrawingArea ( RulerOrigin TopRuler    )
 
   -- Keyboard events
-  void $ GTK.onWidgetKeyPressEvent   window ( handleKeyboardPressEvent   elts vars )
-  void $ GTK.onWidgetKeyReleaseEvent window ( handleKeyboardReleaseEvent elts vars )
+  void $ GTK.afterWidgetKeyPressEvent   window ( handleKeyboardPressEvent   elts vars )
+  void $ GTK.afterWidgetKeyReleaseEvent window ( handleKeyboardReleaseEvent elts vars )
 
   -- Window quit
   void $ GTK.onWidgetDestroy window ( quitEverything window )
 
     where
-      onWidgetMouseEvent :: GTK.DrawingArea -> ActionOrigin -> IO ()
-      onWidgetMouseEvent drawingArea eventOrigin = do
-        void $ GTK.onWidgetMotionNotifyEvent  drawingArea ( handleMotionEvent        elts vars eventOrigin )
-        void $ GTK.onWidgetScrollEvent        drawingArea ( handleScrollEvent        elts vars eventOrigin )
-        void $ GTK.onWidgetButtonPressEvent   drawingArea ( handleMouseButtonEvent   elts vars eventOrigin )
-        void $ GTK.onWidgetButtonReleaseEvent drawingArea ( handleMouseButtonRelease elts vars eventOrigin )
+      afterWidgetMouseEvent :: GTK.DrawingArea -> ActionOrigin -> IO ()
+      afterWidgetMouseEvent drawingArea eventOrigin = do
+        void $ GTK.afterWidgetMotionNotifyEvent  drawingArea ( handleMotionEvent        elts vars eventOrigin )
+        void $ GTK.afterWidgetScrollEvent        drawingArea ( handleScrollEvent        elts vars eventOrigin )
+        void $ GTK.afterWidgetButtonPressEvent   drawingArea ( handleMouseButtonEvent   elts vars eventOrigin )
+        void $ GTK.afterWidgetButtonReleaseEvent drawingArea ( handleMouseButtonRelease elts vars eventOrigin )
 
 --------------------------------------------------------------------------------
 -- Mouse events.