mirror of
https://gitlab.com/sheaf/metabrush.git
synced 2024-11-05 14:53:37 +00:00
WIP on brush repo (does not compile)
This commit is contained in:
parent
b5b29f124a
commit
e176676e45
|
@ -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
|
||||
|
|
|
@ -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 }) <-
|
||||
GIO.fromGValue @( GI.HValue ChildLayer ) val
|
||||
GI.HValue dnd_data <- GIO.fromGValue @( GI.HValue DragSourceData ) 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.
|
||||
|
|
|
@ -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
|
||||
|
||||
|
|
Loading…
Reference in a new issue