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; color: @plain;
background-color: @active; background-color: @active;
border: 0px solid @bg; border: 0px solid @bg;
transition: transition: all 0.35s ease-in-out;
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;
padding-top: 4px; padding-top: 4px;
padding-bottom: 4px; padding-bottom: 4px;
border-top: 1px solid @active; border-top: 1px solid @active;
@ -562,7 +555,6 @@ indent {
border-top: 2px solid @highlight; border-top: 2px solid @highlight;
margin-top: -2px; margin-top: -2px;
box-shadow: box-shadow:
0 -1px 6px 1px @highlight,
inset 0 8px 6px -6px @highlight; inset 0 8px 6px -6px @highlight;
} }

View file

@ -87,8 +87,6 @@ import qualified Data.Text as Text
-- brush-strokes -- brush-strokes
import Math.Bezier.Spline import Math.Bezier.Spline
import Math.Bezier.Stroke
( invalidateCache )
import Math.Module import Math.Module
( Module((*^)) ) ( Module((*^)) )
import Math.Linear import Math.Linear
@ -222,8 +220,12 @@ openFileWarningDialog
openFileWarningDialog window filePath errMess = do openFileWarningDialog window filePath errMess = do
dialogWindow <- GTK.windowNew 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 contentBox <- GTK.boxNew GTK.OrientationVertical 30
GTK.widgetSetMarginStart contentBox 20 GTK.widgetSetMarginStart contentBox 20
@ -238,7 +240,7 @@ openFileWarningDialog window filePath errMess = do
GTK.buttonSetLabel closeButton "OK" GTK.buttonSetLabel closeButton "OK"
GTK.boxAppend contentBox closeButton GTK.boxAppend contentBox closeButton
GTK.windowSetChild dialogWindow (Just contentBox) GTK.windowSetChild dialogWindow ( Just contentBox )
widgetAddClasses dialogWindow ["metabrush", "bg", "plain", "text", "dialog"] widgetAddClasses dialogWindow ["metabrush", "bg", "plain", "text", "dialog"]
widgetAddClass closeButton "dialogButton" widgetAddClass closeButton "dialogButton"
@ -248,9 +250,6 @@ openFileWarningDialog window filePath errMess = do
GTK.widgetSetVisible dialogWindow True 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 -- -- Open folder --
----------------- -----------------
@ -1177,23 +1176,14 @@ instance HandleAction MouseRelease where
= ( holdPos, Just $ ( pos --> holdPos :: T ( 2 ) ) holdPos, Just pos ) = ( holdPos, Just $ ( pos --> holdPos :: T ( 2 ) ) holdPos, Just pos )
| otherwise | otherwise
= ( pos, Nothing, Nothing ) = ( 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 ( _, otherAnchor ) <- getOrCreateDrawAnchor uniqueSupply pathPoint doc
if not firstPoint && anchorsAreComplementary anchor otherAnchor if not firstPoint && anchorsAreComplementary anchor otherAnchor
-- Close path. -- Close path.
then do then do
STM.writeTVar partialPathTVar Nothing STM.writeTVar partialPathTVar Nothing
let let
newSegment :: Spline Open CurveData ( PointData () ) newSegment :: Spline Open () ( PointData () )
newSegment = catMaybesSpline ( CurveData i0 ( invalidateCache undefined ) ) newSegment = catMaybesSpline ()
( PointData p1 () ) ( PointData p1 () )
( do ( do
cp <- mbCp2 cp <- mbCp2
@ -1205,7 +1195,7 @@ instance HandleAction MouseRelease where
guard ( cp /= anchorPos otherAnchor ) guard ( cp /= anchorPos otherAnchor )
pure ( PointData cp () ) pure ( PointData cp () )
) )
( PointData ( anchorPos otherAnchor) () ) ( PointData ( anchorPos otherAnchor ) () )
newDocument :: Document newDocument :: Document
newDocument = addToAnchor anchor newSegment doc newDocument = addToAnchor anchor newSegment doc
diff = HistoryDiff $ ContentDiff diff = HistoryDiff $ ContentDiff
@ -1221,8 +1211,8 @@ instance HandleAction MouseRelease where
else do else do
STM.writeTVar partialPathTVar ( Just $ PartialPath ( anchor { anchorPos = pathPoint } ) partialControlPoint False ) STM.writeTVar partialPathTVar ( Just $ PartialPath ( anchor { anchorPos = pathPoint } ) partialControlPoint False )
let let
newSegment :: Spline Open CurveData ( PointData () ) newSegment :: Spline Open () ( PointData () )
newSegment = catMaybesSpline ( CurveData i0 ( invalidateCache undefined ) ) newSegment = catMaybesSpline ()
( PointData p1 () ) ( PointData p1 () )
( do ( do
cp <- mbCp2 cp <- mbCp2

View file

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

View file

@ -1,10 +1,23 @@
module MetaBrush.UI.StrokeTreeView where module MetaBrush.UI.StrokeTreeView where
-- containers
import Data.Map.Strict
( Map )
-- gi-gio
import qualified GI.Gio as GIO
-- gi-gtk -- gi-gtk
import qualified GI.Gtk as GTK import qualified GI.Gtk as GTK
-- stm
import qualified Control.Concurrent.STM as STM
-- MetaBrush -- MetaBrush
import MetaBrush.Application.Context import MetaBrush.Application.Context
import MetaBrush.Document.Diff
import MetaBrush.Document.History
import MetaBrush.Layer
import MetaBrush.Unique import MetaBrush.Unique
-------------------------------------------------------------------------------- --------------------------------------------------------------------------------
@ -14,3 +27,8 @@ newLayersListModel :: Variables -> Unique -> IO GTK.SingleSelection
switchStrokeView :: GTK.ListView -> Variables -> Maybe Unique -> IO () switchStrokeView :: GTK.ListView -> Variables -> Maybe Unique -> IO ()
newLayerView :: UIElements -> Variables -> IO GTK.ListView 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 -> SomeBrush
instance Show ( NamedBrush brushFields ) where instance Show ( NamedBrush brushFields ) where
show ( NamedBrush { brushName } ) = show ( NamedBrush { brushName } ) = Text.unpack brushName
"NamedBrush\n\
\ { brushName = " <> Text.unpack brushName <> "\n\
\ }"
instance NFData ( NamedBrush brushFields ) where instance NFData ( NamedBrush brushFields ) where
rnf ( NamedBrush { brushName } ) rnf ( NamedBrush { brushName } )
= rnf brushName = rnf brushName

View file

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

View file

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