dynamic file tab close button behaviour

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

app/Main.hs

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

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;

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

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

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 ]

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

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.widgetQueueDraw closeFileArea
-        GTK.setWindowTitle window "MetaBrush"
 
-    void $ GTK.onButtonClicked closeFileButton
+    void $ GTK.onButtonClicked closeFileButton do
-      ( handleAction uiElts vars
+      GTK.widgetQueueDraw closeFileArea
-        ( CloseThis newUnique )
+      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 vars
-        uiElements
         ( Just doc )
         LastTab
 
     void $ GTK.onButtonClicked newFileButton do
       newFileTab
-        vars
+        uiElements vars
-        uiElements
         Nothing
         LastTab
 

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