mirror of
https://gitlab.com/sheaf/metabrush.git
synced 2024-11-05 06:43:37 +00:00
allow selection in brush mode
This commit is contained in:
sheaf
parent
53243621b5
commit
0223c92a85
|
|
@ -954,10 +954,38 @@ instance HandleAction MouseClick where
|
|||
SingleClick -> do
|
||||
modifiers <- STM.readTVar modifiersTVar
|
||||
tool <- STM.readTVar toolTVar
|
||||
case mode of
|
||||
PathMode ->
|
||||
case tool of
|
||||
Selection ->
|
||||
case tool of
|
||||
Selection -> do
|
||||
-- First, check if we can initiate a brush parameter
|
||||
-- modification action through a brush widget.
|
||||
mbBrushWidgetActionUpdDoc <-
|
||||
case mode of
|
||||
MetaMode -> return Nothing
|
||||
PathMode -> return Nothing
|
||||
BrushMode -> do
|
||||
-- Brush mode: modify brush parameters through brush widget.
|
||||
mbAction <- STM.readTVar mouseHoldTVar
|
||||
let mbPrevWidgetAction = case mbAction of
|
||||
Just ( BrushWidgetAction { brushWidgetAction } )
|
||||
-> Just brushWidgetAction
|
||||
_ -> Nothing
|
||||
case applyBrushWidgetAction ( pressingControl modifiers ) pos mbPrevWidgetAction doc of
|
||||
Just ( newDocument, actionState@( BrushWidgetActionState { brushWidgetAction = act } ) ) -> do
|
||||
STM.writeTVar mouseHoldTVar ( Just $ BrushWidgetAction pos actionState )
|
||||
let diff = HistoryDiff $ ContentDiff
|
||||
$ UpdateBrushParameters
|
||||
{ updateBrushStroke = brushWidgetStrokeUnique actionState
|
||||
, updateBrushPoint = brushWidgetPointIndex actionState
|
||||
, updateBrushAction = act
|
||||
}
|
||||
return ( Just $ UpdateDoc $ UpdateDocumentTo newDocument diff )
|
||||
Nothing ->
|
||||
return Nothing
|
||||
-- If we are doing a brush widget action, don't attempt anything else.
|
||||
-- Otherwise, move on to selection.
|
||||
case mbBrushWidgetActionUpdDoc of
|
||||
Just updDoc -> return updDoc
|
||||
Nothing ->
|
||||
-- Selection mode mouse hold:
|
||||
--
|
||||
-- - If holding shift or alt, mouse hold initiates a rectangular selection.
|
||||
|
|
@ -967,7 +995,8 @@ instance HandleAction MouseClick where
|
|||
case selectionMode modifiers of
|
||||
-- Drag move: not holding shift or alt, click has selected something.
|
||||
New
|
||||
| Just dragMove <- dragMoveSelect pos doc
|
||||
| PathMode <- mode -- Only allow dragging points in PathMode
|
||||
, Just dragMove <- dragMoveSelect pos doc
|
||||
-> do
|
||||
STM.writeTVar mouseHoldTVar ( Just $ DragMoveHold pos dragMove )
|
||||
case dragMove of
|
||||
|
|
@ -988,72 +1017,51 @@ 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
|
||||
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
|
||||
BrushMode -> do
|
||||
-- Brush mode: modify brush parameters through brush widget.
|
||||
mbAction <- STM.readTVar mouseHoldTVar
|
||||
let mbPrevWidgetAction = case mbAction of
|
||||
Just ( BrushWidgetAction { brushWidgetAction } )
|
||||
-> Just brushWidgetAction
|
||||
_ -> Nothing
|
||||
case applyBrushWidgetAction ( pressingControl modifiers ) pos mbPrevWidgetAction doc of
|
||||
Just ( newDocument, actionState@( BrushWidgetActionState { brushWidgetAction = act } ) ) -> do
|
||||
STM.writeTVar mouseHoldTVar ( Just $ BrushWidgetAction pos actionState )
|
||||
let diff = HistoryDiff $ ContentDiff
|
||||
$ UpdateBrushParameters
|
||||
{ updateBrushStroke = brushWidgetStrokeUnique actionState
|
||||
, updateBrushPoint = brushWidgetPointIndex actionState
|
||||
, updateBrushAction = act
|
||||
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 )
|
||||
_ ->
|
||||
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
|
||||
|
||||
DoubleClick -> do
|
||||
tool <- STM.readTVar toolTVar
|
||||
modifs <- STM.readTVar modifiersTVar
|
||||
|
|
|
|||
Loading…
Reference in a new issue