mirror of
https://gitlab.com/sheaf/metabrush.git
synced 2024-11-23 15:34:06 +00:00
add accelerator labels to menu items
This commit is contained in:
parent
7033578e20
commit
919acf4928
|
@ -239,6 +239,16 @@ tooltip {
|
|||
border-color: rgb(234,223,204);
|
||||
}
|
||||
|
||||
.accelLabel {
|
||||
padding: 2px 8px 2px 0px;
|
||||
}
|
||||
|
||||
.accelLabel accelerator {
|
||||
font-size: 10px;
|
||||
color: rgb(112, 109, 96);
|
||||
padding: 0px;
|
||||
}
|
||||
|
||||
.windowIcon {
|
||||
min-width: 24px;
|
||||
}
|
||||
|
|
|
@ -63,7 +63,7 @@ import Haskus.Utils.Variant
|
|||
import Control.Concurrent.STM
|
||||
( STM )
|
||||
import qualified Control.Concurrent.STM as STM
|
||||
( atomically, retry )
|
||||
( atomically )
|
||||
import qualified Control.Concurrent.STM.TQueue as STM
|
||||
( TQueue, flushTQueue, writeTQueue )
|
||||
import qualified Control.Concurrent.STM.TVar as STM
|
||||
|
@ -104,8 +104,6 @@ import MetaBrush.UI.FileBar
|
|||
import MetaBrush.UI.ToolBar
|
||||
( Tool(..) )
|
||||
|
||||
import Debug.Trace
|
||||
|
||||
--------------------------------------------------------------------------------
|
||||
|
||||
type Actions = [ MouseMove, MouseClick, MouseRelease, Scroll, KeyboardPress, KeyboardRelease ]
|
||||
|
@ -118,13 +116,12 @@ instance ReduceVariant HandleAction actions => HandleAction ( V actions ) where
|
|||
|
||||
handleActions :: ( Show action, HandleAction action ) => STM.TQueue action -> UIElements -> Variables -> IO Bool
|
||||
handleActions actionTQueue elts vars = do
|
||||
actions <- STM.atomically $ STM.flushTQueue actionTQueue
|
||||
|
||||
--actions <- STM.atomically do
|
||||
-- actions <- STM.flushTQueue actionTQueue
|
||||
-- if null actions
|
||||
-- then STM.retry
|
||||
-- else pure actions
|
||||
actions <- STM.atomically $ STM.flushTQueue actionTQueue
|
||||
traverse_ ( handleAction elts vars ) actions
|
||||
pure True
|
||||
|
||||
|
|
|
@ -4,7 +4,7 @@
|
|||
|
||||
module MetaBrush.Context
|
||||
( UIElements(..), Variables(..)
|
||||
, LR(..), Modifier(..), modifierKey
|
||||
, LR(..), Modifier(..), modifierKey, modifierType
|
||||
, HoldAction(..), PartialPath(..)
|
||||
, currentDocument, withCurrentDocument, modifyingCurrentDocument
|
||||
)
|
||||
|
@ -98,6 +98,11 @@ modifierKey GDK.KEY_Alt_L = Just ( Alt L )
|
|||
modifierKey GDK.KEY_Alt_R = Just ( Alt R )
|
||||
modifierKey _ = Nothing
|
||||
|
||||
modifierType :: Modifier -> GDK.ModifierType
|
||||
modifierType ( Control _ ) = GDK.ModifierTypeControlMask
|
||||
modifierType ( Alt _ ) = GDK.ModifierTypeMod1Mask
|
||||
modifierType ( Shift _ ) = GDK.ModifierTypeShiftMask
|
||||
|
||||
-- | Keep track of a mouse hold action:
|
||||
--
|
||||
-- - start a rectangular selection,
|
||||
|
|
|
@ -30,6 +30,8 @@ import Data.Foldable
|
|||
( for_ )
|
||||
import Data.Kind
|
||||
( Type )
|
||||
import Data.Word
|
||||
( Word32 )
|
||||
import GHC.Generics
|
||||
( Generic )
|
||||
|
||||
|
@ -58,12 +60,16 @@ import Control.Monad.IO.Class
|
|||
-- MetaBrush
|
||||
import MetaBrush.Action
|
||||
( quitEverything )
|
||||
import MetaBrush.Context
|
||||
( LR(..), Modifier(..), modifierType )
|
||||
import MetaBrush.Asset.Colours
|
||||
( Colours )
|
||||
import MetaBrush.Asset.WindowIcons
|
||||
( drawMinimise, drawRestoreDown, drawMaximise, drawClose )
|
||||
import MetaBrush.Util
|
||||
( widgetAddClass, widgetAddClasses )
|
||||
( widgetAddClass, widgetAddClasses
|
||||
, (>>?=)
|
||||
)
|
||||
|
||||
--------------------------------------------------------------------------------
|
||||
-- Types for describing menu items.
|
||||
|
@ -78,6 +84,7 @@ data instance MenuItem submenu Description
|
|||
{ menuItemLabel :: !Text
|
||||
, menuItemClasses :: ![ Text ]
|
||||
, menuItemAction :: !( Maybe Text )
|
||||
, menuItemAccel :: !( Maybe ( Word32, [ Modifier ] ) )
|
||||
, submenuDescription :: !( submenu Description )
|
||||
}
|
||||
data instance MenuItem submenu Object
|
||||
|
@ -145,55 +152,55 @@ data HelpMenu ( rt :: ResourceType )
|
|||
menuDescription :: Menu Description
|
||||
menuDescription
|
||||
= Menu
|
||||
{ file = MenuItemDescription "File" [ "menuItem", "file" ] Nothing fileMenuDescription
|
||||
, edit = MenuItemDescription "Edit" [ "menuItem", "edit" ] Nothing editMenuDescription
|
||||
, view = MenuItemDescription "View" [ "menuItem", "view" ] Nothing viewMenuDescription
|
||||
, help = MenuItemDescription "Help" [ "menuItem", "help" ] Nothing helpMenuDescription
|
||||
{ file = MenuItemDescription "File" [ "menuItem", "file" ] Nothing Nothing fileMenuDescription
|
||||
, edit = MenuItemDescription "Edit" [ "menuItem", "edit" ] Nothing Nothing editMenuDescription
|
||||
, view = MenuItemDescription "View" [ "menuItem", "view" ] Nothing Nothing viewMenuDescription
|
||||
, help = MenuItemDescription "Help" [ "menuItem", "help" ] Nothing Nothing helpMenuDescription
|
||||
}
|
||||
|
||||
fileMenuDescription :: FileMenu Description
|
||||
fileMenuDescription
|
||||
= FileMenu
|
||||
{ new = MenuItemDescription "New" [ "submenuItem" ] Nothing NoSubresource
|
||||
, open = MenuItemDescription "Open" [ "submenuItem" ] Nothing NoSubresource
|
||||
, save = MenuItemDescription "Save" [ "submenuItem" ] Nothing NoSubresource
|
||||
, saveAs = MenuItemDescription "Save as" [ "submenuItem" ] Nothing NoSubresource
|
||||
, close = MenuItemDescription "Close" [ "submenuItem" ] Nothing NoSubresource
|
||||
, quit = MenuItemDescription "Quit" [ "submenuItem" ] Nothing NoSubresource
|
||||
{ new = MenuItemDescription "New" [ "submenuItem" ] Nothing ( Just ( GDK.KEY_N, [ Control L ] ) ) NoSubresource
|
||||
, open = MenuItemDescription "Open" [ "submenuItem" ] Nothing ( Just ( GDK.KEY_O, [ Control L ] ) ) NoSubresource
|
||||
, save = MenuItemDescription "Save" [ "submenuItem" ] Nothing ( Just ( GDK.KEY_S, [ Control L ] ) ) NoSubresource
|
||||
, saveAs = MenuItemDescription "Save as" [ "submenuItem" ] Nothing ( Just ( GDK.KEY_S, [ Control L, Shift L ] ) ) NoSubresource
|
||||
, close = MenuItemDescription "Close" [ "submenuItem" ] Nothing ( Just ( GDK.KEY_W, [ Control L ] ) ) NoSubresource
|
||||
, quit = MenuItemDescription "Quit" [ "submenuItem" ] Nothing ( Just ( GDK.KEY_Q, [ Control L ] ) ) NoSubresource
|
||||
}
|
||||
|
||||
editMenuDescription :: EditMenu Description
|
||||
editMenuDescription
|
||||
= EditMenu
|
||||
{ undo = MenuItemDescription "Undo" [ "submenuItem" ] Nothing NoSubresource
|
||||
, redo = MenuItemDescription "Redo" [ "submenuItem" ] Nothing NoSubresource
|
||||
, history = MenuItemDescription "History" [ "submenuItem" ] Nothing NoSubresource
|
||||
{ undo = MenuItemDescription "Undo" [ "submenuItem" ] Nothing ( Just ( GDK.KEY_Z, [ Control L ] ) ) NoSubresource
|
||||
, redo = MenuItemDescription "Redo" [ "submenuItem" ] Nothing ( Just ( GDK.KEY_Y, [ Control L ] ) ) NoSubresource
|
||||
, history = MenuItemDescription "History" [ "submenuItem" ] Nothing ( Just ( GDK.KEY_H, [ Control L ] ) ) NoSubresource
|
||||
, editSep1 = SeparatorDescription [ "submenuSeparator" ]
|
||||
, cut = MenuItemDescription "Cut" [ "submenuItem" ] Nothing NoSubresource
|
||||
, copy = MenuItemDescription "Copy" [ "submenuItem" ] Nothing NoSubresource
|
||||
, paste = MenuItemDescription "Paste" [ "submenuItem" ] Nothing NoSubresource
|
||||
, duplicate = MenuItemDescription "Duplicate" [ "submenuItem" ] Nothing NoSubresource
|
||||
, delete = MenuItemDescription "Delete" [ "submenuItem" ] Nothing NoSubresource
|
||||
, cut = MenuItemDescription "Cut" [ "submenuItem" ] Nothing ( Just ( GDK.KEY_X, [ Control L ] ) ) NoSubresource
|
||||
, copy = MenuItemDescription "Copy" [ "submenuItem" ] Nothing ( Just ( GDK.KEY_C, [ Control L ] ) ) NoSubresource
|
||||
, paste = MenuItemDescription "Paste" [ "submenuItem" ] Nothing ( Just ( GDK.KEY_V, [ Control L ] ) ) NoSubresource
|
||||
, duplicate = MenuItemDescription "Duplicate" [ "submenuItem" ] Nothing ( Just ( GDK.KEY_D, [ Control L ] ) ) NoSubresource
|
||||
, delete = MenuItemDescription "Delete" [ "submenuItem" ] Nothing ( Just ( GDK.KEY_Delete, [] ) ) NoSubresource
|
||||
, editSep2 = SeparatorDescription [ "submenuSeparator" ]
|
||||
, preferences = MenuItemDescription "Preferences" [ "submenuItem" ] Nothing NoSubresource
|
||||
, preferences = MenuItemDescription "Preferences" [ "submenuItem" ] Nothing ( Just ( GDK.KEY_P, [ Control L, Shift L ] ) ) NoSubresource
|
||||
}
|
||||
|
||||
viewMenuDescription :: ViewMenu Description
|
||||
viewMenuDescription
|
||||
= ViewMenu
|
||||
{ navigator = MenuItemDescription "Navigator" [ "submenuItem" ] Nothing NoSubresource
|
||||
{ navigator = MenuItemDescription "Navigator" [ "submenuItem" ] Nothing Nothing NoSubresource
|
||||
, viewSep1 = SeparatorDescription [ "submenuSeparator" ]
|
||||
, strokes = MenuItemDescription "Strokes" [ "submenuItem" ] Nothing NoSubresource
|
||||
, brushes = MenuItemDescription "Brushes" [ "submenuItem" ] Nothing NoSubresource
|
||||
, metaparameters = MenuItemDescription "Metaparameters" [ "submenuItem" ] Nothing NoSubresource
|
||||
, strokes = MenuItemDescription "Strokes" [ "submenuItem" ] Nothing Nothing NoSubresource
|
||||
, brushes = MenuItemDescription "Brushes" [ "submenuItem" ] Nothing Nothing NoSubresource
|
||||
, metaparameters = MenuItemDescription "Metaparameters" [ "submenuItem" ] Nothing Nothing NoSubresource
|
||||
, viewSep2 = SeparatorDescription [ "submenuSeparator" ]
|
||||
, transform = MenuItemDescription "Transform" [ "submenuItem" ] Nothing NoSubresource
|
||||
, transform = MenuItemDescription "Transform" [ "submenuItem" ] Nothing Nothing NoSubresource
|
||||
}
|
||||
|
||||
helpMenuDescription :: HelpMenu Description
|
||||
helpMenuDescription
|
||||
= HelpMenu
|
||||
{ about = MenuItemDescription "About MetaBrush" [ "submenuItem" ] Nothing NoSubresource }
|
||||
{ about = MenuItemDescription "About MetaBrush" [ "submenuItem" ] Nothing ( Just ( GDK.KEY_question, [ Control L ] ) ) NoSubresource }
|
||||
|
||||
--------------------------------------------------------------------------------
|
||||
-- Creating a GTK menu bar from a menu description.
|
||||
|
@ -201,7 +208,11 @@ helpMenuDescription
|
|||
newMenuItem :: MonadIO m => MenuItem submenu Description -> m GTK.MenuItem
|
||||
newMenuItem ( MenuItemDescription { .. } ) = do
|
||||
menuItem <- GTK.menuItemNewWithLabel menuItemLabel
|
||||
-- Could set accelerator labels...
|
||||
for_ menuItemAccel \ ( key, modifiers ) -> do
|
||||
mbAccelLabel <- liftIO ( GTK.binGetChild menuItem >>?= ( GTK.castTo GTK.AccelLabel ) )
|
||||
for_ mbAccelLabel \ accelLabel -> do
|
||||
GTK.accelLabelSetAccel accelLabel key ( map modifierType modifiers )
|
||||
widgetAddClass accelLabel "accelLabel"
|
||||
unless ( null menuItemClasses ) do
|
||||
widgetAddClasses menuItem menuItemClasses
|
||||
for_ menuItemAction \ actionName -> do
|
||||
|
|
Loading…
Reference in a new issue