hashirama/metabrush
1
0
Fork 0
mirror of https://gitlab.com/sheaf/metabrush.git synced 2024-11-05 14:53:37 +00:00
Code Issues Actions Projects Releases Wiki Activity

update "toggle guides" menu text on toggle

Browse source
This commit is contained in:
sheaf 2020-09-06 14:54:18 +02:00
parent 091c1603bb
commit e4779d8af2
9 changed files with 222 additions and 34 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

43
app/Main.hs
View file

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

19
src/app/MetaBrush/Action.hs
View file

@ -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
View 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

5
src/app/MetaBrush/Context.hs
View file

@ -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
}

7
src/app/MetaBrush/UI/FileBar.hs
View file

@ -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.

6
src/app/MetaBrush/UI/FileBar.hs-boot
View file

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

10
src/app/MetaBrush/UI/Menu.hs
View file

@ -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
View 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 )

1
src/app/MetaBrush/UI/Viewport.hs
View file

@ -2,7 +2,6 @@
{-# LANGUAGE DerivingStrategies #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE TypeApplications #-}
module MetaBrush.UI.Viewport
( Viewport(..), createViewport