WIP on brush repo (does not compile)

MetaBrush.cabal

@@ -241,6 +241,7 @@ executable MetaBrush
       , MetaBrush.Render.Document
       , MetaBrush.Render.Rulers
       , MetaBrush.Time
+      , MetaBrush.UI.BrushList
       , MetaBrush.UI.Coordinates
       , MetaBrush.UI.FileBar
       , MetaBrush.UI.InfoBar

src/app/MetaBrush/UI/StrokeTreeView.hs

@@ -53,7 +53,7 @@ import qualified Data.GI.Base.Overloading as GI
 
 -- lens
 import Control.Lens
-  ( over )
+  ( ix, over )
 
 -- stm
 import qualified Control.Concurrent.STM.TVar as STM
@@ -102,6 +102,17 @@ instance GI.DerivedGObject LayerItem where
   objectInstanceInit _ _ = return Nothing
   objectInterfaces = [ ]
 
+--------------------------------------------------------------------------------
+-- Drag and drop data --
+------------------------
+
+-- | Data passed in a drag-and-drop operation associated with the drag source.
+data DragSourceData
+  = DragBrush     { draggedBrushName :: !Text }
+  | DragLayerItem { draggedLayerItem :: !ChildLayer }
+  deriving stock ( Show, Eq )
+
+
 --------------------------------------------------------------------------------
 -- GTK TreeListModel --
 -----------------------
@@ -480,6 +491,7 @@ newLayerView uiElts@( UIElements { panelsBar = PanelsBar { layersScrolledWindow
             GTK.singleSelectionSetSelected selModel rowPos
 
           let dnd_sourceItem =
+                DragLayerItem $
                   WithinParent
                     { parent = fmap snd srcPar
                     , item = srcUniq
@@ -532,22 +544,37 @@ newLayerView uiElts@( UIElements { panelsBar = PanelsBar { layersScrolledWindow
           --  LayerID {} -> return True
         void $ GTK.onDropTargetDrop dropTarget $ \ val _x y -> do
           dropTargetCleanup
-          dropTgtUniq <- layerUnique <$> getLayerData listItem
+          dropTgt <- getLayerData listItem
 
-          GI.HValue dragSrc@( WithinParent { item = dragSrcUniq }) <-
+          GI.HValue dnd_data <- GIO.fromGValue @( GI.HValue DragSourceData ) val
-            GIO.fromGValue @( GI.HValue ChildLayer ) val
 
           mbTreeListRow <- traverse ( GTK.unsafeCastTo GTK.TreeListRow ) =<< GTK.listItemGetItem listItem
           treeListRow <- case mbTreeListRow of
               Nothing -> error "newLayerView ListItem onSetup: no TreeListRow"
               Just r -> return r
+          dstPar <- getParent treeListRow
 
+          case dnd_data of
+            DragBrush brushName -> do
+              case dropTgt of
+                GroupLayer {} ->
+                  return False
+                StrokeLayer tgtStrokeUnique -> do
+                  updateLayerHierarchy vars $
+                    DoLayerChange $
+                      SetBrush
+                        { setBrushStroke =  WithinParent ( fmap snd dstPar ) tgtStrokeUnique
+                        , setBrushName   = brushName
+                        }
+                  return True
+
+            DragLayerItem dragSrc@( WithinParent { item = dragSrcUniq }) -> do
+              let dropTgtUniq = layerUnique dropTgt
               dstFlatIndex <- GTK.treeListRowGetPosition treeListRow
               h <- GTK.widgetGetHeight expander
               let droppedAbove = y < 0.5 * fromIntegral h
               expanded <- GTK.treeListRowGetExpanded treeListRow
 
-          dstPar <- getParent treeListRow
               isDescendant <- isDescendantOf dragSrcUniq listItem
 
               let mbDropIntoGroup
@@ -880,6 +907,10 @@ data LayerChange
   | Delete
       { deleteItem :: !ChildLayer
       }
+  | SetBrush
+      { setBrushStroke :: !ChildLayer
+      , setBrushName   :: !Text
+      }
 
 -- | Destination of a move operation.
 data MoveDst
@@ -1092,6 +1123,25 @@ applyChangeToLayerHierarchy change hierarchy =
               , delIsGroup  = isJust mbHadChildren
               }
         )
+    SetBrush { setBrushStroke = WithinParent parUniq strokeUnique, setBrushName } ->
+      let
+        ( hierarchy', strokeIx ) =
+          over ( field' @"documentContent"
+               . field' @"strokeHierarchy"
+               . field' @"content"
+               )
+            ( setStrokeBrush brushName )
+            doc
+
+      in
+        ( hierarchy'
+        , Map.empty
+        , Just $
+            StrokeSetBrush
+              { changedBrushStroke = WithinParent parUniq strokeIx
+              , newBrushName = setBrushName
+              }
+        )
 
 -- | Apply a change to the 'ListModel' underlying the UI
 -- representation of the layer hierarchy.
@@ -1148,6 +1198,9 @@ applyDiffToListModel parStoreTVar docUnique ( doOrUndo, diff ) = do
     DeletePoints { deletedStrokes } ->
       unless ( null deletedStrokes ) $
         putStrLn "TODO: delete strokes"
+    StrokeSetBrush { changedBrushStroke = WithinParent changedPar changedIx } -> do
+      let changedStrokeStore = parStoreFromUniq ! changedPar
+      GIO.listModelItemsChanged changedStrokeStore changedIx 0 0
 
 -- | Update the 'StrokeHierarchy' after a drag-and-drop operation,
 -- moving one layer or group around.

src/metabrushes/MetaBrush/Document/Diff.hs

@@ -13,6 +13,10 @@ import Data.Set
 import Control.DeepSeq
   ( NFData(..) )
 
+-- text
+import Data.Text
+  ( Text )
+
 -- brush-strokes
 import Math.Bezier.Spline
 import Math.Linear
@@ -73,6 +77,10 @@ data HierarchyDiff
       , srcPos :: !ChildLayerPosition
       , dstPos :: !ChildLayerPosition
       }
+  | StrokeSetBrush
+      { changedBrushStroke :: !ChildLayerPosition
+      , newBrushName       :: !Text
+      }
   deriving stock ( Show, Generic )
   deriving anyclass NFData