mirror of
https://gitlab.com/sheaf/metabrush.git
synced 2024-11-05 14:53:37 +00:00
implement selection & drag-move in brush mode
This commit is contained in:
sheaf
parent
dfa446254a
commit
9e73da9fff
|
|
@ -1,11 +1,13 @@
|
|||
{-# LANGUAGE BlockArguments #-}
|
||||
{-# LANGUAGE DataKinds #-}
|
||||
{-# LANGUAGE DerivingStrategies #-}
|
||||
{-# LANGUAGE FlexibleInstances #-}
|
||||
{-# LANGUAGE LambdaCase #-}
|
||||
{-# LANGUAGE NamedFieldPuns #-}
|
||||
{-# LANGUAGE PatternSynonyms #-}
|
||||
{-# LANGUAGE TypeApplications #-}
|
||||
{-# LANGUAGE BlockArguments #-}
|
||||
{-# LANGUAGE DataKinds #-}
|
||||
{-# LANGUAGE DerivingStrategies #-}
|
||||
{-# LANGUAGE FlexibleContexts #-}
|
||||
{-# LANGUAGE FlexibleInstances #-}
|
||||
{-# LANGUAGE LambdaCase #-}
|
||||
{-# LANGUAGE NamedFieldPuns #-}
|
||||
{-# LANGUAGE PatternSynonyms #-}
|
||||
{-# LANGUAGE ScopedTypeVariables #-}
|
||||
{-# LANGUAGE TypeApplications #-}
|
||||
|
||||
module MetaBrush.Document.Selection
|
||||
( SelectionMode(..), selectionMode
|
||||
|
|
@ -37,6 +39,8 @@ import Data.Sequence
|
|||
-- generic-lens
|
||||
import Data.Generics.Product.Fields
|
||||
( field' )
|
||||
import Data.Generics.Product.Typed
|
||||
( HasType )
|
||||
|
||||
-- lens
|
||||
import Control.Lens
|
||||
|
|
@ -63,13 +67,14 @@ import Math.Vector2D
|
|||
( Point2D(..), Vector2D(..) )
|
||||
import MetaBrush.Document
|
||||
( Document(..), Stroke(..)
|
||||
, PointData(..), FocusState(..)
|
||||
, _selection
|
||||
, FocusState(..), _selection
|
||||
)
|
||||
import MetaBrush.Event.KeyCodes
|
||||
( pattern Alt_L , pattern Alt_R
|
||||
, pattern Shift_L, pattern Shift_R
|
||||
)
|
||||
import MetaBrush.UI.ToolBar
|
||||
( Mode(..) )
|
||||
|
||||
--------------------------------------------------------------------------------
|
||||
|
||||
|
|
@ -98,34 +103,45 @@ selectionMode = foldMap \case
|
|||
_ -> New
|
||||
|
||||
-- | Updates the selected objects on a single click selection event.
|
||||
selectAt :: SelectionMode -> Point2D Double -> Document -> Document
|
||||
selectAt mode c doc@( Document { zoomFactor } ) =
|
||||
selectAt :: Mode -> SelectionMode -> Point2D Double -> Document -> Document
|
||||
selectAt mode selMode c doc@( Document { zoomFactor } ) =
|
||||
( `evalState` False ) $ field' @"strokes" ( traverse updateStroke ) doc
|
||||
where
|
||||
updateStroke :: Stroke -> State Bool Stroke
|
||||
updateStroke stroke@( Stroke { strokeVisible } ) =
|
||||
( field' @"strokePoints" )
|
||||
( traverse ( updatePoint strokeVisible )
|
||||
>>> fmap matchEndpoints
|
||||
)
|
||||
stroke
|
||||
updatePoint :: Bool -> StrokePoint PointData -> State Bool ( StrokePoint PointData )
|
||||
updatePoint isVisible pt = do
|
||||
updateStroke stroke@( Stroke { strokeVisible } )
|
||||
| Brush <- mode
|
||||
= ( field' @"strokePoints" . traverse )
|
||||
( \ spt ->
|
||||
( field' @"pointData" . field' @"brushShape" )
|
||||
( traverse ( updatePoint strokeVisible ( MkVector2D $ coords spt ) )
|
||||
>>> fmap matchEndpoints
|
||||
)
|
||||
spt
|
||||
)
|
||||
stroke
|
||||
| otherwise
|
||||
= ( field' @"strokePoints" )
|
||||
( traverse ( updatePoint strokeVisible ( Vector2D 0 0 ) )
|
||||
>>> fmap matchEndpoints
|
||||
)
|
||||
stroke
|
||||
updatePoint :: HasType FocusState pt => Bool -> Vector2D Double -> StrokePoint pt -> State Bool ( StrokePoint pt )
|
||||
updatePoint isVisible offset pt = do
|
||||
anotherPointHasAlreadyBeenSelected <- get
|
||||
if selected && not anotherPointHasAlreadyBeenSelected
|
||||
then put True $> case mode of
|
||||
then put True $> case selMode of
|
||||
Subtract -> set _selection Normal pt
|
||||
_ -> set _selection Selected pt
|
||||
else pure $ case mode of
|
||||
else pure $ case selMode of
|
||||
New -> set _selection Normal pt
|
||||
_ -> pt
|
||||
where
|
||||
selected :: Bool
|
||||
selected
|
||||
| not isVisible = False
|
||||
| otherwise = squaredNorm ( c --> coords pt :: Vector2D Double ) < 16 / ( zoomFactor * zoomFactor )
|
||||
| otherwise = squaredNorm ( c --> ( offset • coords pt ) :: Vector2D Double ) * zoomFactor ^ ( 2 :: Int ) < 16
|
||||
-- Ensure consistency of selection at endpoints for closed loops.
|
||||
matchEndpoints :: Seq ( StrokePoint PointData ) -> Seq ( StrokePoint PointData )
|
||||
matchEndpoints :: HasType FocusState pt => Seq ( StrokePoint pt ) -> Seq ( StrokePoint pt )
|
||||
matchEndpoints ( p0 :<| ( ps :|> pn ) )
|
||||
| coords p0 == coords pn
|
||||
= p0 :<| ( ps :|> set _selection ( view _selection p0 ) pn )
|
||||
|
|
@ -142,8 +158,8 @@ data DragMoveSelect
|
|||
|
||||
-- | Checks whether a mouse click can initiate a drag move event,
|
||||
-- and if so returns an updated document with the selection modified from the start of the drag move.
|
||||
dragMoveSelect :: Point2D Double -> Document -> Maybe Document
|
||||
dragMoveSelect c doc@( Document { zoomFactor } ) =
|
||||
dragMoveSelect :: Mode -> Point2D Double -> Document -> Maybe Document
|
||||
dragMoveSelect mode c doc@( Document { zoomFactor } ) =
|
||||
let
|
||||
res :: Tardis ( Maybe DragMoveSelect ) ( Maybe DragMoveSelect ) Document
|
||||
res = do
|
||||
|
|
@ -156,14 +172,30 @@ dragMoveSelect c doc@( Document { zoomFactor } ) =
|
|||
|
||||
where
|
||||
updateStroke :: Stroke -> Tardis ( Maybe DragMoveSelect ) ( Maybe DragMoveSelect ) Stroke
|
||||
updateStroke stroke@( Stroke { strokeVisible } ) =
|
||||
( field' @"strokePoints" )
|
||||
( traverse ( updatePoint strokeVisible )
|
||||
>>> fmap matchEndpoints
|
||||
)
|
||||
stroke
|
||||
updatePoint :: Bool -> StrokePoint PointData -> Tardis ( Maybe DragMoveSelect ) ( Maybe DragMoveSelect ) ( StrokePoint PointData )
|
||||
updatePoint isVisible pt
|
||||
updateStroke stroke@( Stroke { strokeVisible } )
|
||||
| Brush <- mode
|
||||
= ( field' @"strokePoints" . traverse )
|
||||
( \ spt ->
|
||||
( field' @"pointData" . field' @"brushShape" )
|
||||
( traverse ( updatePoint strokeVisible ( MkVector2D $ coords spt ) )
|
||||
>>> fmap matchEndpoints
|
||||
)
|
||||
spt
|
||||
)
|
||||
stroke
|
||||
| otherwise
|
||||
= ( field' @"strokePoints" )
|
||||
( traverse ( updatePoint strokeVisible ( Vector2D 0 0 ) )
|
||||
>>> fmap matchEndpoints
|
||||
)
|
||||
stroke
|
||||
updatePoint
|
||||
:: HasType FocusState pt
|
||||
=> Bool
|
||||
-> Vector2D Double
|
||||
-> StrokePoint pt
|
||||
-> Tardis ( Maybe DragMoveSelect ) ( Maybe DragMoveSelect ) ( StrokePoint pt )
|
||||
updatePoint isVisible offset pt
|
||||
| selected
|
||||
= do
|
||||
mbPreviousSelect <- Tardis.getPast
|
||||
|
|
@ -172,7 +204,7 @@ dragMoveSelect c doc@( Document { zoomFactor } ) =
|
|||
Just _ -> pure pt
|
||||
-- First click on a point: record this.
|
||||
Nothing -> do
|
||||
case pointState ( pointData pt ) of
|
||||
case view _selection pt of
|
||||
Selected -> Tardis.sendFuture ( Just ClickedOnSelected )
|
||||
_ -> Tardis.sendFuture ( Just ClickedOnUnselected )
|
||||
-- Select this point (whether it was previously selected or not).
|
||||
|
|
@ -195,47 +227,62 @@ dragMoveSelect c doc@( Document { zoomFactor } ) =
|
|||
selected :: Bool
|
||||
selected
|
||||
| not isVisible = False
|
||||
| otherwise = squaredNorm ( c --> coords pt :: Vector2D Double ) < 16 / ( zoomFactor * zoomFactor )
|
||||
| otherwise = squaredNorm ( c --> ( offset • coords pt ) :: Vector2D Double ) * zoomFactor ^ ( 2 :: Int ) < 16
|
||||
-- Ensure consistency of selection at endpoints for closed loops.
|
||||
matchEndpoints :: Seq ( StrokePoint PointData ) -> Seq ( StrokePoint PointData )
|
||||
matchEndpoints :: HasType FocusState pt => Seq ( StrokePoint pt ) -> Seq ( StrokePoint pt )
|
||||
matchEndpoints ( p0 :<| ( ps :|> pn ) )
|
||||
| coords p0 == coords pn
|
||||
= p0 :<| ( ps :|> set _selection ( view _selection p0 ) pn )
|
||||
matchEndpoints ps = ps
|
||||
|
||||
-- | Updates the selected objects on a rectangular selection event.
|
||||
selectRectangle :: SelectionMode -> Point2D Double -> Point2D Double -> Document -> Document
|
||||
selectRectangle mode ( Point2D x0 y0 ) ( Point2D x1 y1 ) = over ( field' @"strokes" . mapped ) updateStroke
|
||||
selectRectangle :: Mode -> SelectionMode -> Point2D Double -> Point2D Double -> Document -> Document
|
||||
selectRectangle mode selMode ( Point2D x0 y0 ) ( Point2D x1 y1 ) = over ( field' @"strokes" . mapped ) updateStroke
|
||||
where
|
||||
xMin, xMax, yMin, yMax :: Double
|
||||
( xMin, xMax ) = if x0 <= x1 then ( x0, x1 ) else ( x1, x0 )
|
||||
( yMin, yMax ) = if y0 <= y1 then ( y0, y1 ) else ( y1, y0 )
|
||||
updateStroke :: Stroke -> Stroke
|
||||
updateStroke stroke@( Stroke { strokeVisible } ) =
|
||||
over ( field' @"strokePoints" . mapped )
|
||||
( updatePoint strokeVisible )
|
||||
stroke
|
||||
updatePoint :: Bool -> StrokePoint PointData -> StrokePoint PointData
|
||||
updatePoint isVisible pt
|
||||
| selected = case mode of
|
||||
updateStroke stroke@( Stroke { strokeVisible } )
|
||||
| Brush <- mode
|
||||
= over ( field' @"strokePoints" . mapped )
|
||||
( \ spt ->
|
||||
over ( field' @"pointData" . field' @"brushShape" . mapped )
|
||||
( updatePoint strokeVisible ( MkVector2D $ coords spt ) )
|
||||
spt
|
||||
)
|
||||
stroke
|
||||
| otherwise
|
||||
= over ( field' @"strokePoints" . mapped )
|
||||
( updatePoint strokeVisible ( Vector2D 0 0 ) )
|
||||
stroke
|
||||
updatePoint :: HasType FocusState pt => Bool -> Vector2D Double -> StrokePoint pt -> StrokePoint pt
|
||||
updatePoint isVisible offset pt
|
||||
| selected = case selMode of
|
||||
Subtract -> set _selection Normal pt
|
||||
_ -> set _selection Selected pt
|
||||
| otherwise = case mode of
|
||||
| otherwise = case selMode of
|
||||
New -> set _selection Normal pt
|
||||
_ -> pt
|
||||
where
|
||||
x, y :: Double
|
||||
Point2D x y = coords pt
|
||||
Point2D x y = offset • coords pt
|
||||
selected :: Bool
|
||||
selected
|
||||
| not isVisible = False
|
||||
| otherwise = x >= xMin && x <= xMax && y >= yMin && y <= yMax
|
||||
|
||||
-- | Translate all selected points by the given vector.
|
||||
translateSelection :: Vector2D Double -> Document -> Document
|
||||
translateSelection t = over ( field' @"strokes" . mapped . field' @"strokePoints" . mapped ) updateStrokePoint
|
||||
translateSelection :: Mode -> Vector2D Double -> Document -> Document
|
||||
translateSelection mode t
|
||||
| Brush <- mode
|
||||
= over ( field' @"strokes" . mapped . field' @"strokePoints" . mapped . field' @"pointData" . field' @"brushShape" . mapped )
|
||||
updateStrokePoint
|
||||
| otherwise
|
||||
= over ( field' @"strokes" . mapped . field' @"strokePoints" . mapped )
|
||||
updateStrokePoint
|
||||
where
|
||||
updateStrokePoint :: StrokePoint PointData -> StrokePoint PointData
|
||||
updateStrokePoint :: HasType FocusState pt => StrokePoint pt -> StrokePoint pt
|
||||
updateStrokePoint pt
|
||||
| Selected <- view _selection pt
|
||||
= pt { coords = t • coords pt }
|
||||
|
|
@ -243,13 +290,22 @@ translateSelection t = over ( field' @"strokes" . mapped . field' @"strokePoints
|
|||
= pt
|
||||
|
||||
-- | Delete the selected points.
|
||||
deleteSelected :: Document -> Document
|
||||
deleteSelected
|
||||
= fst . runIdentity . ( `Tardis.runTardisT` ( False, False ) )
|
||||
. ( field' @"strokes" . traverse . field' @"strokePoints" )
|
||||
deleteSelected :: Mode -> Document -> Document
|
||||
deleteSelected mode doc = fst . runIdentity . ( `Tardis.runTardisT` ( False, False ) ) $ case mode of
|
||||
Brush ->
|
||||
( field' @"strokes" . traverse . field' @"strokePoints" . traverse . field' @"pointData" . field' @"brushShape" )
|
||||
updateStroke
|
||||
doc
|
||||
_ ->
|
||||
( field' @"strokes" . traverse . field' @"strokePoints" )
|
||||
updateStroke
|
||||
doc
|
||||
where
|
||||
updateStroke :: Seq ( StrokePoint PointData ) -> Tardis Bool Bool ( Seq ( StrokePoint PointData ) )
|
||||
updateStroke
|
||||
:: forall pt
|
||||
. HasType FocusState pt
|
||||
=> Seq ( StrokePoint pt )
|
||||
-> Tardis Bool Bool ( Seq ( StrokePoint pt ) )
|
||||
updateStroke Empty = pure Empty
|
||||
updateStroke ( p :<| ps ) = case p of
|
||||
PathPoint {}
|
||||
|
|
@ -274,7 +330,7 @@ deleteSelected
|
|||
-- - if the next path point is going to be deleted.
|
||||
--
|
||||
-- Need to be lazy in "nextPathPointDeleted" to avoid looping.
|
||||
res :: Seq ( StrokePoint PointData )
|
||||
res :: Seq ( StrokePoint pt )
|
||||
res = if selectionState == Selected || prevPathPointDeleted || nextPathPointDeleted
|
||||
then rest
|
||||
else p :<| rest
|
||||
|
|
|
|||
|
|
@ -96,7 +96,7 @@ handleEvents
|
|||
uniqueSupply
|
||||
activeDocumentTVar openDocumentsTVar
|
||||
mousePosTVar mouseHoldTVar pressedKeysTVar
|
||||
toolTVar _modeTVar partialPathTVar
|
||||
toolTVar modeTVar partialPathTVar
|
||||
window viewportDrawingArea infoBar = do
|
||||
|
||||
-- Mouse events
|
||||
|
|
@ -105,12 +105,12 @@ handleEvents
|
|||
_ <- GTK.onWidgetScrollEvent viewportDrawingArea
|
||||
( handleScrollEvent activeDocumentTVar openDocumentsTVar mousePosTVar mouseHoldTVar pressedKeysTVar toolTVar viewportDrawingArea infoBar )
|
||||
_ <- GTK.onWidgetButtonPressEvent viewportDrawingArea
|
||||
( handleMouseButtonEvent uniqueSupply activeDocumentTVar openDocumentsTVar mousePosTVar mouseHoldTVar pressedKeysTVar toolTVar partialPathTVar viewportDrawingArea )
|
||||
( handleMouseButtonEvent uniqueSupply activeDocumentTVar openDocumentsTVar mousePosTVar mouseHoldTVar pressedKeysTVar toolTVar modeTVar partialPathTVar viewportDrawingArea )
|
||||
_ <- GTK.onWidgetButtonReleaseEvent viewportDrawingArea
|
||||
( handleMouseButtonRelease uniqueSupply activeDocumentTVar openDocumentsTVar mousePosTVar mouseHoldTVar pressedKeysTVar toolTVar partialPathTVar viewportDrawingArea )
|
||||
( handleMouseButtonRelease uniqueSupply activeDocumentTVar openDocumentsTVar mousePosTVar mouseHoldTVar pressedKeysTVar toolTVar modeTVar partialPathTVar viewportDrawingArea )
|
||||
|
||||
-- Keyboard events
|
||||
_ <- GTK.onWidgetKeyPressEvent window ( handleKeyboardPressEvent activeDocumentTVar openDocumentsTVar mousePosTVar pressedKeysTVar toolTVar partialPathTVar viewportDrawingArea )
|
||||
_ <- GTK.onWidgetKeyPressEvent window ( handleKeyboardPressEvent activeDocumentTVar openDocumentsTVar mousePosTVar pressedKeysTVar toolTVar modeTVar partialPathTVar viewportDrawingArea )
|
||||
_ <- GTK.onWidgetKeyReleaseEvent window ( handleKeyboardReleaseEvent pressedKeysTVar )
|
||||
|
||||
-- Window quit
|
||||
|
|
@ -294,7 +294,7 @@ handleMouseButtonEvent
|
|||
:: UniqueSupply
|
||||
-> STM.TVar ( Maybe Int ) -> STM.TVar ( IntMap Document )
|
||||
-> STM.TVar ( Maybe ( Point2D Double ) ) -> STM.TVar ( Maybe HoldEvent ) -> STM.TVar [ Word32 ]
|
||||
-> STM.TVar Tool -> STM.TVar ( Maybe PartialPath )
|
||||
-> STM.TVar Tool -> STM.TVar Mode -> STM.TVar ( Maybe PartialPath )
|
||||
-> GTK.DrawingArea
|
||||
-> GDK.EventButton
|
||||
-> IO Bool
|
||||
|
|
@ -302,7 +302,7 @@ handleMouseButtonEvent
|
|||
uniqueSupply
|
||||
activeDocumentTVar openDocumentsTVar
|
||||
mousePosTVar mouseHoldTVar pressedKeysTVar
|
||||
toolTVar partialPathTVar
|
||||
toolTVar modeTVar partialPathTVar
|
||||
viewportDrawingArea
|
||||
mouseClickEvent
|
||||
= do
|
||||
|
|
@ -330,6 +330,7 @@ handleMouseButtonEvent
|
|||
STM.writeTVar mousePosTVar ( Just pos )
|
||||
pressedKeys <- STM.readTVar pressedKeysTVar
|
||||
tool <- STM.readTVar toolTVar
|
||||
mode <- STM.readTVar modeTVar
|
||||
case tool of
|
||||
|
||||
-- Selection mode mouse hold:
|
||||
|
|
@ -342,7 +343,7 @@ handleMouseButtonEvent
|
|||
case selectionMode pressedKeys of
|
||||
-- Drag move: not holding shift or alt, click has selected something.
|
||||
New
|
||||
| Just newDoc <- dragMoveSelect pos doc
|
||||
| Just newDoc <- dragMoveSelect mode pos doc
|
||||
-> do
|
||||
let
|
||||
newDocs :: IntMap Document
|
||||
|
|
@ -392,7 +393,7 @@ handleMouseButtonRelease
|
|||
:: UniqueSupply
|
||||
-> STM.TVar ( Maybe Int ) -> STM.TVar ( IntMap Document )
|
||||
-> STM.TVar ( Maybe ( Point2D Double ) ) -> STM.TVar ( Maybe HoldEvent ) -> STM.TVar [ Word32 ]
|
||||
-> STM.TVar Tool -> STM.TVar ( Maybe PartialPath )
|
||||
-> STM.TVar Tool -> STM.TVar Mode -> STM.TVar ( Maybe PartialPath )
|
||||
-> GTK.DrawingArea
|
||||
-> GDK.EventButton
|
||||
-> IO Bool
|
||||
|
|
@ -400,7 +401,7 @@ handleMouseButtonRelease
|
|||
uniqueSupply
|
||||
activeDocumentTVar openDocumentsTVar
|
||||
mousePosTVar mouseHoldTVar pressedKeysTVar
|
||||
toolTVar partialPathTVar
|
||||
toolTVar modeTVar partialPathTVar
|
||||
viewportDrawingArea
|
||||
mouseReleaseEvent
|
||||
= do
|
||||
|
|
@ -428,22 +429,22 @@ handleMouseButtonRelease
|
|||
pressedKeys <- STM.readTVar pressedKeysTVar
|
||||
mbHoldPos <- STM.swapTVar mouseHoldTVar Nothing
|
||||
tool <- STM.readTVar toolTVar
|
||||
|
||||
mode <- STM.readTVar modeTVar
|
||||
newDoc <- case tool of
|
||||
|
||||
Selection -> do
|
||||
let
|
||||
mode :: SelectionMode
|
||||
mode = selectionMode pressedKeys
|
||||
selMode :: SelectionMode
|
||||
selMode = selectionMode pressedKeys
|
||||
case mbHoldPos of
|
||||
Just hold
|
||||
| DragMoveHold pos0 <- hold
|
||||
, pos0 /= pos
|
||||
-> pure $ translateSelection ( pos0 --> pos ) doc
|
||||
-> pure $ translateSelection mode ( pos0 --> pos ) doc
|
||||
| SelectionHold pos0 <- hold
|
||||
, pos0 /= pos
|
||||
-> pure $ selectRectangle mode pos0 pos doc
|
||||
_ -> pure $ selectAt mode pos doc
|
||||
-> pure $ selectRectangle mode selMode pos0 pos doc
|
||||
_ -> pure $ selectAt mode selMode pos doc
|
||||
|
||||
Pen -> do
|
||||
mbPartialPath <- STM.readTVar partialPathTVar
|
||||
|
|
@ -539,14 +540,14 @@ handleMouseButtonRelease
|
|||
handleKeyboardPressEvent
|
||||
:: STM.TVar ( Maybe Int ) -> STM.TVar ( IntMap Document )
|
||||
-> STM.TVar ( Maybe ( Point2D Double ) ) -> STM.TVar [ Word32 ]
|
||||
-> STM.TVar Tool -> STM.TVar ( Maybe PartialPath )
|
||||
-> STM.TVar Tool -> STM.TVar Mode -> STM.TVar ( Maybe PartialPath )
|
||||
-> GTK.DrawingArea
|
||||
-> GDK.EventKey
|
||||
-> IO Bool
|
||||
handleKeyboardPressEvent
|
||||
activeDocumentTVar openDocumentsTVar
|
||||
mousePosTVar pressedKeysTVar
|
||||
toolTVar partialPathTVar
|
||||
toolTVar modeTVar partialPathTVar
|
||||
viewportDrawingArea
|
||||
evt = do
|
||||
keyCode <- GDK.getEventKeyKeyval evt
|
||||
|
|
@ -556,7 +557,7 @@ handleKeyboardPressEvent
|
|||
case keyCode of
|
||||
Escape -> GTK.mainQuit
|
||||
Return -> do
|
||||
tool <- STM.atomically $ STM.readTVar toolTVar
|
||||
tool <- STM.readTVarIO toolTVar
|
||||
case tool of
|
||||
-- End ongoing drawing on pressing enter key.
|
||||
Pen -> do
|
||||
|
|
@ -564,7 +565,8 @@ handleKeyboardPressEvent
|
|||
GTK.widgetQueueDraw viewportDrawingArea
|
||||
_ -> pure ()
|
||||
Delete -> do
|
||||
tool <- STM.atomically $ STM.readTVar toolTVar
|
||||
tool <- STM.readTVarIO toolTVar
|
||||
mode <- STM.readTVarIO modeTVar
|
||||
case tool of
|
||||
-- Delete selected points on pressing 'Delete'.
|
||||
Selection -> do
|
||||
|
|
@ -574,7 +576,7 @@ handleKeyboardPressEvent
|
|||
for_ ( IntMap.lookup i docs ) \ doc -> do
|
||||
let
|
||||
newDoc :: Document
|
||||
newDoc = deleteSelected doc
|
||||
newDoc = deleteSelected mode doc
|
||||
newDocs :: IntMap Document
|
||||
newDocs = IntMap.insert i newDoc docs
|
||||
STM.atomically $ STM.writeTVar openDocumentsTVar newDocs
|
||||
|
|
|
|||
|
|
@ -133,7 +133,7 @@ renderDocument
|
|||
modifiedStrokes
|
||||
| Just ( DragMoveHold p0 ) <- mbHoldEvent
|
||||
, Just p1 <- mbMousePos
|
||||
= strokes $ translateSelection ( p0 --> p1 ) doc
|
||||
= strokes $ translateSelection mode ( p0 --> p1 ) doc
|
||||
| Just ( PartialPath p0 cp0 _ _ ) <- mbPartialPath
|
||||
, let
|
||||
mbFinalPoint :: Maybe ( Point2D Double )
|
||||
|
|
|
|||
Loading…
Reference in a new issue