adjust what is rendered in different modes

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

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

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

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