mirror of
https://gitlab.com/sheaf/metabrush.git
synced 2024-11-05 06:43:37 +00:00
pen + brush mode = no op
This commit is contained in:
parent
6a9dca211a
commit
71f42894f8
|
@ -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
|
||||
|
|
|
@ -119,10 +119,6 @@ import MetaBrush.Stroke
|
|||
import MetaBrush.Unique
|
||||
( Unique )
|
||||
|
||||
|
||||
import Debug.Utils
|
||||
( trace )
|
||||
|
||||
--------------------------------------------------------------------------------
|
||||
-- Subdivision.
|
||||
|
||||
|
|
Loading…
Reference in a new issue