mirror of
https://gitlab.com/sheaf/metabrush.git
synced 2024-11-05 14:53:37 +00:00
implement deletion of selection
This commit is contained in:
parent
0f2eddab80
commit
107b27ebca
1
.gitignore
vendored
1
.gitignore
vendored
|
@ -4,6 +4,7 @@ cabal.project.local
|
||||||
assets/*.svg
|
assets/*.svg
|
||||||
assets/*/
|
assets/*/
|
||||||
refs/
|
refs/
|
||||||
|
img/examples
|
||||||
|
|
||||||
*.txt
|
*.txt
|
||||||
*.md
|
*.md
|
||||||
|
|
|
@ -61,6 +61,7 @@ library
|
||||||
, Math.Bezier.Quadratic
|
, Math.Bezier.Quadratic
|
||||||
, Math.Bezier.Stroke
|
, Math.Bezier.Stroke
|
||||||
, Math.Bezier.Subdivision
|
, Math.Bezier.Subdivision
|
||||||
|
, Math.Epsilon
|
||||||
, Math.Module
|
, Math.Module
|
||||||
, Math.RealRoots
|
, Math.RealRoots
|
||||||
, Math.Vector2D
|
, Math.Vector2D
|
||||||
|
|
|
@ -78,13 +78,13 @@ data StrokePoint
|
||||||
data PointType
|
data PointType
|
||||||
= PathPoint
|
= PathPoint
|
||||||
| ControlPoint
|
| ControlPoint
|
||||||
deriving stock Show
|
deriving stock ( Show, Eq )
|
||||||
|
|
||||||
data FocusState
|
data FocusState
|
||||||
= Normal
|
= Normal
|
||||||
| Hover
|
| Hover
|
||||||
| Selected
|
| Selected
|
||||||
deriving stock Show
|
deriving stock ( Show, Eq )
|
||||||
|
|
||||||
currentDocument :: STM.TVar ( Maybe Int ) -> STM.TVar ( IntMap Document ) -> IO ( Maybe Document )
|
currentDocument :: STM.TVar ( Maybe Int ) -> STM.TVar ( IntMap Document ) -> IO ( Maybe Document )
|
||||||
currentDocument activeDocumentTVar openDocumentsTVar = STM.atomically do
|
currentDocument activeDocumentTVar openDocumentsTVar = STM.atomically do
|
||||||
|
|
|
@ -28,6 +28,10 @@ import Data.Word
|
||||||
import Data.Act
|
import Data.Act
|
||||||
( Act((•)), Torsor((-->)) )
|
( Act((•)), Torsor((-->)) )
|
||||||
|
|
||||||
|
-- containers
|
||||||
|
import Data.Sequence
|
||||||
|
( Seq(..) )
|
||||||
|
|
||||||
-- generic-lens
|
-- generic-lens
|
||||||
import Data.GenericLens.Internal
|
import Data.GenericLens.Internal
|
||||||
( over )
|
( over )
|
||||||
|
@ -53,7 +57,7 @@ import Math.Vector2D
|
||||||
( Point2D(..), Vector2D(..) )
|
( Point2D(..), Vector2D(..) )
|
||||||
import MetaBrush.Document
|
import MetaBrush.Document
|
||||||
( Document(..), Stroke(..), StrokePoint(..)
|
( Document(..), Stroke(..), StrokePoint(..)
|
||||||
, FocusState(..)
|
, PointType(..), FocusState(..)
|
||||||
)
|
)
|
||||||
import MetaBrush.Event.KeyCodes
|
import MetaBrush.Event.KeyCodes
|
||||||
( pattern Alt_L , pattern Alt_R
|
( pattern Alt_L , pattern Alt_R
|
||||||
|
@ -215,6 +219,37 @@ translateSelection t = over ( field' @"strokes" ) ( fmap updateStroke )
|
||||||
| otherwise
|
| otherwise
|
||||||
= pt
|
= pt
|
||||||
|
|
||||||
-- | Delete the selected points
|
-- | Delete the selected points.
|
||||||
deleteSelected :: Document -> Document
|
deleteSelected :: Document -> Document
|
||||||
deleteSelected doc = doc -- TODO
|
deleteSelected doc
|
||||||
|
= fst . runIdentity . ( `Tardis.runTardisT` ( False, False ) )
|
||||||
|
$ field' @"strokes"
|
||||||
|
( traverse $ field' @"strokePoints" updateStroke )
|
||||||
|
doc
|
||||||
|
where
|
||||||
|
updateStroke :: Seq StrokePoint -> Tardis Bool Bool ( Seq StrokePoint )
|
||||||
|
updateStroke Empty = pure Empty
|
||||||
|
updateStroke ( StrokePoint { pointType = PathPoint, pointState = Selected } :<| ps ) = do
|
||||||
|
Tardis.sendPast True
|
||||||
|
Tardis.sendFuture True
|
||||||
|
updateStroke ps
|
||||||
|
updateStroke ( p@( StrokePoint { pointType = PathPoint } ) :<| ps ) = do
|
||||||
|
Tardis.sendPast False
|
||||||
|
Tardis.sendFuture False
|
||||||
|
( p :<| ) <$> updateStroke ps
|
||||||
|
updateStroke ( p@( StrokePoint { pointType = ControlPoint, pointState } ) :<| ps ) = do
|
||||||
|
prevPathPointDeleted <- Tardis.getPast
|
||||||
|
nextPathPointDeleted <- Tardis.getFuture
|
||||||
|
rest <- updateStroke ps
|
||||||
|
let
|
||||||
|
-- Control point must be deleted:
|
||||||
|
-- - if it is selected,
|
||||||
|
-- - if the previous path point was deleted,
|
||||||
|
-- - if the next path point is going to be deleted.
|
||||||
|
--
|
||||||
|
-- Need to be lazy in "nextPathPointDeleted" to avoid looping.
|
||||||
|
res :: Seq StrokePoint
|
||||||
|
res = if pointState == Selected || prevPathPointDeleted || nextPathPointDeleted
|
||||||
|
then rest
|
||||||
|
else p :<| rest
|
||||||
|
pure res
|
||||||
|
|
12
src/lib/Math/Epsilon.hs
Normal file
12
src/lib/Math/Epsilon.hs
Normal file
|
@ -0,0 +1,12 @@
|
||||||
|
{-# LANGUAGE ScopedTypeVariables #-}
|
||||||
|
|
||||||
|
module Math.Epsilon
|
||||||
|
( epsilon )
|
||||||
|
where
|
||||||
|
|
||||||
|
--------------------------------------------------------------------------------
|
||||||
|
|
||||||
|
{-# SPECIALISE epsilon :: Float #-}
|
||||||
|
{-# SPECIALISE epsilon :: Double #-}
|
||||||
|
epsilon :: forall r. RealFloat r => r
|
||||||
|
epsilon = encodeFloat 1 ( 5 - floatDigits ( 0 :: r ) )
|
|
@ -12,18 +12,20 @@ import Data.List.NonEmpty
|
||||||
import Data.Maybe
|
import Data.Maybe
|
||||||
( mapMaybe )
|
( mapMaybe )
|
||||||
|
|
||||||
|
-- MetaBrush
|
||||||
|
import Math.Epsilon
|
||||||
|
( epsilon )
|
||||||
|
|
||||||
--------------------------------------------------------------------------------
|
--------------------------------------------------------------------------------
|
||||||
|
|
||||||
-- | Find real roots of a polynomial.
|
-- | Find real roots of a polynomial.
|
||||||
realRoots :: forall r. RealFloat r => [ r ] -> [ r ]
|
realRoots :: forall r. RealFloat r => [ r ] -> [ r ]
|
||||||
realRoots p = mapMaybe isReal ( roots eps 10000 ( map (:+ 0) p ) )
|
realRoots p = mapMaybe isReal ( roots epsilon 10000 ( map (:+ 0) p ) )
|
||||||
where
|
where
|
||||||
isReal :: Complex r -> Maybe r
|
isReal :: Complex r -> Maybe r
|
||||||
isReal ( a :+ b )
|
isReal ( a :+ b )
|
||||||
| abs b < eps = Just a
|
| abs b < epsilon = Just a
|
||||||
| otherwise = Nothing
|
| otherwise = Nothing
|
||||||
eps :: r
|
|
||||||
eps = encodeFloat 1 ( 5 - floatDigits ( 0 :: r ) )
|
|
||||||
|
|
||||||
-- | Compute all roots of a polynomial using Laguerre's method and (forward) deflation.
|
-- | Compute all roots of a polynomial using Laguerre's method and (forward) deflation.
|
||||||
--
|
--
|
||||||
|
|
|
@ -5,7 +5,9 @@
|
||||||
{-# LANGUAGE MultiParamTypeClasses #-}
|
{-# LANGUAGE MultiParamTypeClasses #-}
|
||||||
|
|
||||||
module Math.Vector2D
|
module Math.Vector2D
|
||||||
( Point2D(..), Vector2D(..) )
|
( Point2D(..), Vector2D(..)
|
||||||
|
, cross
|
||||||
|
)
|
||||||
where
|
where
|
||||||
|
|
||||||
-- base
|
-- base
|
||||||
|
@ -56,3 +58,7 @@ instance Num a => Module a ( Vector2D a ) where
|
||||||
instance Num a => Inner a ( Vector2D a ) where
|
instance Num a => Inner a ( Vector2D a ) where
|
||||||
( Vector2D ( Point2D x1 y1 ) ) ^.^ ( Vector2D ( Point2D x2 y2 ) )
|
( Vector2D ( Point2D x1 y1 ) ) ^.^ ( Vector2D ( Point2D x2 y2 ) )
|
||||||
= x1 * x2 + y1 * y2
|
= x1 * x2 + y1 * y2
|
||||||
|
|
||||||
|
cross :: Num a => Vector2D a -> Vector2D a -> a
|
||||||
|
cross ( Vector2D ( Point2D x1 y1 ) ) ( Vector2D ( Point2D x2 y2 ) )
|
||||||
|
= x1 * y2 - x2 * y1
|
||||||
|
|
Loading…
Reference in a new issue