mirror of
https://gitlab.com/sheaf/metabrush.git
synced 2024-11-27 09:24:08 +00:00
update "toggle guides" menu text on toggle
This commit is contained in:
parent
091c1603bb
commit
e4779d8af2
43
app/Main.hs
43
app/Main.hs
|
@ -3,6 +3,7 @@
|
|||
{-# LANGUAGE NegativeLiterals #-}
|
||||
{-# LANGUAGE OverloadedStrings #-}
|
||||
{-# LANGUAGE RecordWildCards #-}
|
||||
{-# LANGUAGE RecursiveDo #-}
|
||||
{-# LANGUAGE ScopedTypeVariables #-}
|
||||
{-# LANGUAGE TypeApplications #-}
|
||||
|
||||
|
@ -91,9 +92,7 @@ import MetaBrush.UI.FileBar
|
|||
import MetaBrush.UI.InfoBar
|
||||
( InfoBar(..), createInfoBar, updateInfoBar )
|
||||
import MetaBrush.UI.Menu
|
||||
( createMenuBar
|
||||
--, MenuItem(..), Menu(..), FileMenu(..), EditMenu(..), ViewMenu(..)
|
||||
)
|
||||
( createMenuBar )
|
||||
import MetaBrush.UI.Panels
|
||||
( createPanelBar )
|
||||
import MetaBrush.UI.ToolBar
|
||||
|
@ -348,30 +347,30 @@ main = do
|
|||
|
||||
infoBar@( InfoBar { infoBarArea } ) <- createInfoBar colours
|
||||
|
||||
---------------------------------------------------------
|
||||
-- File bar
|
||||
|
||||
fileBar@( FileBar { fileBarBox } ) <-
|
||||
createFileBar
|
||||
colours
|
||||
variables
|
||||
window titleBar title viewport infoBar
|
||||
rec
|
||||
|
||||
---------------------------------------------------------
|
||||
-- File bar
|
||||
|
||||
fileBar@( FileBar { fileBarBox } ) <-
|
||||
createFileBar
|
||||
colours
|
||||
variables
|
||||
window titleBar title viewport infoBar menu
|
||||
|
||||
------------
|
||||
-- Menu bar
|
||||
|
||||
let
|
||||
uiElements :: UIElements
|
||||
uiElements = UIElements { menu, fileBar, .. }
|
||||
|
||||
menu <- createMenuBar uiElements variables colours
|
||||
|
||||
GTK.boxPackStart mainView fileBarBox False False 0
|
||||
GTK.boxPackStart mainView viewportGrid True True 0
|
||||
GTK.boxPackStart mainView infoBarArea False False 0
|
||||
|
||||
let
|
||||
uiElements :: UIElements
|
||||
uiElements = UIElements {..}
|
||||
|
||||
------------
|
||||
-- Menu bar
|
||||
|
||||
_menu <- createMenuBar uiElements variables colours
|
||||
|
||||
--GTK.widgetSetSensitive ( menuItem $ close $ menuItemSubmenu $ file menu ) False
|
||||
|
||||
---------------------------------------------------------
|
||||
-- Panels
|
||||
|
||||
|
|
|
@ -74,6 +74,10 @@ import qualified Control.Concurrent.STM as STM
|
|||
import qualified Control.Concurrent.STM.TVar as STM
|
||||
( readTVar, readTVarIO, swapTVar, modifyTVar', writeTVar )
|
||||
|
||||
-- text
|
||||
import Data.Text
|
||||
( Text )
|
||||
|
||||
-- MetaBrush
|
||||
import Math.Bezier.Stroke
|
||||
( StrokePoint(..) )
|
||||
|
@ -115,6 +119,8 @@ import MetaBrush.UI.InfoBar
|
|||
( updateInfoBar )
|
||||
import {-# SOURCE #-} MetaBrush.UI.FileBar
|
||||
( TabLocation(..), newFileTab, removeFileTab )
|
||||
import MetaBrush.UI.Menu
|
||||
( MenuItem(..), Menu(..), ViewMenu(..) )
|
||||
import MetaBrush.UI.ToolBar
|
||||
( Tool(..) )
|
||||
import MetaBrush.UI.Viewport
|
||||
|
@ -490,8 +496,17 @@ data ToggleGuides = ToggleGuides
|
|||
deriving stock Show
|
||||
|
||||
instance HandleAction ToggleGuides where
|
||||
handleAction ( UIElements { viewport = Viewport {..} } ) ( Variables { showGuidesTVar } ) _ = do
|
||||
STM.atomically $ STM.modifyTVar' showGuidesTVar not
|
||||
handleAction ( UIElements { viewport = Viewport {..}, menu } ) ( Variables { showGuidesTVar } ) _ = do
|
||||
guidesWereShown <- STM.atomically do
|
||||
guidesWereShown <- STM.readTVar showGuidesTVar
|
||||
STM.writeTVar showGuidesTVar ( not guidesWereShown )
|
||||
pure guidesWereShown
|
||||
let
|
||||
newText :: Text
|
||||
newText
|
||||
| guidesWereShown = "Show guides"
|
||||
| otherwise = "Hide guides"
|
||||
GTK.menuItemSetLabel ( menuItem $ toggleGuides $ menuItemSubmenu $ view menu ) newText
|
||||
GTK.widgetQueueDraw viewportDrawingArea
|
||||
for_ [ rulerCornerDrawingArea, topRulerDrawingArea, leftRulerDrawingArea ] \ drawingArea -> do
|
||||
GTK.widgetQueueDraw drawingArea
|
||||
|
|
112
src/app/MetaBrush/Action.hs-boot
Normal file
112
src/app/MetaBrush/Action.hs-boot
Normal file
|
@ -0,0 +1,112 @@
|
|||
module MetaBrush.Action where
|
||||
|
||||
-- base
|
||||
import Data.Word
|
||||
( Word32 )
|
||||
|
||||
-- gi-gtk
|
||||
import qualified GI.Gtk as GTK
|
||||
|
||||
-- MetaBrush
|
||||
import Math.Vector2D
|
||||
( Point2D, Vector2D )
|
||||
import {-# SOURCE #-} MetaBrush.Context
|
||||
( UIElements, Variables )
|
||||
import {-# SOURCE #-} MetaBrush.UI.FileBar
|
||||
( TabLocation(..) )
|
||||
import MetaBrush.UI.Viewport
|
||||
( Ruler(..) )
|
||||
import MetaBrush.Unique
|
||||
( Unique )
|
||||
|
||||
--------------------------------------------------------------------------------
|
||||
|
||||
class HandleAction action where
|
||||
handleAction :: UIElements -> Variables -> action -> IO ()
|
||||
|
||||
instance HandleAction ()
|
||||
|
||||
data NewFile = NewFile TabLocation
|
||||
instance HandleAction NewFile
|
||||
|
||||
data OpenFile = OpenFile TabLocation
|
||||
instance HandleAction OpenFile
|
||||
|
||||
data OpenFolder = OpenFolder TabLocation
|
||||
instance HandleAction OpenFolder
|
||||
|
||||
data Save = Save
|
||||
instance HandleAction Save
|
||||
|
||||
data SaveAs = SaveAs
|
||||
instance HandleAction SaveAs
|
||||
|
||||
data Close
|
||||
= CloseActive
|
||||
| CloseThis
|
||||
{ docToClose :: Unique }
|
||||
instance HandleAction Close
|
||||
|
||||
data SwitchTo = SwitchTo Unique
|
||||
instance HandleAction SwitchTo
|
||||
|
||||
data Quit = Quit
|
||||
instance HandleAction Quit
|
||||
quitEverything :: GTK.Window -> IO ()
|
||||
|
||||
data Undo = Undo
|
||||
instance HandleAction Undo
|
||||
|
||||
data Redo = Redo
|
||||
instance HandleAction Redo
|
||||
|
||||
data DiscardChanges = DiscardChanges
|
||||
instance HandleAction DiscardChanges
|
||||
|
||||
data Cut = Cut
|
||||
instance HandleAction Cut
|
||||
|
||||
data Copy = Copy
|
||||
instance HandleAction Copy
|
||||
|
||||
data Paste = Paste
|
||||
instance HandleAction Paste
|
||||
|
||||
data Duplicate = Duplicate
|
||||
instance HandleAction Duplicate
|
||||
|
||||
data Delete = Delete
|
||||
instance HandleAction Delete
|
||||
|
||||
data ToggleGuides = ToggleGuides
|
||||
instance HandleAction ToggleGuides
|
||||
|
||||
data Confirm = Confirm
|
||||
instance HandleAction Confirm
|
||||
|
||||
data About = About
|
||||
instance HandleAction About
|
||||
|
||||
data MouseMove = MouseMove ( Point2D Double )
|
||||
instance HandleAction MouseMove
|
||||
|
||||
data ActionOrigin
|
||||
= ViewportOrigin
|
||||
| RulerOrigin Ruler
|
||||
data MouseClickType
|
||||
= SingleClick
|
||||
| DoubleClick
|
||||
data MouseClick = MouseClick ActionOrigin MouseClickType Word32 ( Point2D Double )
|
||||
instance HandleAction MouseClick
|
||||
|
||||
data MouseRelease = MouseRelease Word32 ( Point2D Double )
|
||||
instance HandleAction MouseRelease
|
||||
|
||||
data Scroll = Scroll ( Point2D Double ) ( Vector2D Double )
|
||||
instance HandleAction Scroll
|
||||
|
||||
data KeyboardPress = KeyboardPress Word32
|
||||
instance HandleAction KeyboardPress
|
||||
|
||||
data KeyboardRelease = KeyboardRelease Word32
|
||||
instance HandleAction KeyboardRelease
|
|
@ -1,12 +1,12 @@
|
|||
{-# LANGUAGE BlockArguments #-}
|
||||
{-# LANGUAGE ConstraintKinds #-}
|
||||
{-# LANGUAGE DataKinds #-}
|
||||
{-# LANGUAGE DerivingStrategies #-}
|
||||
{-# LANGUAGE FlexibleContexts #-}
|
||||
{-# LANGUAGE LambdaCase #-}
|
||||
{-# LANGUAGE OverloadedStrings #-}
|
||||
{-# LANGUAGE RecordWildCards #-}
|
||||
{-# LANGUAGE NamedFieldPuns #-}
|
||||
{-# LANGUAGE TypeApplications #-}
|
||||
|
||||
module MetaBrush.Context
|
||||
( UIElements(..), Variables(..)
|
||||
|
@ -74,6 +74,8 @@ import {-# SOURCE #-} MetaBrush.UI.FileBar
|
|||
( FileBar, removeFileTab )
|
||||
import {-# SOURCE #-} MetaBrush.UI.InfoBar
|
||||
( InfoBar, updateInfoBar )
|
||||
import {-# SOURCE #-} MetaBrush.UI.Menu
|
||||
( Menu, ResourceType(Object) )
|
||||
import MetaBrush.UI.ToolBar
|
||||
( Tool, Mode )
|
||||
import MetaBrush.UI.Viewport
|
||||
|
@ -93,6 +95,7 @@ data UIElements
|
|||
, fileBar :: !FileBar
|
||||
, viewport :: !Viewport
|
||||
, infoBar :: !InfoBar
|
||||
, menu :: Menu Object -- needs to be lazy for "recursive do"
|
||||
, colours :: !Colours
|
||||
}
|
||||
|
||||
|
|
|
@ -1,4 +1,5 @@
|
|||
{-# LANGUAGE BlockArguments #-}
|
||||
{-# LANGUAGE DataKinds #-}
|
||||
{-# LANGUAGE DerivingStrategies #-}
|
||||
{-# LANGUAGE NamedFieldPuns #-}
|
||||
{-# LANGUAGE OverloadedStrings #-}
|
||||
|
@ -50,6 +51,8 @@ import MetaBrush.Document
|
|||
( Document(..), emptyDocument )
|
||||
import {-# SOURCE #-} MetaBrush.UI.InfoBar
|
||||
( InfoBar, updateInfoBar )
|
||||
import {-# SOURCE #-} MetaBrush.UI.Menu
|
||||
( Menu, ResourceType(Object) )
|
||||
import MetaBrush.UI.Viewport
|
||||
( Viewport(..) )
|
||||
import MetaBrush.Unique
|
||||
|
@ -184,12 +187,12 @@ newFileTab
|
|||
-- Updates the active document when buttons are clicked.
|
||||
createFileBar
|
||||
:: Colours -> Variables
|
||||
-> GTK.Window -> GTK.Box -> GTK.Label -> Viewport -> InfoBar
|
||||
-> GTK.Window -> GTK.Box -> GTK.Label -> Viewport -> InfoBar -> Menu Object
|
||||
-> IO FileBar
|
||||
createFileBar
|
||||
colours
|
||||
vars@( Variables { openDocumentsTVar } )
|
||||
window titleBar title viewport infoBar
|
||||
window titleBar title viewport infoBar menu
|
||||
= do
|
||||
|
||||
-- Create file bar: box containing scrollable tabs, and a "+" button after it.
|
||||
|
|
|
@ -1,3 +1,5 @@
|
|||
{-# LANGUAGE DataKinds #-}
|
||||
|
||||
module MetaBrush.UI.FileBar
|
||||
( FileBar(..)
|
||||
, createFileBar, newFileTab, removeFileTab
|
||||
|
@ -17,6 +19,8 @@ import MetaBrush.Document
|
|||
( Document )
|
||||
import {-# SOURCE #-} MetaBrush.UI.InfoBar
|
||||
( InfoBar )
|
||||
import {-# SOURCE #-} MetaBrush.UI.Menu
|
||||
( Menu, ResourceType(Object) )
|
||||
import MetaBrush.UI.Viewport
|
||||
( Viewport )
|
||||
import MetaBrush.Unique
|
||||
|
@ -39,7 +43,7 @@ instance Show TabLocation
|
|||
|
||||
createFileBar
|
||||
:: Colours -> Variables
|
||||
-> GTK.Window -> GTK.Box -> GTK.Label -> Viewport -> InfoBar
|
||||
-> GTK.Window -> GTK.Box -> GTK.Label -> Viewport -> InfoBar -> Menu Object
|
||||
-> IO FileBar
|
||||
|
||||
newFileTab
|
||||
|
|
|
@ -60,7 +60,7 @@ import Control.Monad.IO.Class
|
|||
( MonadIO(liftIO) )
|
||||
|
||||
-- MetaBrush
|
||||
import MetaBrush.Action
|
||||
import {-# SOURCE #-} MetaBrush.Action
|
||||
import MetaBrush.Context
|
||||
( UIElements(..), Variables(..)
|
||||
, LR(..), Modifier(..), modifierType
|
||||
|
@ -69,7 +69,7 @@ import MetaBrush.Asset.Colours
|
|||
( Colours )
|
||||
import MetaBrush.Asset.WindowIcons
|
||||
( drawMinimise, drawRestoreDown, drawMaximise, drawClose )
|
||||
import MetaBrush.UI.FileBar
|
||||
import {-# SOURCE #-} MetaBrush.UI.FileBar
|
||||
( TabLocation(..) )
|
||||
import MetaBrush.Util
|
||||
( widgetAddClass, widgetAddClasses )
|
||||
|
@ -159,7 +159,7 @@ data ViewMenu ( rt :: ResourceType )
|
|||
, viewSep2 :: !( Separator rt )
|
||||
, transform :: !( MenuItem () NoSubresource rt )
|
||||
, viewSep3 :: !( Separator rt )
|
||||
, guides :: !( MenuItem ToggleGuides NoSubresource rt )
|
||||
, toggleGuides :: !( MenuItem ToggleGuides NoSubresource rt )
|
||||
}
|
||||
deriving stock Generic
|
||||
|
||||
|
@ -219,7 +219,7 @@ viewMenuDescription
|
|||
, viewSep2 = SeparatorDescription [ "submenuSeparator" ]
|
||||
, transform = MenuItemDescription "Transform" [ "submenuItem" ] () Nothing NoSubresource
|
||||
, viewSep3 = SeparatorDescription [ "submenuSeparator" ]
|
||||
, guides = MenuItemDescription "Guides" [ "submenuItem" ] ToggleGuides ( Just ( GDK.KEY_G, [] ) ) NoSubresource
|
||||
, toggleGuides = MenuItemDescription "Hide guides" [ "submenuItem" ] ToggleGuides ( Just ( GDK.KEY_G, [] ) ) NoSubresource
|
||||
}
|
||||
|
||||
helpMenuDescription :: HelpMenu Description
|
||||
|
@ -305,7 +305,7 @@ newMenuBar uiElts vars accelGroup = do
|
|||
|
||||
-- | Add the menu bar to the given box (title bar box).
|
||||
createMenuBar :: UIElements -> Variables -> Colours -> IO ( Menu Object )
|
||||
createMenuBar uiElts@( UIElements { titleBar, window } ) vars colours = do
|
||||
createMenuBar uiElts@( UIElements { window, titleBar } ) vars colours = do
|
||||
accelGroup <- GTK.accelGroupNew
|
||||
GTK.windowAddAccelGroup window accelGroup
|
||||
( menuBar, menu ) <- newMenuBar uiElts vars accelGroup
|
||||
|
|
53
src/app/MetaBrush/UI/Menu.hs-boot
Normal file
53
src/app/MetaBrush/UI/Menu.hs-boot
Normal file
|
@ -0,0 +1,53 @@
|
|||
{-# LANGUAGE DataKinds #-}
|
||||
{-# LANGUAGE PolyKinds #-}
|
||||
{-# LANGUAGE RoleAnnotations #-}
|
||||
{-# LANGUAGE TypeFamilies #-}
|
||||
|
||||
module MetaBrush.UI.Menu
|
||||
( ResourceType(..), MenuItem
|
||||
, Menu
|
||||
, FileMenu, EditMenu, ViewMenu, HelpMenu
|
||||
, newMenuBar, createMenuBar
|
||||
) where
|
||||
|
||||
-- base
|
||||
import Data.Kind
|
||||
( Type )
|
||||
|
||||
-- gi-gtk
|
||||
import qualified GI.Gtk as GTK
|
||||
|
||||
-- transformers
|
||||
import Control.Monad.IO.Class
|
||||
( MonadIO )
|
||||
import MetaBrush.Asset.Colours
|
||||
( Colours )
|
||||
import {-# SOURCE #-} MetaBrush.Context
|
||||
( UIElements, Variables )
|
||||
|
||||
--------------------------------------------------------------------------------
|
||||
|
||||
data ResourceType
|
||||
= Description
|
||||
| Object
|
||||
|
||||
data family MenuItem ( action :: Type ) ( submenu :: ResourceType -> Type ) ( r :: ResourceType )
|
||||
|
||||
data Menu ( rt :: ResourceType )
|
||||
type role Menu nominal
|
||||
|
||||
data FileMenu ( rt :: ResourceType )
|
||||
type role FileMenu nominal
|
||||
|
||||
data EditMenu ( rt :: ResourceType )
|
||||
type role EditMenu nominal
|
||||
|
||||
data ViewMenu ( rt :: ResourceType )
|
||||
type role ViewMenu nominal
|
||||
|
||||
data HelpMenu ( rt :: ResourceType )
|
||||
type role HelpMenu nominal
|
||||
|
||||
newMenuBar :: MonadIO m => UIElements -> Variables -> GTK.AccelGroup -> m ( GTK.MenuBar, Menu Object )
|
||||
|
||||
createMenuBar :: UIElements -> Variables -> Colours -> IO ( Menu Object )
|
|
@ -2,7 +2,6 @@
|
|||
{-# LANGUAGE DerivingStrategies #-}
|
||||
{-# LANGUAGE OverloadedStrings #-}
|
||||
{-# LANGUAGE RecordWildCards #-}
|
||||
{-# LANGUAGE TypeApplications #-}
|
||||
|
||||
module MetaBrush.UI.Viewport
|
||||
( Viewport(..), createViewport
|
||||
|
|
Loading…
Reference in a new issue