fix draw anchor curve indexing

assets/theme.css

@@ -526,14 +526,7 @@ indent {
   color: @plain;
   background-color: @active;
   border: 0px solid @bg;
-  transition:
-    border-color 0.3s ease-out,
-    border-color 0.2s ease-in,
-    background-color 0.6s ease-out,
-    background-color 0.4s ease-in,
-    box-shadow 0.6s ease-out,
-    box-shadow 0.4s ease-in;
-
+  transition: all 0.35s ease-in-out;
   padding-top: 4px;
   padding-bottom: 4px;
   border-top: 1px solid @active;
@@ -562,7 +555,6 @@ indent {
   border-top: 2px solid @highlight;
   margin-top: -2px;
   box-shadow:
-    0 -1px 6px 1px @highlight,
     inset 0 8px 6px -6px @highlight;
 }
 

src/app/MetaBrush/Application/Action.hs

@@ -87,8 +87,6 @@ import qualified Data.Text as Text
 
 -- brush-strokes
 import Math.Bezier.Spline
-import Math.Bezier.Stroke
-  ( invalidateCache )
 import Math.Module
   ( Module((*^)) )
 import Math.Linear
@@ -222,8 +220,12 @@ openFileWarningDialog
 openFileWarningDialog window filePath errMess = do
 
   dialogWindow <- GTK.windowNew
-  GTK.setWindowDecorated dialogWindow False
-  GTK.windowSetTransientFor dialogWindow (Just window)
+
+  -- Show a header, but not a "X" close button.
+  GTK.setWindowDecorated dialogWindow True
+  GTK.windowSetDeletable dialogWindow False
+  GTK.windowSetTitle dialogWindow ( Just "Warning" )
+  GTK.windowSetTransientFor dialogWindow ( Just window )
 
   contentBox <- GTK.boxNew GTK.OrientationVertical 30
   GTK.widgetSetMarginStart  contentBox 20
@@ -238,7 +240,7 @@ openFileWarningDialog window filePath errMess = do
   GTK.buttonSetLabel closeButton "OK"
   GTK.boxAppend contentBox closeButton
 
-  GTK.windowSetChild dialogWindow (Just contentBox)
+  GTK.windowSetChild dialogWindow ( Just contentBox )
 
   widgetAddClasses dialogWindow ["metabrush", "bg", "plain", "text", "dialog"]
   widgetAddClass closeButton "dialogButton"
@@ -248,9 +250,6 @@ openFileWarningDialog window filePath errMess = do
 
   GTK.widgetSetVisible dialogWindow True
 
-  -- TODO: make the dialog draggable.
-  -- See https://discourse.gnome.org/t/enabling-window-dragging-on-specific-elements-in-gtk-4/5731/4
-
 -----------------
 -- Open folder --
 -----------------
@@ -1177,23 +1176,14 @@ instance HandleAction MouseRelease where
                             = ( holdPos, Just $ ( pos --> holdPos :: T ( ℝ 2 ) ) • holdPos, Just pos )
                             | otherwise
                             = ( pos, Nothing, Nothing )
-                          i0
-                            | anchorIsAtEnd anchor
-                            = case anchorIndex anchor of
-                                FirstPoint -> 0
-                                PointIndex { pointCurve = i } -> i + 1
-                            | otherwise
-                            = case anchorIndex anchor of
-                                FirstPoint -> -1
-                                PointIndex { pointCurve = i } -> i - 1
                         ( _, otherAnchor ) <- getOrCreateDrawAnchor uniqueSupply pathPoint doc
                         if not firstPoint && anchorsAreComplementary anchor otherAnchor
                         -- Close path.
                         then do
                           STM.writeTVar partialPathTVar Nothing
                           let
-                            newSegment :: Spline Open CurveData ( PointData () )
-                            newSegment = catMaybesSpline ( CurveData i0 ( invalidateCache undefined ) )
+                            newSegment :: Spline Open () ( PointData () )
+                            newSegment = catMaybesSpline ()
                               ( PointData p1 () )
                               ( do
                                   cp <- mbCp2
@@ -1205,7 +1195,7 @@ instance HandleAction MouseRelease where
                                   guard ( cp /= anchorPos otherAnchor )
                                   pure ( PointData cp () )
                               )
-                              ( PointData ( anchorPos otherAnchor) () )
+                              ( PointData ( anchorPos otherAnchor ) () )
                             newDocument :: Document
                             newDocument = addToAnchor anchor newSegment doc
                             diff = HistoryDiff $ ContentDiff
@@ -1221,8 +1211,8 @@ instance HandleAction MouseRelease where
                           else do
                             STM.writeTVar partialPathTVar ( Just $ PartialPath ( anchor { anchorPos = pathPoint } ) partialControlPoint False )
                             let
-                              newSegment :: Spline Open CurveData ( PointData () )
-                              newSegment = catMaybesSpline ( CurveData i0 ( invalidateCache undefined ) )
+                              newSegment :: Spline Open () ( PointData () )
+                              newSegment = catMaybesSpline ()
                                 ( PointData p1 () )
                                 ( do
                                     cp <- mbCp2

src/app/MetaBrush/Application/UpdateDocument.hs

@@ -64,7 +64,8 @@ import MetaBrush.Document
   )
 import MetaBrush.Document.Diff
 import MetaBrush.Document.History
-  ( DocumentHistory(..), atStart, atEnd
+  ( DocumentHistory(..), Do(..)
+  , atStart, atEnd
   , newFutureStep, affirmPresentSaved
   )
 import MetaBrush.GTK.Util
@@ -74,7 +75,7 @@ import {-# SOURCE #-} MetaBrush.UI.FileBar
 import MetaBrush.UI.InfoBar
   ( updateInfoBar )
 import {-# SOURCE #-} MetaBrush.UI.StrokeTreeView
-  ( switchStrokeView )
+  ( applyDiffToListModel, switchStrokeView )
 import MetaBrush.UI.Viewport
   ( Viewport(..) )
 import MetaBrush.Unique
@@ -181,6 +182,11 @@ modifyingCurrentDocument uiElts@( UIElements { menuActions } ) vars@( Variables
               )
             uiUpdateAction <- updateUIAction NoActiveDocChange uiElts vars
             pure $ Ap do
+              case histDiff of
+                DocumentDiff {} -> return ()
+                HierarchyDiff hDiff ->
+                  applyDiffToListModel parStoresTVar unique ( Do, hDiff )
+                ContentDiff {} -> return ()
               uiUpdateAction
               for_ ( HashMap.lookup ( WinAction "undo" ) menuActions ) ( `GIO.setSimpleActionEnabled` True  )
               for_ ( HashMap.lookup ( WinAction "redo" ) menuActions ) ( `GIO.setSimpleActionEnabled` False )

src/app/MetaBrush/UI/StrokeTreeView.hs-boot

@@ -1,10 +1,23 @@
 module MetaBrush.UI.StrokeTreeView where
 
+-- containers
+import Data.Map.Strict
+  ( Map )
+
+-- gi-gio
+import qualified GI.Gio as GIO
+
 -- gi-gtk
 import qualified GI.Gtk as GTK
 
+-- stm
+import qualified Control.Concurrent.STM as STM
+
 -- MetaBrush
 import MetaBrush.Application.Context
+import MetaBrush.Document.Diff
+import MetaBrush.Document.History
+import MetaBrush.Layer
 import MetaBrush.Unique
 
 --------------------------------------------------------------------------------
@@ -14,3 +27,8 @@ newLayersListModel :: Variables -> Unique -> IO GTK.SingleSelection
 switchStrokeView :: GTK.ListView -> Variables -> Maybe Unique -> IO ()
 
 newLayerView :: UIElements -> Variables -> IO GTK.ListView
+
+applyDiffToListModel :: STM.TVar ( Map Unique ( Map ( Parent Unique ) GIO.ListStore ) )
+                     -> Unique
+                     -> ( Do, HierarchyDiff )
+                     -> IO ()

src/metabrushes/MetaBrush/Brush.hs

@@ -99,11 +99,7 @@ data SomeBrush where
     -> SomeBrush
 
 instance Show ( NamedBrush brushFields ) where
-  show ( NamedBrush { brushName } ) =
-    "NamedBrush\n\
-    \  { brushName = "  <> Text.unpack brushName <> "\n\
-    \  }"
-
+  show ( NamedBrush { brushName } ) = Text.unpack brushName
 instance NFData ( NamedBrush brushFields ) where
   rnf ( NamedBrush { brushName } )
     = rnf brushName

src/metabrushes/MetaBrush/Document/Serialise.hs

@@ -120,7 +120,8 @@ import MetaBrush.Asset.Brushes
 import MetaBrush.Brush
   ( NamedBrush(..), SomeBrush(..), provePointFields, duplicates )
 import MetaBrush.Document
-import MetaBrush.Layer ( LayerMetadata(..) )
+import MetaBrush.Layer
+  ( LayerMetadata(..) )
 import MetaBrush.Serialisable
   ( Serialisable(..)
   , encodeSpline, decodeSpline

src/metabrushes/MetaBrush/Draw.hs

@@ -49,10 +49,14 @@ import qualified Control.Monad.Trans.Except as Except
 import Control.Monad.Trans.Reader
   ( runReaderT )
 
--- MetaBrush
+-- brush-strokes
 import Math.Bezier.Spline
+import Math.Bezier.Stroke
+  ( invalidateCache )
 import Math.Linear
   ( ℝ(..) )
+
+-- MetaBrush
 import MetaBrush.Assert
   ( assert )
 import MetaBrush.Brush
@@ -208,7 +212,7 @@ getOrCreateDrawAnchor uniqueSupply c doc@( Document { documentContent = oldConte
                 -> Just anchor
               _ -> Nothing
 
-addToAnchor :: DrawAnchor -> StrokeSpline Open () -> Document -> Document
+addToAnchor :: DrawAnchor -> Spline Open () ( PointData () ) -> Document -> Document
 addToAnchor anchor newSpline doc@( Document { documentMetadata, documentContent = oldContent } ) =
   let
     strokes' =
@@ -233,14 +237,24 @@ addToAnchor anchor newSpline doc@( Document { documentMetadata, documentContent
             = if anchorIsAtEnd anchor
               then
                 let
+                  i0 = case splineCurves prevSpline of
+                    OpenCurves ( _ :|> lastCurve ) ->
+                      curveIndex ( curveData lastCurve ) + 1
+                    _ -> 0
                   setBrushData :: PointData () -> PointData brushData
                   setBrushData = set ( field @"brushParams" ) ( brushParams ( splineEnd prevSpline ) )
-                in prevSpline <> fmap setBrushData newSpline
+                  setData = bimapSpline ( \ _ -> bimapCurve ( \ s -> CurveData i0 ( invalidateCache $ undefined s ) ) ( \ _ -> setBrushData ) ) setBrushData
+                in prevSpline <> setData newSpline
               else
                 let
+                  i0 = case splineCurves prevSpline of
+                    OpenCurves ( firstCurve :<| _ ) ->
+                      curveIndex ( curveData firstCurve ) - 1
+                    _ -> 0
                   setBrushData :: PointData () -> PointData brushData
                   setBrushData = set ( field @"brushParams" ) ( brushParams ( splineStart prevSpline ) )
-                in fmap setBrushData ( reverseSpline newSpline ) <> prevSpline
+                  setData = bimapSpline ( \ _ -> bimapCurve ( \ s -> CurveData i0 ( invalidateCache $ undefined s ) ) ( \ _ -> setBrushData ) ) setBrushData
+                in setData ( reverseSpline newSpline ) <> prevSpline
             | otherwise
             = assert False ( "addToAnchor: trying to add to closed spline " <> show strokeUnique )
                 prevSpline -- should never add to a closed spline