From 264fa8dff0ecb83ea5f2fd2153b882cd503e5b46 Mon Sep 17 00:00:00 2001 From: sheaf Date: Fri, 4 Sep 2020 22:28:31 +0200 Subject: [PATCH] dynamic file tab close button behaviour --- MetaBrush.cabal | 1 + app/Main.hs | 1 + assets/theme.css | 7 ++- src/app/MetaBrush/Action.hs | 6 +- src/app/MetaBrush/Asset/CloseTabButton.hs | 75 +++++++++++++++++++++++ src/app/MetaBrush/Asset/Colours.hs | 3 +- src/app/MetaBrush/Context.hs | 3 + src/app/MetaBrush/UI/FileBar.hs | 56 +++++++++++------ src/app/MetaBrush/UI/FileBar.hs-boot | 14 ++++- 9 files changed, 138 insertions(+), 28 deletions(-) create mode 100644 src/app/MetaBrush/Asset/CloseTabButton.hs diff --git a/MetaBrush.cabal b/MetaBrush.cabal index 75fc3fc..80c3eb8 100644 --- a/MetaBrush.cabal +++ b/MetaBrush.cabal @@ -98,6 +98,7 @@ executable MetaBrush other-modules: MetaBrush.Action , MetaBrush.Asset.Brushes + , MetaBrush.Asset.CloseTabButton , MetaBrush.Asset.Colours , MetaBrush.Asset.Cursor , MetaBrush.Asset.InfoBar diff --git a/app/Main.hs b/app/Main.hs index 33eeeb6..5ecb85d 100644 --- a/app/Main.hs +++ b/app/Main.hs @@ -332,6 +332,7 @@ main = do fileBar@( FileBar { fileBarBox } ) <- createFileBar + colours variables window titleBar title viewportDrawingArea infoBar diff --git a/assets/theme.css b/assets/theme.css index 913ae2f..2c2e8e0 100644 --- a/assets/theme.css +++ b/assets/theme.css @@ -9,6 +9,9 @@ .active { background-color: rgb(72,70,61); } +.close { + color: rgb(181,43,43); +} .highlight { color: rgb(234,223,204); } @@ -349,11 +352,13 @@ tooltip { .fileBarTabButton { padding-left: 8px; - padding-right: 3px; + padding-right: 2px; margin: 0px; } .fileBarCloseButton { + min-width: 10px; + min-height: 22px; padding-left: 1px; padding-right: 5px; margin: 0px; diff --git a/src/app/MetaBrush/Action.hs b/src/app/MetaBrush/Action.hs index f17888c..aec572d 100644 --- a/src/app/MetaBrush/Action.hs +++ b/src/app/MetaBrush/Action.hs @@ -126,7 +126,7 @@ data NewFile = NewFile TabLocation instance HandleAction NewFile where handleAction uiElts vars ( NewFile tabLoc ) = - newFileTab vars uiElts Nothing tabLoc + newFileTab uiElts vars Nothing tabLoc --------------- -- Open file -- @@ -155,7 +155,7 @@ instance HandleAction OpenFile where case mbDoc of Left _errMessage -> pure () -- TODO: show warning dialog? Right doc -> do - newFileTab vars uiElts ( Just doc ) tabLoc + newFileTab uiElts vars ( Just doc ) tabLoc ----------------- -- Open folder -- @@ -184,7 +184,7 @@ instance HandleAction OpenFolder where case mbDoc of Left _errMessage -> pure () -- TODO: show warning dialog? Right doc -> do - newFileTab vars uiElts ( Just doc ) tabLoc + newFileTab uiElts vars ( Just doc ) tabLoc pure () --------------- diff --git a/src/app/MetaBrush/Asset/CloseTabButton.hs b/src/app/MetaBrush/Asset/CloseTabButton.hs new file mode 100644 index 0000000..a2ef709 --- /dev/null +++ b/src/app/MetaBrush/Asset/CloseTabButton.hs @@ -0,0 +1,75 @@ +{-# LANGUAGE BlockArguments #-} +{-# LANGUAGE NegativeLiterals #-} +{-# LANGUAGE RecordWildCards #-} + +module MetaBrush.Asset.CloseTabButton + ( drawCloseTabButton ) + where + +-- gi-cairo-render +import qualified GI.Cairo.Render as Cairo + +-- gi-gtk +import qualified GI.Gtk as GTK + +-- MetaBrush +import MetaBrush.Asset.Colours + ( ColourRecord(..), Colours ) +import MetaBrush.Util + ( withRGBA ) + +-------------------------------------------------------------------------------- + +-- | "Close tab" button. +drawCloseTabButton :: Colours -> Bool -> [ GTK.StateFlags ] -> Cairo.Render Bool +drawCloseTabButton ( Colours { .. } ) unsavedChanges flags = do + + Cairo.setLineCap Cairo.LineCapRound + Cairo.setLineJoin Cairo.LineJoinMiter + + if unsavedChanges + then do + if clicked + then withRGBA close Cairo.setSourceRGBA + else withRGBA plain Cairo.setSourceRGBA + Cairo.arc 5 11 5 0 ( 2 * pi ) + Cairo.fill + if clicked + then withRGBA bg Cairo.setSourceRGBA + else + if hover + then withRGBA close Cairo.setSourceRGBA + else withRGBA bg Cairo.setSourceRGBA + else + if clicked + then do + Cairo.setLineWidth 5 + withRGBA close Cairo.setSourceRGBA + drawCross + + withRGBA bg Cairo.setSourceRGBA + else + if hover + then withRGBA close Cairo.setSourceRGBA + else withRGBA plain Cairo.setSourceRGBA + + Cairo.setLineWidth 2 + + drawCross + + pure True + where + hover, clicked :: Bool + hover = any ( == GTK.StateFlagsPrelight ) flags + clicked = any ( == GTK.StateFlagsActive ) flags + +drawCross :: Cairo.Render () +drawCross = do + Cairo.newPath + Cairo.moveTo 3 9 + Cairo.lineTo 7 13 + Cairo.stroke + + Cairo.moveTo 3 13 + Cairo.lineTo 7 9 + Cairo.stroke diff --git a/src/app/MetaBrush/Asset/Colours.hs b/src/app/MetaBrush/Asset/Colours.hs index 0c6e0b7..f9767f3 100644 --- a/src/app/MetaBrush/Asset/Colours.hs +++ b/src/app/MetaBrush/Asset/Colours.hs @@ -30,7 +30,7 @@ import Data.Text data ColourRecord a = Colours - { bg, active, highlight, cursor, cursorOutline + { bg, active, close, highlight, cursor, cursorOutline , plain, base, splash , pathPoint, pathPointOutline, controlPoint, controlPointOutline , path, brush, brushStroke, brushCenter @@ -58,6 +58,7 @@ colourNames :: ColourRecord ColourName colourNames = Colours { bg = ColourName "bg" BackgroundColour [ GTK.StateFlagsNormal ] , active = ColourName "active" BackgroundColour [ GTK.StateFlagsNormal ] + , close = ColourName "close" Colour [ GTK.StateFlagsNormal ] , highlight = ColourName "highlight" Colour [ GTK.StateFlagsNormal ] , cursor = ColourName "cursor" Colour [ GTK.StateFlagsNormal ] , cursorOutline = ColourName "cursorStroke" Colour [ GTK.StateFlagsNormal ] diff --git a/src/app/MetaBrush/Context.hs b/src/app/MetaBrush/Context.hs index 1e26c4e..d7fbf65 100644 --- a/src/app/MetaBrush/Context.hs +++ b/src/app/MetaBrush/Context.hs @@ -52,6 +52,8 @@ import Data.Text -- MetaBrush import Math.Vector2D ( Point2D ) +import MetaBrush.Asset.Colours + ( Colours ) import MetaBrush.Document ( Document(..) ) import MetaBrush.Document.Draw @@ -77,6 +79,7 @@ data UIElements , fileBar :: !FileBar , viewportDrawingArea :: !GTK.DrawingArea , infoBar :: !InfoBar + , colours :: !Colours } data Variables diff --git a/src/app/MetaBrush/UI/FileBar.hs b/src/app/MetaBrush/UI/FileBar.hs index afd01f5..47b01b7 100644 --- a/src/app/MetaBrush/UI/FileBar.hs +++ b/src/app/MetaBrush/UI/FileBar.hs @@ -24,6 +24,10 @@ import Data.Traversable import qualified Data.Map.Strict as Map ( lookup, insert, delete ) +-- gi-cairo-connector +import qualified GI.Cairo.Render.Connector as Cairo + ( renderWithContext ) + -- gi-gtk import qualified GI.Gtk as GTK @@ -36,6 +40,10 @@ import qualified Control.Concurrent.STM.TVar as STM -- MetaBrush import MetaBrush.Action ( SwitchTo(..), Close(..), handleAction ) +import MetaBrush.Asset.CloseTabButton + ( drawCloseTabButton ) +import MetaBrush.Asset.Colours + ( Colours ) import MetaBrush.Context ( UIElements(..), Variables(..) , updateTitle @@ -66,14 +74,14 @@ data TabLocation deriving stock Show newFileTab - :: Variables - -> UIElements + :: UIElements + -> Variables -> Maybe Document -> TabLocation -> IO () newFileTab - vars@( Variables { .. } ) uiElts@( UIElements { fileBar = FileBar {..}, .. } ) + vars@( Variables { .. } ) mbDoc newTabLoc = do @@ -87,10 +95,24 @@ newFileTab newDocUniq <- STM.atomically $ freshUnique uniqueSupply pure ( emptyDocument ( "Untitled " <> uniqueText newDocUniq ) newDocUniq ) + let + newUnique :: Unique + newUnique = documentUnique newDoc + -- File tab elements. pgButton <- GTK.radioButtonNewWithLabelFromWidget ( Just fileBarPhantomRadioButton ) ( displayName newDoc ) GTK.toggleButtonSetMode pgButton False -- don't display radio indicator - closeFileButton <- GTK.buttonNewWithLabel "x" + closeFileButton <- GTK.buttonNew + closeFileArea <- GTK.drawingAreaNew + GTK.containerAdd closeFileButton closeFileArea + + void $ GTK.onWidgetDraw closeFileArea \ cairoContext -> do + mbTabDoc <- Map.lookup newUnique <$> STM.readTVarIO openDocumentsTVar + let + unsaved :: Bool + unsaved = maybe False unsavedChanges mbTabDoc + flags <- GTK.widgetGetStateFlags closeFileButton + Cairo.renderWithContext ( drawCloseTabButton colours unsaved flags ) cairoContext -- Create box for file tab elements. tab <- GTK.boxNew GTK.OrientationHorizontal 0 @@ -131,9 +153,6 @@ newFileTab pure False -- Update the state: switch to this new document. - let - newUnique :: Unique - newUnique = documentUnique newDoc STM.atomically do STM.modifyTVar' openDocumentsTVar ( Map.insert newUnique newDoc ) STM.modifyTVar' fileBarTabsTVar ( Map.insert newUnique tab ) @@ -151,13 +170,11 @@ newFileTab ( SwitchTo newUnique ) else do GTK.widgetSetStateFlags tab ( filter ( /= GTK.StateFlagsActive ) flags ) True - GTK.labelSetText title "MetaBrush" - GTK.setWindowTitle window "MetaBrush" + GTK.widgetQueueDraw closeFileArea - void $ GTK.onButtonClicked closeFileButton - ( handleAction uiElts vars - ( CloseThis newUnique ) - ) + void $ GTK.onButtonClicked closeFileButton do + GTK.widgetQueueDraw closeFileArea + handleAction uiElts vars ( CloseThis newUnique ) GTK.toggleButtonSetActive pgButton True @@ -165,10 +182,11 @@ newFileTab -- -- Updates the active document when buttons are clicked. createFileBar - :: Variables + :: Colours -> Variables -> GTK.Window -> GTK.Box -> GTK.Label -> GTK.DrawingArea -> InfoBar -> IO FileBar createFileBar + colours vars@( Variables { openDocumentsTVar } ) window titleBar title viewportDrawingArea infoBar = do @@ -184,8 +202,8 @@ createFileBar newFileButton <- GTK.buttonNewWithLabel "+" widgetAddClasses newFileButton [ "newFileButton" ] - GTK.boxPackStart fileBarBox fileTabsScroll True True 0 - GTK.boxPackStart fileBarBox newFileButton False False 0 + GTK.boxPackEnd fileBarBox newFileButton False False 0 + GTK.boxPackStart fileBarBox fileTabsScroll True True 0 fileTabsBox <- GTK.boxNew GTK.OrientationHorizontal 0 GTK.containerAdd fileTabsScroll fileTabsBox @@ -203,15 +221,13 @@ createFileBar documents <- STM.readTVarIO openDocumentsTVar for_ documents \ doc -> newFileTab - vars - uiElements + uiElements vars ( Just doc ) LastTab void $ GTK.onButtonClicked newFileButton do newFileTab - vars - uiElements + uiElements vars Nothing LastTab diff --git a/src/app/MetaBrush/UI/FileBar.hs-boot b/src/app/MetaBrush/UI/FileBar.hs-boot index 0f25e27..9b3e07b 100644 --- a/src/app/MetaBrush/UI/FileBar.hs-boot +++ b/src/app/MetaBrush/UI/FileBar.hs-boot @@ -9,6 +9,8 @@ module MetaBrush.UI.FileBar import qualified GI.Gtk as GTK -- MetaBrush +import MetaBrush.Asset.Colours + ( Colours ) import {-# SOURCE #-} MetaBrush.Context ( Variables, UIElements ) import MetaBrush.Document @@ -34,10 +36,16 @@ data TabLocation instance Show TabLocation createFileBar - :: Variables + :: Colours -> Variables -> GTK.Window -> GTK.Box -> GTK.Label -> GTK.DrawingArea -> InfoBar -> IO FileBar -newFileTab :: Variables -> UIElements -> Maybe Document -> TabLocation -> IO () +newFileTab + :: UIElements -> Variables + -> Maybe Document -> TabLocation + -> IO () -removeFileTab :: GTK.Window -> GTK.Label -> GTK.DrawingArea -> InfoBar -> Variables -> Unique -> IO () +removeFileTab + :: GTK.Window -> GTK.Label -> GTK.DrawingArea -> InfoBar -> Variables + -> Unique + -> IO ()