diff --git a/app/Main.hs b/app/Main.hs index 57d7dad..41c9798 100644 --- a/app/Main.hs +++ b/app/Main.hs @@ -126,7 +126,10 @@ testDocuments = IntMap.fromList [ PathPoint ( Point2D 0 (-100) ) ( PointData Normal ( ellipse 30 8 $ BrushPointData Normal ) ) , ControlPoint ( Point2D 0 ( -30) ) ( PointData Normal ( ellipse 25 6 $ BrushPointData Normal ) ) , ControlPoint ( Point2D 0 ( 30) ) ( PointData Normal ( ellipse 15 6 $ BrushPointData Normal ) ) - , PathPoint ( Point2D 0 ( 100) ) ( PointData Normal ( ellipse 5 2 $ BrushPointData Normal ) ) + , PathPoint ( Point2D 0 ( 100) ) ( PointData Normal ( ellipse 15 6 $ BrushPointData Normal ) ) + , ControlPoint ( Point2D 0 ( 150) ) ( PointData Normal ( ellipse 15 6 $ BrushPointData Normal ) ) + , ControlPoint ( Point2D 0 ( 200) ) ( PointData Normal ( ellipse 15 6 $ BrushPointData Normal ) ) + , PathPoint ( Point2D 0 ( 250) ) ( PointData Normal ( ellipse 10 1 $ BrushPointData Normal ) ) ] -------------------------------------------------------------------------------- diff --git a/src/app/MetaBrush/Render/Document.hs b/src/app/MetaBrush/Render/Document.hs index 1d61d39..0ce50a3 100644 --- a/src/app/MetaBrush/Render/Document.hs +++ b/src/app/MetaBrush/Render/Document.hs @@ -15,7 +15,7 @@ module MetaBrush.Render.Document -- base import Control.Monad - ( guard ) + ( guard, when, unless ) import Data.Foldable ( for_, sequenceA_ ) import Data.Functor.Compose @@ -102,14 +102,6 @@ compositeRenders = sequenceA_ toAll :: Cairo.Render () -> Compose Renders Cairo.Render () toAll action = Compose ( pure action ) -whenPath :: Applicative m => Mode -> m () -> m () -whenPath Path = id -whenPath _ = const ( pure () ) - -whenBrush :: Applicative m => Mode -> m () -> m () -whenBrush Brush = id -whenBrush _ = const ( pure () ) - -------------------------------------------------------------------------------- renderDocument @@ -183,7 +175,7 @@ renderStroke :: Colours -> Mode -> Double -> Stroke -> Compose Renders Cairo.Ren renderStroke cols@( Colours { brush } ) mode zoom ( Stroke { strokePoints = pts, strokeVisible } ) | strokeVisible = renderStrokePoints cols mode zoom - ( whenBrush mode . renderBrushShape ( cols { path = brush } ) ( 2 * zoom ) ) + ( when ( mode == Brush ) . renderBrushShape ( cols { path = brush } ) ( 1.5 * zoom ) ) pts *> Compose blank { renderStrokes = drawStroke cols ( stroke pts ) } | otherwise @@ -202,7 +194,7 @@ renderStrokePoints -> Compose Renders Cairo.Render () renderStrokePoints _ _ _ _ Empty = pure () renderStrokePoints cols mode zoom renderSubcontent ( pt0 :<| pts ) = - Compose blank { renderPPts = whenPath mode $ drawPoint cols zoom pt0 } + Compose blank { renderPPts = when ( mode == Path ) $ drawPoint cols zoom pt0 } *> renderSubcontent pt0 *> go pt0 pts where @@ -214,9 +206,9 @@ renderStrokePoints cols mode zoom renderSubcontent ( pt0 :<| pts ) = | PathPoint {} <- p1 = Compose blank { renderPPts - = whenPath mode $ drawPoint cols zoom p1 + = when ( mode == Path ) $ drawPoint cols zoom p1 , renderPath - = drawLine cols zoom p0 p1 + = unless ( mode == Meta ) $ drawLine cols zoom p0 p1 } *> renderSubcontent p1 *> go p1 ps @@ -226,15 +218,15 @@ renderStrokePoints cols mode zoom renderSubcontent ( pt0 :<| pts ) = , PathPoint {} <- p2 = Compose blank { renderCLines - = whenPath mode do + = when ( mode == Path ) do drawLine cols zoom p0 p1 drawLine cols zoom p1 p2 , renderCPts - = whenPath mode $ drawPoint cols zoom p1 + = when ( mode == Path ) $ drawPoint cols zoom p1 , renderPPts - = whenPath mode $ drawPoint cols zoom p2 + = when ( mode == Path ) $ drawPoint cols zoom p2 , renderPath - = drawQuadraticBezier cols zoom ( coords <$> Quadratic.Bezier { p0, p1, p2 } ) + = unless ( mode == Meta ) $ drawQuadraticBezier cols zoom ( coords <$> Quadratic.Bezier { p0, p1, p2 } ) } *> renderSubcontent p1 *> renderSubcontent p2 @@ -246,17 +238,17 @@ renderStrokePoints cols mode zoom renderSubcontent ( pt0 :<| pts ) = , PathPoint {} <- p3 = Compose blank { renderCLines - = whenPath mode do + = when ( mode == Path ) do drawLine cols zoom p0 p1 drawLine cols zoom p2 p3 , renderCPts - = whenPath mode do + = when ( mode == Path ) do drawPoint cols zoom p1 drawPoint cols zoom p2 , renderPPts - = whenPath mode $ drawPoint cols zoom p3 + = when ( mode == Path ) $ drawPoint cols zoom p3 , renderPath - = drawCubicBezier cols zoom ( coords <$> Cubic.Bezier { p0, p1, p2, p3 } ) + = unless ( mode == Meta ) $ drawCubicBezier cols zoom ( coords <$> Cubic.Bezier { p0, p1, p2, p3 } ) } *> renderSubcontent p1 *> renderSubcontent p2 @@ -275,7 +267,7 @@ renderBrushShape cols zoom pt = toAll do Cairo.save Cairo.translate x y - *> renderStrokePoints cols Brush zoom ( const $ pure () ) brushPts + *> renderStrokePoints cols Path zoom ( const $ pure () ) brushPts *> Compose blank { renderPPts = drawCross cols zoom } *> toAll Cairo.restore @@ -476,10 +468,10 @@ drawCross :: Colours -> Double -> Cairo.Render () drawCross ( Colours { .. } ) zoom = do Cairo.save - Cairo.setLineWidth 2 + Cairo.setLineWidth 1.5 withRGBA brushCenter Cairo.setSourceRGBA - Cairo.scale ( 2 / zoom ) ( 2 / zoom ) + Cairo.scale ( 1.5 / zoom ) ( 1.5 / zoom ) Cairo.moveTo -3 -3 Cairo.lineTo 3 3 diff --git a/src/app/MetaBrush/UI/ToolBar.hs b/src/app/MetaBrush/UI/ToolBar.hs index d9c37d1..f520bac 100644 --- a/src/app/MetaBrush/UI/ToolBar.hs +++ b/src/app/MetaBrush/UI/ToolBar.hs @@ -44,13 +44,13 @@ import MetaBrush.Render.Util data Tool = Selection | Pen - deriving stock Show + deriving stock ( Show, Eq ) data Mode = Path | Brush | Meta - deriving stock Show + deriving stock ( Show, Eq ) data ToolBar = ToolBar diff --git a/src/lib/Math/Bezier/Stroke.hs b/src/lib/Math/Bezier/Stroke.hs index af72bff..dc79b7f 100644 --- a/src/lib/Math/Bezier/Stroke.hs +++ b/src/lib/Math/Bezier/Stroke.hs @@ -335,7 +335,7 @@ cubicBezierBrush t ( Cubic.Bezier p0s p1s p2s p3s ) = Seq.zipWith4 f p0s p1s p2s fitCurve :: ( Double -> ( Point2D Double, Vector2D Double ) ) -> Seq ( StrokePoint () ) -fitCurve curve = splinePoints $ fitSpline 2 10 1e-4 1e-5 80 curve +fitCurve curve = splinePoints $ fitSpline 1 13 1e-4 1e-5 100 curve splinePoints :: Seq ( Cubic.Bezier ( Point2D Double ) ) -> Seq ( StrokePoint () ) splinePoints Empty = Empty