mirror of
https://gitlab.com/sheaf/metabrush.git
synced 2024-11-05 14:53: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
|
_ -> 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
|
||||||
|
|
|
@ -119,10 +119,6 @@ import MetaBrush.Stroke
|
||||||
import MetaBrush.Unique
|
import MetaBrush.Unique
|
||||||
( Unique )
|
( Unique )
|
||||||
|
|
||||||
|
|
||||||
import Debug.Utils
|
|
||||||
( trace )
|
|
||||||
|
|
||||||
--------------------------------------------------------------------------------
|
--------------------------------------------------------------------------------
|
||||||
-- Subdivision.
|
-- Subdivision.
|
||||||
|
|
||||||
|
|
Loading…
Reference in a new issue