implement deletion of selection

.gitignore

@@ -4,6 +4,7 @@ cabal.project.local
 assets/*.svg
 assets/*/
 refs/
+img/examples
 
 *.txt
 *.md

MetaBrush.cabal

@@ -61,6 +61,7 @@ library
       , Math.Bezier.Quadratic
       , Math.Bezier.Stroke
       , Math.Bezier.Subdivision
+      , Math.Epsilon
       , Math.Module
       , Math.RealRoots
       , Math.Vector2D

src/app/MetaBrush/Document.hs

@@ -78,13 +78,13 @@ data StrokePoint
 data PointType
   = PathPoint
   | ControlPoint
-  deriving stock Show
+  deriving stock ( Show, Eq )
 
 data FocusState
   = Normal
   | Hover
   | Selected
-  deriving stock Show
+  deriving stock ( Show, Eq )
 
 currentDocument :: STM.TVar ( Maybe Int ) -> STM.TVar ( IntMap Document ) -> IO ( Maybe Document )
 currentDocument activeDocumentTVar openDocumentsTVar = STM.atomically do

src/app/MetaBrush/Document/Selection.hs

@@ -28,6 +28,10 @@ import Data.Word
 import Data.Act
   ( Act((•)), Torsor((-->)) )
 
+-- containers
+import Data.Sequence
+  ( Seq(..) )
+
 -- generic-lens
 import Data.GenericLens.Internal
   ( over )
@@ -53,7 +57,7 @@ import Math.Vector2D
   ( Point2D(..), Vector2D(..) )
 import MetaBrush.Document
   ( Document(..), Stroke(..), StrokePoint(..)
-  , FocusState(..)
+  , PointType(..), FocusState(..)
   )
 import MetaBrush.Event.KeyCodes
   ( pattern Alt_L  , pattern Alt_R
@@ -215,6 +219,37 @@ translateSelection t = over ( field' @"strokes" ) ( fmap updateStroke )
       | otherwise
       = pt
 
--- | Delete the selected points
+-- | Delete the selected points.
 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

src/lib/Math/Epsilon.hs

@@ -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 ) )

src/lib/Math/RealRoots.hs

@@ -12,18 +12,20 @@ import Data.List.NonEmpty
 import Data.Maybe
   ( mapMaybe )
 
+-- MetaBrush
+import Math.Epsilon
+  ( epsilon )
+
 --------------------------------------------------------------------------------
 
 -- | Find real roots of a polynomial.
 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
     isReal :: Complex r -> Maybe r
     isReal ( a :+ b )
-      | abs b < eps = Just a
-      | otherwise   = Nothing
-    eps :: r
-    eps = encodeFloat 1 ( 5 - floatDigits ( 0 :: r ) )
+      | abs b < epsilon = Just a
+      | otherwise       = Nothing
 
 -- | Compute all roots of a polynomial using Laguerre's method and (forward) deflation.
 --

src/lib/Math/Vector2D.hs

@@ -5,7 +5,9 @@
 {-# LANGUAGE MultiParamTypeClasses #-}
 
 module Math.Vector2D
-  ( Point2D(..), Vector2D(..) )
+  ( Point2D(..), Vector2D(..)
+  , cross
+  )
   where
 
 -- base
@@ -56,3 +58,7 @@ instance Num a => Module a ( Vector2D a ) where
 instance Num a => Inner a ( Vector2D a ) where
   ( Vector2D ( Point2D x1 y1 ) ) ^.^ ( Vector2D ( Point2D x2 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