mirror of
https://gitlab.com/sheaf/metabrush.git
synced 2024-11-23 15:34:06 +00:00
fix draw anchor curve indexing
This commit is contained in:
parent
264e04555b
commit
66490b87aa
|
@ -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;
|
||||||
}
|
}
|
||||||
|
|
||||||
|
|
|
@ -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
|
||||||
|
|
|
@ -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 )
|
||||||
|
|
|
@ -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 ()
|
||||||
|
|
|
@ -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
|
||||||
|
|
|
@ -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
|
||||||
|
|
|
@ -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
|
||||||
|
|
Loading…
Reference in a new issue