hashirama/metabrush
1
0
Fork 0
mirror of https://gitlab.com/sheaf/metabrush.git synced 2024-11-23 15:34:06 +00:00
Code Issues Actions Projects Releases Wiki Activity

pen + brush mode = no op

Browse source
This commit is contained in:
sheaf 2024-10-21 10:43:13 +02:00
parent 6a9dca211a
commit 71f42894f8
2 changed files with 46 additions and 47 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

89
src/app/MetaBrush/Application/Action.hs
View file

@ -1034,50 +1034,53 @@ instance HandleAction MouseClick where
_ -> do _ -> do
STM.writeTVar mouseHoldTVar ( Just $ SelectionHold pos ) STM.writeTVar mouseHoldTVar ( Just $ SelectionHold pos )
pure Don'tModifyDoc pure Don'tModifyDoc
Pen -> do Pen -> case mode of
-- Pen tool in path mode: start or continue a drawing operation. BrushMode -> pure Don'tModifyDoc
mbPartialPath <- STM.readTVar partialPathTVar MetaMode -> pure Don'tModifyDoc
mbSelBrush <- STM.readTVar selectedBrushTVar PathMode -> do
STM.writeTVar mouseHoldTVar ( Just $ DrawHold pos ) -- Pen tool in path mode: start or continue a drawing operation.
case mbPartialPath of mbPartialPath <- STM.readTVar partialPathTVar
-- No path started yet: find anchor for drawing (existing stroke endpoint, or new stroke). mbSelBrush <- STM.readTVar selectedBrushTVar
Nothing -> do STM.writeTVar mouseHoldTVar ( Just $ DrawHold pos )
( newDocument, drawAnchor ) <- case mbPartialPath of
getOrCreateDrawAnchor uniqueSupply mbSelBrush pos doc -- No path started yet: find anchor for drawing (existing stroke endpoint, or new stroke).
let firstPos = anchorPos drawAnchor newDocument Nothing -> do
STM.writeTVar partialPathTVar ( newDocument, drawAnchor ) <-
( Just $ PartialPath getOrCreateDrawAnchor uniqueSupply mbSelBrush pos doc
{ partialPathAnchor = drawAnchor let firstPos = anchorPos drawAnchor newDocument
, partialControlPoint = Nothing STM.writeTVar partialPathTVar
, firstPoint = Just firstPos ( Just $ PartialPath
} { partialPathAnchor = drawAnchor
) , partialControlPoint = Nothing
if anchorIsNew drawAnchor , firstPoint = Just firstPos
then do }
let )
diff :: Diff if anchorIsNew drawAnchor
diff = HistoryDiff $ HierarchyDiff then do
$ NewLayer let
{ newUnique = anchorStroke drawAnchor diff :: Diff
, newPosition = WithinParent Root 0 diff = HistoryDiff $ HierarchyDiff
-- TODO: add the stroke above the selected layer $ NewLayer
-- or something of the sort. { newUnique = anchorStroke drawAnchor
, newIsGroup = False , newPosition = WithinParent Root 0
} -- TODO: add the stroke above the selected layer
pure ( UpdateDoc $ UpdateDocumentTo newDocument diff ) -- or something of the sort.
else , newIsGroup = False
}
pure ( UpdateDoc $ UpdateDocumentTo newDocument diff )
else
pure Don'tModifyDoc
-- Path already started: indicate that we are continuing a path.
Just pp@( PartialPath { firstPoint = mbFirst } ) -> do
let stillAtFirstPoint = case mbFirst of
Nothing -> Nothing
Just p ->
if inPointClickRange zoom p pos
then Just p
else Nothing
STM.writeTVar partialPathTVar
( Just $ pp { firstPoint = stillAtFirstPoint } )
pure Don'tModifyDoc pure Don'tModifyDoc
-- Path already started: indicate that we are continuing a path.
Just pp@( PartialPath { firstPoint = mbFirst } ) -> do
let stillAtFirstPoint = case mbFirst of
Nothing -> Nothing
Just p ->
if inPointClickRange zoom p pos
then Just p
else Nothing
STM.writeTVar partialPathTVar
( Just $ pp { firstPoint = stillAtFirstPoint } )
pure Don'tModifyDoc
DoubleClick -> do DoubleClick -> do
tool <- STM.readTVar toolTVar tool <- STM.readTVar toolTVar

4
src/metabrushes/MetaBrush/Action.hs
View file

@ -119,10 +119,6 @@ import MetaBrush.Stroke
import MetaBrush.Unique import MetaBrush.Unique
( Unique ) ( Unique )
import Debug.Utils
( trace )
-------------------------------------------------------------------------------- --------------------------------------------------------------------------------
-- Subdivision. -- Subdivision.