add visible/locked layer icons

MetaBrush.cabal

@@ -235,7 +235,7 @@ executable MetaBrush
       , MetaBrush.Asset.Cursor
       , MetaBrush.Asset.InfoBar
       , MetaBrush.Asset.Logo
-      , MetaBrush.Asset.TickBox
+      , MetaBrush.Asset.StrokeIcons
       , MetaBrush.Asset.Tools
       , MetaBrush.Asset.WindowIcons
       , MetaBrush.Event

assets/theme.css

@@ -6,7 +6,7 @@
 */
 
 .metabrush .toggle, .metabrush .dialogButton, .metabrush .titlebar,
-.metabrush .windowIcon, .metabrush .fileBarCloseButton,
+.metabrush .windowIcon, .metabrush .strokeButton, .metabrush .fileBarCloseButton,
 .metabrush .newFileButton, .metabrush .header,
 .metabrush .paned, .metabrush .panel, .metabrush .tabs, .metabrush .frame {
   all: unset;
@@ -565,25 +565,13 @@ To specify it in CSS, set the box-shadow of the contents node."
   margin-right: 4px;
 }
 
-/* Check boxes */
+/* Stroke visibility and locked button */
-.metabrush checkbutton {
+.metabrush .strokeButton {
-  background-image: none;
+  min-width: 16px;
-  background-color: unset;
+  min-height: 16px;
+  margin-right: 4px;
 }
 
-.metabrush checkbutton check {
-  color: @highlight;
-  border: 1px solid @bg;
-  border-radius: 3px;
-  padding: 1px;
-  background-image: none;
-  background-color: @active;
-  box-shadow: unset;
-  padding: 3px;
-  transform: scale(0.66);
-}
-
-
 .metabrush .layer-item, .metabrush .brush-item {
   color: @plain;
   background-color: @active;

src/app/MetaBrush/Asset/StrokeIcons.hs

@@ -0,0 +1,110 @@
+module MetaBrush.Asset.StrokeIcons
+  ( drawVisible, drawInvisible, drawLocked, drawUnlocked )
+  where
+
+-- gi-cairo-render
+import qualified GI.Cairo.Render as Cairo
+
+-- MetaBrush
+import MetaBrush.Asset.Colours
+  ( ColourRecord(..), Colours )
+import MetaBrush.GTK.Util
+  ( withRGBA, withRGBAndAlpha )
+
+--------------------------------------------------------------------------------
+
+drawVisible :: Colours -> Cairo.Render Bool
+drawVisible ( Colours { bg, highlight } ) = do
+
+  withRGBA bg Cairo.setSourceRGBA
+
+  Cairo.moveTo 1.5 8
+  Cairo.curveTo 6 2 10 2 14.5 8
+  Cairo.curveTo 10 14 6 14 1.5 8
+  Cairo.closePath
+  Cairo.fillPreserve
+
+  withRGBA highlight Cairo.setSourceRGBA
+
+  Cairo.newPath
+  Cairo.arc 8 8 3.1 0 ( 2 * pi )
+  Cairo.closePath
+  Cairo.fillPreserve
+
+  withRGBA bg Cairo.setSourceRGBA
+
+  Cairo.newPath
+  Cairo.arc 8 8 2.2 0 ( 2 * pi )
+  Cairo.closePath
+  Cairo.fillPreserve
+
+  withRGBA highlight Cairo.setSourceRGBA
+
+  Cairo.newPath
+  Cairo.arc 6.2 6.2 1.8 ( 1.75 * pi ) ( 0.75 * pi )
+  Cairo.closePath
+  Cairo.fillPreserve
+
+  pure True
+
+drawInvisible :: Colours -> Cairo.Render Bool
+drawInvisible ( Colours { bg } ) = do
+
+  withRGBA bg Cairo.setSourceRGBA
+
+  Cairo.moveTo 1.5 8
+  Cairo.curveTo 6 2 10 2 14.5 8
+  Cairo.curveTo 10 14 6 14 1.5 8
+  Cairo.closePath
+  Cairo.fillPreserve
+
+  pure True
+
+drawLocked :: Colours -> Cairo.Render Bool
+drawLocked ( Colours { .. } ) = do
+
+  withRGBA bg Cairo.setSourceRGBA
+
+  Cairo.newPath
+  Cairo.moveTo  3 6.5
+  Cairo.lineTo  3 12
+  Cairo.arcNegative 4 12 1 pi ( 0.5 * pi )
+  Cairo.lineTo 12.5 13
+  Cairo.arcNegative 12 12 1 ( 0.5 * pi ) 0
+  Cairo.lineTo 13 6.5
+  Cairo.closePath
+  Cairo.fillPreserve
+
+  Cairo.newPath
+  Cairo.moveTo 5 6.5
+  Cairo.lineTo 5 5
+  Cairo.arc 8 5 3 pi 0
+  Cairo.lineTo 11 6.5
+  Cairo.setLineWidth 1.5
+  Cairo.stroke
+
+  pure True
+
+drawUnlocked :: Colours -> Cairo.Render Bool
+drawUnlocked ( Colours { .. } ) = do
+
+  withRGBAndAlpha bg 0.1 Cairo.setSourceRGBA
+
+  Cairo.newPath
+  Cairo.moveTo  3 6.5
+  Cairo.lineTo  3 12
+  Cairo.arcNegative 4 12 1 pi ( 0.5 * pi )
+  Cairo.lineTo 12.5 13
+  Cairo.arcNegative 12 12 1 ( 0.5 * pi ) 0
+  Cairo.lineTo 13 6.5
+  Cairo.closePath
+  Cairo.fillPreserve
+
+  Cairo.newPath
+  Cairo.moveTo 5 6.5
+  Cairo.lineTo 5 5
+  Cairo.arc 8 5 3 pi ( 1.8 * pi )
+  Cairo.setLineWidth 1.5
+  Cairo.stroke
+
+  pure True

src/app/MetaBrush/Asset/TickBox.hs

@@ -1,100 +0,0 @@
-module MetaBrush.Asset.TickBox
-  ( drawBox, drawTickedBox )
-  where
-
--- gi-cairo-render
-import qualified GI.Cairo.Render as Cairo
-
--- MetaBrush
-import MetaBrush.Asset.Colours
-  ( ColourRecord(..), Colours )
-import MetaBrush.GTK.Util
-  ( withRGBA )
-
---------------------------------------------------------------------------------
-
--- | Non-ticked box. Width = 14, height = 12.
-drawBox :: Colours -> Cairo.Render Bool
-drawBox ( Colours { plain } ) = do
-  withRGBA plain Cairo.setSourceRGBA
-
-  Cairo.newPath
-  Cairo.moveTo   2.015625  0.769531
-  Cairo.curveTo  0.910156  0.769531  0         1.6875    0         2.789063
-  Cairo.lineTo   0        10
-  Cairo.curveTo  0        11.101563  0.910156 12.015625  2.015625 12.015625
-  Cairo.lineTo   9.226563 12.015625
-  Cairo.curveTo 10.328125 12.015625 11.246094 11.101563 11.246094 10
-  Cairo.lineTo  11.246094  2.789063
-  Cairo.curveTo 11.246094  1.6875   10.328125  0.769531  9.226563  0.769531
-  Cairo.closePath
-  Cairo.moveTo   2.015625  2.375
-  Cairo.lineTo   9.226563  2.375
-  Cairo.curveTo  9.46875   2.375    9.640625  2.546875 9.640625  2.789063
-  Cairo.lineTo   9.640625 10
-  Cairo.curveTo  9.640625 10.242188 9.46875  10.414063 9.226563 10.414063
-  Cairo.lineTo   2.015625 10.414063
-  Cairo.curveTo  1.769531 10.414063 1.597656 10.242188 1.597656 10
-  Cairo.lineTo   1.597656  2.789063
-  Cairo.curveTo  1.597656  2.546875 1.769531  2.375    2.015625  2.375
-  Cairo.closePath
-
-  Cairo.setFillRule Cairo.FillRuleWinding
-  Cairo.fillPreserve
-
-  pure True
-
-
--- | Ticked box. Width = 14, height = 12.
-drawTickedBox :: Colours -> Cairo.Render Bool
-drawTickedBox ( Colours { plain } ) = do
-
-  -- Box
-  withRGBA plain Cairo.setSourceRGBA
-  Cairo.newPath
-  Cairo.moveTo   2.015625  0.769531
-  Cairo.curveTo  0.910156  0.769531  0         1.679688  0         2.785156
-  Cairo.lineTo   0         9.996094
-  Cairo.curveTo  0        11.097656  0.910156 12.015625  2.015625 12.015625
-  Cairo.lineTo   9.226563 12.015625
-  Cairo.curveTo 10.328125 12.015625 11.246094 11.097656 11.246094  9.996094
-  Cairo.lineTo  11.246094  5.867188
-  Cairo.lineTo   9.640625  7.476563
-  Cairo.lineTo   9.640625  9.996094
-  Cairo.curveTo  9.640625 10.238281  9.46875  10.410156  9.226563 10.410156
-  Cairo.lineTo   2.015625 10.410156
-  Cairo.curveTo  1.769531 10.410156  1.597656 10.238281  1.597656  9.996094
-  Cairo.lineTo   1.597656  2.785156
-  Cairo.curveTo  1.597656  2.539063  1.769531  2.371094  2.015625  2.371094
-  Cairo.lineTo   9.226563  2.371094
-  Cairo.curveTo  9.277344  2.371094  9.324219  2.378906  9.367188  2.394531
-  Cairo.lineTo  10.511719  1.25
-  Cairo.curveTo 10.160156  0.957031  9.710938  0.769531  9.226563  0.769531
-  Cairo.closePath
-  Cairo.fillPreserve
-
-  -- Tickmark
-  withRGBA plain Cairo.setSourceRGBA
-  Cairo.newPath
-  Cairo.moveTo  13.40625  0.0078125
-  Cairo.curveTo 13.191406 0.0390625 12.96875   0.144531  12.785156 0.328125
-  Cairo.lineTo   6.511719 6.605469
-  Cairo.lineTo   4.597656 4.691406
-  Cairo.curveTo  4.230469 4.328125   3.710938  4.257813   3.425781 4.542969
-  Cairo.lineTo   3.144531 4.820313
-  Cairo.curveTo  2.863281 5.105469   2.929688  5.628906   3.300781 5.992188
-  Cairo.lineTo   5.8125   8.5
-  Cairo.curveTo  5.925781 8.609375   6.046875  8.683594   6.175781 8.738281
-  Cairo.curveTo  6.261719 8.78125    6.332031  8.804688   6.417969 8.816406
-  Cairo.curveTo  6.425781 8.816406   6.429688  8.816406   6.445313 8.816406
-  Cairo.curveTo  6.53125  8.824219   6.605469  8.820313   6.6875   8.796875
-  Cairo.curveTo  6.71875  8.789063   6.746094  8.785156   6.773438 8.773438
-  Cairo.curveTo  6.929688 8.722656   7.085938  8.644531   7.21875  8.511719
-  Cairo.lineTo  14.097656 1.625
-  Cairo.curveTo 14.464844 1.261719  14.53125   0.738281  14.253906 0.453125
-  Cairo.lineTo  13.976563 0.179688
-  Cairo.curveTo 13.835938 0.0351563 13.632813 -0.0195313 13.421875 0.0078125
-  Cairo.closePath
-  Cairo.fillPreserve
-
-  pure True

src/app/MetaBrush/GTK/Util.hs

@@ -2,7 +2,8 @@
 {-# LANGUAGE ScopedTypeVariables #-}
 
 module MetaBrush.GTK.Util
-  ( withRGBA, showRGBA
+  ( withRGBA, withRGBAndAlpha
+  , showRGBA
   , widgetAddClasses, widgetAddClass
   , widgetShow
   , (>=?=>), (>>?=)
@@ -45,6 +46,13 @@ withRGBA rgba f = do
   a <- realToFrac <$> GDK.getRGBAAlpha rgba
   f r g b a
 
+withRGBAndAlpha :: MonadIO m => GDK.RGBA -> Double -> ( Double -> Double -> Double -> Double -> m b ) -> m b
+withRGBAndAlpha rgba alpha f = do
+  r <- realToFrac <$> GDK.getRGBARed   rgba
+  g <- realToFrac <$> GDK.getRGBAGreen rgba
+  b <- realToFrac <$> GDK.getRGBABlue  rgba
+  f r g b alpha
+
 showRGBA :: MonadIO m => GDK.RGBA -> m String
 showRGBA rgba = withRGBA rgba \ r g b a ->
   pure $ "rgba(" ++ show r ++ "," ++ show g ++ "," ++ show b ++ "," ++ show a ++ ")"

src/app/MetaBrush/UI/StrokeTreeView.hs

@@ -47,6 +47,10 @@ import qualified Data.Sequence as Seq
 import Data.Generics.Product.Fields
   ( field' )
 
+-- gi-cairo-connector
+import qualified GI.Cairo.Render.Connector as Cairo
+  ( renderWithContext )
+
 -- gi-gdk
 import qualified GI.Gdk as GDK
 
@@ -87,6 +91,8 @@ import MetaBrush.Application.Context
 import MetaBrush.Application.UpdateDocument
 import MetaBrush.Asset.Brushes
   ( lookupBrush )
+import MetaBrush.Asset.StrokeIcons
+  ( drawVisible, drawInvisible, drawLocked, drawUnlocked )
 import MetaBrush.Brush
 import MetaBrush.Document
 import MetaBrush.Document.Diff
@@ -323,9 +329,10 @@ instance HasLayerData GTK.ListItem where
 --        - Label
 data LayerViewWidget =
   LayerViewWidget
-    { layerViewContentBox  :: GTK.Box
+    { layerViewContentBox    :: GTK.Box
-    , layerViewCheckButton :: GTK.CheckButton
+    , layerViewVisibleButton :: ( GTK.Button, GTK.DrawingArea )
-    , layerViewLabel       :: GTK.EditableLabel
+    , layerViewLockedButton  :: ( GTK.Button, GTK.DrawingArea )
+    , layerViewLabel         :: GTK.EditableLabel
     }
 
 newLayerViewWidget :: IO GTK.TreeExpander
@@ -337,14 +344,27 @@ newLayerViewWidget = do
   GTK.treeExpanderSetIndentForDepth expander True
   GTK.treeExpanderSetHideExpander   expander False
 
-  contentBox <- GTK.boxNew GTK.OrientationHorizontal 20
+  contentBox <- GTK.boxNew GTK.OrientationHorizontal 0
   GTK.treeExpanderSetChild expander ( Just contentBox )
 
-  checkBox <- GTK.checkButtonNew
-  GTK.boxAppend contentBox checkBox
   itemLabel <- editableLabelNew
   GTK.boxAppend contentBox itemLabel
 
+  visibleButton <- GTK.buttonNew
+  lockedButton  <- GTK.buttonNew
+  GTK.boxAppend contentBox visibleButton
+  GTK.boxAppend contentBox lockedButton
+
+
+  widgetAddClass visibleButton "strokeButton"
+  widgetAddClass  lockedButton "strokeButton"
+
+  visibleButtonArea <- GTK.drawingAreaNew
+  lockedButtonArea  <- GTK.drawingAreaNew
+
+  GTK.buttonSetChild visibleButton ( Just visibleButtonArea )
+  GTK.buttonSetChild  lockedButton ( Just  lockedButtonArea )
+
   return expander
 
 -- | Create a new editable label, but remove any 'DragSource' or 'DropTarget'
@@ -393,20 +413,33 @@ getLayerViewWidget expander = do
     Nothing -> error "getLayerViewWidget: expected ListItem->Expander->Box"
     Just contentBox0 -> do
       contentBox <- GTK.unsafeCastTo GTK.Box contentBox0
-      mbCheckButton <- traverse ( GTK.unsafeCastTo GTK.CheckButton ) =<< GTK.widgetGetFirstChild contentBox
+      mbLayerLabel <- traverse ( GTK.unsafeCastTo GTK.EditableLabel ) =<< GTK.widgetGetFirstChild contentBox
-      case mbCheckButton of
+      case mbLayerLabel of
-        Nothing -> error "getLayerViewWidget: expected ListItem->Expander->Box->CheckButton"
+        Nothing -> error "getLayerViewWidget: expected ListItem->Expander->Box->LayerLabel"
-        Just checkButton -> do
+        Just layerLabel -> do
-          mbLayerLabel <- traverse ( GTK.unsafeCastTo GTK.EditableLabel ) =<< GTK.widgetGetNextSibling checkButton
+          mbVisibleButton <- traverse ( GTK.unsafeCastTo GTK.Button ) =<< GTK.widgetGetNextSibling layerLabel
-          case mbLayerLabel of
+          case mbVisibleButton of
-            Nothing -> error "getLayerViewWidget: expected ListItem->Expander->Box->{CheckButton,LayerLabel}"
+            Nothing -> error "getLayerViewWidget: expected ListItem->Expander->Box->{LayerLabel,Button}"
-            Just layerLabel ->
+            Just visibleButton -> do
-              return $
+              mbVisibleArea <- traverse ( GTK.unsafeCastTo GTK.DrawingArea ) =<< GTK.widgetGetFirstChild visibleButton
-                LayerViewWidget
+              case mbVisibleArea of
-                  { layerViewContentBox = contentBox
+                Nothing -> error "getLayerViewWidget: expected ListItem->Expander->Box->{LayerLabel,Button->DrawingArea}"
-                  , layerViewCheckButton = checkButton
+                Just visibleArea -> do
-                  , layerViewLabel = layerLabel
+                  mbLockedButton <- traverse ( GTK.unsafeCastTo GTK.Button ) =<< GTK.widgetGetNextSibling visibleButton
-                  }
+                  case mbLockedButton of
+                    Nothing -> error "getLayerViewWidget: expected ListItem->Expander->Box->{LayerLabel,Button,Button}"
+                    Just lockedButton -> do
+                      mbLockedArea <- traverse ( GTK.unsafeCastTo GTK.DrawingArea ) =<< GTK.widgetGetFirstChild lockedButton
+                      case mbLockedArea of
+                        Nothing -> error "getLayerViewWidget: expected ListItem->Expander->Box->{LayerLabel,Button,Button->DrawingArea}"
+                        Just lockedArea -> do
+                          return $
+                            LayerViewWidget
+                              { layerViewContentBox = contentBox
+                              , layerViewVisibleButton = ( visibleButton, visibleArea )
+                              , layerViewLockedButton = ( lockedButton, lockedArea )
+                              , layerViewLabel = layerLabel
+                              }
 
 ------------------
 -- GTK ListView --
@@ -414,7 +447,7 @@ getLayerViewWidget expander = do
 
 -- | Create a new 'GTK.ListView' that displays 'LayerItem's.
 newLayerView :: UIElements -> Variables -> IO GTK.ListView
-newLayerView uiElts@( UIElements { window } ) vars = mdo
+newLayerView uiElts@( UIElements { window, colours } ) vars = mdo
 
   layersListFactory <- GTK.signalListItemFactoryNew
   layerMenu <- GIO.menuNew
@@ -445,8 +478,10 @@ newLayerView uiElts@( UIElements { window } ) vars = mdo
         widgetAddClass expander "layer-item"
 
         LayerViewWidget
-          { layerViewLabel = label
+          { layerViewLabel         = label
-          , layerViewCheckButton = visibleButton }
+          , layerViewVisibleButton = ( visibleButton, visibleDrawingArea )
+          , layerViewLockedButton  = (  lockedButton,  lockedDrawingArea )
+          }
             <- getLayerViewWidget expander
 
         ------------------
@@ -484,21 +519,56 @@ newLayerView uiElts@( UIElements { window } ) vars = mdo
              -> return ()
 
         ----------------------------
-        -- Visibility CheckButton --
+        -- Visible/locked buttons --
         ----------------------------
 
-        void $ GTK.onCheckButtonToggled visibleButton $ do
+        void $ GTK.onButtonClicked visibleButton $ do
           uniq <- layerUnique <$> getLayerData listItem
-          visible <- GTK.checkButtonGetActive ?self
           modifyingCurrentDocument uiElts vars \ doc -> do
-            let doc' =
+            let wasInvisible = Set.member uniq ( invisibleLayers $ layerMetadata $ documentMetadata doc )
-                 over ( field' @"documentMetadata" . field' @"layerMetadata"
+                doc' =
-                      . field' @"invisibleLayers"
+                  over ( field' @"documentMetadata" . field' @"layerMetadata"
-                      )
+                       . field' @"invisibleLayers"
-                    ( if visible then Set.delete uniq else Set.insert uniq )
+                       )
+                    ( if wasInvisible then Set.delete uniq else Set.insert uniq )
                     doc
             return $
-              UpdateDoc $ UpdateDocumentTo doc' TrivialDiff
+              UpdateDocAndThen ( UpdateDocumentTo doc' TrivialDiff ) $
+                GTK.widgetQueueDraw visibleDrawingArea
+
+        void $ GTK.onButtonClicked lockedButton $ do
+          uniq <- layerUnique <$> getLayerData listItem
+          modifyingCurrentDocument uiElts vars \ doc -> do
+            let wasLocked = Set.member uniq ( lockedLayers $ layerMetadata $ documentMetadata doc )
+                doc' =
+                  over ( field' @"documentMetadata" . field' @"layerMetadata"
+                       . field' @"lockedLayers"
+                       )
+                    ( if wasLocked then Set.delete uniq else Set.insert uniq )
+                    doc
+            return $
+              UpdateDocAndThen ( UpdateDocumentTo doc' TrivialDiff ) $
+                GTK.widgetQueueDraw lockedDrawingArea
+
+        GTK.drawingAreaSetDrawFunc visibleDrawingArea $ Just \ _ cairoContext _ _ -> do
+          uniq <- layerUnique <$> getLayerData listItem
+          mbActiveDoc <- STM.atomically $ activeDocument vars
+          for_ mbActiveDoc $ \ ( _activeDocUnique, activeDocHist ) -> do
+            let meta = layerMetadata $ documentMetadata $ present activeDocHist
+                invis = Set.member uniq ( invisibleLayers meta )
+            if invis
+            then void $ Cairo.renderWithContext ( drawInvisible colours ) cairoContext
+            else void $ Cairo.renderWithContext ( drawVisible   colours ) cairoContext
+
+        GTK.drawingAreaSetDrawFunc lockedDrawingArea $ Just \ _ cairoContext _ _ -> do
+          uniq <- layerUnique <$> getLayerData listItem
+          mbActiveDoc <- STM.atomically $ activeDocument vars
+          for_ mbActiveDoc $ \ ( _activeDocUnique, activeDocHist ) -> do
+            let meta = layerMetadata $ documentMetadata $ present activeDocHist
+                locked = Set.member uniq ( lockedLayers meta )
+            if locked
+            then void $ Cairo.renderWithContext ( drawLocked   colours ) cairoContext
+            else void $ Cairo.renderWithContext ( drawUnlocked colours ) cairoContext
 
         -------------------
         -- EditableLabel --
@@ -805,8 +875,9 @@ newLayerView uiElts@( UIElements { window } ) vars = mdo
             Just expander0 -> GTK.unsafeCastTo GTK.TreeExpander expander0
 
         LayerViewWidget
-          { layerViewCheckButton = checkButton
+          { layerViewLabel = layerLabel
-          , layerViewLabel       = layerLabel
+          , layerViewVisibleButton = ( _, visibleDrawingArea )
+          , layerViewLockedButton  = ( _,  lockedDrawingArea )
           } <- getLayerViewWidget expander
 
         layer <- getLayerData listItem
@@ -814,20 +885,17 @@ newLayerView uiElts@( UIElements { window } ) vars = mdo
         for_ mbActiveDoc $ \ ( _activeDocUnique, activeDocHist ) -> do
           let meta = layerMetadata $ documentMetadata $ present activeDocHist
 
-          -- All we do is set the name and visibility of this layer/group.
+          -- All we do is set the name of this layer/group,
-
+          -- and re-render the visible/locked buttons.
           let mbLayerText  = Map.lookup ( layerUnique layer ) ( layerNames meta )
-              layerVisible = not $ Set.member ( layerUnique layer ) ( invisibleLayers meta )
-
           mbTreeListRow <- traverse ( GTK.unsafeCastTo GTK.TreeListRow ) =<< GTK.listItemGetItem listItem
           treeListRow <- case mbTreeListRow of
             Nothing -> error "newLayerView ListItem onBind: no TreeListRow"
             Just r -> return r
           GTK.treeExpanderSetListRow expander ( Just treeListRow )
-
-          GTK.widgetSetVisible checkButton True
-          GTK.checkButtonSetActive checkButton layerVisible
           for_ mbLayerText $ GTK.editableSetText layerLabel
+          GTK.widgetQueueDraw visibleDrawingArea
+          GTK.widgetQueueDraw  lockedDrawingArea
 
   listView <- GTK.listViewNew ( Nothing @GTK.SingleSelection ) ( Just layersListFactory )
   return listView