fix draw anchor curve indexing

This commit is contained in:
sheaf 2024-09-28 01:32:03 +02:00
parent 264e04555b
commit 66490b87aa
7 changed files with 60 additions and 43 deletions

View file

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

View file

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

View file

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

View file

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

View file

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

View file

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

View file

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