hashirama/metabrush
1
0
Fork 0
mirror of https://gitlab.com/sheaf/metabrush.git synced 2024-11-23 15:34:06 +00:00
Code Issues Actions Projects Releases Wiki Activity

dynamic file tab close button behaviour

Browse source
This commit is contained in:
sheaf 2020-09-04 22:28:31 +02:00
parent 86729cb462
commit 264fa8dff0
9 changed files with 138 additions and 28 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

1
MetaBrush.cabal
View file

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

1
app/Main.hs
View file

@ -332,6 +332,7 @@ main = do
fileBar@( FileBar { fileBarBox } ) <-
createFileBar
colours
variables
window titleBar title viewportDrawingArea infoBar

7
assets/theme.css
View file

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

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

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

75
src/app/MetaBrush/Asset/CloseTabButton.hs Normal file
View file

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

3
src/app/MetaBrush/Asset/Colours.hs
View file

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

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

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

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

@ -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.boxPackEnd fileBarBox newFileButton False False 0
GTK.boxPackStart fileBarBox fileTabsScroll True True 0
GTK.boxPackStart fileBarBox newFileButton False False 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

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

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