diff --git a/brush-strokes/src/lib/Math/Bezier/Stroke.hs b/brush-strokes/src/lib/Math/Bezier/Stroke.hs index bca2619..c29d718 100644 --- a/brush-strokes/src/lib/Math/Bezier/Stroke.hs +++ b/brush-strokes/src/lib/Math/Bezier/Stroke.hs @@ -50,9 +50,8 @@ import Data.List import Data.List.NonEmpty ( NonEmpty ) import qualified Data.List.NonEmpty as NE - ( cons, singleton ) import Data.Maybe - ( fromMaybe, isJust, listToMaybe, mapMaybe ) + ( catMaybes, fromMaybe, isJust, listToMaybe, mapMaybe ) import Data.Proxy ( Proxy(..) ) import Data.Semigroup @@ -82,7 +81,6 @@ import qualified Data.IntMap.Strict as IntMap import Data.Sequence ( Seq(..) ) import qualified Data.Sequence as Seq - ( empty, index, length, reverse, singleton, zipWith ) -- deepseq import Control.DeepSeq @@ -732,8 +730,8 @@ joinWithBrush brush startTgt endTgt = joinBetweenOffsets brush startOffset endOf joinBetweenOffsets :: forall crvData ptData. HasType ( ℝ 2 ) ptData => Spline Closed crvData ptData -> Offset -> Offset -> SplinePts Open joinBetweenOffsets spline - ( Offset { offsetIndex = i1, offsetParameter = mb_t1 } ) - ( Offset { offsetIndex = i2, offsetParameter = mb_t2 } ) + ( Offset { offsetIndex = i1, offsetParameter = fromMaybe 1 -> t1 } ) + ( Offset { offsetIndex = i2, offsetParameter = fromMaybe 0 -> t2 } ) | i2 > i1 = let pcs, lastAndRest :: Maybe ( SplinePts Open ) @@ -749,13 +747,16 @@ joinBetweenOffsets , dropFirstPiece =<< pcs , fst <$> ( splitFirstPiece t2 =<< lastAndRest ) ] - | i2 == i1 && mb_t2 >= mb_t1 + | i2 == i1 && t2 >= t1 = let pcs :: Maybe ( SplinePts Open ) pcs = discardCurveData <$> dropCurves i1 openSpline in maybe empty fst - ( splitFirstPiece t2 . snd =<< ( splitFirstPiece t1 =<< pcs ) ) + ( splitFirstPiece ( ( t2 - t1 ) / ( 1 - t1 ) ) . snd =<< ( splitFirstPiece t1 =<< pcs ) ) + -- NB: we want to split: 0 -- t1 -- t2 -- 1 + -- First split at t1, then split again but after rescaling + -- using t |-> ( t - t1 ) / ( 1 - t1 ). | otherwise = let start, middle, end :: SplinePts Open @@ -764,21 +765,17 @@ joinBetweenOffsets $ first ( splitSplineAt i2 ) $ splitSplineAt i1 openSpline in - fromMaybe empty $ - mconcat - [ snd <$> splitFirstPiece t1 start - , dropFirstPiece start - , Just middle - , fst <$> splitFirstPiece t2 end - ] + sconcat $ NE.fromList $ catMaybes $ + [ snd <$> splitFirstPiece t1 start + , dropFirstPiece start + , Just middle + , fst <$> splitFirstPiece t2 ( if i1 == i2 then start else end ) + ] where empty :: SplinePts Open empty = Spline { splineStart = ℝ2 0 0, splineCurves = OpenCurves Empty } openSpline :: Spline Open crvData ptData openSpline = adjustSplineType spline - t1, t2 :: Double - t1 = fromMaybe 0.5 mb_t1 - t2 = fromMaybe 0.5 mb_t2 discardCurveData diff --git a/src/metabrushes/MetaBrush/Action.hs b/src/metabrushes/MetaBrush/Action.hs index 8db57bf..66c249f 100644 --- a/src/metabrushes/MetaBrush/Action.hs +++ b/src/metabrushes/MetaBrush/Action.hs @@ -23,7 +23,7 @@ module MetaBrush.Action import Control.Arrow ( second ) import Control.Monad - ( guard, when ) + ( guard, when, unless ) import Control.Monad.ST ( RealWorld ) import Data.Foldable @@ -349,105 +349,101 @@ dragMoveSelect c ( Document { documentContent, documentMetadata } ) = -> Int -> PointData brushParams -> Curve clo' ( CurveData RealWorld ) ( PointData brushParams ) -> State ( Maybe DragMoveSelect ) () - dragSelectSplineCurve uniq start i sp0 crv = do + dragSelectSplineCurve uniq start i sp0 = \case + LineTo sp1 ( CurveData { curveIndex } ) -> do + traverse_ ( dragSelectSplinePoint uniq ( PointIndex curveIndex PathPoint ) ) sp1 + unlessPrevDrag $ do + let + mbCurveDrag :: Maybe DragMoveSelect + mbCurveDrag = do + let + t :: Double + p :: ℝ 2 + ( t, p ) = + closestPointOnSegment @( T ( ℝ 2 ) ) + c + ( Segment ( coords sp0 ) ( coords $ fromNextPoint start sp1 ) ) + guard ( inSelectionRange p ) + pure $ + ClickedOnCurve + { dragStrokeUnique = uniq + , dragCurve = curveIndex + , dragCurveIndex = i + , dragCurveParameter = t + } + for_ mbCurveDrag $ State.put . Just + Bezier2To sp1 sp2 ( CurveData { curveIndex } ) -> do + dragSelectSplinePoint uniq ( PointIndex curveIndex ( ControlPoint Bez2Cp ) ) sp1 + traverse_ ( dragSelectSplinePoint uniq ( PointIndex curveIndex PathPoint ) ) sp2 + unlessPrevDrag $ do + let + mbCurveDrag :: Maybe DragMoveSelect + mbCurveDrag = do + let + bez :: Quadratic.Bezier ( ℝ 2 ) + bez = Quadratic.Bezier ( coords sp0 ) ( coords sp1 ) ( coords $ fromNextPoint start sp2 ) + sq_d :: Double + t :: Double + Min ( Arg sq_d (t, _) ) = + Quadratic.closestPoint @( T ( ℝ 2 ) ) bez c + guard ( t > 0 && t < 1 && sq_d * zoomFactor ^ ( 2 :: Int ) < 16 ) + pure $ + ClickedOnCurve + { dragStrokeUnique = uniq + , dragCurve = curveIndex + , dragCurveIndex = i + , dragCurveParameter = t + } + for_ mbCurveDrag $ State.put . Just + Bezier3To sp1 sp2 sp3 ( CurveData { curveIndex } ) -> do + dragSelectSplinePoint uniq ( PointIndex curveIndex ( ControlPoint Bez3Cp1 ) ) sp1 + dragSelectSplinePoint uniq ( PointIndex curveIndex ( ControlPoint Bez3Cp2 ) ) sp2 + traverse_ ( dragSelectSplinePoint uniq ( PointIndex curveIndex PathPoint ) ) sp3 + unlessPrevDrag $ do + let + mbCurveDrag :: Maybe DragMoveSelect + mbCurveDrag = do + let + bez :: Cubic.Bezier ( ℝ 2 ) + bez = Cubic.Bezier ( coords sp0 ) ( coords sp1 ) ( coords sp2 ) ( coords $ fromNextPoint start sp3 ) + sq_d :: Double + t :: Double + Min ( Arg sq_d (t, _) ) = + Cubic.closestPoint @( T ( ℝ 2 ) ) bez c + guard ( t > 0 && t < 1 && sq_d * zoomFactor ^ ( 2 :: Int ) < 16 ) + pure $ + ClickedOnCurve + { dragStrokeUnique = uniq + , dragCurve = curveIndex + , dragCurveIndex = i + , dragCurveParameter = t + } + for_ mbCurveDrag $ State.put . Just + + unlessPrevDrag :: State ( Maybe DragMoveSelect ) () -> State ( Maybe DragMoveSelect ) () + unlessPrevDrag action = do + mbPrevDrag <- State.get + unless ( isJust mbPrevDrag ) $ + action + + unlessPrevPointDrag :: State ( Maybe DragMoveSelect ) () -> State ( Maybe DragMoveSelect ) () + unlessPrevPointDrag action = do mbPrevDrag <- State.get case mbPrevDrag of - -- If we've clicked on a point, don't try anything further. Just ( ClickedOnPoint {} ) -> return () - _notPointDrag -> do - -- If we've already initiated a curve drag, don't try - -- another curve drag. However, we allow overridding a curve drag - -- by a point drag. - let clickedOnCurve = isJust mbPrevDrag - case crv of - LineTo sp1 ( CurveData { curveIndex } ) -> do - -- Check endpoints first. - traverse_ ( dragSelectSplinePoint uniq ( PointIndex curveIndex PathPoint ) ) sp1 - let - mbCurveDrag :: Maybe DragMoveSelect - mbCurveDrag = do - guard ( not clickedOnCurve ) - let - t :: Double - p :: ℝ 2 - ( t, p ) = - closestPointOnSegment @( T ( ℝ 2 ) ) - c - ( Segment ( coords sp0 ) ( coords $ fromNextPoint start sp1 ) ) - guard ( inSelectionRange p ) - pure $ - ClickedOnCurve - { dragStrokeUnique = uniq - , dragCurve = curveIndex - , dragCurveIndex = i - , dragCurveParameter = t - } - for_ mbCurveDrag $ State.put . Just - Bezier2To sp1 sp2 ( CurveData { curveIndex } ) -> do - -- Check endpoints first. - dragSelectSplinePoint uniq ( PointIndex curveIndex ( ControlPoint Bez2Cp ) ) sp1 - traverse_ ( dragSelectSplinePoint uniq ( PointIndex curveIndex PathPoint ) ) sp2 - let - mbCurveDrag :: Maybe DragMoveSelect - mbCurveDrag = do - guard ( not clickedOnCurve ) - let - bez :: Quadratic.Bezier ( ℝ 2 ) - bez = Quadratic.Bezier ( coords sp0 ) ( coords sp1 ) ( coords $ fromNextPoint start sp2 ) - sq_d :: Double - t :: Double - Min ( Arg sq_d (t, _) ) = - Quadratic.closestPoint @( T ( ℝ 2 ) ) bez c - guard ( t > 0 && t < 1 && sq_d * zoomFactor ^ ( 2 :: Int ) < 16 ) - pure $ - ClickedOnCurve - { dragStrokeUnique = uniq - , dragCurve = curveIndex - , dragCurveIndex = i - , dragCurveParameter = t - } - for_ mbCurveDrag $ State.put . Just - Bezier3To sp1 sp2 sp3 ( CurveData { curveIndex } ) -> do - -- Check endpoints first. - dragSelectSplinePoint uniq ( PointIndex curveIndex ( ControlPoint Bez3Cp1 ) ) sp1 - dragSelectSplinePoint uniq ( PointIndex curveIndex ( ControlPoint Bez3Cp2 ) ) sp2 - traverse_ ( dragSelectSplinePoint uniq ( PointIndex curveIndex PathPoint ) ) sp3 - let - mbCurveDrag :: Maybe DragMoveSelect - mbCurveDrag = do - guard ( not clickedOnCurve ) - let - bez :: Cubic.Bezier ( ℝ 2 ) - bez = Cubic.Bezier ( coords sp0 ) ( coords sp1 ) ( coords sp2 ) ( coords $ fromNextPoint start sp3 ) - sq_d :: Double - t :: Double - Min ( Arg sq_d (t, _) ) = - Cubic.closestPoint @( T ( ℝ 2 ) ) bez c - guard ( t > 0 && t < 1 && sq_d * zoomFactor ^ ( 2 :: Int ) < 16 ) - pure $ - ClickedOnCurve - { dragStrokeUnique = uniq - , dragCurve = curveIndex - , dragCurveIndex = i - , dragCurveParameter = t - } - for_ mbCurveDrag $ State.put . Just + _ -> action dragSelectSplinePoint :: Unique -> PointIndex -> PointData brushParams -> State ( Maybe DragMoveSelect ) () dragSelectSplinePoint u ptIx pt = - when ( inSelectionRange ( coords pt ) ) do - mbPrevDrag <- State.get - case mbPrevDrag of - Just ( ClickedOnPoint {} ) -> return () - _ -> do - let - drag :: DragMoveSelect - drag = ClickedOnPoint - { dragPoint = ( u, ptIx ) - , dragPointWasSelected = - elemStrokePoint u ptIx ( selectedPoints documentMetadata ) - } - State.put $ Just drag + unlessPrevPointDrag $ when ( inSelectionRange ( coords pt ) ) do + let + drag :: DragMoveSelect + drag = ClickedOnPoint + { dragPoint = ( u, ptIx ) + , dragPointWasSelected = + elemStrokePoint u ptIx ( selectedPoints documentMetadata ) + } + State.put $ Just drag addOrRemove :: SelectionMode