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
STM.writeTVar mouseHoldTVar ( Just $ SelectionHold pos )
pure Don'tModifyDoc
Pen -> do
-- Pen tool in path mode: start or continue a drawing operation.
mbPartialPath <- STM.readTVar partialPathTVar
mbSelBrush <- STM.readTVar selectedBrushTVar
STM.writeTVar mouseHoldTVar ( Just $ DrawHold pos )
case mbPartialPath of
-- No path started yet: find anchor for drawing (existing stroke endpoint, or new stroke).
Nothing -> do
( newDocument, drawAnchor ) <-
getOrCreateDrawAnchor uniqueSupply mbSelBrush pos doc
let firstPos = anchorPos drawAnchor newDocument
STM.writeTVar partialPathTVar
( Just $ PartialPath
{ partialPathAnchor = drawAnchor
, partialControlPoint = Nothing
, firstPoint = Just firstPos
}
)
if anchorIsNew drawAnchor
then do
let
diff :: Diff
diff = HistoryDiff $ HierarchyDiff
$ NewLayer
{ newUnique = anchorStroke drawAnchor
, newPosition = WithinParent Root 0
-- TODO: add the stroke above the selected layer
-- or something of the sort.
, newIsGroup = False
}
pure ( UpdateDoc $ UpdateDocumentTo newDocument diff )
else
Pen -> case mode of
BrushMode -> pure Don'tModifyDoc
MetaMode -> pure Don'tModifyDoc
PathMode -> do
-- Pen tool in path mode: start or continue a drawing operation.
mbPartialPath <- STM.readTVar partialPathTVar
mbSelBrush <- STM.readTVar selectedBrushTVar
STM.writeTVar mouseHoldTVar ( Just $ DrawHold pos )
case mbPartialPath of
-- No path started yet: find anchor for drawing (existing stroke endpoint, or new stroke).
Nothing -> do
( newDocument, drawAnchor ) <-
getOrCreateDrawAnchor uniqueSupply mbSelBrush pos doc
let firstPos = anchorPos drawAnchor newDocument
STM.writeTVar partialPathTVar
( Just $ PartialPath
{ partialPathAnchor = drawAnchor
, partialControlPoint = Nothing
, firstPoint = Just firstPos
}
)
if anchorIsNew drawAnchor
then do
let
diff :: Diff
diff = HistoryDiff $ HierarchyDiff
$ NewLayer
{ newUnique = anchorStroke drawAnchor
, newPosition = WithinParent Root 0
-- TODO: add the stroke above the selected layer
-- or something of the sort.
, 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
-- 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
tool <- STM.readTVar toolTVar

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

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