use R2 instead of Point2D & Vector2D

MetaBrush.cabal

@@ -170,7 +170,6 @@ library splines
     exposed-modules:
         Math.Bezier.Cubic
       , Math.Bezier.Cubic.Fit
-      , Math.Bezier.Envelope
       , Math.Bezier.Quadratic
       , Math.Bezier.Spline
       , Math.Bezier.Stroke

src/app/MetaBrush/Action.hs

@@ -90,7 +90,7 @@ import Math.Bezier.Stroke
 import Math.Module
   ( Module((*^)), quadrance )
 import Math.Linear
-  ( Point2D(..), Vector2D(..) )
+  ( ℝ(..), T(..) )
 import MetaBrush.Context
   ( UIElements(..), Variables(..)
   , Modifier(..), modifierKey
@@ -658,24 +658,24 @@ instance HandleAction About where
 -- Mouse movement --
 --------------------
 
-data MouseMove = MouseMove !( Point2D Double )
+data MouseMove = MouseMove !( ℝ 2 )
   deriving stock Show
 
 instance HandleAction MouseMove where
   handleAction
     ( UIElements { viewport = Viewport {..}, .. } )
     vars@( Variables {..} )
-    ( MouseMove ( Point2D x y ) )
+    ( MouseMove ( ℝ2 x y ) )
     = do
       viewportWidth  <- fromIntegral @_ @Double <$> GTK.widgetGetAllocatedWidth  viewportDrawingArea
       viewportHeight <- fromIntegral @_ @Double <$> GTK.widgetGetAllocatedHeight viewportDrawingArea
       uiUpdateAction <- STM.atomically $ withActiveDocument vars \ doc@( Document {..} ) -> do
         modifiers   <- STM.readTVar modifiersTVar
         let
-          toViewport :: Point2D Double -> Point2D Double
+          toViewport :: ℝ 2 -> ℝ 2
           toViewport = toViewportCoordinates zoomFactor ( viewportWidth, viewportHeight ) viewportCenter
-          pos :: Point2D Double
+          pos :: ℝ 2
-          pos = toViewport ( Point2D x y )
+          pos = toViewport ( ℝ2 x y )
         STM.writeTVar mousePosTVar ( Just pos )
         ----------------------------------------------------------
         -- With the pen tool, keeping control pressed while moving the mouse
@@ -714,7 +714,7 @@ data MouseClick =
     { clickOrigin :: !ActionOrigin
     , clickType   :: !MouseClickType
     , clickButton :: !Word32
-    , clickCoords :: !( Point2D Double )
+    , clickCoords :: !( ℝ 2 )
     }
   deriving stock Show
 
@@ -731,9 +731,9 @@ instance HandleAction MouseClick where
         viewportHeight <- fromIntegral @_ @Double <$> GTK.widgetGetAllocatedHeight viewportDrawingArea
         modifyingCurrentDocument uiElts vars \ doc@( Document { zoomFactor, viewportCenter } ) -> do
           let
-            toViewport :: Point2D Double -> Point2D Double
+            toViewport :: ℝ 2 -> ℝ 2
             toViewport = toViewportCoordinates zoomFactor ( viewportWidth, viewportHeight ) viewportCenter
-            pos :: Point2D Double
+            pos :: ℝ 2
             pos = toViewport mouseClickCoords
           STM.writeTVar mousePosTVar ( Just pos )
           mode <- STM.readTVar modeTVar
@@ -853,14 +853,14 @@ instance HandleAction MouseClick where
 -- Mouse release --
 -------------------
 
-data MouseRelease = MouseRelease !Word32 !( Point2D Double )
+data MouseRelease = MouseRelease !Word32 !( ℝ 2 )
   deriving stock Show
 
 instance HandleAction MouseRelease where
   handleAction 
     uiElts@( UIElements { viewport = Viewport {..} } )
     vars@( Variables {..} )
-    ( MouseRelease button ( Point2D x y ) )
+    ( MouseRelease button ( ℝ2 x y ) )
     = case button of
 
       -- Left mouse button.
@@ -869,16 +869,16 @@ instance HandleAction MouseRelease where
         viewportHeight <- fromIntegral @_ @Double <$> GTK.widgetGetAllocatedHeight viewportDrawingArea
         modifyingCurrentDocument uiElts vars \ doc@( Document { zoomFactor, viewportCenter } ) -> do
           let
-            toViewport :: Point2D Double -> Point2D Double
+            toViewport :: ℝ 2 -> ℝ 2
             toViewport = toViewportCoordinates zoomFactor ( viewportWidth, viewportHeight ) viewportCenter
-            pos :: Point2D Double
+            pos :: ℝ 2
-            pos = toViewport ( Point2D x y )
+            pos = toViewport ( ℝ2 x y )
           STM.writeTVar mousePosTVar  ( Just pos )
           modifiers <- STM.readTVar modifiersTVar
           mbHoldPos <- STM.swapTVar mouseHoldTVar Nothing
 
           case mbHoldPos of
-            Just ( GuideAction { holdStartPos = holdStartPos@( Point2D hx hy ), guideAction } ) -> do
+            Just ( GuideAction { holdStartPos = holdStartPos@( ℝ2 hx hy ), guideAction } ) -> do
               case guideAction of
                 CreateGuide ruler
                   | createGuide
@@ -905,7 +905,7 @@ instance HandleAction MouseRelease where
                         newDocument =
                           over
                             ( field' @"documentContent" . field' @"guides" . ix guideUnique . field' @"guidePoint" )
-                            ( ( holdStartPos --> pos :: Vector2D Double ) • )
+                            ( ( holdStartPos --> pos :: T ( ℝ 2 ) ) • )
                             doc
                         changeText :: Text
                         changeText = "Move guide"
@@ -922,7 +922,7 @@ instance HandleAction MouseRelease where
                       in pure ( UpdateDoc . UpdateDocumentTo $ HistoryChange {..} )
                   where
                     l, t :: Double
-                    Point2D l t = toViewport ( Point2D 0 0 )
+                    ℝ2 l t = toViewport ( ℝ2 0 0 )
                     keepGuide :: Bool
                     keepGuide
                       =  ( x >= 0 || hx < l ) -- mouse hold position (hx,hy) is in document coordinates,
@@ -943,7 +943,7 @@ instance HandleAction MouseRelease where
                     Just hold
                       | PathMode <- mode
                       , DragMoveHold { holdStartPos = pos0, dragAction } <- hold
-                      , quadrance @( Vector2D Double ) pos0 pos * zoomFactor ^ ( 2 :: Int ) >= 16
+                      , quadrance @( T ( ℝ 2 ) ) pos0 pos * zoomFactor ^ ( 2 :: Int ) >= 16
                       -> let
                             alternateMode :: Bool
                             alternateMode = any ( \case { Alt _ -> True; _ -> False } ) modifiers
@@ -951,7 +951,7 @@ instance HandleAction MouseRelease where
                             Just upd -> pure $ UpdateDoc ( UpdateDocumentTo upd )
                             Nothing  -> pure Don'tModifyDoc
                       | SelectionHold pos0 <- hold
-                      , quadrance @( Vector2D Double ) pos0 pos * zoomFactor ^ ( 2 :: Int ) >= 16
+                      , quadrance @( T ( ℝ 2 ) ) pos0 pos * zoomFactor ^ ( 2 :: Int ) >= 16
                       -> pure ( UpdateDoc . UpdateDocumentTo . TrivialChange $ selectRectangle selMode pos0 pos doc )
                     _ -> pure ( UpdateDoc . UpdateDocumentTo . TrivialChange $ selectAt selMode pos doc )
 
@@ -977,12 +977,12 @@ instance HandleAction MouseRelease where
                           }
                         ) -> do
                         let
-                          pathPoint :: Point2D Double
+                          pathPoint :: ℝ 2
-                          mbControlPoint :: Maybe ( Point2D Double )
+                          mbControlPoint :: Maybe ( ℝ 2 )
-                          partialControlPoint :: Maybe ( Point2D Double )
+                          partialControlPoint :: Maybe ( ℝ 2 )
                           ( pathPoint, mbControlPoint, partialControlPoint )
                             | Just ( DrawHold holdPos ) <- mbHoldPos
-                            = ( holdPos, Just $ ( pos --> holdPos :: Vector2D Double ) • holdPos, Just pos )
+                            = ( holdPos, Just $ ( pos --> holdPos :: T ( ℝ 2 ) ) • holdPos, Just pos )
                             | otherwise
                             = ( pos, Nothing, Nothing )
                         ( _, otherAnchor, otherAnchorPt, _ ) <- getOrCreateDrawAnchor uniqueSupply pathPoint doc
@@ -1049,14 +1049,14 @@ instance HandleAction MouseRelease where
 -- Scrolling --
 ---------------
 
-data Scroll = Scroll !( Maybe ( Point2D Double ) ) !( Vector2D Double )
+data Scroll = Scroll !( Maybe ( ℝ 2 ) ) !( T ( ℝ 2 ) )
   deriving stock Show
 
 instance HandleAction Scroll where
   handleAction
     uiElts
     vars@( Variables {..} )
-    ( Scroll mbMousePos ( Vector2D dx dy ) ) = do
+    ( Scroll mbMousePos ( V2 dx dy ) ) = do
 
       --viewportWidth  <- fromIntegral @_ @Double <$> GTK.widgetGetAllocatedWidth  viewportDrawingArea
       --viewportHeight <- fromIntegral @_ @Double <$> GTK.widgetGetAllocatedHeight viewportDrawingArea
@@ -1065,9 +1065,9 @@ instance HandleAction Scroll where
         modifyingCurrentDocument uiElts vars \ ( doc@( Document { viewportCenter = oldCenter, zoomFactor = oldZoomFactor } ) ) -> do
           modifiers <- STM.readTVar modifiersTVar
           let
-            mousePos :: Point2D Double
+            mousePos :: ℝ 2
             mousePos = fromMaybe oldCenter mbMousePos
-            finalMousePos :: Point2D Double
+            finalMousePos :: ℝ 2
             newDoc :: Document
             ( newDoc, finalMousePos )
               -- Zooming using 'Control'.
@@ -1079,23 +1079,23 @@ instance HandleAction Scroll where
                     = max 0.0078125 ( oldZoomFactor / sqrt 2 )
                     | otherwise
                     = min 256 ( oldZoomFactor * sqrt 2 )
-                  newCenter :: Point2D Double
+                  newCenter :: ℝ 2
                   newCenter
-                    = ( 1 - oldZoomFactor / newZoomFactor ) *^ ( oldCenter --> mousePos :: Vector2D Double )
+                    = ( 1 - oldZoomFactor / newZoomFactor ) *^ ( oldCenter --> mousePos :: T ( ℝ 2 ) )
                     • oldCenter
                 in ( doc { zoomFactor = newZoomFactor, viewportCenter = newCenter }, mousePos )
               -- Vertical scrolling turned into horizontal scrolling using 'Shift'.
               | dx == 0 && any ( \ case { Shift _ -> True; _ -> False } ) modifiers
               = let
-                  newCenter :: Point2D Double
+                  newCenter :: ℝ 2
-                  newCenter = ( ( 25 / oldZoomFactor ) *^ Vector2D dy 0 ) • oldCenter
+                  newCenter = ( ( 25 / oldZoomFactor ) *^ V2 dy 0 ) • oldCenter
-                in ( doc { viewportCenter = newCenter }, ( oldCenter --> newCenter :: Vector2D Double ) • mousePos )
+                in ( doc { viewportCenter = newCenter }, ( oldCenter --> newCenter :: T ( ℝ 2 ) ) • mousePos )
               -- Vertical scrolling.
               | otherwise
               = let
-                  newCenter :: Point2D Double
+                  newCenter :: ℝ 2
-                  newCenter = ( ( 25 / oldZoomFactor ) *^ Vector2D dx dy ) • oldCenter
+                  newCenter = ( ( 25 / oldZoomFactor ) *^ V2 dx dy ) • oldCenter
-                in ( doc { viewportCenter = newCenter }, ( oldCenter --> newCenter :: Vector2D Double ) • mousePos )
+                in ( doc { viewportCenter = newCenter }, ( oldCenter --> newCenter :: T ( ℝ 2 ) ) • mousePos )
           for_ mbMousePos \ _ ->
             STM.writeTVar mousePosTVar ( Just finalMousePos )
           pure ( UpdateDoc . UpdateDocumentTo . TrivialChange $ newDoc )

src/app/MetaBrush/Action.hs-boot

@@ -17,7 +17,7 @@ import Data.Text
 
 -- MetaBrush
 import Math.Linear
-  ( Point2D, Vector2D )
+  ( ℝ(..), T(..) )
 import {-# SOURCE #-} MetaBrush.Context
   ( UIElements, Variables )
 import {-# SOURCE #-} MetaBrush.UI.FileBar
@@ -105,7 +105,7 @@ instance HandleAction Confirm
 data About = About
 instance HandleAction About
 
-data MouseMove = MouseMove !( Point2D Double )
+data MouseMove = MouseMove !( ℝ 2 )
 instance HandleAction MouseMove
 
 data ActionOrigin
@@ -119,14 +119,14 @@ data MouseClick =
     { clickOrigin :: !ActionOrigin
     , clickType   :: !MouseClickType
     , clickButton :: !Word32
-    , clickCoords :: !( Point2D Double )
+    , clickCoords :: !( ℝ 2 )
     }
 instance HandleAction MouseClick
 
-data MouseRelease = MouseRelease !Word32 !( Point2D Double )
+data MouseRelease = MouseRelease !Word32 !( ℝ 2 )
 instance HandleAction MouseRelease
 
-data Scroll = Scroll !( Maybe ( Point2D Double ) ) !( Vector2D Double )
+data Scroll = Scroll !( Maybe ( ℝ 2 ) ) !( T ( ℝ 2 ) )
 instance HandleAction Scroll
 
 data KeyboardPress = KeyboardPress !Word32

src/app/MetaBrush/Application.hs

@@ -80,7 +80,7 @@ import Math.Bezier.Spline
 import Math.Bezier.Stroke
   ( invalidateCache )
 import Math.Linear
-  ( Point2D(..), ℝ(..) )
+  ( ℝ(..) )
 import MetaBrush.Action
   ( ActionOrigin(..) )
 import qualified MetaBrush.Asset.Brushes as Asset.Brushes
@@ -162,11 +162,11 @@ runApplication application = do
             , strokeBrush   = Just Asset.Brushes.ellipse
             , strokeSpline  =
               Spline
-                { splineStart  = mkPoint ( Point2D 10 -20 ) 2 1 0
+                { splineStart  = mkPoint ( ℝ2 10 -20 ) 2 1 0
                 , splineCurves = OpenCurves $ Seq.fromList
-                  [ LineTo { curveEnd = NextPoint ( mkPoint ( Point2D  10  10 ) 10 5 ( pi / 4 ) ), curveData = invalidateCache undefined }
+                  [ LineTo { curveEnd = NextPoint ( mkPoint ( ℝ2  10  10 ) 10 5 ( pi / 4 ) ), curveData = invalidateCache undefined }
-                  , LineTo { curveEnd = NextPoint ( mkPoint ( Point2D -10  10 )  8 5 ( pi / 4 ) ), curveData = invalidateCache undefined }
+                  , LineTo { curveEnd = NextPoint ( mkPoint ( ℝ2 -10  10 )  8 5 ( pi / 4 ) ), curveData = invalidateCache undefined }
-                  , LineTo { curveEnd = NextPoint ( mkPoint ( Point2D -10 -20 ) 10 7 ( pi / 2 ) ), curveData = invalidateCache undefined }
+                  , LineTo { curveEnd = NextPoint ( mkPoint ( ℝ2 -10 -20 ) 10 7 ( pi / 2 ) ), curveData = invalidateCache undefined }
                   ]
                 }
             }
@@ -174,14 +174,14 @@ runApplication application = do
         )
       ]
         where
-          mkPoint :: Point2D Double -> Double -> Double -> Double -> PointData ( Record Asset.Brushes.EllipseBrushFields )
+          mkPoint :: ℝ 2 -> Double -> Double -> Double -> PointData ( Record Asset.Brushes.EllipseBrushFields )
           mkPoint pt a b phi = PointData pt Normal ( MkR $ ℝ3 a b phi )
 
   recomputeStrokesTVar <- STM.newTVarIO @Bool                                    False
   documentRenderTVar   <- STM.newTVarIO @( ( Int32, Int32 ) -> Cairo.Render () ) ( const $ pure () )
   activeDocumentTVar   <- STM.newTVarIO @( Maybe Unique )                        Nothing
   openDocumentsTVar    <- STM.newTVarIO @( Map Unique DocumentHistory )          testDocuments
-  mousePosTVar         <- STM.newTVarIO @( Maybe ( Point2D Double ) )            Nothing
+  mousePosTVar         <- STM.newTVarIO @( Maybe ( ℝ 2 ) )                       Nothing
   mouseHoldTVar        <- STM.newTVarIO @( Maybe HoldAction )                    Nothing
   modifiersTVar        <- STM.newTVarIO @( Set Modifier )                        Set.empty
   toolTVar             <- STM.newTVarIO @Tool                                    Selection

src/app/MetaBrush/Context.hs

@@ -42,7 +42,7 @@ import Data.HashMap.Strict
 import Math.Bezier.Cubic.Fit
   ( FitParameters )
 import Math.Linear
-  ( Point2D )
+  ( ℝ(..) )
 import {-# SOURCE #-} MetaBrush.Action
   ( ActionName )
 import MetaBrush.Asset.Colours
@@ -88,7 +88,7 @@ data Variables
   , documentRenderTVar   :: !( STM.TVar ( ( Int32, Int32 ) -> Cairo.Render () ) )
   , activeDocumentTVar   :: !( STM.TVar ( Maybe Unique )                        )
   , openDocumentsTVar    :: !( STM.TVar ( Map Unique DocumentHistory )          )
-  , mousePosTVar         :: !( STM.TVar ( Maybe ( Point2D Double ) )            )
+  , mousePosTVar         :: !( STM.TVar ( Maybe ( ℝ 2 ) )                       )
   , mouseHoldTVar        :: !( STM.TVar ( Maybe HoldAction )                    )
   , modifiersTVar        :: !( STM.TVar ( Set Modifier )                        )
   , toolTVar             :: !( STM.TVar Tool                                    )
@@ -134,12 +134,12 @@ data GuideAction
 --  - draw a control point,
 --  - create/modify a guide.
 data HoldAction
-  = SelectionHold { holdStartPos :: !( Point2D Double ) }
+  = SelectionHold { holdStartPos :: !( ℝ 2 ) }
-  | DragMoveHold  { holdStartPos :: !( Point2D Double )
+  | DragMoveHold  { holdStartPos :: !( ℝ 2 )
                   , dragAction   :: !DragMoveSelect
                   }
-  | DrawHold      { holdStartPos :: !( Point2D Double ) }
+  | DrawHold      { holdStartPos :: !( ℝ 2 ) }
-  | GuideAction   { holdStartPos :: !( Point2D Double )
+  | GuideAction   { holdStartPos :: !( ℝ 2 )
                   , guideAction  :: !GuideAction
                   }
   deriving stock Show
@@ -147,8 +147,8 @@ data HoldAction
 -- | Keep track of a path that is in the middle of being drawn.
 data PartialPath
   = PartialPath
-  { partialStartPos     :: !( Point2D Double )
+  { partialStartPos     :: !( ℝ 2 )
-  , partialControlPoint :: !( Maybe ( Point2D Double ) )
+  , partialControlPoint :: !( Maybe ( ℝ 2 ) )
   , partialPathAnchor   :: !DrawAnchor
   , firstPoint          :: !Bool
   }

src/app/MetaBrush/Document/Selection.hs

@@ -96,7 +96,7 @@ import Math.Bezier.Stroke
 import Math.Module
   ( Module, lerp, squaredNorm, closestPointOnSegment )
 import Math.Linear
-  ( Point2D(..), Vector2D(..), Segment(..), T(..) )
+  ( Segment(..), ℝ(..), T(..) )
 import {-# SOURCE #-} MetaBrush.Context
   ( Modifier(..) )
 import MetaBrush.Document
@@ -138,7 +138,7 @@ selectionMode = foldMap \case
   _       -> New
 
 -- | Updates the selected objects on a single click selection event.
-selectAt :: SelectionMode -> Point2D Double -> Document -> Document
+selectAt :: SelectionMode -> ℝ 2 -> Document -> Document
 selectAt selMode c doc@( Document { zoomFactor } ) =
   ( `evalState` False ) $ ( field' @"documentContent" . field' @"strokes" . traverse ) updateStrokeHierarchy doc
     where
@@ -175,7 +175,7 @@ selectAt selMode c doc@( Document { zoomFactor } ) =
               selected :: Bool
               selected
                 | not isVisible = False
-                | otherwise     = squaredNorm ( c --> coords pt :: Vector2D Double ) * zoomFactor ^ ( 2 :: Int ) < 16
+                | otherwise     = squaredNorm ( c --> coords pt :: T ( ℝ 2 ) ) * zoomFactor ^ ( 2 :: Int ) < 16
 
 -- | Type of a drag move selection:
 --
@@ -205,7 +205,7 @@ instance Semigroup DragMoveSelect where
 
 -- | Checks whether a mouse click can initiate a drag move event,
 -- and if so returns an updated document with the selection modified from the start of the drag move.
-dragMoveSelect :: Point2D Double -> Document -> Maybe ( DragMoveSelect, Document )
+dragMoveSelect :: ℝ 2 -> Document -> Maybe ( DragMoveSelect, Document )
 dragMoveSelect c doc@( Document { zoomFactor } ) =
   let
     res :: WriterT ( Maybe DragMoveSelect ) ( Tardis ( Maybe DragMoveSelect ) ( Maybe DragMoveSelect ) ) Document
@@ -256,9 +256,9 @@ dragMoveSelect c doc@( Document { zoomFactor } ) =
           mbCurveDrag = do
             let
               t :: Double
-              p :: Point2D Double
+              p :: ℝ 2
               ( t, p )
-                = closestPointOnSegment @( Vector2D Double ) c ( Segment ( coords sp0 ) ( coords $ fromNextPoint start sp1 ) )
+                = closestPointOnSegment @( T ( ℝ 2 ) ) c ( Segment ( coords sp0 ) ( coords $ fromNextPoint start sp1 ) )
             guard ( inSelectionRange isVisible p )
             pure $
               ClickedOnCurve
@@ -274,12 +274,12 @@ dragMoveSelect c doc@( Document { zoomFactor } ) =
           mbCurveDrag :: Maybe DragMoveSelect
           mbCurveDrag = do
             let
-              bez :: Quadratic.Bezier ( Point2D Double )
+              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 @( Vector2D Double ) bez c
+                = Quadratic.closestPoint @( T ( ℝ 2 ) ) bez c
             guard ( t > 0 && t < 1 && sq_d * zoomFactor ^ ( 2 :: Int ) < 16 )
             pure $
               ClickedOnCurve
@@ -296,12 +296,12 @@ dragMoveSelect c doc@( Document { zoomFactor } ) =
           mbCurveDrag :: Maybe DragMoveSelect
           mbCurveDrag = do
             let
-              bez :: Cubic.Bezier ( Point2D Double )
+              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 @( Vector2D Double ) bez c
+                = Cubic.closestPoint @( T ( ℝ 2 ) ) bez c
             guard ( t > 0 && t < 1 && sq_d * zoomFactor ^ ( 2 :: Int ) < 16 )
             pure $
               ClickedOnCurve
@@ -315,10 +315,10 @@ dragMoveSelect c doc@( Document { zoomFactor } ) =
         sp3' <- traverse ( updateSplinePoint isVisible ) sp3
         pure ( bez3 { controlPoint1 = sp1', controlPoint2 = sp2', curveEnd = sp3' } )
 
-    inSelectionRange :: Bool -> Point2D Double -> Bool
+    inSelectionRange :: Bool -> ℝ 2 -> Bool
     inSelectionRange isVisible p
       | not isVisible = False
-      | otherwise     = squaredNorm ( c --> p :: Vector2D Double ) * zoomFactor ^ ( 2 :: Int ) < 16
+      | otherwise     = squaredNorm ( c --> p :: T ( ℝ 2 ) ) * zoomFactor ^ ( 2 :: Int ) < 16
 
     updateSplinePoint
       :: Bool -> PointData brushParams
@@ -365,8 +365,8 @@ dragMoveSelect c doc@( Document { zoomFactor } ) =
         pure ( set _selection newPointState pt )
 
 -- | Updates the selected objects on a rectangular selection event.
-selectRectangle :: SelectionMode -> Point2D Double -> Point2D Double -> Document -> Document
+selectRectangle :: SelectionMode -> ℝ 2 -> ℝ 2 -> Document -> Document
-selectRectangle selMode ( Point2D x0 y0 ) ( Point2D x1 y1 )
+selectRectangle selMode ( ℝ2 x0 y0 ) ( ℝ2 x1 y1 )
   = over ( field' @"documentContent" . field' @"strokes" . mapped )
       updateStrokeHierarchy
     where
@@ -397,7 +397,7 @@ selectRectangle selMode ( Point2D x0 y0 ) ( Point2D x1 y1 )
           _        -> pt
         where
           x, y :: Double
-          Point2D x y = coords pt
+          ℝ2 x y = coords pt
           selected :: Bool
           selected
             | not isVisible = False
@@ -416,7 +416,7 @@ data UpdateInfo
 -- | Translate all selected points by the given vector.
 --
 -- Returns the updated document, together with info about how many points were translated.
-translateSelection :: Vector2D Double -> Document -> ( Document, UpdateInfo )
+translateSelection :: T ( ℝ 2 ) -> Document -> ( Document, UpdateInfo )
 translateSelection t doc =
   ( `runState` mempty ) . ( `evalStateT` False ) $ ( field' @"documentContent" . field' @"strokes" . traverse ) updateStrokeHierarchy doc
   where
@@ -683,7 +683,7 @@ deleteSelected doc =
 
 
 -- | Perform a drag move action on a document.
-dragUpdate :: Point2D Double -> Point2D Double -> DragMoveSelect -> Bool -> Document -> Maybe DocChange
+dragUpdate :: ℝ 2 -> ℝ 2 -> DragMoveSelect -> Bool -> Document -> Maybe DocChange
 dragUpdate p0 p PointDrag _ doc = do
   let
     ( newDocument, updateInfo ) = translateSelection ( p0 --> p ) doc
@@ -799,9 +799,9 @@ dragUpdate _ p ( ClickedOnCurve { dragStrokeUnique, dragSegmentIndex, dragSegmen
                       -> Curve Open ( CachedStroke RealWorld ) ( PointData pointParams )
                     quadraticDragCurve dat ( Quadratic.Bezier { Quadratic.p1 = sp1, Quadratic.p2 = sp2 } ) =
                       let
-                        cp :: Point2D Double
+                        cp :: ℝ 2
                         Quadratic.Bezier { Quadratic.p1 = cp } =
-                          Quadratic.interpolate @( Vector2D Double ) ( coords sp0 ) ( coords sp2 ) dragSegmentParameter p
+                          Quadratic.interpolate @( T ( ℝ 2 ) ) ( coords sp0 ) ( coords sp2 ) dragSegmentParameter p
                       in Bezier2To ( set _coords cp sp1 ) ( NextPoint sp2 ) ( invalidateCache dat )
                     cubicDragCurve
                       :: CachedStroke RealWorld
@@ -809,9 +809,9 @@ dragUpdate _ p ( ClickedOnCurve { dragStrokeUnique, dragSegmentIndex, dragSegmen
                       -> Curve Open ( CachedStroke RealWorld ) ( PointData pointParams )
                     cubicDragCurve dat ( Cubic.Bezier { Cubic.p1 = sp1, Cubic.p2 = sp2, Cubic.p3 = sp3 } ) =
                       let
-                        cp1, cp2 :: Point2D Double
+                        cp1, cp2 :: ℝ 2
                         Cubic.Bezier { Cubic.p1 = cp1, Cubic.p2 = cp2 } =
-                          Cubic.drag @( Vector2D Double )
+                          Cubic.drag @( T ( ℝ 2 ) )
                             ( Cubic.Bezier ( coords sp0 ) ( coords sp1 ) ( coords sp2 ) ( coords sp3 ) )
                             dragSegmentParameter
                             p

src/app/MetaBrush/Event.hs

@@ -27,7 +27,7 @@ import qualified Control.Concurrent.STM.TVar as STM
 
 -- MetaBrush
 import Math.Linear
-  ( Point2D(..), Vector2D(..) )
+  ( ℝ(..), T(..) )
 import MetaBrush.Action
   ( HandleAction(..)
   , ActionOrigin(..)
@@ -77,13 +77,13 @@ handleEvents elts@( UIElements { viewport = Viewport {..}, .. } ) vars = do
 
 handleMotionEvent :: UIElements -> Variables -> ActionOrigin -> ( Double -> Double -> IO () )
 handleMotionEvent elts vars eventOrigin x y = do
-  mousePos <- adjustMousePosition ( viewport elts ) eventOrigin ( Point2D x y )
+  mousePos <- adjustMousePosition ( viewport elts ) eventOrigin ( ℝ2 x y )
   handleAction elts vars ( MouseMove mousePos )
 
 handleScrollEvent :: UIElements -> Variables -> ( Double -> Double -> IO Bool )
 handleScrollEvent elts vars dx dy = do
   mbMousePos <- STM.readTVarIO ( mousePosTVar vars )
-  handleAction elts vars ( Scroll mbMousePos ( Vector2D dx dy ) )
+  handleAction elts vars ( Scroll mbMousePos ( V2 dx dy ) )
   pure False
 
 handleMouseButtonEvent
@@ -103,7 +103,7 @@ handleMouseButtonEvent elts@( UIElements{ viewport = Viewport {..} } ) vars even
     _ <- GTK.widgetGrabFocus viewportDrawingArea
     button <- max 1 <$> GTK.gestureSingleGetCurrentButton gestureClick
     --        ^^^^^ use button number 1 if no button number is reported (button == 0)
-    mousePos <- adjustMousePosition ( viewport elts ) eventOrigin ( Point2D x y )
+    mousePos <- adjustMousePosition ( viewport elts ) eventOrigin ( ℝ2 x y )
     handleAction elts vars ( MouseClick eventOrigin click button mousePos )
 
 handleMouseButtonRelease
@@ -112,23 +112,23 @@ handleMouseButtonRelease
 handleMouseButtonRelease elts vars eventOrigin gestureClick _ x y = do
   button <- max 1 <$> GTK.gestureSingleGetCurrentButton gestureClick
   --        ^^^^^ same as above
-  mousePos <- adjustMousePosition ( viewport elts ) eventOrigin ( Point2D x y )
+  mousePos <- adjustMousePosition ( viewport elts ) eventOrigin ( ℝ2 x y )
   handleAction elts vars ( MouseRelease button mousePos )
 
-adjustMousePosition :: Viewport -> ActionOrigin -> Point2D Double -> IO ( Point2D Double )
+adjustMousePosition :: Viewport -> ActionOrigin -> ℝ 2 -> IO ( ℝ 2 )
 adjustMousePosition   _                   ViewportOrigin        pt            = pure pt
-adjustMousePosition ( Viewport {..} ) ( RulerOrigin ruler ) ( Point2D x y ) =
+adjustMousePosition ( Viewport {..} ) ( RulerOrigin ruler ) ( ℝ2 x y ) =
   case ruler of
     RulerCorner -> do
       dx <- fromIntegral @_ @Double <$> GTK.widgetGetAllocatedWidth  rulerCornerDrawingArea
       dy <- fromIntegral @_ @Double <$> GTK.widgetGetAllocatedHeight rulerCornerDrawingArea
-      pure ( Point2D ( x - dx ) ( y - dy ) )
+      pure ( ℝ2 ( x - dx ) ( y - dy ) )
     LeftRuler -> do
       dx <- fromIntegral @_ @Double <$> GTK.widgetGetAllocatedWidth    leftRulerDrawingArea
-      pure ( Point2D ( x - dx ) y )
+      pure ( ℝ2 ( x - dx ) y )
     TopRuler -> do
       dy <- fromIntegral @_ @Double <$> GTK.widgetGetAllocatedHeight    topRulerDrawingArea
-      pure ( Point2D x ( y - dy ) )
+      pure ( ℝ2 x ( y - dy ) )
 
 --------------------------------------------------------------------------------
 -- Keyboard events.

src/app/MetaBrush/Render/Document.hs

@@ -72,7 +72,9 @@ import Math.Bezier.Stroke
   , computeStrokeOutline
   )
 import Math.Linear
-  ( Point2D(..), Vector2D(..), T(..) )
+  ( ℝ(..), T(..) )
+import Math.Linear.Dual
+  ( fun )
 import MetaBrush.Asset.Colours
   ( Colours, ColourRecord(..) )
 import MetaBrush.Brush
@@ -142,13 +144,13 @@ blankRender _ = pure ()
 
 getDocumentRender
   :: Colours -> FitParameters -> Mode -> Bool
-  -> Set Modifier -> Maybe ( Point2D Double ) -> Maybe HoldAction -> Maybe PartialPath
+  -> Set Modifier -> Maybe ( ℝ 2 ) -> Maybe HoldAction -> Maybe PartialPath
   -> Document
   -> ST RealWorld ( ( Int32, Int32 ) -> Cairo.Render () )
 getDocumentRender
   cols fitParams mode debug
   modifiers mbMousePos mbHoldEvent mbPartialPath
-  doc@( Document { viewportCenter = Point2D cx cy, zoomFactor, documentContent = content } )
+  doc@( Document { viewportCenter = ℝ2 cx cy, zoomFactor, documentContent = content } )
     = do
 
       let
@@ -169,13 +171,13 @@ getDocumentRender
                 _              -> foldMap visibleStrokes . strokes $ content
             | Just ( PartialPath p0 cp0 anchor firstPoint ) <- mbPartialPath
             , let
-                mbFinalPoint :: Maybe ( Point2D Double )
+                mbFinalPoint :: Maybe ( ℝ 2 )
-                mbControlPoint :: Maybe ( Point2D Double )
+                mbControlPoint :: Maybe ( ℝ 2 )
                 ( mbFinalPoint, mbControlPoint )
                   | Just ( DrawHold holdPos ) <- mbHoldEvent
                   = if   firstPoint
                     then ( mbMousePos  , Just holdPos )
-                    else ( Just holdPos, ( \ cp -> ( cp --> holdPos :: Vector2D Double ) • holdPos ) <$> mbMousePos )
+                    else ( Just holdPos, ( \ cp -> ( cp --> holdPos :: T ( ℝ 2 ) ) • holdPos ) <$> mbMousePos )
                   | otherwise
                   = ( mbMousePos, Nothing )
             , Just finalPoint <- mbFinalPoint
@@ -295,12 +297,12 @@ strokeRenderData fitParams
                   -- Compute the outline using the brush function.
                     ( outline, fitPts ) <-
                       computeStrokeOutline @( T ( Record usedFields) ) @clo
-                        fitParams ( toUsedParams . brushParams ) ( brushFn . embedUsedParams ) spline
+                        fitParams ( toUsedParams . brushParams ) ( fun brushFn . embedUsedParams ) spline
                     pure $
                       StrokeWithOutlineRenderData
                         { strokeDataSpline    = spline
                         , strokeOutlineData   = ( outline, fitPts )
-                        , strokeBrushFunction = brushFn . embedUsedParams . toUsedParams
+                        , strokeBrushFunction = fun brushFn . embedUsedParams . toUsedParams
                         }
         _ -> pure $
                 StrokeRenderData
@@ -409,11 +411,11 @@ renderBrushShape
 renderBrushShape cols mbHoverContext zoom brushFn pt =
   let
     x, y :: Double
-    Point2D x y = coords pt
+    ℝ2 x y = coords pt
     brushPts :: SplinePts Closed
     brushPts = brushFn ( brushParams pt )
     mbHoverContext' :: Maybe HoverContext
-    mbHoverContext' = Vector2D -x -y • mbHoverContext
+    mbHoverContext' = V2 -x -y • mbHoverContext
   in
     toAll do
       Cairo.save
@@ -427,11 +429,11 @@ drawPoint ( Colours {..} ) mbHover zoom PathPoint pt
   = do
   let
     x, y :: Double
-    Point2D x y = coords pt
+    ℝ2 x y = coords pt
     hsqrt3 :: Double
     hsqrt3 = sqrt 0.75
     selectionState :: FocusState
-    selectionState = view _selection pt <> hovered mbHover zoom ( Point2D x y )
+    selectionState = view _selection pt <> hovered mbHover zoom ( ℝ2 x y )
 
   Cairo.save
   Cairo.translate x y
@@ -463,9 +465,9 @@ drawPoint ( Colours {..} ) mbHover zoom ControlPoint pt
   = do
   let
     x, y :: Double
-    Point2D x y = coords pt
+    ℝ2 x y = coords pt
     selectionState :: FocusState
-    selectionState = view _selection pt <> hovered mbHover zoom ( Point2D x y )
+    selectionState = view _selection pt <> hovered mbHover zoom ( ℝ2 x y )
 
   Cairo.save
   Cairo.translate x y
@@ -494,8 +496,8 @@ drawLine :: Colours -> Double -> PointType -> PointData b -> PointData b -> Cair
 drawLine ( Colours { path, controlPointLine } ) zoom pointType p1 p2 = do
   let
     x1, y1, x2, y2 :: Double
-    Point2D x1 y1 = coords p1
+    ℝ2 x1 y1 = coords p1
-    Point2D x2 y2 = coords p2
+    ℝ2 x2 y2 = coords p2
 
   Cairo.save
   Cairo.moveTo x1 y1
@@ -512,18 +514,18 @@ drawLine ( Colours { path, controlPointLine } ) zoom pointType p1 p2 = do
 
   Cairo.restore
 
-drawQuadraticBezier :: Colours -> Double -> Quadratic.Bezier ( Point2D Double ) -> Cairo.Render ()
+drawQuadraticBezier :: Colours -> Double -> Quadratic.Bezier ( ℝ 2 ) -> Cairo.Render ()
 drawQuadraticBezier cols zoom bez =
   drawCubicBezier cols zoom
-    ( Cubic.fromQuadratic @( Vector2D Double ) bez )
+    ( Cubic.fromQuadratic @( T ( ℝ 2 ) ) bez )
 
-drawCubicBezier :: Colours -> Double -> Cubic.Bezier ( Point2D Double ) -> Cairo.Render ()
+drawCubicBezier :: Colours -> Double -> Cubic.Bezier ( ℝ 2 ) -> Cairo.Render ()
 drawCubicBezier ( Colours { path } ) zoom
   ( Cubic.Bezier
-    { p0 = Point2D x0 y0
+    { p0 = ℝ2 x0 y0
-    , p1 = Point2D x1 y1
+    , p1 = ℝ2 x1 y1
-    , p2 = Point2D x2 y2
+    , p2 = ℝ2 x2 y2
-    , p3 = Point2D x3 y3
+    , p3 = ℝ2 x3 y3
     }
   )
   = do
@@ -573,26 +575,26 @@ drawOutline cols@( Colours {..} ) debug zoom strokeData = do
     makeOutline :: SplinePts Closed -> Cairo.Render ()
     makeOutline spline = bifoldSpline
       ( drawCurve ( splineStart spline ) )
-      ( \ ( Point2D x y ) -> Cairo.moveTo x y )
+      ( \ ( ℝ2 x y ) -> Cairo.moveTo x y )
       spline
 
-    drawCurve :: forall clo. SplineTypeI clo => Point2D Double -> Point2D Double -> Curve clo () ( Point2D Double ) -> Cairo.Render ()
+    drawCurve :: forall clo. SplineTypeI clo => ℝ 2 -> ℝ 2 -> Curve clo () ( ℝ 2 ) -> Cairo.Render ()
-    drawCurve start ( Point2D x0 y0 ) crv = case crv of
+    drawCurve start ( ℝ2 x0 y0 ) crv = case crv of
       LineTo mp1 _ ->
-        let Point2D x1 y1 = fromNextPoint start mp1
+        let ℝ2 x1 y1 = fromNextPoint start mp1
         in Cairo.lineTo x1 y1
-      Bezier2To ( Point2D x1 y1 ) mp2 _ ->
+      Bezier2To ( ℝ2 x1 y1 ) mp2 _ ->
-        let Point2D x2 y2 = fromNextPoint start mp2
+        let ℝ2 x2 y2 = fromNextPoint start mp2
         in Cairo.curveTo
               ( ( 2 * x1 + x0 ) / 3 ) ( ( 2 * y1 + y0 ) / 3 )
               ( ( 2 * x1 + x2 ) / 3 ) ( ( 2 * y1 + y2 ) / 3 )
               x2 y2
-      Bezier3To ( Point2D x1 y1 ) ( Point2D x2 y2 ) mp3 _ ->
+      Bezier3To ( ℝ2 x1 y1 ) ( ℝ2 x2 y2 ) mp3 _ ->
-        let Point2D x3 y3 = fromNextPoint start mp3
+        let ℝ2 x3 y3 = fromNextPoint start mp3
         in Cairo.curveTo x1 y1 x2 y2 x3 y3
 
 drawFitPoint :: Colours -> Double -> FitPoint -> StateT Double Cairo.Render ()
-drawFitPoint _ zoom ( FitPoint { fitPoint = Point2D x y } ) = do
+drawFitPoint _ zoom ( FitPoint { fitPoint = ℝ2 x y } ) = do
 
   hue <- get
   put ( hue + 0.01 )
@@ -607,7 +609,7 @@ drawFitPoint _ zoom ( FitPoint { fitPoint = Point2D x y } ) = do
     Cairo.fill
     Cairo.restore
 
-drawFitPoint _ zoom ( FitTangent { fitPoint = Point2D x y, fitTangent = Vector2D tx ty } ) = do
+drawFitPoint _ zoom ( FitTangent { fitPoint = ℝ2 x y, fitTangent = V2 tx ty } ) = do
 
   hue <- get
   put ( hue + 0.01 )
@@ -626,8 +628,8 @@ drawFitPoint _ zoom ( FitTangent { fitPoint = Point2D x y, fitTangent = Vector2D
     Cairo.fill
     Cairo.restore
 
-drawSelectionRectangle :: Colours -> Double -> Point2D Double -> Point2D Double -> Cairo.Render ()
+drawSelectionRectangle :: Colours -> Double -> ℝ 2 -> ℝ 2 -> Cairo.Render ()
-drawSelectionRectangle ( Colours {..} ) zoom ( Point2D x0 y0 ) ( Point2D x1 y1 ) = do
+drawSelectionRectangle ( Colours {..} ) zoom ( ℝ2 x0 y0 ) ( ℝ2 x1 y1 ) = do
 
   Cairo.save
 

src/app/MetaBrush/Render/Rulers.hs

@@ -45,7 +45,7 @@ import Control.Lens
 
 -- MetaBrush
 import Math.Linear
-  ( Point2D(..), Vector2D(..) )
+  ( ℝ(..), T(..) )
 import MetaBrush.Action
   ( ActionOrigin(..) )
 import MetaBrush.Asset.Colours
@@ -70,13 +70,13 @@ import MetaBrush.GTK.Util
 
 renderRuler
   :: Colours -> ( Int32, Int32 ) -> ActionOrigin -> ( Int32, Int32 )
-  -> Maybe ( Point2D Double ) -> Maybe HoldAction -> Bool
+  -> Maybe ( ℝ 2 ) -> Maybe HoldAction -> Bool
   -> Document
   -> Cairo.Render ()
 renderRuler
   cols@( Colours {..} ) ( viewportWidth, viewportHeight ) actionOrigin ( width, height )
   mbMousePos mbHoldEvent showGuides
-  ( Document { viewportCenter = center@( Point2D cx cy ), zoomFactor, documentContent = Content { guides } } ) = do
+  ( Document { viewportCenter = center@( ℝ2 cx cy ), zoomFactor, documentContent = Content { guides } } ) = do
 
     let
       modifiedGuides :: [ Guide ]
@@ -87,8 +87,8 @@ renderRuler
             MoveGuide guideUnique
               ->
                 let
-                  translate :: Point2D Double -> Point2D Double
+                  translate :: ℝ 2 -> ℝ 2
-                  translate = ( ( mousePos0 --> mousePos :: Vector2D Double ) • )
+                  translate = ( ( mousePos0 --> mousePos :: T ( ℝ 2 ) ) • )
                 in toList
                  $ Map.adjust
                    ( over ( field' @"guidePoint" ) translate . set ( field' @"guideFocus" ) Selected )
@@ -99,14 +99,14 @@ renderRuler
                   addNewGuides :: [ Guide ] -> [ Guide ]
                   addNewGuides gs = case ruler of
                     RulerCorner
-                      -> Guide { guidePoint = mousePos, guideNormal = Vector2D 0 1, guideFocus = Selected, guideUnique = unsafeUnique 0 }
+                      -> Guide { guidePoint = mousePos, guideNormal = V2 0 1, guideFocus = Selected, guideUnique = unsafeUnique 0 }
-                       : Guide { guidePoint = mousePos, guideNormal = Vector2D 1 0, guideFocus = Selected, guideUnique = unsafeUnique 1 }
+                       : Guide { guidePoint = mousePos, guideNormal = V2 1 0, guideFocus = Selected, guideUnique = unsafeUnique 1 }
                        : gs
                     LeftRuler
-                      -> Guide { guidePoint = mousePos, guideNormal = Vector2D 1 0, guideFocus = Selected, guideUnique = unsafeUnique 2 }
+                      -> Guide { guidePoint = mousePos, guideNormal = V2 1 0, guideFocus = Selected, guideUnique = unsafeUnique 2 }
                        : gs
                     TopRuler
-                      -> Guide { guidePoint = mousePos, guideNormal = Vector2D 0 1, guideFocus = Selected, guideUnique = unsafeUnique 3 }
+                      -> Guide { guidePoint = mousePos, guideNormal = V2 0 1, guideFocus = Selected, guideUnique = unsafeUnique 3 }
                        : gs
                  in addNewGuides ( toList guides )
         | otherwise
@@ -114,7 +114,7 @@ renderRuler
 
       mbHoverContext :: Maybe HoverContext
       mbHoverContext
-        | Just mp@( Point2D x y ) <- mbMousePos
+        | Just mp@( ℝ2 x y ) <- mbMousePos
         , x <= left || y <= top -- only hover guides from within ruler area
         = Just ( MouseHover mp )
         | otherwise
@@ -131,7 +131,7 @@ renderRuler
     -- Render guides.
     when showGuides ( for_ modifiedGuides ( renderGuide cols mbHoverContext zoomFactor ) )
     -- Render mouse cursor indicator.
-    for_ mbMousePos \ ( Point2D mx my ) ->
+    for_ mbMousePos \ ( ℝ2 mx my ) ->
       case actionOrigin of
         RulerOrigin TopRuler  -> do
           Cairo.save
@@ -166,8 +166,8 @@ renderRuler
     dx = fromIntegral width
     dy = fromIntegral height
     left, right, top, bottom :: Double
-    Point2D left  top    = toViewport ( Point2D 0 0 )
+    ℝ2 left  top    = toViewport ( ℝ2 0 0 )
-    Point2D right bottom = toViewport ( Point2D ( fromIntegral viewportWidth ) ( fromIntegral viewportHeight ) )
+    ℝ2 right bottom = toViewport ( ℝ2 ( fromIntegral viewportWidth ) ( fromIntegral viewportHeight ) )
     additionalAdjustment :: Cairo.Render ()
     additionalAdjustment = case actionOrigin of
       ViewportOrigin -> pure ()
@@ -178,7 +178,7 @@ renderRuler
           Cairo.translate dx 0
         TopRuler -> do
           Cairo.translate 0 dy
-    toViewport :: Point2D Double -> Point2D Double
+    toViewport :: ℝ 2 -> ℝ 2
     toViewport = toViewportCoordinates zoomFactor ( fromIntegral viewportWidth, fromIntegral viewportHeight ) center
 
     setTickRenderContext :: Cairo.Render ()
@@ -282,7 +282,7 @@ data Tick
 
 renderGuide :: Colours -> Maybe HoverContext -> Double -> Guide -> Cairo.Render ()
 renderGuide ( Colours {..} ) mbHoverContext zoom
-  gd@( Guide { guidePoint = Point2D x y, guideNormal = Vector2D nx ny, guideFocus } )
+  gd@( Guide { guidePoint = ℝ2 x y, guideNormal = V2 nx ny, guideFocus } )
   = do
 
     Cairo.save

src/app/MetaBrush/UI/Coordinates.hs

@@ -30,7 +30,7 @@ import Math.Bezier.Spline
 import Math.Module
   ( (*^), squaredNorm, closestPointOnSegment )
 import Math.Linear
-  ( Point2D(..), Vector2D(..), Segment(..) )
+  ( ℝ(..), T(..), Segment(..) )
 import MetaBrush.Document
   ( Stroke(..), PointData(..)
   , coords
@@ -39,13 +39,13 @@ import MetaBrush.Document
 --------------------------------------------------------------------------------
 
 -- | Convert a position relative to the drawing area into viewport coordinates.
-toViewportCoordinates :: Double -> ( Double, Double ) -> Point2D Double -> Point2D Double -> Point2D Double
+toViewportCoordinates :: Double -> ( Double, Double ) -> ℝ 2 -> ℝ 2 -> ℝ 2
-toViewportCoordinates zoomFactor ( viewportWidth, viewportHeight ) viewportCenter ( Point2D x y )
+toViewportCoordinates zoomFactor ( viewportWidth, viewportHeight ) viewportCenter ( ℝ2 x y )
-  = ( recip zoomFactor *^ ( Point2D ( 0.5 * viewportWidth ) ( 0.5 * viewportHeight ) --> Point2D x y :: Vector2D Double ) )
+  = ( recip zoomFactor *^ ( ℝ2 ( 0.5 * viewportWidth ) ( 0.5 * viewportHeight ) --> ℝ2 x y :: T ( ℝ 2 ) ) )
   • viewportCenter
 
 -- | Find the closest point in a set of strokes.
-closestPoint :: Point2D Double -> Stroke -> ArgMin Double ( Maybe ( Point2D Double ) )
+closestPoint :: ℝ 2 -> Stroke -> ArgMin Double ( Maybe ( ℝ 2 ) )
 closestPoint c ( Stroke { strokeSpline, strokeVisible = True } ) =
   coerce $
     bifoldSpline @_ @Identity
@@ -53,8 +53,8 @@ closestPoint c ( Stroke { strokeSpline, strokeVisible = True } ) =
       ( res . coords )
       strokeSpline
   where
-    res :: Point2D Double -> Identity ( ArgMin BoundedDouble ( Maybe ( Point2D Double ) ) )
+    res :: ℝ 2 -> Identity ( ArgMin BoundedDouble ( Maybe ( ℝ 2 ) ) )
-    res p = coerce $ Arg ( squaredNorm ( c --> p :: Vector2D Double ) ) ( Just p )
+    res p = coerce $ Arg ( squaredNorm ( c --> p :: T ( ℝ 2 ) ) ) ( Just p )
 
     closestPointToCurve
       :: forall clo crvData brushParams
@@ -62,18 +62,18 @@ closestPoint c ( Stroke { strokeSpline, strokeVisible = True } ) =
       => PointData brushParams
       -> PointData brushParams
       -> Curve clo crvData ( PointData brushParams )
-      -> Identity ( ArgMin BoundedDouble ( Maybe ( Point2D Double ) ) )
+      -> Identity ( ArgMin BoundedDouble ( Maybe ( ℝ 2 ) ) )
     closestPointToCurve start p0 ( LineTo p1 _ ) =
-      res ( snd $ closestPointOnSegment @( Vector2D Double ) c ( Segment (coords p0 ) ( coords $ fromNextPoint start p1 ) ) )
+      res ( snd $ closestPointOnSegment @( T ( ℝ 2 ) ) c ( Segment (coords p0 ) ( coords $ fromNextPoint start p1 ) ) )
     closestPointToCurve start p0 ( Bezier2To p1 p2 _ ) = coerce $
       fmap ( fmap ( Just . snd ) )
-        ( Quadratic.closestPoint @( Vector2D Double ) ( Quadratic.Bezier ( coords p0 ) ( coords p1 ) ( coords $ fromNextPoint start p2 ) ) c )
+        ( Quadratic.closestPoint @( T ( ℝ 2 ) ) ( Quadratic.Bezier ( coords p0 ) ( coords p1 ) ( coords $ fromNextPoint start p2 ) ) c )
     closestPointToCurve start p0 ( Bezier3To p1 p2 p3 _ ) = coerce $
       fmap ( fmap ( Just . snd ) )
-        ( Cubic.closestPoint @( Vector2D Double ) ( Cubic.Bezier ( coords p0 ) ( coords p1 ) ( coords p2 ) ( coords $ fromNextPoint start p3 ) ) c )
+        ( Cubic.closestPoint @( T ( ℝ 2 ) ) ( Cubic.Bezier ( coords p0 ) ( coords p1 ) ( coords p2 ) ( coords $ fromNextPoint start p3 ) ) c )
-closestPoint _ _ = coerce $ mempty @( ArgMin BoundedDouble ( Maybe ( Point2D Double ) ) )
+closestPoint _ _ = coerce $ mempty @( ArgMin BoundedDouble ( Maybe ( ℝ 2 ) ) )
 
--- Messing around to emulate a `Monoid` instance for `ArgMin Double ( Maybe ( Point2D Double ) )`
+-- Messing around to emulate a `Monoid` instance for `ArgMin Double ( Maybe ( ℝ 2 ) )`
 newtype BoundedDouble = BoundedDouble Double
   deriving stock   Show
   deriving newtype ( Eq, Ord )

src/app/MetaBrush/UI/InfoBar.hs

@@ -36,7 +36,7 @@ import qualified Data.Text as Text
 
 -- MetaBrush
 import Math.Linear
-  ( Point2D(..) )
+  ( ℝ(..) )
 import MetaBrush.Asset.Colours
   ( Colours )
 import MetaBrush.Asset.Cursor
@@ -164,14 +164,14 @@ updateInfoBar viewportDrawingArea ( InfoBar {..} ) ( Variables { mousePosTVar }
         GTK.labelSetText botRightPosText $ Text.pack ( "x: " <> na <> "\ny: " <> na )
       Just ( Document { zoomFactor, viewportCenter } ) -> do
         let
-          toViewport :: Point2D Double -> Point2D Double
+          toViewport :: ℝ 2 -> ℝ 2
           toViewport = toViewportCoordinates zoomFactor ( viewportWidth, viewportHeight ) viewportCenter
-          Point2D l t = toViewport ( Point2D 0 0 )
+          ℝ2 l t = toViewport ( ℝ2 0 0 )
-          Point2D r b = toViewport ( Point2D viewportWidth viewportHeight )
+          ℝ2 r b = toViewport ( ℝ2 viewportWidth viewportHeight )
         mbMousePos <- STM.readTVarIO mousePosTVar
         GTK.labelSetText zoomText $ Text.pack ( fixed 5 2 ( 100 * zoomFactor ) <> "%" )
         case mbMousePos of
-          Just ( Point2D mx my ) ->
+          Just ( ℝ2 mx my ) ->
             GTK.labelSetText cursorPosText $ Text.pack ( "x: " <> fixed 6 2 mx <> "\ny: " <> fixed 6 2 my )
           Nothing ->
             GTK.labelSetText cursorPosText $ Text.pack ( "x: " <> na <> "\ny: " <> na )

src/convert/Main.hs

@@ -40,7 +40,7 @@ import Math.Bezier.Spline
 import Math.Bezier.Stroke
   ( CachedStroke(..) )
 import Math.Linear
-  ( Point2D(..) )
+  ( ℝ(..) )
 
 -- metabrushes
 import MetaBrush.Asset.Brushes
@@ -140,7 +140,7 @@ main = case test of
         Document
           { displayName     = "beta"
           , mbFilePath      = Just "betamf.mb"
-          , viewportCenter  = Point2D 0 0
+          , viewportCenter  = ℝ2 0 0
           , zoomFactor      = 16
           , documentUnique  = docUnique
           , documentContent =

src/convert/MetaBrush/MetaFont/Convert.hs

@@ -66,7 +66,7 @@ import Math.Bezier.Stroke
 import Math.Module
   ( lerp )
 import Math.Linear
-  ( Point2D(..), Vector2D(..) )
+  ( ℝ(..), T(..) )
 
 -- metabrushes
 import MetaBrush.DSL.Interpolation
@@ -142,7 +142,7 @@ trailToSpline (Diagrams.Loc { Diagrams.loc = Linear.P ( Linear.V2 sx sy ), Diagr
   where
     start :: PointData ptParams
     start = PointData
-              { pointCoords = Point2D sx sy
+              { pointCoords = ℝ2 sx sy
               , pointState  = Normal
               , brushParams = ptDatum
               }
@@ -157,9 +157,9 @@ trailToSpline (Diagrams.Loc { Diagrams.loc = Linear.P ( Linear.V2 sx sy ), Diagr
         nextStart =
           case seg of
             Diagrams.Linear    ( Diagrams.OffsetClosed ( Linear.V2 ex ey ) ) ->
-              Vector2D ex ey • ( p0 { brushParams = par1 } )
+              V2 ex ey • ( p0 { brushParams = par1 } )
             Diagrams.Cubic _ _ ( Diagrams.OffsetClosed ( Linear.V2 ex ey ) ) ->
-              Vector2D ex ey • ( p0 { brushParams = par1 } )
+              V2 ex ey • ( p0 { brushParams = par1 } )
         curve :: Curve Open (CachedStroke RealWorld) (PointData ptParams)
         curve = segmentToCurve p0 par1 seg
       in
@@ -180,8 +180,8 @@ segmentToCurve p0@( PointData { brushParams = startParams } ) endParams = \case
       }
   Diagrams.Cubic ( Linear.V2 x1 y1 ) ( Linear.V2 x2 y2 ) end ->
     Bezier3To
-      { controlPoint1 = Vector2D x1 y1 • ( p0 { brushParams = lerpParams (1/3) startParams endParams } )
+      { controlPoint1 = V2 x1 y1 • ( p0 { brushParams = lerpParams (1/3) startParams endParams } )
-      , controlPoint2 = Vector2D x2 y2 • ( p0 { brushParams = lerpParams (2/3) startParams endParams } )
+      , controlPoint2 = V2 x2 y2 • ( p0 { brushParams = lerpParams (2/3) startParams endParams } )
       , curveEnd      = offsetToNextPoint ( p0 { brushParams = endParams } ) end
       , curveData     = noCache
       }
@@ -196,7 +196,7 @@ offsetToNextPoint :: PointData ptParams
 offsetToNextPoint _ Diagrams.OffsetOpen
   = BackToStart
 offsetToNextPoint p0 ( Diagrams.OffsetClosed ( Linear.V2 ex ey ) )
-  = NextPoint $ Vector2D ex ey • p0
+  = NextPoint $ V2 ex ey • p0
 
 noCache :: CachedStroke RealWorld
 noCache = runRW# \ s ->

src/metabrushes/MetaBrush/Asset/Brushes.hs

@@ -1,3 +1,4 @@
+{-# LANGUAGE AllowAmbiguousTypes #-}
 {-# LANGUAGE OverloadedStrings   #-}
 
 module MetaBrush.Asset.Brushes where
@@ -23,7 +24,7 @@ import qualified Data.HashMap.Strict as HashMap
 -- MetaBrush
 import Math.Bezier.Spline
 import Math.Linear
-  ( Point2D(..), ℝ(..), T(..) )
+  ( ℝ(..), T(..) )
 import Math.Linear.Dual
   ( D, type (~>)(..), Var(var), konst )
 import Math.Module
@@ -34,8 +35,6 @@ import MetaBrush.Records
 
 --------------------------------------------------------------------------------
 
-type CircleBrushFields = '[ "r" ]
-
 lookupBrush :: Text -> Maybe SomeBrush
 lookupBrush nm = HashMap.lookup nm brushes
 
@@ -53,45 +52,25 @@ brushes = HashMap.fromList
 κ :: Double
 κ = 0.5519150244935105707435627227925
 
-circleSpline :: (Double -> Double -> ptData) -> Spline 'Closed () ptData
+type CircleBrushFields = '[ "r" ]
-circleSpline p =
-  Spline { splineStart  = p 1 0
-         , splineCurves = ClosedCurves crvs lastCrv }
-  where
-    crvs = Seq.fromList
-      [ Bezier3To (p  1  κ) (p  κ  1) (NextPoint (p  0  1)) ()
-      , Bezier3To (p -κ  1) (p -1  κ) (NextPoint (p -1  0)) ()
-      , Bezier3To (p -1 -κ) (p -κ -1) (NextPoint (p  0 -1)) ()
-      ]
-    lastCrv =
-        Bezier3To (p  κ -1) (p  1 -κ) BackToStart ()
-
 circle :: Brush CircleBrushFields
-circle = BrushData "circle" (WithParams deflts shape)
+circle = BrushData "circle" ( WithParams deflts circleBrush )
   where
     deflts :: Record CircleBrushFields
     deflts = MkR ( ℝ1 1 )
-    shape :: Record CircleBrushFields -> SplinePts 'Closed
-    shape ( MkR ( ℝ1 r ) ) =
-      circleSpline ( \ x y -> Point2D (r * x) (r * y) )
 
 type EllipseBrushFields = '[ "a", "b", "phi" ]
-
 ellipse :: Brush EllipseBrushFields
-ellipse = BrushData "ellipse" (WithParams deflts shape)
+ellipse = BrushData "ellipse" ( WithParams deflts ellipseBrush )
   where
     deflts :: Record EllipseBrushFields
     deflts = MkR ( ℝ3 1 1 0 )
-    shape :: Record EllipseBrushFields -> SplinePts 'Closed
-    shape ( MkR ( ℝ3 a b phi ) ) =
-      circleSpline ( \ x y -> Point2D (a * x * cos phi - b * y * sin phi)
-                                      (b * y * cos phi + a * x * sin phi) )
 
 --------------------------------------------------------------------------------
 -- Differentiable brushes.
 
-circleSpline2 :: ( Double -> Double -> D ( ℝ 3 ) ptData ) -> D ( ℝ 3 ) ( Spline 'Closed () ptData )
+circleSpline :: Applicative ( D u ) => ( Double -> Double -> D u v ) -> D u ( Spline 'Closed () v )
-circleSpline2 p = sequenceA $
+circleSpline p = sequenceA $
   Spline { splineStart  = p 1 0
          , splineCurves = ClosedCurves crvs lastCrv }
   where
@@ -103,24 +82,44 @@ circleSpline2 p = sequenceA $
     lastCrv =
         Bezier3To (p  κ -1) (p  1 -κ) BackToStart ()
 
-ellipseBrush :: ℝ 3 ~> Spline 'Closed () ( ℝ 2 )
+circleBrush :: Record CircleBrushFields ~> Spline 'Closed () ( ℝ 2 )
+circleBrush =
+  D \ params ->
+    let r :: D ( Record CircleBrushFields ) Double
+        r   = runD ( var @1 ) params
+        mkPt :: Double -> Double -> D ( Record CircleBrushFields ) ( ℝ 2 )
+        mkPt ( kon -> x ) ( kon -> y )
+          = fmap coerce
+          $   ( x * r ) *^ e_x
+          ^+^ ( y * r ) *^ e_y
+    in circleSpline @( Record CircleBrushFields ) mkPt
+  where
+    e_x, e_y :: D ( Record CircleBrushFields ) ( T ( ℝ 2 ) )
+    e_x = pure $ T $ ℝ2 1 0
+    e_y = pure $ T $ ℝ2 0 1
+
+    kon = konst @( Record CircleBrushFields )
+
+ellipseBrush :: Record EllipseBrushFields ~> Spline 'Closed () ( ℝ 2 )
 ellipseBrush =
   D \ params ->
-    let a, b, phi :: D ( ℝ 3 ) Double
+    let a, b, phi :: D ( Record EllipseBrushFields ) Double
         a   = runD ( var @1 ) params
         b   = runD ( var @2 ) params
         phi = runD ( var @3 ) params
-        mkPt :: Double -> Double -> D ( ℝ 3 ) ( ℝ 2 )
+        mkPt :: Double -> Double -> D ( Record EllipseBrushFields ) ( ℝ 2 )
-        mkPt ( konst -> x ) ( konst -> y )
+        mkPt ( kon -> x ) ( kon -> y )
           = fmap coerce
           $   ( x * a * cos phi - y * b * sin phi ) *^ e_x
           ^+^ ( y * b * cos phi + x * a * sin phi ) *^ e_y
-    in circleSpline2 mkPt
+    in circleSpline @( Record EllipseBrushFields ) mkPt
   where
-    e_x, e_y :: D ( ℝ 3 ) ( T ( ℝ 2 ) )
+    e_x, e_y :: D ( Record EllipseBrushFields ) ( T ( ℝ 2 ) )
     e_x = pure $ T $ ℝ2 1 0
     e_y = pure $ T $ ℝ2 0 1
 
+    kon = konst @( Record EllipseBrushFields )
+
 --ellipseArc :: ℝ 2 ~> ℝ 2
 --ellipseArc = brushStroke ( linear myPath ) ( uncurryD $ fmap bezier3 myBrush )
 

src/metabrushes/MetaBrush/Brush.hs

@@ -37,11 +37,13 @@ import qualified Data.Text as Text
   ( unpack )
 
 -- MetaBrush
+import Math.Linear
+import Math.Linear.Dual
+  ( Diffy )
 import Math.Bezier.Spline
   ( SplineType(Closed), SplinePts)
 import MetaBrush.Records
 import MetaBrush.Serialisable
-import Math.Linear
 
 --------------------------------------------------------------------------------
 
@@ -55,6 +57,7 @@ data Brush brushFields where
     :: forall brushFields
     .  ( KnownSymbols brushFields
        , Representable ( ℝ ( Length brushFields) )
+       , Diffy ( ℝ ( Length brushFields) )
        , Typeable brushFields )
     => { brushName     :: !Text
        , brushFunction :: BrushFunction brushFields

src/metabrushes/MetaBrush/Document.hs

@@ -87,7 +87,7 @@ import Math.Module
   , squaredNorm, quadrance
   )
 import Math.Linear
-  ( Point2D(..), Vector2D(..) )
+  ( ℝ(..), T(..) )
 import MetaBrush.Brush
   ( Brush, PointFields )
 import MetaBrush.Records
@@ -98,12 +98,12 @@ import MetaBrush.Unique
 
 data AABB
   = AABB
-  { topLeft, botRight :: !( Point2D Double ) }
+  { topLeft, botRight :: !( ℝ 2 ) }
   deriving stock    ( Show, Generic )
   deriving anyclass NFData
 
-mkAABB :: Point2D Double -> Point2D Double -> AABB
+mkAABB :: ℝ 2 -> ℝ 2 -> AABB
-mkAABB ( Point2D x1 y1 ) ( Point2D x2 y2 ) = AABB ( Point2D xmin ymin ) ( Point2D xmax ymax )
+mkAABB ( ℝ2 x1 y1 ) ( ℝ2 x2 y2 ) = AABB ( ℝ2 xmin ymin ) ( ℝ2 xmax ymax )
   where
     ( xmin, xmax )
       | x1 > x2   = ( x2, x1 )
@@ -117,7 +117,7 @@ data Document
   = Document
   { displayName     :: !Text
   , mbFilePath      :: !( Maybe FilePath )
-  , viewportCenter  :: !( Point2D Double )
+  , viewportCenter  :: !( ℝ 2 )
   , zoomFactor      :: !Double
   , documentUnique  :: Unique
   , documentContent :: !DocumentContent
@@ -217,14 +217,14 @@ overStrokeSpline f = coerce ( _strokeSpline @Identity ( coerce . f ) )
 
 data PointData params
   = PointData
-  { pointCoords :: !( Point2D Double )
+  { pointCoords :: !( ℝ 2 )
   , pointState  :: FocusState
   , brushParams :: !params
   }
   deriving stock ( Show, Generic )
   deriving anyclass NFData
 
-instance Act (Vector2D Double) (PointData params) where
+instance Act (T ( ℝ 2 )) (PointData params) where
   v • ( dat@( PointData { pointCoords = p } ) ) =
     dat { pointCoords = v • p }
 
@@ -255,7 +255,7 @@ emptyDocument docName unique =
   Document
     { displayName     = docName
     , mbFilePath      = Nothing
-    , viewportCenter  = Point2D 0 0
+    , viewportCenter  = ℝ2 0 0
     , zoomFactor      = 1
     , documentUnique  = unique
     , documentContent =
@@ -270,29 +270,29 @@ emptyDocument docName unique =
 --------------------------------------------------------------------------------
 
 data HoverContext
-  = MouseHover     !( Point2D Double )
+  = MouseHover     !( ℝ 2 )
   | RectangleHover !AABB
   deriving stock    ( Show, Generic )
   deriving anyclass NFData
 
-instance Act ( Vector2D Double ) HoverContext where
+instance Act ( T ( ℝ 2 ) ) HoverContext where
   v • MouseHover p = MouseHover ( v • p )
   v • RectangleHover ( AABB p1 p2 ) = RectangleHover ( AABB ( v • p1 ) ( v • p2 ) )
 
-instance Act ( Vector2D Double ) ( Maybe HoverContext ) where
+instance Act ( T ( ℝ 2 ) ) ( Maybe HoverContext ) where
   (•) v = fmap ( v • )
 
 class Hoverable a where
   hovered :: Maybe HoverContext -> Double -> a -> FocusState
 
-instance Hoverable ( Point2D Double ) where
+instance Hoverable ( ℝ 2 ) where
   hovered Nothing _ _ = Normal
   hovered ( Just ( MouseHover p ) ) zoom q
-    | quadrance @( Vector2D Double ) p q * zoom ^ ( 2 :: Int ) < 16
+    | quadrance @( T ( ℝ 2 ) ) p q * zoom ^ ( 2 :: Int ) < 16
     = Hover
     | otherwise
     = Normal
-  hovered ( Just ( RectangleHover ( AABB ( Point2D x1 y1 ) ( Point2D x2 y2 ) ) ) ) _ ( Point2D x y )
+  hovered ( Just ( RectangleHover ( AABB ( ℝ2 x1 y1 ) ( ℝ2 x2 y2 ) ) ) ) _ ( ℝ2 x y )
     | x >= x1 && x <= x2 && y >= y1 && y <= y2
     = Hover
     | otherwise
@@ -305,10 +305,10 @@ instance HasSelection ( PointData brushParams ) where
 instance HasSelection BrushPointData where
   _selection = field' @"brushPointState"
 
-_coords :: Lens' ( PointData brushParams ) ( Point2D Double )
+_coords :: Lens' ( PointData brushParams ) ( ℝ 2 )
 _coords = field' @"pointCoords"
 
-coords :: PointData brushParams -> Point2D Double
+coords :: PointData brushParams -> ℝ 2
 coords = view _coords
 
 data FocusDifference
@@ -329,7 +329,7 @@ instance Group FocusDifference where
 
 data DiffPointData diffBrushParams
   = DiffPointData
-  { diffVector :: !( Vector2D Double )
+  { diffVector :: !( T ( ℝ 2 ) )
   , diffParams :: !diffBrushParams
   , diffState  :: !FocusDifference
   }
@@ -371,8 +371,8 @@ instance Module Double brushParams => Module Double ( DiffPointData brushParams
 
 data Guide
   = Guide
-  { guidePoint  :: !( Point2D  Double ) -- ^ point on the guide line
+  { guidePoint  :: !( ℝ 2 )       -- ^ point on the guide line
-  , guideNormal :: !( Vector2D Double ) -- ^ /normalised/ normal vector of the guide
+  , guideNormal :: !( T ( ℝ 2 ) ) -- ^ /normalised/ normal vector of the guide
   , guideFocus  :: !FocusState
   , guideUnique :: Unique
   }
@@ -386,11 +386,11 @@ data Ruler
   deriving stock Show
 
 -- | Try to select a guide at the given document coordinates.
-selectedGuide :: Point2D Double -> Document -> Maybe Guide
+selectedGuide :: ℝ 2 -> Document -> Maybe Guide
 selectedGuide c ( Document { zoomFactor, documentContent = Content { guides } } ) =
   \case { Min ( Arg _ g ) -> g } <$> foldMap ( selectGuide_maybe c zoomFactor ) guides
 
-selectGuide_maybe :: Point2D Double -> Double -> Guide -> Maybe ( ArgMin Double Guide )
+selectGuide_maybe :: ℝ 2 -> Double -> Guide -> Maybe ( ArgMin Double Guide )
 selectGuide_maybe c zoom guide@( Guide { guidePoint = p, guideNormal = n } )
   | sqDist * zoom ^ ( 2 :: Int ) < 4
   = Just ( Min ( Arg sqDist guide ) )
@@ -403,7 +403,7 @@ selectGuide_maybe c zoom guide@( Guide { guidePoint = p, guideNormal = n } )
     sqDist = t ^ ( 2 :: Int ) / squaredNorm n
 
 -- | Add new guide after a mouse drag from a ruler area.
-addGuide :: UniqueSupply -> Ruler -> Point2D Double -> Document -> STM Document
+addGuide :: UniqueSupply -> Ruler -> ℝ 2 -> Document -> STM Document
 addGuide uniqueSupply ruler p doc = ( `runReaderT` uniqueSupply ) $ ( field' @"documentContent" . field' @"guides" ) insertNewGuides doc
   where
     insertNewGuides :: Map Unique Guide -> ReaderT UniqueSupply STM ( Map Unique Guide )
@@ -414,22 +414,22 @@ addGuide uniqueSupply ruler p doc = ( `runReaderT` uniqueSupply ) $ ( field' @"d
           uniq2 <- freshUnique
           let
             guide1, guide2 :: Guide
-            guide1 = Guide { guidePoint = p, guideNormal = Vector2D 0 1, guideFocus = Normal, guideUnique = uniq1 }
+            guide1 = Guide { guidePoint = p, guideNormal = V2 0 1, guideFocus = Normal, guideUnique = uniq1 }
-            guide2 = Guide { guidePoint = p, guideNormal = Vector2D 1 0, guideFocus = Normal, guideUnique = uniq2 }
+            guide2 = Guide { guidePoint = p, guideNormal = V2 1 0, guideFocus = Normal, guideUnique = uniq2 }
           pure ( Map.insert uniq2 guide2 . Map.insert uniq1 guide1 $ gs )
       TopRuler
         -> do
           uniq1 <- freshUnique
           let
             guide1 :: Guide
-            guide1 = Guide { guidePoint = p, guideNormal = Vector2D 0 1, guideFocus = Normal, guideUnique = uniq1 }
+            guide1 = Guide { guidePoint = p, guideNormal = V2 0 1, guideFocus = Normal, guideUnique = uniq1 }
           pure ( Map.insert uniq1 guide1 gs )
       LeftRuler
         -> do
           uniq2 <- freshUnique
           let
             guide2 :: Guide
-            guide2 = Guide { guidePoint = p, guideNormal = Vector2D 1 0, guideFocus = Normal, guideUnique = uniq2 }
+            guide2 = Guide { guidePoint = p, guideNormal = V2 1 0, guideFocus = Normal, guideUnique = uniq2 }
           pure ( Map.insert uniq2 guide2 gs )
 
 instance Hoverable Guide where

src/metabrushes/MetaBrush/Document/Draw.hs

@@ -59,7 +59,7 @@ import Math.Bezier.Spline
 import Math.Module
   ( squaredNorm )
 import Math.Linear
-  ( Point2D(..), Vector2D(..), ℝ(..) )
+  ( ℝ(..), T(..) )
 import MetaBrush.Assert
   ( assert )
 import MetaBrush.Brush
@@ -94,9 +94,9 @@ anchorsAreComplementary _ _ = False
 
 getOrCreateDrawAnchor
   :: UniqueSupply
-  -> Point2D Double
+  -> ℝ 2
   -> Document
-  -> STM ( Document, DrawAnchor, Point2D Double, Maybe Text )
+  -> STM ( Document, DrawAnchor, ℝ 2, Maybe Text )
 getOrCreateDrawAnchor uniqueSupply c doc@( Document { zoomFactor } ) =
   case
       ( `runState` Nothing )
@@ -135,13 +135,13 @@ getOrCreateDrawAnchor uniqueSupply c doc@( Document { zoomFactor } ) =
     -- Deselect all points, and try to find a valid anchor for drawing
     -- (a path start/end point at mouse click point).
 
-    updateStrokeHierarchy :: StrokeHierarchy -> State ( Maybe ( ( DrawAnchor, Point2D Double ), Text ) ) StrokeHierarchy
+    updateStrokeHierarchy :: StrokeHierarchy -> State ( Maybe ( ( DrawAnchor, ℝ 2 ), Text ) ) StrokeHierarchy
     updateStrokeHierarchy ( StrokeGroup { .. } ) = do
       newContents <- traverse updateStrokeHierarchy groupContents
       pure ( StrokeGroup { groupContents = newContents, .. } )
     updateStrokeHierarchy ( StrokeLeaf { strokeLeaf } ) = StrokeLeaf <$> updateStroke strokeLeaf
 
-    updateStroke :: Stroke -> State ( Maybe ( ( DrawAnchor, Point2D Double ), Text ) ) Stroke
+    updateStroke :: Stroke -> State ( Maybe ( ( DrawAnchor, ℝ 2 ), Text ) ) Stroke
     updateStroke stroke@( Stroke { strokeName, strokeVisible, strokeUnique } ) = _strokeSpline updateStrokeSpline stroke
 
       where
@@ -149,7 +149,7 @@ getOrCreateDrawAnchor uniqueSupply c doc@( Document { zoomFactor } ) =
           :: forall clo brushParams
           .  SplineTypeI clo
           => StrokeSpline clo brushParams
-          -> State ( Maybe ( ( DrawAnchor, Point2D Double ), Text ) ) ( StrokeSpline clo brushParams )
+          -> State ( Maybe ( ( DrawAnchor, ℝ 2 ), Text ) ) ( StrokeSpline clo brushParams )
         updateStrokeSpline spline = do
 
           mbAnchor <- get
@@ -167,24 +167,24 @@ getOrCreateDrawAnchor uniqueSupply c doc@( Document { zoomFactor } ) =
 
           where
             -- See if we can anchor a drawing operation on a given (visible) stroke.
-            endpointAnchor :: Unique -> StrokeSpline clo brushParams -> Maybe ( DrawAnchor, Point2D Double )
+            endpointAnchor :: Unique -> StrokeSpline clo brushParams -> Maybe ( DrawAnchor, ℝ 2 )
             endpointAnchor uniq ( Spline { splineStart, splineCurves } ) = case ssplineType @clo of
               SOpen
                 | let
-                    p0 :: Point2D Double
+                    p0 :: ℝ 2
                     p0 = coords splineStart
                 , inPointClickRange p0
                 -> Just ( AnchorAtStart uniq, p0 )
                 | OpenCurves ( _ :|> lastCurve ) <- splineCurves
                 , let
-                    pn :: Point2D Double
+                    pn :: ℝ 2
                     pn = coords ( openCurveEnd lastCurve )
                 , inPointClickRange pn
                 -> Just ( AnchorAtEnd uniq, pn )
               _ -> Nothing
-            inPointClickRange :: Point2D Double -> Bool
+            inPointClickRange :: ℝ 2 -> Bool
             inPointClickRange p =
-              squaredNorm ( c --> p :: Vector2D Double ) < 16 / ( zoomFactor * zoomFactor )
+              squaredNorm ( c --> p :: T ( ℝ 2 ) ) < 16 / ( zoomFactor * zoomFactor )
 
 addToAnchor :: DrawAnchor -> StrokeSpline Open () -> Document -> Document
 addToAnchor anchor newSpline = over ( field' @"documentContent" . field' @"strokes" . mapped ) updateStrokeHierarchy

src/metabrushes/MetaBrush/Document/Serialise.hs

@@ -106,7 +106,7 @@ import qualified Waargonaut.Types.Whitespace as JSON
 import Math.Bezier.Spline
   (  SplineType(..), SSplineType(..), SplineTypeI(..) )
 import Math.Linear
-  ( Point2D(..), Vector2D(..))
+  ( ℝ(..), T(..) )
 import MetaBrush.Asset.Brushes
   ( lookupBrush )
 import MetaBrush.Brush
@@ -192,7 +192,7 @@ encodePointData
     )
   => JSON.Encoder f ( PointData brushParams )
 encodePointData = JSON.Encoder.mapLikeObj \ ( PointData { pointCoords, brushParams } ) ->
-    JSON.Encoder.atKey' "coords"      ( encoder @( Point2D Double ) ) pointCoords
+    JSON.Encoder.atKey' "coords"      ( encoder @( ℝ 2 ) )         pointCoords
   . JSON.Encoder.atKey' "brushParams" ( encoder @( Record flds ) ) brushParams
 
 decodePointData
@@ -203,7 +203,7 @@ decodePointData
     )
   => JSON.Decoder m ( PointData brushParams )
 decodePointData = do
-  pointCoords <- JSON.Decoder.atKey "coords"      ( decoder @( Point2D Double ) )
+  pointCoords <- JSON.Decoder.atKey "coords"      ( decoder @( ℝ 2 ) )
   let
     pointState :: FocusState
     pointState = Normal
@@ -318,13 +318,13 @@ decodeStrokeHierarchy uniqueSupply = do
 
 encodeGuide :: Applicative f => JSON.Encoder f Guide
 encodeGuide = JSON.Encoder.mapLikeObj \ ( Guide { guidePoint, guideNormal } ) ->
-    JSON.Encoder.atKey' "point"  ( encoder @( Point2D  Double ) ) guidePoint
+    JSON.Encoder.atKey' "point"  ( encoder @( ℝ 2 ) )       guidePoint
-  . JSON.Encoder.atKey' "normal" ( encoder @( Vector2D Double ) ) guideNormal
+  . JSON.Encoder.atKey' "normal" ( encoder @( T ( ℝ 2 ) ) ) guideNormal
 
 decodeGuide :: MonadIO m => UniqueSupply -> JSON.Decoder m Guide
 decodeGuide uniqueSupply = do
-  guidePoint  <- JSON.Decoder.atKey "point"  ( decoder @( Point2D  Double ) )
+  guidePoint  <- JSON.Decoder.atKey "point"  ( decoder @( ℝ 2 ) )
-  guideNormal <- JSON.Decoder.atKey "normal" ( decoder @( Vector2D Double ) )
+  guideNormal <- JSON.Decoder.atKey "normal" ( decoder @( T ( ℝ 2 ) ) )
   let
     guideFocus :: FocusState
     guideFocus = Normal
@@ -356,14 +356,14 @@ encodeDocument = JSON.Encoder.mapLikeObj
   \ ( Document { displayName, viewportCenter, zoomFactor, documentContent } ) ->
     JSON.Encoder.atKey' "version" ( JSON.Encoder.list JSON.Encoder.int ) ( versionBranch Cabal.version )
   . JSON.Encoder.atKey' "name"    JSON.Encoder.text                      displayName
-  . JSON.Encoder.atKey' "center"  ( encoder @( Point2D Double ) )        viewportCenter
+  . JSON.Encoder.atKey' "center"  ( encoder @( ℝ 2 ) )        viewportCenter
   . JSON.Encoder.atKey' "zoom"    ( encoder @Double )                    zoomFactor
   . JSON.Encoder.atKey' "content" encodeDocumentContent                  documentContent
 
 decodeDocument :: MonadIO m => UniqueSupply -> Maybe FilePath -> JSON.Decoder m Document
 decodeDocument uniqueSupply mbFilePath = do
   displayName     <- JSON.Decoder.atKey "name" JSON.Decoder.text
-  viewportCenter  <- JSON.Decoder.atKey "center" ( decoder @( Point2D Double ) )
+  viewportCenter  <- JSON.Decoder.atKey "center" ( decoder @( ℝ 2 ) )
   zoomFactor      <- JSON.Decoder.atKey "zoom"   ( decoder @Double )
   documentUnique  <- lift ( liftIO . STM.atomically $ runReaderT freshUnique uniqueSupply )
   documentContent <- JSON.Decoder.atKey "content" ( decodeDocumentContent uniqueSupply )

src/metabrushes/MetaBrush/Document/SubdivideStroke.hs

@@ -51,7 +51,7 @@ import Math.Bezier.Stroke
 import Math.Module
   ( lerp, quadrance, closestPointOnSegment )
 import Math.Linear
-  ( Point2D(..), Vector2D(..), Segment(..), T(..) )
+  ( Segment(..), ℝ(..), T(..) )
 import MetaBrush.Document
   ( Document(..), Stroke(..), StrokeHierarchy(..), StrokeSpline
   , PointData(..), DiffPointData(..)
@@ -63,7 +63,7 @@ import MetaBrush.Records
 --------------------------------------------------------------------------------
 
 -- | Subdivide a path at the given center, provided a path indeed lies there.
-subdivide :: Point2D Double -> Document -> Maybe ( Document, Text )
+subdivide :: ℝ 2 -> Document -> Maybe ( Document, Text )
 subdivide c doc@( Document { zoomFactor } ) =
   let
     updatedDoc :: Document
@@ -95,14 +95,14 @@ subdivide c doc@( Document { zoomFactor } ) =
           | otherwise
           = fmap ( \ curves -> adjustSplineType @clo $ Spline { splineStart, splineCurves = OpenCurves curves } )
           $ bifoldSpline
-              ( updateCurve ( "stroke " <> strokeName ) ( Vector2D 0 0 ) )
+              ( updateCurve ( "stroke " <> strokeName ) ( V2 0 0 ) )
               ( const $ pure Empty )
               ( adjustSplineType @Open spline )
 
             where
               updateCurve
                 :: Text
-                -> Vector2D Double
+                -> T ( ℝ 2 )
                 -> PointData brushParams
                 -> Curve Open ( CachedStroke RealWorld ) ( PointData brushParams )
                 -> State ( Maybe Text )
@@ -110,13 +110,13 @@ subdivide c doc@( Document { zoomFactor } ) =
               updateCurve txt offset sp0 curve = case curve of
                 line@( LineTo ( NextPoint sp1 ) dat ) ->
                   let
-                      p0, p1, s :: Point2D Double
+                      p0, p1, s :: ℝ 2
                       t :: Double
                       p0 = coords sp0
                       p1 = coords sp1
-                      ( t, s ) = closestPointOnSegment @( Vector2D Double ) ( invert offset • c ) ( Segment p0 p1 )
+                      ( t, s ) = closestPointOnSegment @( T ( ℝ 2 ) ) ( invert offset • c ) ( Segment p0 p1 )
                       sqDist :: Double
-                      sqDist = quadrance @( Vector2D Double ) c ( offset • s )
+                      sqDist = quadrance @( T ( ℝ 2 ) ) c ( offset • s )
                   in if t > 0 && t < 1 && sqDist * zoomFactor ^ ( 2 :: Int ) < 16
                     then
                       let
@@ -128,13 +128,13 @@ subdivide c doc@( Document { zoomFactor } ) =
                     else pure $ Seq.singleton line
                 bez2@( Bezier2To sp1 ( NextPoint sp2 ) dat ) ->
                   let
-                    p0, p1, p2 :: Point2D Double
+                    p0, p1, p2 :: ℝ 2
                     p0 = coords sp0
                     p1 = coords sp1
                     p2 = coords sp2
                     sqDist :: Double
                     Min ( Arg sqDist ( t, _ ) )
-                      = Quadratic.closestPoint @( Vector2D Double ) ( Quadratic.Bezier {..} ) ( invert offset • c )
+                      = Quadratic.closestPoint @( T ( ℝ 2 ) ) ( Quadratic.Bezier {..} ) ( invert offset • c )
                   in if t > 0 && t < 1 && sqDist * zoomFactor ^ ( 2 :: Int ) < 16
                     then case Quadratic.subdivide @( DiffPointData ( T brushParams ) ) ( Quadratic.Bezier sp0 sp1 sp2 ) t of
                       ( Quadratic.Bezier _ q1 subdiv, Quadratic.Bezier _ r1 _ ) -> do
@@ -147,13 +147,13 @@ subdivide c doc@( Document { zoomFactor } ) =
                     else pure $ Seq.singleton bez2
                 bez3@( Bezier3To sp1 sp2 ( NextPoint sp3 ) dat ) ->
                   let
-                      p0, p1, p2, p3 :: Point2D Double
+                      p0, p1, p2, p3 :: ℝ 2
                       p0 = coords sp0
                       p1 = coords sp1
                       p2 = coords sp2
                       p3 = coords sp3
                       Min ( Arg sqDist ( t, _ ) )
-                        = Cubic.closestPoint @( Vector2D Double ) ( Cubic.Bezier {..} ) ( invert offset • c )
+                        = Cubic.closestPoint @( T ( ℝ 2 ) ) ( Cubic.Bezier {..} ) ( invert offset • c )
                   in if t > 0 && t < 1 && sqDist * zoomFactor ^ ( 2 :: Int ) < 16
                     then case Cubic.subdivide @( DiffPointData ( T brushParams ) ) ( Cubic.Bezier sp0 sp1 sp2 sp3 ) t of
                       ( Cubic.Bezier _ q1 q2 subdiv, Cubic.Bezier _ r1 r2 _ ) -> do

src/metabrushes/MetaBrush/Records.hs

@@ -49,6 +49,7 @@ import qualified Data.Text as Text
 
 -- MetaBrush
 import Math.Linear
+import Math.Linear.Dual
 import Math.Module
 
 --------------------------------------------------------------------------------
@@ -66,7 +67,7 @@ type WithParams :: [ Symbol ] -> Type -> Type
 data WithParams params a =
   WithParams
     { defaultParams :: Record params
-    , withParams    :: Record params -> a
+    , withParams    :: Record params ~> a
     }
 
 --------------------------------------------------------------------------------
@@ -122,6 +123,11 @@ instance ( Torsor ( T ( ℝ ( Length ks ) ) ) ( ℝ ( Length ks ) )
         => Torsor ( T ( Record ks ) ) ( Record ks ) where
   MkR g --> MkR a = T $ MkR $ unT $ g --> a
 
+type instance D ( Record ks ) = D ( ℝ ( Length ks ) )
+
+deriving newtype instance Var n ( ℝ ( Length ks ) ) => Var n ( Record ks )
+deriving newtype instance Diffy ( ℝ ( Length ks ) ) => Diffy ( Record ks )
+
 --------------------------------------------------------------------------------
 
 type Length :: [ k ] -> Nat

src/metabrushes/MetaBrush/Serialisable.hs

@@ -82,7 +82,7 @@ import Math.Bezier.Spline
 import Math.Bezier.Stroke
   ( CachedStroke(..) )
 import Math.Linear
-  ( Point2D(..), Vector2D(..), ℝ(..)
+  ( ℝ(..), T(..)
   , Fin(..), Representable(tabulate, index)
   )
 import MetaBrush.Records
@@ -99,17 +99,17 @@ instance Serialisable Double where
   encoder = contramap Scientific.fromFloatDigits JSON.Encoder.scientific
   decoder = fmap      Scientific.toRealFloat     JSON.Decoder.scientific
 
-instance Serialisable a => Serialisable ( Point2D a ) where
+instance Serialisable ( ℝ 2 ) where
-  encoder = JSON.Encoder.mapLikeObj \ ( Point2D x y ) ->
+  encoder = JSON.Encoder.mapLikeObj \ ( ℝ2 x y ) ->
       JSON.Encoder.atKey' "x" encoder x
     . JSON.Encoder.atKey' "y" encoder y
-  decoder = Point2D <$> JSON.Decoder.atKey "x" decoder <*> JSON.Decoder.atKey "y" decoder
+  decoder = ℝ2 <$> JSON.Decoder.atKey "x" decoder <*> JSON.Decoder.atKey "y" decoder
 
-instance Serialisable a => Serialisable ( Vector2D a ) where
+instance Serialisable ( T ( ℝ 2 ) ) where
-  encoder = JSON.Encoder.mapLikeObj \ ( Vector2D x y ) ->
+  encoder = JSON.Encoder.mapLikeObj \ ( V2 x y ) ->
       JSON.Encoder.atKey' "x" encoder x
     . JSON.Encoder.atKey' "y" encoder y
-  decoder = Vector2D <$> JSON.Decoder.atKey "x" decoder <*> JSON.Decoder.atKey "y" decoder
+  decoder = V2 <$> JSON.Decoder.atKey "x" decoder <*> JSON.Decoder.atKey "y" decoder
 instance ( KnownSymbols ks, Representable ( ℝ ( Length ks ) ) ) => Serialisable ( Record ks ) where
   encoder = contramap encodeFields ( JSON.Encoder.keyValueTupleFoldable ( encoder @Double ) )
     where

src/splines/Math/Bezier/Cubic.hs

@@ -62,7 +62,7 @@ import Math.Module
 import Math.Roots
   ( realRoots, solveQuadratic )
 import Math.Linear
-  ( Point2D(..), Vector2D(..), T(..) )
+  ( ℝ(..), T(..) )
 
 --------------------------------------------------------------------------------
 
@@ -138,12 +138,12 @@ squaredCurvature bez t
     sq_nm_g' = squaredNorm @v g'
 
 -- | Signed curvature of a planar cubic Bézier curve.
-signedCurvature :: forall r. Floating r => Bezier ( Point2D r ) -> r -> r
+signedCurvature :: Bezier ( ℝ 2 ) -> Double -> Double
 signedCurvature bez t = ( g' `cross` g'' ) / norm g' ^ ( 3 :: Int )
   where
-    g', g'' :: Vector2D r
+    g', g'' :: T ( ℝ 2 )
-    g'  = bezier'  @( Vector2D r ) bez t
+    g'  = bezier'  @( T ( ℝ 2 ) ) bez t
-    g'' = bezier'' @( Vector2D r ) bez t
+    g'' = bezier'' @( T ( ℝ 2 ) ) bez t
 
 -- | Subdivide a cubic Bézier curve into two parts.
 subdivide :: forall v r p. ( Torsor v p, Module r v ) => Bezier p -> r -> ( Bezier p, Bezier p )
@@ -231,13 +231,13 @@ drag ( Bezier {..} ) t q = Bezier { p0, p1 = p1', p2 = p2', p3 }
 -- Formula taken from:
 --  "A Basis for the Implicit Representation of Planar Rational Cubic Bézier Curves"
 --      – Oliver J. D. Barrowclough, 2016
-selfIntersectionParameters :: forall r. RealFloat r => Bezier ( Point2D r ) -> [ r ]
+selfIntersectionParameters :: Bezier ( ℝ 2 ) -> [ Double ]
 selfIntersectionParameters ( Bezier {..} ) = solveQuadratic c0 c1 c2
   where
-    areaConstant :: Point2D r -> Point2D r -> Point2D r -> r
+    areaConstant :: ℝ 2 -> ℝ 2 -> ℝ 2 -> Double
-    areaConstant ( Point2D x1 y1 ) ( Point2D x2 y2 ) ( Point2D x3 y3 ) =
+    areaConstant ( ℝ2 x1 y1 ) ( ℝ2 x2 y2 ) ( ℝ2 x3 y3 ) =
       x1 * ( y2 - y3 ) + x2 * ( y3 - y1 ) + x3 * ( y1 - y2 )
-    l0, l1, l2, l3, f1, f2, f3, c0, c1, c2 :: r
+    l0, l1, l2, l3, f1, f2, f3, c0, c1, c2 :: Double
     l0 = areaConstant p3 p2 p1
     l1 = areaConstant p2 p3 p0
     l2 = areaConstant p1 p0 p3

src/splines/Math/Bezier/Cubic/Fit.hs

@@ -80,7 +80,7 @@ import Math.Module
 import Math.Roots
   ( laguerre ) --, eval, derivative )
 import Math.Linear
-  ( Mat22(..), Point2D(..), Vector2D(..) )
+  ( Mat22(..), ℝ(..), T(..) )
 
 --------------------------------------------------------------------------------
 
@@ -97,10 +97,10 @@ data FitParameters
 
 data FitPoint
   = FitPoint
-    { fitPoint   :: !( Point2D  Double ) }
+    { fitPoint   :: !( ℝ 2 ) }
   | FitTangent
-    { fitPoint   :: !( Point2D  Double )
+    { fitPoint   :: !( ℝ 2 )
-    , fitTangent :: !( Vector2D Double )
+    , fitTangent :: !( T ( ℝ 2 ) )
     }
   deriving stock    ( Show, Generic )
   deriving anyclass NFData
@@ -120,7 +120,7 @@ data FitPoint
 -- including the meaning of \( \texttt{t_tol} \) and \( \texttt{maxIters} \).
 fitSpline
   :: FitParameters
-  -> ( Double -> ( Point2D Double, Vector2D Double ) ) -- ^ curve \( t \mapsto ( C(t), C'(t) ) \) to fit
+  -> ( Double -> ( ℝ 2, T ( ℝ 2 ) ) ) -- ^ curve \( t \mapsto ( C(t), C'(t) ) \) to fit
   -> ( SplinePts Open, Seq FitPoint )
 fitSpline ( FitParameters {..} ) = go 0
   where
@@ -128,13 +128,13 @@ fitSpline ( FitParameters {..} ) = go 0
     dt = recip ( fromIntegral nbSegments )
     go
       :: Int
-      -> ( Double -> ( Point2D Double, Vector2D Double ) )
+      -> ( Double -> ( ℝ 2, T ( ℝ 2 ) ) )
       -> ( SplinePts Open, Seq FitPoint )
     go subdiv curveFn =
       let
-        p, r :: Point2D Double
+        p, r :: ℝ 2
-        tp, tr :: Vector2D Double
+        tp, tr :: T ( ℝ 2 )
-        qs :: [ Point2D Double ]
+        qs :: [ ℝ 2 ]
         (p, tp) = curveFn 0
         (r, tr) = curveFn 1
         qs = [ fst $ curveFn ( dt * fromIntegral j ) | j <- [ 1 .. nbSegments - 1 ] ]
@@ -190,12 +190,12 @@ fitPiece
   :: Double    -- ^ \( \texttt{dist_tol} \), tolerance for the distance
   -> Double    -- ^ \( \texttt{t_tol} \), the tolerance for the Bézier parameter
   -> Int       -- ^ \( \texttt{maxIters} \), maximum number of iterations
-  -> Point2D Double     -- ^ \( p \), start point
+  -> ℝ 2       -- ^ \( p \), start point
-  -> Vector2D Double    -- ^ \( \textrm{t}_p \), start tangent vector (length is ignored)
+  -> T ( ℝ 2 ) -- ^ \( \textrm{t}_p \), start tangent vector (length is ignored)
-  -> [ Point2D Double ] -- ^ \( \left ( q_i \right )_{i=1}^n \), points to fit
+  -> [ ℝ 2 ]   -- ^ \( \left ( q_i \right )_{i=1}^n \), points to fit
-  -> Point2D Double     -- ^ \( r \), end point
+  -> ℝ 2       -- ^ \( r \), end point
-  -> Vector2D Double    -- ^ \( \textrm{t}_r \), end tangent vector (length is ignored)
+  -> T ( ℝ 2 ) -- ^ \( \textrm{t}_r \), end tangent vector (length is ignored)
-  -> ( Cubic.Bezier ( Point2D Double ), ArgMax Double Double )
+  -> ( Cubic.Bezier ( ℝ 2 ), ArgMax Double Double )
 fitPiece dist_tol t_tol maxIters p tp qs r tr =
   runST do
     -- Initialise the parameter values to a uniform subdivision.
@@ -207,25 +207,25 @@ fitPiece dist_tol t_tol maxIters p tp qs r tr =
     uniform :: Int -> Double
     uniform i = fromIntegral ( i + 1 ) / fromIntegral ( n + 1 )
 
-    f0, f1, f2, f3 :: Double -> Vector2D Double
+    f0, f1, f2, f3 :: Double -> T ( ℝ 2 )
     f0 t = h1 t *^ tp
     f1 t = h2 t *^ tr
-    f2 t = h0 t *^ ( MkVector2D p )
+    f2 t = h0 t *^ ( T p )
-    f3 t = h3 t *^ ( MkVector2D r )
+    f3 t = h3 t *^ ( T r )
 
-    loop :: forall s. Unboxed.MVector s Double -> Int -> ST s ( Cubic.Bezier ( Point2D Double ), ArgMax Double Double )
+    loop :: forall s. Unboxed.MVector s Double -> Int -> ST s ( Cubic.Bezier ( ℝ 2 ), ArgMax Double Double )
     loop ts count = do
       let
-        hermiteParameters :: Mat22 Double -> Vector2D Double -> Int -> [ Point2D Double ] -> ST s ( Vector2D Double )
+        hermiteParameters :: Mat22 -> T ( ℝ 2 ) -> Int -> [ ℝ 2 ] -> ST s ( T ( ℝ 2 ) )
-        hermiteParameters ( Mat22 a11 a12 _ a22 ) ( Vector2D b1 b2 ) i ( q : rest ) = do
+        hermiteParameters ( Mat22 a11 a12 _ a22 ) ( V2 b1 b2 ) i ( q : rest ) = do
           ti <- Unboxed.MVector.unsafeRead ts i
           let
-            f0i, f1i, f2i, f3i :: Vector2D Double
+            f0i, f1i, f2i, f3i :: T ( ℝ 2 )
             f0i = f0 ti
             f1i = f1 ti
             f2i = f2 ti
             f3i = f3 ti
-            q'  = MkVector2D q ^-^ f2i ^-^ f3i
+            q'  = T q ^-^ f2i ^-^ f3i
             a11', a12', a21', a22', b1', b2' :: Double
             a11' = a11 + ( f0i ^.^ f0i )
             a12' = a12 + ( f1i ^.^ f0i )
@@ -233,18 +233,18 @@ fitPiece dist_tol t_tol maxIters p tp qs r tr =
             a22' = a22 + ( f1i ^.^ f1i )
             b1'  = b1  + ( q'  ^.^ f0i )
             b2'  = b2  + ( q'  ^.^ f1i )
-          hermiteParameters ( Mat22 a11' a12' a21' a22' ) ( Vector2D b1' b2' ) ( i + 1 ) rest
+          hermiteParameters ( Mat22 a11' a12' a21' a22' ) ( V2 b1' b2' ) ( i + 1 ) rest
         hermiteParameters a b _ [] = pure ( linearSolve a b )
 
-      ~(Vector2D s1 s2) <- hermiteParameters ( Mat22 0 0 0 0 ) ( Vector2D 0 0 ) 0 qs
+      ~(V2 s1 s2) <- hermiteParameters ( Mat22 0 0 0 0 ) ( V2 0 0 ) 0 qs
 
       let
         -- Convert from Hermite form to Bézier form.
-        cp1, cp2 :: Point2D Double
+        cp1, cp2 :: ℝ 2
         cp1 = ( (  s1 / 3 ) *^ tp ) • p
         cp2 = ( ( -s2 / 3 ) *^ tr ) • r
 
-        bez :: Cubic.Bezier ( Point2D Double )
+        bez :: Cubic.Bezier ( ℝ 2 )
         bez = Cubic.Bezier p cp1 cp2 r
 
       -- Run one iteration of Laguerre's method to improve the parameter values t_i,
@@ -256,7 +256,7 @@ fitPiece dist_tol t_tol maxIters p tp qs r tr =
           laguerreStepResult :: Complex Double
           laguerreStepResult = runST do
             coeffs <- unsafeThawPrimArray . primArrayFromListN 6
-                    $ Cubic.ddist @( Vector2D Double ) bez q
+                    $ Cubic.ddist @( T ( ℝ 2 ) ) bez q
             laguerre epsilon 1 coeffs ( ti :+ 0 )
         ti' <- case laguerreStepResult of
           x :+ y
@@ -272,7 +272,7 @@ fitPiece dist_tol t_tol maxIters p tp qs r tr =
              $> ( min 1 $ max 0 x )
         let
           sq_dist :: Double
-          sq_dist = quadrance @( Vector2D Double ) q ( Cubic.bezier @( Vector2D Double ) bez ti' )
+          sq_dist = quadrance @( T ( ℝ 2 ) ) q ( Cubic.bezier @( T ( ℝ 2 ) ) bez ti' )
         modify' ( second ( <> Max ( Arg sq_dist ti' ) ) )
         lift ( Unboxed.MVector.unsafeWrite ts i ti' )
 

src/splines/Math/Bezier/Envelope.hs

@@ -1,612 +0,0 @@
-{-# LANGUAGE ScopedTypeVariables #-}
-
--- TODO: unused module.
-module Math.Bezier.Envelope where
-
--- acts
-import Data.Act
-  ( Torsor((-->)) )
-
--- deepseq
-import Control.DeepSeq
-  ( NFData )
-
--- primitive
-import Data.Primitive.Types
-  ( Prim )
-
--- MetaBrush
-import Math.Roots
-  ( realRoots )
-import qualified Math.Bezier.Cubic as Cubic
-  ( Bezier(..), bezier, bezier' )
-import qualified Math.Bezier.Quadratic as Quadratic
-  ( Bezier(..), bezier, bezier' )
-import Math.Module
-  ( Module((^+^),(*^)), lerp, cross )
-import Math.Linear
-  ( Point2D(..), Vector2D(..), Segment(..) )
-
---------------------------------------------------------------------------------
-
-{-
-data StrokePolynomialData
-  = StrokePolynomialData
-  { envelope  :: !Poly
-  , envelope' :: !Poly
-  , tangent   :: !( Poly, Poly )
-  , type1Cusps :: [ ( Double, Double ) ]
-  , type2Cusps :: [ ( Double, Double ) ]
-  }
-  deriving stock Show
-
-validRoot :: Sized 2 ( Complex Double ) -> Maybe ( Double, Double )
-validRoot r 
-  |  any isNaN [a,b,c,d]
-  || any isInfinite [a,b,c,d]
-  || any ( not . nearZero ) [b,d]
-  || any ( < 0 ) [ a, c ]
-  || any ( > 1 ) [ a, c ]
-  = Nothing
-  | otherwise
-  = Just ( a, c )
-  where
-    a, b, c, d :: Double
-    a :+ b = r %!! 0
-    c :+ d = r %!! 1
-
-{-
-:seti -XNegativeLiterals -XFlexibleInstances -XRebindableSyntax
-:m Math.Linear Math.Bezier.Envelope
-import qualified Math.Bezier.Cubic as Cubic
-import Prelude hiding ( fromInteger )
-import AlgebraicPrelude ( fromInteger )
-
-:{
-let
-  path :: Cubic.Bezier ( Point2D AlgebraicPrelude.Rational )
-  path = Cubic.Bezier
-    (Point2D p0_x p0_y) (Point2D p1_x p1_y) (Point2D p2_x p2_y) (Point2D p3_x p3_y)
-  brush :: Cubic.Bezier ( Cubic.Bezier ( Point2D AlgebraicPrelude.Rational ) )
-  brush = Cubic.Bezier
-    ( Cubic.Bezier (Point2D b00_x b00_y) (Point2D b01_x b01_y) (Point2D b02_x b02_y) (Point2D b03_x b03_y) )
-    ( Cubic.Bezier (Point2D b10_x b10_y) (Point2D b11_x b11_y) (Point2D b12_x b12_y) (Point2D b13_x b13_y) )
-    ( Cubic.Bezier (Point2D b20_x b20_y) (Point2D b21_x b21_y) (Point2D b22_x b22_y) (Point2D b23_x b23_y) )
-    ( Cubic.Bezier (Point2D b30_x b30_y) (Point2D b31_x b31_y) (Point2D b32_x b32_y) (Point2D b33_x b33_y) )
-:}
-
-:{
-let
-  path :: Cubic.Bezier ( Point2D AlgebraicPrelude.Rational )
-  path = Cubic.Bezier
-    (Point2D 0.5 0.5) (Point2D 0.5 4) (Point2D 1 4) (Point2D 6 2)
-  brush :: Cubic.Bezier ( Cubic.Bezier ( Point2D AlgebraicPrelude.Rational ) )
-  brush = Cubic.Bezier
-    ( Cubic.Bezier (Point2D 0   -0.5) (Point2D  1  1  ) (Point2D -1  1  ) (Point2D 0 -0.5) )
-    ( Cubic.Bezier (Point2D 0.5 -0.5) (Point2D  5  1  ) (Point2D -5  1  ) (Point2D 0 -0.5) )
-    ( Cubic.Bezier (Point2D 0   -0.5) (Point2D  1  1  ) (Point2D -1  1  ) (Point2D 0 -0.5) )
-    ( Cubic.Bezier (Point2D 1   -0.2) (Point2D -3 -0.8) (Point2D -1 -0.2) (Point2D 1 -0.2) )
-:}
-
-strokePolynomialData33 path brush
-
--}
-
--- c(t,u) = p(t) + b(t,u) = ( x(t,u), y(t,u) )
-strokePolynomialData33
-  :: Cubic.Bezier ( Point2D CA.Rational )
-  -> Cubic.Bezier ( Cubic.Bezier ( Point2D CA.Rational ) )
-  -> StrokePolynomialData
-strokePolynomialData33 ( Cubic.Bezier (Point2D p0_x p0_y) (Point2D p1_x p1_y) (Point2D p2_x p2_y) (Point2D p3_x p3_y) )
-  ( Cubic.Bezier
-    ( Cubic.Bezier (Point2D b00_x b00_y) (Point2D b01_x b01_y) (Point2D b02_x b02_y) (Point2D b03_x b03_y) )
-    ( Cubic.Bezier (Point2D b10_x b10_y) (Point2D b11_x b11_y) (Point2D b12_x b12_y) (Point2D b13_x b13_y) )
-    ( Cubic.Bezier (Point2D b20_x b20_y) (Point2D b21_x b21_y) (Point2D b22_x b22_y) (Point2D b23_x b23_y) )
-    ( Cubic.Bezier (Point2D b30_x b30_y) (Point2D b31_x b31_y) (Point2D b32_x b32_y) (Point2D b33_x b33_y) )
-  ) = StrokePolynomialData
-        { envelope
-        , envelope'  = pepu
-        , tangent    = ( dxdt, dydt )
-        , type1Cusps = trace ( show "grobner = " <> show grobner ) [] --mapMaybe validRoot $ unsafePerformIO . evalRandIO $ CA.solveM ( CA.toIdeal [ envelope, pepu ]  )
-        , type2Cusps = [] --mapMaybe validRoot $ unsafePerformIO . evalRandIO $ CA.solveM ( CA.toIdeal [ dxdt, dydt ] )
-        }
-    where
-
-      grobner = CA.f4 ( CA.toIdeal [ envelope, dxdt, dydt ] )
-
-      -- Computation of ∂c/∂t: partial derivatives ∂x/∂t and ∂y/∂t.
-
-      t, u :: Poly
-      t = CA.fromMonomial $ ( CA.varMonom ( Data.Type.Natural.sNat @2 ) 0 )
-      u = CA.fromMonomial $ ( CA.varMonom ( Data.Type.Natural.sNat @2 ) 1 )
-
-      bez3Pol :: Poly -> Poly -> Poly -> Poly -> Poly -> Poly
-      bez3Pol v a0 a1 a2 a3
-        = a0 * ( 1 - v ) ^ ( 3 :: Int )
-        + 3 * a1 * v * ( 1 - v ) ^ ( 2 :: Int )
-        + 3 * a2 * ( 1 - v ) * v ^ ( 2 :: Int )
-        + a3 * v ^ ( 3 :: Int )
-
-      bez3'Pol :: Poly -> Poly -> Poly -> Poly -> Poly -> Poly
-      bez3'Pol v a0 a1 a2 a3
-        = 3 * 
-        ( a1 - a0
-        + 2 * ( a0 + a2 - 2 * a1 ) * v
-        + ( a3 - 3 * a2 + 3 * a1 - a0 ) * v ^ ( 2 :: Int )
-        )
-
-      f0_x, f1_x, f2_x, f3_x, f0_y, f1_y, f2_y, f3_y :: Poly
-      f0_x = bez3'Pol t ( CA.injectCoeff b00_x ) ( CA.injectCoeff b10_x ) ( CA.injectCoeff b20_x ) ( CA.injectCoeff b30_x )
-      f1_x = bez3'Pol t ( CA.injectCoeff b01_x ) ( CA.injectCoeff b11_x ) ( CA.injectCoeff b21_x ) ( CA.injectCoeff b31_x )
-      f2_x = bez3'Pol t ( CA.injectCoeff b02_x ) ( CA.injectCoeff b12_x ) ( CA.injectCoeff b22_x ) ( CA.injectCoeff b32_x )
-      f3_x = bez3'Pol t ( CA.injectCoeff b03_x ) ( CA.injectCoeff b13_x ) ( CA.injectCoeff b23_x ) ( CA.injectCoeff b33_x )
-      f0_y = bez3'Pol t ( CA.injectCoeff b00_y ) ( CA.injectCoeff b10_y ) ( CA.injectCoeff b20_y ) ( CA.injectCoeff b30_y )
-      f1_y = bez3'Pol t ( CA.injectCoeff b01_y ) ( CA.injectCoeff b11_y ) ( CA.injectCoeff b21_y ) ( CA.injectCoeff b31_y )
-      f2_y = bez3'Pol t ( CA.injectCoeff b02_y ) ( CA.injectCoeff b12_y ) ( CA.injectCoeff b22_y ) ( CA.injectCoeff b32_y )
-      f3_y = bez3'Pol t ( CA.injectCoeff b03_y ) ( CA.injectCoeff b13_y ) ( CA.injectCoeff b23_y ) ( CA.injectCoeff b33_y )
-
-      pxpt, pypt :: Poly
-      pxpt = trace "pxpt = " . traceShowId $ bez3'Pol t ( CA.injectCoeff p0_x ) ( CA.injectCoeff p1_x ) ( CA.injectCoeff p2_x ) ( CA.injectCoeff p3_x ) + bez3Pol u f0_x f1_x f2_x f3_x
-      pypt = trace "pypt = " . traceShowId $ bez3'Pol t ( CA.injectCoeff p0_y ) ( CA.injectCoeff p1_y ) ( CA.injectCoeff p2_y ) ( CA.injectCoeff p3_y ) + bez3Pol u f0_y f1_y f2_y f3_y
-
-      -- Computation of ∂c/∂u: partial derivatives ∂x/∂u and ∂y/∂u.
-
-      g0_x, g1_x, g2_x, g3_x, g0_y, g1_y, g2_y, g3_y :: Poly
-      g0_x = bez3Pol t ( CA.injectCoeff b00_x ) ( CA.injectCoeff b10_x ) ( CA.injectCoeff b20_x ) ( CA.injectCoeff b30_x )
-      g1_x = bez3Pol t ( CA.injectCoeff b01_x ) ( CA.injectCoeff b11_x ) ( CA.injectCoeff b21_x ) ( CA.injectCoeff b31_x )
-      g2_x = bez3Pol t ( CA.injectCoeff b02_x ) ( CA.injectCoeff b12_x ) ( CA.injectCoeff b22_x ) ( CA.injectCoeff b32_x )
-      g3_x = bez3Pol t ( CA.injectCoeff b03_x ) ( CA.injectCoeff b13_x ) ( CA.injectCoeff b23_x ) ( CA.injectCoeff b33_x )
-      g0_y = bez3Pol t ( CA.injectCoeff b00_y ) ( CA.injectCoeff b10_y ) ( CA.injectCoeff b20_y ) ( CA.injectCoeff b30_y )
-      g1_y = bez3Pol t ( CA.injectCoeff b01_y ) ( CA.injectCoeff b11_y ) ( CA.injectCoeff b21_y ) ( CA.injectCoeff b31_y )
-      g2_y = bez3Pol t ( CA.injectCoeff b02_y ) ( CA.injectCoeff b12_y ) ( CA.injectCoeff b22_y ) ( CA.injectCoeff b32_y )
-      g3_y = bez3Pol t ( CA.injectCoeff b03_y ) ( CA.injectCoeff b13_y ) ( CA.injectCoeff b23_y ) ( CA.injectCoeff b33_y )
-
-      pxpu, pypu :: Poly
-      pxpu = bez3'Pol u g0_x g1_x g2_x g3_x
-      pypu = bez3'Pol u g0_y g1_y g2_y g3_y
-
-      -- Envelope equation.
-      envelope :: Poly
-      envelope = pxpt * pypu - pypt * pxpu
-
-      -- Computation of total derivative dc/dt = ( dx/dt, dy/dt ).
-      -- Rather, we are clearing denominators:
-      -- dc/dt = ∂c/∂t + ∂c/∂u ∂u/dt
-      -- ∂u/∂t = - ( ∂ envelope / ∂ t ) / ( ∂ envelope / ∂ u )
-      --
-      -- So we compute instead:
-      -- ( ∂ envelope / ∂ u ) dc/dt = ( ∂ envelope / ∂ u ) ∂c/∂t - ( ∂ envelope / ∂ t ) ∂c/∂u.
-
-      pepu, pept :: Poly
-      pept = CA.diff 0 envelope
-      pepu = CA.diff 1 envelope
-
-      dxdt, dydt :: Poly
-      dxdt = pxpt * pepu - pxpu * pept
-      dydt = pypt * pepu - pypu * pept
-
--}
--- | Find the roots of the envelope equation for a family of cubic Bézier curves
--- varying along a cubic Bézier path.
---
--- \[ c(t,u) = p(t) + b(t,u), \]
---
--- where \( t \mapsto p(t) \) describes the underlying path,
--- and \( u \mapsto b(t_0,u) \) describes the brush shape at point \( t = t_0 \).
---
--- The envelope equation is then:
---
--- \[ \frac{\partial c}{\partial t} \cross \frac{\partial c}{\partial u} = 0. \]
---
--- Given \( t_0 \), this function returns a (possibly empty) list of values \( u_i \)
--- satisfying the envelope equation at \( (t_0, u_i) \).
---
--- The points \( c(t_0,u_i) \) are thus potential outline points on the contour stroked
--- by the brush as it moves along the path.
-envelope33
-  :: forall r
-  .  ( RealFloat r, Prim r, NFData r )
-  => Cubic.Bezier ( Point2D r ) -> Cubic.Bezier ( Cubic.Bezier ( Point2D r ) ) -> r -> [ r ]
-envelope33 path
-  ( Cubic.Bezier
-    ( Cubic.Bezier b00 b01 b02 b03 )
-    ( Cubic.Bezier b10 b11 b12 b13 )
-    ( Cubic.Bezier b20 b21 b22 b23 )
-    ( Cubic.Bezier b30 b31 b32 b33 )
-  ) t0 = realRoots 50 [ a5, a4, a3, a2, a1, a0 ]
-
-  where
-
-    -- Compute ∂p/∂t(t0).
-    dpdt :: Vector2D r
-    dpdt = Cubic.bezier' @( Vector2D r ) path t0
-
-    -- Compute ∂b/∂t(t0,u) using the Bernstein basis:
-    --
-    -- ∂b/∂t(t0,u) = Cubic.bezier ( Cubic.Bezier ct0 ct1 ct2 ct3 ) u.
-    ct0, ct1, ct2, ct3, dt0, dt1, dt2, dt3 :: Vector2D r
-    ct0 = Cubic.bezier' @( Vector2D r ) ( Cubic.Bezier b00 b10 b20 b30 ) t0
-    ct1 = Cubic.bezier' @( Vector2D r ) ( Cubic.Bezier b01 b11 b21 b31 ) t0
-    ct2 = Cubic.bezier' @( Vector2D r ) ( Cubic.Bezier b02 b12 b22 b32 ) t0
-    ct3 = Cubic.bezier' @( Vector2D r ) ( Cubic.Bezier b03 b13 b23 b33 ) t0
-
-    -- Add ∂p/∂t and convert the Bernstein representation to the monomial basis to obtain
-    --
-    -- ∂c/∂t(t0,u) = dt0 + u dt1 + u² dt2 + u³ dt3.
-    dt0 = ct0 ^+^ dpdt
-    dt1 = 3 *^ ( ct0 --> ct1 )
-    dt2 = 3 *^ ( ct1 --> ct0 ^+^ ct1 --> ct2 )
-    dt3 = ct0 --> ct3 ^+^ 3 *^ ( ct2 --> ct1 )
-
-    -- Compute ∂c/∂u(t0,u) using the Bernstein basis:
-    --
-    -- ∂c/∂u(t0,u) = Cubic.bezier' ( Cubic.Bezier cu0 cu1 cu2 cu3 ) u.
-    cu0, cu1, cu2, cu3 :: Point2D r
-    cu0 = Cubic.bezier  @( Vector2D r ) ( Cubic.Bezier b00 b10 b20 b30 ) t0
-    cu1 = Cubic.bezier  @( Vector2D r ) ( Cubic.Bezier b01 b11 b21 b31 ) t0
-    cu2 = Cubic.bezier  @( Vector2D r ) ( Cubic.Bezier b02 b12 b22 b32 ) t0
-    cu3 = Cubic.bezier  @( Vector2D r ) ( Cubic.Bezier b03 b13 b23 b33 ) t0
-
-    -- Convert the Bernstein representation to the monomial basis to obtain
-    --
-    -- ∂c/∂u(t0,u) = du0 + u du1 + u² du2.
-    du0, du1, du2 :: Vector2D r
-    du0 = cu0 --> cu1
-    du1 = 2 *^ ( cu1 --> cu0 ^+^ cu1 --> cu2 )
-    du2 = cu0 --> cu3 ^+^ 3 *^ ( cu2 --> cu1 )
-
-    -- Expand out the cross-product ∂c/∂t × ∂c/∂u to obtain the envelope equation:
-    --
-    -- a0 + a1 u + a2 u² + a3 u³ + a4 u⁴ + a5 u⁵.
-    a0, a1, a2, a3, a4, a5 :: r
-    a0 = dt0 `cross` du0
-    a1 = dt1 `cross` du0 + dt0 `cross` du1
-    a2 = dt2 `cross` du0 + dt1 `cross` du1 + dt0 `cross` du2
-    a3 = dt3 `cross` du0 + dt2 `cross` du1 + dt1 `cross` du2
-    a4 = dt3 `cross` du1 + dt2 `cross` du2
-    a5 = dt3 `cross` du2
-
--- | Find the roots of the envelope equation for a family of cubic Bézier curves
--- varying along a quadratic Bézier path.
---
--- See 'envelope33' for more information.
-envelope23
-  :: forall r
-  .  ( RealFloat r, Prim r, NFData r )
-  => Quadratic.Bezier ( Point2D r ) -> Quadratic.Bezier ( Cubic.Bezier ( Point2D r ) ) -> r -> [ r ]
-envelope23 path
-  ( Quadratic.Bezier
-    ( Cubic.Bezier b00 b01 b02 b03 )
-    ( Cubic.Bezier b10 b11 b12 b13 )
-    ( Cubic.Bezier b20 b21 b22 b23 )
-  ) t0 = realRoots 50 [ a5, a4, a3, a2, a1, a0 ]
-
-  where
-
-    dpdt :: Vector2D r
-    dpdt = Quadratic.bezier' @( Vector2D r ) path t0
-
-    ct0, ct1, ct2, ct3, dt0, dt1, dt2, dt3 :: Vector2D r
-    ct0 = Quadratic.bezier' @( Vector2D r ) ( Quadratic.Bezier b00 b10 b20 ) t0
-    ct1 = Quadratic.bezier' @( Vector2D r ) ( Quadratic.Bezier b01 b11 b21 ) t0
-    ct2 = Quadratic.bezier' @( Vector2D r ) ( Quadratic.Bezier b02 b12 b22 ) t0
-    ct3 = Quadratic.bezier' @( Vector2D r ) ( Quadratic.Bezier b03 b13 b23 ) t0
-
-    dt0 = ct0 ^+^ dpdt
-    dt1 = 3 *^ ( ct0 --> ct1 )
-    dt2 = 3 *^ ( ct1 --> ct0 ^+^ ct1 --> ct2 )
-    dt3 = ct0 --> ct3 ^+^ 3 *^ ( ct2 --> ct1 )
-
-    cu0, cu1, cu2, cu3 :: Point2D r
-    cu0 = Quadratic.bezier  @( Vector2D r ) ( Quadratic.Bezier b00 b10 b20 ) t0
-    cu1 = Quadratic.bezier  @( Vector2D r ) ( Quadratic.Bezier b01 b11 b21 ) t0
-    cu2 = Quadratic.bezier  @( Vector2D r ) ( Quadratic.Bezier b02 b12 b22 ) t0
-    cu3 = Quadratic.bezier  @( Vector2D r ) ( Quadratic.Bezier b03 b13 b23 ) t0
-
-    du0, du1, du2 :: Vector2D r
-    du0 = cu0 --> cu1
-    du1 = 2 *^ ( cu1 --> cu0 ^+^ cu1 --> cu2 )
-    du2 = cu0 --> cu3 ^+^ 3 *^ ( cu2 --> cu1 )
-
-    a0, a1, a2, a3, a4, a5 :: r
-    a0 = dt0 `cross` du0
-    a1 = dt1 `cross` du0 + dt0 `cross` du1
-    a2 = dt2 `cross` du0 + dt1 `cross` du1 + dt0 `cross` du2
-    a3 = dt3 `cross` du0 + dt2 `cross` du1 + dt1 `cross` du2
-    a4 = dt3 `cross` du1 + dt2 `cross` du2
-    a5 = dt3 `cross` du2
-
--- | Find the roots of the envelope equation for a family of cubic Bézier curves
--- varying along a straight line path.
---
--- See 'envelope33' for more information.
-envelope13
-  :: forall r
-  .  ( RealFloat r, Prim r, NFData r )
-  => Segment ( Point2D r ) -> Segment ( Cubic.Bezier ( Point2D r ) ) -> r -> [ r ]
-envelope13 ( Segment p0 p1 )
-  ( Segment
-    ( Cubic.Bezier b00 b01 b02 b03 )
-    ( Cubic.Bezier b10 b11 b12 b13 )
-  ) t0 = realRoots 50 [ a5, a4, a3, a2, a1, a0 ]
-
-  where
-
-    dpdt :: Vector2D r
-    dpdt = p0 --> p1
-
-    ct0, ct1, ct2, ct3, dt0, dt1, dt2, dt3 :: Vector2D r
-    ct0 = b00 --> b10
-    ct1 = b01 --> b11
-    ct2 = b02 --> b12
-    ct3 = b03 --> b13
-
-    dt0 = ct0 ^+^ dpdt
-    dt1 = 3 *^ ( ct0 --> ct1 )
-    dt2 = 3 *^ ( ct1 --> ct0 ^+^ ct1 --> ct2 )
-    dt3 = ct0 --> ct3 ^+^ 3 *^ ( ct2 --> ct1 )
-
-    cu0, cu1, cu2, cu3 :: Point2D r
-    cu0 = lerp @( Vector2D r ) t0 b00 b10
-    cu1 = lerp @( Vector2D r ) t0 b01 b11
-    cu2 = lerp @( Vector2D r ) t0 b02 b12
-    cu3 = lerp @( Vector2D r ) t0 b03 b13
-
-    du0, du1, du2 :: Vector2D r
-    du0 = cu0 --> cu1
-    du1 = 2 *^ ( cu1 --> cu0 ^+^ cu1 --> cu2 )
-    du2 = cu0 --> cu3 ^+^ 3 *^ ( cu2 --> cu1 )
-
-    a0, a1, a2, a3, a4, a5 :: r
-    a0 = dt0 `cross` du0
-    a1 = dt1 `cross` du0 + dt0 `cross` du1
-    a2 = dt2 `cross` du0 + dt1 `cross` du1 + dt0 `cross` du2
-    a3 = dt3 `cross` du0 + dt2 `cross` du1 + dt1 `cross` du2
-    a4 = dt3 `cross` du1 + dt2 `cross` du2
-    a5 = dt3 `cross` du2
-
--- | Find the roots of the envelope equation for a family of quadratic Bézier curves
--- varying along a cubic Bézier path.
---
--- See 'envelope33' for more information.
-envelope32
-  :: forall r
-  .  ( RealFloat r, Prim r, NFData r )
-  => Cubic.Bezier ( Point2D r ) -> Cubic.Bezier ( Quadratic.Bezier ( Point2D r ) ) -> r -> [ r ]
-envelope32 path
-  ( Cubic.Bezier
-    ( Quadratic.Bezier b00 b01 b02 )
-    ( Quadratic.Bezier b10 b11 b12 )
-    ( Quadratic.Bezier b20 b21 b22 )
-    ( Quadratic.Bezier b30 b31 b32 )
-  ) t0 = realRoots 50 [ a3, a2, a1, a0 ]
-
-  where
-
-    dpdt :: Vector2D r
-    dpdt = Cubic.bezier' @( Vector2D r ) path t0
-
-    ct0, ct1, ct2, dt0, dt1, dt2 :: Vector2D r
-    ct0 = Cubic.bezier' @( Vector2D r ) ( Cubic.Bezier b00 b10 b20 b30 ) t0
-    ct1 = Cubic.bezier' @( Vector2D r ) ( Cubic.Bezier b01 b11 b21 b31 ) t0
-    ct2 = Cubic.bezier' @( Vector2D r ) ( Cubic.Bezier b02 b12 b22 b32 ) t0
-
-    dt0 = ct0 ^+^ dpdt
-    dt1 = 2 *^ ( ct0 --> ct1 )
-    dt2 = ct1 --> ct0 ^+^ ct1 --> ct2
-
-    cu0, cu1, cu2 :: Point2D r
-    cu0 = Cubic.bezier  @( Vector2D r ) ( Cubic.Bezier b00 b10 b20 b30 ) t0
-    cu1 = Cubic.bezier  @( Vector2D r ) ( Cubic.Bezier b01 b11 b21 b31 ) t0
-    cu2 = Cubic.bezier  @( Vector2D r ) ( Cubic.Bezier b02 b12 b22 b32 ) t0
-
-    du0, du1 :: Vector2D r
-    du0 = cu0 --> cu1
-    du1 = cu1 --> cu0 ^+^ cu1 --> cu2
-
-    a0, a1, a2, a3 :: r
-    a0 = dt0 `cross` du0
-    a1 = dt1 `cross` du0 + dt0 `cross` du1
-    a2 = dt2 `cross` du0 + dt1 `cross` du1
-    a3 = dt2 `cross` du1
-
--- | Find the roots of the envelope equation for a family of quadratic Bézier curves
--- varying along a quadratic Bézier path.
---
--- See 'envelope33' for more information.
-envelope22
-  :: forall r
-  .  ( RealFloat r, Prim r, NFData r )
-  => Quadratic.Bezier ( Point2D r ) -> Quadratic.Bezier ( Quadratic.Bezier ( Point2D r ) ) -> r -> [ r ]
-envelope22 path
-  ( Quadratic.Bezier
-    ( Quadratic.Bezier b00 b01 b02 )
-    ( Quadratic.Bezier b10 b11 b12 )
-    ( Quadratic.Bezier b20 b21 b22 )
-  ) t0 = realRoots 50 [ a3, a2, a1, a0 ]
-
-  where
-
-    dpdt :: Vector2D r
-    dpdt = Quadratic.bezier' @( Vector2D r ) path t0
-
-    ct0, ct1, ct2, dt0, dt1, dt2 :: Vector2D r
-    ct0 = Quadratic.bezier' @( Vector2D r ) ( Quadratic.Bezier b00 b10 b20 ) t0
-    ct1 = Quadratic.bezier' @( Vector2D r ) ( Quadratic.Bezier b01 b11 b21 ) t0
-    ct2 = Quadratic.bezier' @( Vector2D r ) ( Quadratic.Bezier b02 b12 b22 ) t0
-
-    dt0 = ct0 ^+^ dpdt
-    dt1 = 2 *^ ( ct0 --> ct1 )
-    dt2 = ct1 --> ct0 ^+^ ct1 --> ct2
-
-    cu0, cu1, cu2 :: Point2D r
-    cu0 = Quadratic.bezier  @( Vector2D r ) ( Quadratic.Bezier b00 b10 b20 ) t0
-    cu1 = Quadratic.bezier  @( Vector2D r ) ( Quadratic.Bezier b01 b11 b21 ) t0
-    cu2 = Quadratic.bezier  @( Vector2D r ) ( Quadratic.Bezier b02 b12 b22 ) t0
-
-    du0, du1 :: Vector2D r
-    du0 = cu0 --> cu1
-    du1 = cu1 --> cu0 ^+^ cu1 --> cu2
-
-    a0, a1, a2, a3 :: r
-    a0 = dt0 `cross` du0
-    a1 = dt1 `cross` du0 + dt0 `cross` du1
-    a2 = dt2 `cross` du0 + dt1 `cross` du1
-    a3 = dt2 `cross` du1
-
--- | Find the roots of the envelope equation for a family of quadratic Bézier curves
--- varying along a straight line.
---
--- See 'envelope33' for more information.
-envelope12
-  :: forall r
-  .  ( RealFloat r, Prim r, NFData r )
-  => Segment ( Point2D r ) -> Segment ( Quadratic.Bezier ( Point2D r ) ) -> r -> [ r ]
-envelope12 ( Segment p0 p1 )
-  ( Segment
-    ( Quadratic.Bezier b00 b01 b02 )
-    ( Quadratic.Bezier b10 b11 b12 )
-  ) t0 = realRoots 50 [ a3, a2, a1, a0 ]
-
-  where
-
-    dpdt :: Vector2D r
-    dpdt = p0 --> p1
-
-    ct0, ct1, ct2, dt0, dt1, dt2 :: Vector2D r
-    ct0 = b00 --> b10
-    ct1 = b01 --> b11
-    ct2 = b02 --> b12
-
-    dt0 = ct0 ^+^ dpdt
-    dt1 = 2 *^ ( ct0 --> ct1 )
-    dt2 = ct1 --> ct0 ^+^ ct1 --> ct2
-
-    cu0, cu1, cu2 :: Point2D r
-    cu0 = lerp @( Vector2D r ) t0 b00 b10
-    cu1 = lerp @( Vector2D r ) t0 b01 b11
-    cu2 = lerp @( Vector2D r ) t0 b02 b12
-
-    du0, du1 :: Vector2D r
-    du0 = cu0 --> cu1
-    du1 = cu1 --> cu0 ^+^ cu1 --> cu2
-
-    a0, a1, a2, a3 :: r
-    a0 = dt0 `cross` du0
-    a1 = dt1 `cross` du0 + dt0 `cross` du1
-    a2 = dt2 `cross` du0 + dt1 `cross` du1
-    a3 = dt2 `cross` du1
-
--- | Find the roots of the envelope equation for a family of line segments
--- varying along a cubic Bézier curve.
---
--- See 'envelope33' for more information.
-envelope31
-  :: forall r
-  .  ( RealFloat r, Prim r, NFData r )
-  => Cubic.Bezier ( Point2D r ) -> Cubic.Bezier ( Segment ( Point2D r ) ) -> r -> [ r ]
-envelope31 path
-  ( Cubic.Bezier
-    ( Segment b00 b01 )
-    ( Segment b10 b11 )
-    ( Segment b20 b21 )
-    ( Segment b30 b31 )
-  ) t0 = [ -a1 / a0 ]
-
-  where
-
-    dpdt :: Vector2D r
-    dpdt = Cubic.bezier' @( Vector2D r ) path t0
-
-    ct0, ct1, dt0, dt1 :: Vector2D r
-    ct0 = Cubic.bezier' @( Vector2D r ) ( Cubic.Bezier b00 b10 b20 b30 ) t0
-    ct1 = Cubic.bezier' @( Vector2D r ) ( Cubic.Bezier b01 b11 b21 b31 ) t0
-
-    dt0 = ct0 ^+^ dpdt
-    dt1 = ct0 --> ct1
-
-    cu0, cu1 :: Point2D r
-    cu0 = Cubic.bezier  @( Vector2D r ) ( Cubic.Bezier b00 b10 b20 b30 ) t0
-    cu1 = Cubic.bezier  @( Vector2D r ) ( Cubic.Bezier b01 b11 b21 b31 ) t0
-
-    du0 :: Vector2D r
-    du0 = cu0 --> cu1
-
-    a0, a1 :: r
-    a0 = dt0 `cross` du0
-    a1 = dt1 `cross` du0
-
--- | Find the roots of the envelope equation for a family of line segments
--- varying along a quadratic Bézier curve.
---
--- See 'envelope33' for more information.
-envelope21
-  :: forall r
-  .  ( RealFloat r, Prim r, NFData r )
-  => Quadratic.Bezier ( Point2D r ) -> Quadratic.Bezier ( Segment ( Point2D r ) ) -> r -> [ r ]
-envelope21 path
-  ( Quadratic.Bezier
-    ( Segment b00 b01 )
-    ( Segment b10 b11 )
-    ( Segment b20 b21 )
-  ) t0 = [ -a1 / a0 ]
-
-  where
-
-    dpdt :: Vector2D r
-    dpdt = Quadratic.bezier' @( Vector2D r ) path t0
-
-    ct0, ct1, dt0, dt1 :: Vector2D r
-    ct0 = Quadratic.bezier' @( Vector2D r ) ( Quadratic.Bezier b00 b10 b20 ) t0
-    ct1 = Quadratic.bezier' @( Vector2D r ) ( Quadratic.Bezier b01 b11 b21 ) t0
-
-    dt0 = ct0 ^+^ dpdt
-    dt1 = ct0 --> ct1
-
-    cu0, cu1 :: Point2D r
-    cu0 = Quadratic.bezier  @( Vector2D r ) ( Quadratic.Bezier b00 b10 b20 ) t0
-    cu1 = Quadratic.bezier  @( Vector2D r ) ( Quadratic.Bezier b01 b11 b21 ) t0
-
-    du0 :: Vector2D r
-    du0 = cu0 --> cu1
-
-    a0, a1 :: r
-    a0 = dt0 `cross` du0
-    a1 = dt1 `cross` du0
-
--- | Find the roots of the envelope equation for a family of line segments
--- varying along a straight line path.
---
--- See 'envelope33' for more information.
-envelope11
-  :: forall r
-  .  ( RealFloat r, Prim r, NFData r )
-  => Segment ( Point2D r ) -> Segment ( Segment ( Point2D r ) ) -> r -> [ r ]
-envelope11 ( Segment p0 p1 )
-  ( Segment
-    ( Segment b00 b01 )
-    ( Segment b10 b11 )
-  ) t0 = [ -a1 / a0 ]
-
-  where
-
-    dpdt :: Vector2D r
-    dpdt = p0 --> p1
-
-    ct0, ct1, dt0, dt1 :: Vector2D r
-    ct0 = b00 --> b10
-    ct1 = b01 --> b11
-
-    dt0 = ct0 ^+^ dpdt
-    dt1 = ct0 --> ct1
-
-    cu0, cu1 :: Point2D r
-    cu0 = lerp @( Vector2D r ) t0 b00 b10
-    cu1 = lerp @( Vector2D r ) t0 b01 b11
-
-    du0 :: Vector2D r
-    du0 = cu0 --> cu1
-
-    a0, a1 :: r
-    a0 = dt0 `cross` du0
-    a1 = dt1 `cross` du0

src/splines/Math/Bezier/Quadratic.hs

@@ -59,7 +59,7 @@ import Math.Module
 import Math.Roots
   ( realRoots )
 import Math.Linear
-  ( Point2D(..), Vector2D(..), T(..) )
+  ( ℝ(..), T(..) )
 
 --------------------------------------------------------------------------------
 
@@ -117,12 +117,12 @@ squaredCurvature bez t
     sq_nm_g' = squaredNorm @v g'
 
 -- | Signed curvature of a planar quadratic Bézier curve.
-signedCurvature :: forall r. Floating r => Bezier ( Point2D r ) -> r -> r
+signedCurvature :: Bezier ( ℝ 2 ) -> Double -> Double
 signedCurvature bez t = ( g' `cross` g'' ) / norm g' ^ ( 3 :: Int )
   where
-    g', g'' :: Vector2D r
+    g', g'' :: T ( ℝ 2 )
-    g'  = bezier'  @( Vector2D r ) bez t
+    g'  = bezier'  @( T ( ℝ 2 ) ) bez t
-    g'' = bezier'' @( Vector2D r ) bez
+    g'' = bezier'' @( T ( ℝ 2 ) ) bez
 
 -- | Subdivide a quadratic Bézier curve into two parts.
 subdivide :: forall v r p. ( Torsor v p, Module r v ) => Bezier p -> r -> ( Bezier p, Bezier p )

src/splines/Math/Bezier/Spline.hs

@@ -56,7 +56,7 @@ import Control.Monad.Trans.State.Strict
 import qualified Math.Bezier.Cubic as Cubic
   ( Bezier(..) )
 import Math.Linear
-  ( Point2D )
+  ( ℝ(..) )
 
 --------------------------------------------------------------------------------
 
@@ -215,8 +215,7 @@ instance KnownSplineType clo => Bifoldable ( Spline clo ) where
 instance KnownSplineType clo => Bitraversable ( Spline clo ) where
   bitraverse fc fp = bitraverseSpline ( const $ bitraverse fc fp ) fp
 
-type SplinePts clo = Spline clo () ( Point2D Double )
+type SplinePts clo = Spline clo () ( ℝ 2 )
-
 
 bimapCurve
   :: Functor ( NextPoint clo )

src/splines/Math/Bezier/Stroke.hs

@@ -120,7 +120,7 @@ data Offset
   = Offset
   { offsetIndex     :: !Int
   , offsetParameter :: !( Maybe Double )
-  , offset          :: !( Vector2D Double )
+  , offset          :: !( T ( ℝ 2 ) )
   }
   deriving stock    ( Show, Generic )
   deriving anyclass NFData
@@ -143,7 +143,7 @@ instance Monoid OutlineData where
   mempty = TwoSided empt empt
     where
       empt :: ( SplinePts Open, Seq FitPoint )
-      empt = ( Spline { splineStart = Point2D 0 0, splineCurves = OpenCurves Empty }, Empty )
+      empt = ( Spline { splineStart = ℝ2 0 0, splineCurves = OpenCurves Empty }, Empty )
 
 newtype CachedStroke s = CachedStroke { cachedStrokeRef :: STRef s ( Maybe OutlineData ) }
 instance Show ( CachedStroke s ) where
@@ -163,7 +163,7 @@ invalidateCache = runRW# \ s ->
       set ( typed @( CachedStroke RealWorld ) )
         ( CachedStroke $ STRef mutVar )
 
-coords :: forall ptData. HasType ( Point2D Double ) ptData => ptData -> Point2D Double
+coords :: forall ptData. HasType ( ℝ 2 ) ptData => ptData -> ℝ 2
 coords = view typed
 
 --------------------------------------------------------------------------------
@@ -174,7 +174,7 @@ computeStrokeOutline ::
      , Group  diffParams
      , Module Double diffParams
      , Torsor diffParams brushParams
-     , HasType ( Point2D Double ) ptData
+     , HasType ( ℝ 2 ) ptData
      , HasType ( CachedStroke s ) crvData
      , NFData ptData, NFData crvData
      -- Debugging.
@@ -199,7 +199,7 @@ computeStrokeOutline fitParams ptParams brushFn spline@( Spline { splineStart =
     , let
         endPt :: ptData
         endPt = openCurveEnd lastCurve
-        startTgtFwd, startTgtBwd, endTgtFwd, endTgtBwd :: Vector2D Double
+        startTgtFwd, startTgtBwd, endTgtFwd, endTgtBwd :: T ( ℝ 2 )
         startTgtFwd =       snd ( firstOutlineFwd 0 )
         startTgtBwd = -1 *^ snd ( firstOutlineBwd 1 )
         endTgtFwd   =       snd (  lastOutlineFwd 1 )
@@ -209,36 +209,36 @@ computeStrokeOutline fitParams ptParams brushFn spline@( Spline { splineStart =
         endBrush   = brushShape endPt
 
         -- Computation of which brush segment to use for the end caps.
-        startTgt, endTgt :: Vector2D Double
+        startTgt, endTgt :: T ( ℝ 2 )
         startTgt = coords spt0 --> coords ( openCurveStart firstCurve )
         endTgt = case prevCurves of
           Empty          -> endTangent spt0 spt0                      lastCurve
           _ :|> lastPrev -> endTangent spt0 ( openCurveEnd lastPrev ) lastCurve
-        startTestTgt, endTestTgt :: Vector2D Double
+        startTestTgt, endTestTgt :: T ( ℝ 2 )
-        startTestTgt = Vector2D sty -stx
+        startTestTgt = V2 sty -stx
           where
             stx, sty :: Double
-            Vector2D stx sty = startTgt
+            V2 stx sty = startTgt
-        endTestTgt = Vector2D ety -etx
+        endTestTgt = V2 ety -etx
           where
             etx, ety :: Double
-            Vector2D etx ety = endTgt
+            V2 etx ety = endTgt
 
         startCap, endCap :: SplinePts Open
         startCap
           | isJust $ between CCW startTgtBwd startTgtFwd startTestTgt
-          = fmap ( MkVector2D ( coords spt0 ) • )
+          = fmap ( T ( coords spt0 ) • )
           $ joinWithBrush startBrush startTgtBwd startTgtFwd
           | otherwise
-          = fmap ( MkVector2D ( coords spt0 ) • )
+          = fmap ( T ( coords spt0 ) • )
           . reverseSpline
           $ joinWithBrush startBrush startTgtFwd startTgtBwd
         endCap
           | isJust $ between CCW endTgtBwd endTgtFwd endTestTgt
-          = fmap ( MkVector2D ( coords endPt ) • )
+          = fmap ( T ( coords endPt ) • )
           $ joinWithBrush endBrush endTgtFwd endTgtBwd
           | otherwise
-          = fmap ( MkVector2D ( coords endPt ) • )
+          = fmap ( T ( coords endPt ) • )
           . reverseSpline
           $ joinWithBrush endBrush endTgtBwd endTgtFwd
 
@@ -255,7 +255,7 @@ computeStrokeOutline fitParams ptParams brushFn spline@( Spline { splineStart =
     , ( firstOutlineFwd, firstOutlineBwd ) :<| _ <- outlineFns
     , _ :|> ( lastOutlineFwd, lastOutlineBwd )   <- outlineFns
     , let
-        startTgt, endTgt, startTgtFwd, startTgtBwd, endTgtFwd, endTgtBwd :: Vector2D Double
+        startTgt, endTgt, startTgtFwd, startTgtBwd, endTgtFwd, endTgtBwd :: T ( ℝ 2 )
         startTgt = case prevCurves of
           Empty          -> startTangent spt0 spt0 lastCurve
           firstCrv :<| _ -> startTangent spt0 spt0 firstCrv
@@ -279,15 +279,15 @@ computeStrokeOutline fitParams ptParams brushFn spline@( Spline { splineStart =
   -- Single point.
   _ ->
     pure
-      ( Left $ fmap ( MkVector2D ( coords spt0 ) • ) ( brushShape spt0 )
+      ( Left $ fmap ( T ( coords spt0 ) • ) ( brushShape spt0 )
       , Empty
       )
   where
 
     outlineFns
       :: Seq
-          ( Double -> ( Point2D Double, Vector2D Double )
+          ( Double -> ( ℝ 2, T ( ℝ 2 ) )
-          , Double -> ( Point2D Double, Vector2D Double )
+          , Double -> ( ℝ 2, T ( ℝ 2 ) )
           )
     outlineFns = go spt0 ( openCurves $ splineCurves ( adjustSplineType @Open spline ) )
       where
@@ -295,8 +295,8 @@ computeStrokeOutline fitParams ptParams brushFn spline@( Spline { splineStart =
           :: ptData
           -> Seq ( Curve Open crvData ptData )
           -> Seq
-              ( Double -> ( Point2D Double, Vector2D Double )
+              ( Double -> ( ℝ 2, T ( ℝ 2 ) )
-              , Double -> ( Point2D Double, Vector2D Double )
+              , Double -> ( ℝ 2, T ( ℝ 2 ) )
               )
         go _ Empty = Empty
         go p0 ( crv :<| crvs ) =
@@ -305,7 +305,7 @@ computeStrokeOutline fitParams ptParams brushFn spline@( Spline { splineStart =
     brushShape :: ptData -> SplinePts Closed
     brushShape pt = brushFn ( ptParams pt )
 
-    updateSpline :: ( Vector2D Double, Vector2D Double, Vector2D Double ) -> ST s OutlineData
+    updateSpline :: ( T ( ℝ 2 ), T ( ℝ 2 ), T ( ℝ 2 ) ) -> ST s OutlineData
     updateSpline ( lastTgt, lastTgtFwd, lastTgtBwd )
       = execWriterT
       . ( `evalStateT` ( lastTgt, lastTgtFwd, lastTgtBwd ) )
@@ -313,9 +313,9 @@ computeStrokeOutline fitParams ptParams brushFn spline@( Spline { splineStart =
           ( \ ptData curve -> do
             ( prevTgt, prev_tgtFwd, prev_tgtBwd ) <- get
             let
-              fwd, bwd :: Double -> ( Point2D Double, Vector2D Double )
+              fwd, bwd :: Double -> ( ℝ 2, T ( ℝ 2 ) )
               ( fwd, bwd ) = outlineFunctions @diffParams ptParams brushFn ptData curve
-              tgt, next_tgt, tgtFwd, next_tgtFwd, tgtBwd, next_tgtBwd :: Vector2D Double
+              tgt, next_tgt, tgtFwd, next_tgtFwd, tgtBwd, next_tgtBwd :: T ( ℝ 2 )
               tgt         = startTangent spt0 ptData curve
               next_tgt    =   endTangent spt0 ptData curve
               tgtFwd      =       snd ( fwd 0 )
@@ -331,8 +331,8 @@ computeStrokeOutline fitParams ptParams brushFn spline@( Spline { splineStart =
 
     updateCurveData
       :: crvData
-      -> ( Double -> ( Point2D Double, Vector2D Double ) )
+      -> ( Double -> ( ℝ 2, T ( ℝ 2 ) ) )
-      -> ( Double -> ( Point2D Double, Vector2D Double ) )
+      -> ( Double -> ( ℝ 2, T ( ℝ 2 ) ) )
       -> WriterT OutlineData ( ST s ) ()
     updateCurveData ( view ( typed @( CachedStroke s ) ) -> CachedStroke { cachedStrokeRef } ) fwd bwd = do
       mbOutline <- lift ( readSTRef cachedStrokeRef )
@@ -358,21 +358,21 @@ computeStrokeOutline fitParams ptParams brushFn spline@( Spline { splineStart =
     -- This happens at corners of the brush path (including endpoints of an open brush path, where the tangent flips direction).
     tellBrushJoin
       :: Monad m
-      => ( Vector2D Double, Vector2D Double, Vector2D Double )
+      => ( T ( ℝ 2 ), T ( ℝ 2 ), T ( ℝ 2 ) )
       -> ptData
-      -> ( Vector2D Double, Vector2D Double, Vector2D Double )
+      -> ( T ( ℝ 2 ), T ( ℝ 2 ), T ( ℝ 2 ) )
       -> WriterT OutlineData m ()
     tellBrushJoin ( prevTgt, prevTgtFwd, prevTgtBwd ) sp0 ( tgt, tgtFwd, tgtBwd ) =
       tell $ TwoSided ( fwdJoin, Empty ) ( bwdJoin, Empty )
       where
-        ptOffset :: Vector2D Double
+        ptOffset :: T ( ℝ 2 )
-        ptOffset = Point2D 0 0 --> coords sp0
+        ptOffset = ℝ2 0 0 --> coords sp0
         brush0 :: SplinePts Closed
         brush0 = brushShape sp0
 
         -- Figure out which part of the brush to use for the join.
         ori :: Orientation
-        ori = splineOrientation @Double brush0
+        ori = splineOrientation brush0
         fwdCond, bwdCond :: Bool
         ( fwdCond, bwdCond )
           | prevTgt `cross` tgt < 0 && prevTgt ^.^ tgt < 0
@@ -383,11 +383,11 @@ computeStrokeOutline fitParams ptParams brushFn spline@( Spline { splineStart =
           = ( not . isJust $ between ori prevTgtFwd tgtFwd testTgt2
             , not . isJust $ between ori prevTgtBwd tgtBwd ( -1 *^ testTgt2 )
             )
-        testTgt1, testTgt2 :: Vector2D Double
+        testTgt1, testTgt2 :: T ( ℝ 2 )
-        testTgt1 = Vector2D -ty tx
+        testTgt1 = V2 -ty tx
           where
             tx, ty :: Double
-            Vector2D tx ty = tgt ^-^ prevTgt
+            V2 tx ty = tgt ^-^ prevTgt
         testTgt2
           | prevTgt ^.^ tgt < 0
           = testTgt1
@@ -420,7 +420,7 @@ outlineFunctions
   :: forall diffParams brushParams crvData ptData
   .  ( Group  diffParams, Module Double diffParams
      , Torsor diffParams brushParams
-     , HasType ( Point2D Double ) ptData
+     , HasType ( ℝ 2 ) ptData
      -- Debugging.
      , Show ptData
      )
@@ -428,68 +428,68 @@ outlineFunctions
   -> ( brushParams -> SplinePts Closed )
   -> ptData
   -> Curve Open crvData ptData
-  -> ( Double -> ( Point2D Double, Vector2D Double )
+  -> ( Double -> ( ℝ 2, T ( ℝ 2 ) )
-     , Double -> ( Point2D Double, Vector2D Double )
+     , Double -> ( ℝ 2, T ( ℝ 2 ) )
      )
 outlineFunctions ptParams brushFn sp0 crv =
   let
-    p0 :: Point2D Double
+    p0 :: ℝ 2
     p0 = coords sp0
     brush :: Double -> SplinePts Closed
-    f  :: Double -> Point2D  Double
+    f  :: Double -> ℝ 2
-    f' :: Double -> Vector2D Double
+    f' :: Double -> T ( ℝ 2 )
     ( brush, f, f' ) = case crv of
       LineTo    { curveEnd = NextPoint sp1 }
         | let
-            p1 :: Point2D Double
+            p1 :: ℝ 2
             p1 = coords sp1
-            tgt :: Vector2D Double
+            tgt :: T ( ℝ 2 )
             tgt = p0 --> p1
             brush1 :: Double -> SplinePts Closed
             brush1 t = brushFn ( lerp @diffParams t ( ptParams sp0 ) ( ptParams sp1 ) )
-        -> ( brush1, \ t -> lerp @( Vector2D Double ) t p0 p1, const tgt )
+        -> ( brush1, \ t -> lerp @( T ( ℝ 2 ) ) t p0 p1, const tgt )
       Bezier2To { controlPoint = sp1, curveEnd = NextPoint sp2 }
         | let
-            p1, p2 :: Point2D Double
+            p1, p2 :: ℝ 2
             p1 = coords sp1
             p2 = coords sp2
-            bez :: Quadratic.Bezier ( Point2D Double )
+            bez :: Quadratic.Bezier ( ℝ 2 )
             bez = Quadratic.Bezier {..}
             brush2 :: Double -> SplinePts Closed
             brush2 t =
               brushFn $
                 Quadratic.bezier @diffParams
                   ( Quadratic.Bezier ( ptParams sp0 ) ( ptParams sp1 ) ( ptParams sp2 ) ) t
-        -> ( brush2, Quadratic.bezier @( Vector2D Double ) bez, Quadratic.bezier' bez )
+        -> ( brush2, Quadratic.bezier @( T ( ℝ 2 ) ) bez, Quadratic.bezier' bez )
       Bezier3To { controlPoint1 = sp1, controlPoint2 = sp2, curveEnd = NextPoint sp3 }
         | let
-            p1, p2, p3 :: Point2D Double
+            p1, p2, p3 :: ℝ 2
             p1 = coords sp1
             p2 = coords sp2
             p3 = coords sp3
-            bez :: Cubic.Bezier ( Point2D Double )
+            bez :: Cubic.Bezier ( ℝ 2 )
             bez = Cubic.Bezier {..}
             brush3 :: Double -> SplinePts Closed
             brush3 t =
               brushFn $
                 Cubic.bezier @diffParams
                   ( Cubic.Bezier ( ptParams sp0 ) ( ptParams sp1 ) ( ptParams sp2 ) ( ptParams sp3 ) ) t
-        -> ( brush3, Cubic.bezier @( Vector2D Double ) bez, Cubic.bezier' bez )
+        -> ( brush3, Cubic.bezier @( T ( ℝ 2 ) ) bez, Cubic.bezier' bez )
-    fwd, bwd :: Double -> ( Point2D Double, Vector2D Double )
+    fwd, bwd :: Double -> ( ℝ 2, T ( ℝ 2 ) )
     fwd t
       = ( off t --offset ( withTangent ( fwd' t ) ( brush t ) ) • f t
         , fwd' t
         )
       where
-        off :: Double -> Point2D Double
+        off :: Double -> ℝ 2
         off u = offset ( withTangent ( f' u ) ( brush u ) ) • f u
-        offTgt :: Double -> Vector2D Double
+        offTgt :: Double -> T ( ℝ 2 )
         offTgt u
           | u < 0.5
           = 1e9 *^ ( off u --> off (u + 1e-9) )
           | otherwise
           = 1e9 *^ ( off (u - 1e-9) --> off u )
-        fwd' :: Double -> Vector2D Double
+        fwd' :: Double -> T ( ℝ 2 )
         fwd' u
           | squaredNorm ( offTgt u ) < epsilon
           = f' u
@@ -502,15 +502,15 @@ outlineFunctions ptParams brushFn sp0 crv =
       where
         s :: Double
         s = 1 - t
-        off :: Double -> Point2D Double
+        off :: Double -> ℝ 2
         off u = offset ( withTangent ( -1 *^ f' u ) ( brush u ) ) • f u
-        offTgt :: Double -> Vector2D Double
+        offTgt :: Double -> T ( ℝ 2 )
         offTgt u
           | u < 0.5
           = 1e9 *^ ( off u --> off (u + 1e-9) )
           | otherwise
           = 1e9 *^ ( off (u - 1e-9) --> off u )
-        bwd' :: Double -> Vector2D Double
+        bwd' :: Double -> T ( ℝ 2 )
         bwd' u
           | squaredNorm ( offTgt u ) < epsilon
           = -1 *^ f' u
@@ -523,7 +523,7 @@ outlineFunctions ptParams brushFn sp0 crv =
 -- used in the "stroke" function.
 -----
 
-startTangent, endTangent :: ( SplineTypeI clo, HasType ( Point2D Double ) ptData ) => ptData -> ptData -> Curve clo crvData ptData -> Vector2D Double
+startTangent, endTangent :: ( SplineTypeI clo, HasType ( ℝ 2 ) ptData ) => ptData -> ptData -> Curve clo crvData ptData -> T ( ℝ 2 )
 startTangent sp p0 ( LineTo    mp1      _ ) = coords p0 --> coords ( fromNextPoint sp mp1 )
 startTangent _  p0 ( Bezier2To  p1 _    _ ) = coords p0 --> coords p1
 startTangent _  p0 ( Bezier3To  p1 _ _  _ ) = coords p0 --> coords p1
@@ -531,7 +531,7 @@ endTangent   sp p0 ( LineTo         mp1 _ ) = coords p0 --> coords ( fromNextPoi
 endTangent   sp _  ( Bezier2To   p0 mp1 _ ) = coords p0 --> coords ( fromNextPoint sp mp1 )
 endTangent   sp _  ( Bezier3To _ p0 mp1 _ ) = coords p0 --> coords ( fromNextPoint sp mp1 )
 
-lastTangent :: HasType ( Point2D Double ) ptData => Spline Closed crvData ptData -> Maybe ( Vector2D Double )
+lastTangent :: HasType ( ℝ 2 ) ptData => Spline Closed crvData ptData -> Maybe ( T ( ℝ 2 ) )
 lastTangent ( Spline { splineCurves = NoCurves } ) = Nothing
 lastTangent ( Spline { splineStart, splineCurves = ClosedCurves Empty          lst } ) = Just $ endTangent splineStart splineStart lst
 lastTangent ( Spline { splineStart, splineCurves = ClosedCurves ( _ :|> prev ) lst } ) = Just $ endTangent splineStart ( openCurveEnd prev ) lst
@@ -540,13 +540,13 @@ lastTangent ( Spline { splineStart, splineCurves = ClosedCurves ( _ :|> prev ) l
 
 -- | Compute the join at a point of discontinuity of the tangent vector direction (G1 discontinuity).
 joinWithBrush
-  :: ( HasType ( Point2D Double ) ptData
+  :: ( HasType ( ℝ 2 ) ptData
      -- debugging
      , Show ptData, Show crvData
      )
   => Spline Closed crvData ptData
-  -> Vector2D Double
+  -> T ( ℝ 2 )
-  -> Vector2D Double
+  -> T ( ℝ 2 )
   -> SplinePts Open
 joinWithBrush brush startTgt endTgt = joinBetweenOffsets brush startOffset endOffset
   where
@@ -555,7 +555,7 @@ joinWithBrush brush startTgt endTgt = joinBetweenOffsets brush startOffset endOf
     endOffset   = withTangent   endTgt brush
 
 -- | Select the section of a spline in between two offsets.
-joinBetweenOffsets :: forall crvData ptData. HasType ( Point2D Double ) ptData => Spline Closed crvData ptData -> Offset -> Offset -> SplinePts Open
+joinBetweenOffsets :: forall crvData ptData. HasType ( ℝ 2 ) ptData => Spline Closed crvData ptData -> Offset -> Offset -> SplinePts Open
 joinBetweenOffsets
   spline
   ( Offset { offsetIndex = i1, offsetParameter = mb_t1 } )
@@ -599,7 +599,7 @@ joinBetweenOffsets
             ]
   where
     empty :: SplinePts Open
-    empty = Spline { splineStart = Point2D 0 0, splineCurves = OpenCurves Empty }
+    empty = Spline { splineStart = ℝ2 0 0, splineCurves = OpenCurves Empty }
     openSpline :: Spline Open crvData ptData
     openSpline = adjustSplineType spline
     t1, t2 :: Double
@@ -608,12 +608,12 @@ joinBetweenOffsets
 
 
 discardCurveData
-  :: ( Bifunctor f, HasType ( Point2D Double ) ptData )
+  :: ( Bifunctor f, HasType ( ℝ 2 ) ptData )
-  => f crvData ptData -> f () ( Point2D Double )
+  => f crvData ptData -> f () ( ℝ 2 )
 discardCurveData = bimap ( const () ) coords
 
 -- | Drop the first curve in a Bézier spline.
-dropFirstPiece :: HasType ( Point2D Double ) ptData => Spline Open crvData ptData -> Maybe ( SplinePts Open )
+dropFirstPiece :: HasType ( ℝ 2 ) ptData => Spline Open crvData ptData -> Maybe ( SplinePts Open )
 dropFirstPiece ( Spline { splineCurves = OpenCurves curves } ) = case curves of
   Empty                    -> Nothing
   fstPiece :<| laterPieces -> 
@@ -623,15 +623,15 @@ dropFirstPiece ( Spline { splineCurves = OpenCurves curves } ) = case curves of
       }
 
 -- | Subdivide the first piece at the given parameter, discarding the subsequent pieces.
-splitFirstPiece :: HasType ( Point2D Double ) ptData => Double -> Spline Open crvData ptData -> Maybe ( SplinePts Open, SplinePts Open )
+splitFirstPiece :: HasType ( ℝ 2 ) ptData => Double -> Spline Open crvData ptData -> Maybe ( SplinePts Open, SplinePts Open )
 splitFirstPiece t ( Spline { splineStart = sp0, splineCurves = OpenCurves curves } ) = case curves of
   Empty          -> Nothing
   fstPiece :<| _ -> case fstPiece of
     LineTo { curveEnd = NextPoint sp1 } ->
       let
-        p1, p :: Point2D Double
+        p1, p :: ℝ 2
         p1 = coords sp1
-        p = lerp @( Vector2D Double ) t p0 p1
+        p = lerp @( T ( ℝ 2 ) ) t p0 p1
       in
         Just
           ( Spline
@@ -647,11 +647,11 @@ splitFirstPiece t ( Spline { splineStart = sp0, splineCurves = OpenCurves curves
           )
     Bezier2To { controlPoint = sp1, curveEnd = NextPoint sp2 } ->
       let
-        p1, p2, q1, p, r1 :: Point2D Double
+        p1, p2, q1, p, r1 :: ℝ 2
         p1 = coords sp1
         p2 = coords sp2
         ( Quadratic.Bezier _ q1 p, Quadratic.Bezier _ r1 _ )
-          = Quadratic.subdivide @( Vector2D Double ) ( Quadratic.Bezier {..} ) t
+          = Quadratic.subdivide @( T ( ℝ 2 ) ) ( Quadratic.Bezier {..} ) t
       in
         Just
           ( Spline
@@ -667,12 +667,12 @@ splitFirstPiece t ( Spline { splineStart = sp0, splineCurves = OpenCurves curves
           )
     Bezier3To { controlPoint1 = sp1, controlPoint2 = sp2, curveEnd = NextPoint sp3 } ->
       let
-        p1, p2, p3, q1, q2, p, r1, r2 :: Point2D Double
+        p1, p2, p3, q1, q2, p, r1, r2 :: ℝ 2
         p1 = coords sp1
         p2 = coords sp2
         p3 = coords sp3
         ( Cubic.Bezier _ q1 q2 p, Cubic.Bezier _ r1 r2 _ )
-          = Cubic.subdivide @( Vector2D Double ) ( Cubic.Bezier {..} ) t
+          = Cubic.subdivide @( T ( ℝ 2 ) ) ( Cubic.Bezier {..} ) t
       in
         Just
           ( Spline
@@ -687,7 +687,7 @@ splitFirstPiece t ( Spline { splineStart = sp0, splineCurves = OpenCurves curves
             }
           )
   where
-    p0 :: Point2D Double
+    p0 :: ℝ 2
     p0 = coords sp0
 
 --------------------------------------------------------------------------------
@@ -697,8 +697,8 @@ splitFirstPiece t ( Spline { splineStart = sp0, splineCurves = OpenCurves curves
 -- Does /not/ check that the provided nib shape is convex.
 withTangent
   :: forall crvData ptData
-  .  ( HasType ( Point2D Double ) ptData, Show crvData, Show ptData )
+  .  ( HasType ( ℝ 2 ) ptData, Show crvData, Show ptData )
-  => Vector2D Double -> Spline Closed crvData ptData -> Offset
+  => T ( ℝ 2 ) -> Spline Closed crvData ptData -> Offset
 withTangent tgt_wanted spline@( Spline { splineStart } )
   -- only allow non-empty splines
   | Just tgt_last <- lastTangent spline
@@ -712,24 +712,24 @@ withTangent tgt_wanted spline@( Spline { splineStart } )
           \tangent vector: " <> show tgt_wanted <> "\n\
           \spline:\n" <> showSplinePoints spline <> "\n"
   | otherwise
-  = Offset { offsetIndex = 0, offsetParameter = Just 0, offset = MkVector2D ( coords splineStart ) }
+  = Offset { offsetIndex = 0, offsetParameter = Just 0, offset = T ( coords splineStart ) }
 
   where
-    badTangent :: Vector2D Double -> Bool
+    badTangent :: T ( ℝ 2 ) -> Bool
-    badTangent ( Vector2D tx ty ) =
+    badTangent ( V2 tx ty ) =
          isNaN tx || isNaN ty || isInfinite tx || isInfinite ty
       || ( abs tx < epsilon && abs ty < epsilon )
     ori :: Orientation
-    ori = splineOrientation @Double spline
+    ori = splineOrientation spline
-    go :: Int -> ptData -> Curve Open crvData ptData -> StateT ( Vector2D Double ) ( Except Offset ) ()
+    go :: Int -> ptData -> Curve Open crvData ptData -> StateT ( T ( ℝ 2 ) ) ( Except Offset ) ()
     go i cp cseg = do
       tgt_prev <- get
       let
-        p :: Point2D Double
+        p :: ℝ 2
         p = coords cp
-        seg :: Curve Open crvData ( Point2D Double )
+        seg :: Curve Open crvData ( ℝ 2 )
         seg = fmap coords cseg
-        tgt_start, tgt_end :: Vector2D Double
+        tgt_start, tgt_end :: T ( ℝ 2 )
         tgt_start = startTangent splineStart cp cseg
         tgt_end   = endTangent   splineStart cp cseg
       -- Handle corner.
@@ -739,38 +739,38 @@ withTangent tgt_wanted spline@( Spline { splineStart } )
             Offset
               { offsetIndex     = i
               , offsetParameter = Just 0
-              , offset          = MkVector2D p
+              , offset          = T p
               }
       -- Handle segment.
       lift $ handleSegment i p seg tgt_start
       put tgt_end
 
-    handleSegment :: Int -> Point2D Double -> Curve Open crvData ( Point2D Double ) -> Vector2D Double -> Except Offset ()
+    handleSegment :: Int -> ℝ 2 -> Curve Open crvData ( ℝ 2 ) -> T ( ℝ 2 ) -> Except Offset ()
     handleSegment i p0 ( LineTo ( NextPoint p1 ) _ ) tgt0
       | tgt_wanted `strictlyParallel` tgt0
       , let
-          offset :: Vector2D Double
+          offset :: T ( ℝ 2 )
-          offset = MkVector2D $ lerp @( Vector2D Double ) 0.5 p0 p1
+          offset = T $ lerp @( T ( ℝ 2 ) ) 0.5 p0 p1
       = throwE ( Offset { offsetIndex = i, offsetParameter = Nothing, offset } )
       | otherwise
       = pure ()
     handleSegment i p0 ( Bezier2To p1 ( NextPoint p2 ) _ ) tgt0 =
       let
-        tgt1 :: Vector2D Double
+        tgt1 :: T ( ℝ 2 )
         tgt1 = p1 --> p2
       in for_ ( convexCombination tgt0 tgt1 tgt_wanted ) \ t ->
           throwE $
             Offset
               { offsetIndex     = i
               , offsetParameter = Just t
-              , offset          = MkVector2D $ Quadratic.bezier @( Vector2D Double ) ( Quadratic.Bezier {..} ) t
+              , offset          = T $ Quadratic.bezier @( T ( ℝ 2 ) ) ( Quadratic.Bezier {..} ) t
               }
     handleSegment i p0 ( Bezier3To p1 p2 ( NextPoint p3 ) _ ) tgt0 =
       let
-        tgt1, tgt2 :: Vector2D Double
+        tgt1, tgt2 :: T ( ℝ 2 )
         tgt1 = p1 --> p2
         tgt2 = p2 --> p3
-        bez :: Cubic.Bezier ( Point2D Double )
+        bez :: Cubic.Bezier ( ℝ 2 )
         bez = Cubic.Bezier {..}
         c01, c12, c23 :: Double
         c01 = tgt_wanted `cross` tgt0
@@ -794,7 +794,7 @@ withTangent tgt_wanted spline@( Spline { splineStart } )
               Offset
                 { offsetIndex     = i
                 , offsetParameter = Just t
-                , offset          = MkVector2D $ Cubic.bezier @( Vector2D Double ) bez t
+                , offset          = T $ Cubic.bezier @( T ( ℝ 2 ) ) bez t
                 }
 
 --------------------------------------------------------------------------------

src/splines/Math/Linear.hs

@@ -5,7 +5,7 @@
 
 module Math.Linear
   ( -- * Points and vectors
-    Point2D(..), Vector2D(.., Vector2D), Segment(..), Mat22(..)
+    Segment(..), Mat22(..)
 
   -- * Points and vectors (second version)
   , ℝ(..), T(.., V2, V3)
@@ -46,39 +46,7 @@ import Data.Group.Generics
 
 --------------------------------------------------------------------------------
 
-data Point2D a = Point2D !a !a
+data Mat22 = Mat22 !Double !Double !Double !Double
-  deriving stock ( Eq, Generic, Generic1, Functor, Foldable, Traversable )
-  deriving ( Act ( Vector2D a ), Torsor ( Vector2D a ) )
-    via Vector2D a
-  deriving Applicative
-    via Generically1 Point2D
-  deriving anyclass ( NFData, NFData1 )
-
-instance Show a => Show (Point2D a) where
-  showsPrec i (Point2D a b) = showsPrec i (a,b)
-
-newtype Vector2D a = MkVector2D { tip :: Point2D a }
-  deriving stock   ( Generic, Generic1, Foldable, Traversable )
-  deriving newtype ( Eq, Functor, Applicative, NFData, NFData1 )
-  deriving ( Semigroup, Monoid, Group )
-    via Generically ( Point2D ( Sum a ) )
-
--- | One-off datatype used for the 'Show' instance of Vector2D.
-data V a = V a a
-  deriving stock Show
-instance Show a => Show (Vector2D a) where
-  showsPrec i (Vector2D x y) = showsPrec i (V x y)
-
-{-# COMPLETE Vector2D #-}
-pattern Vector2D :: a -> a -> Vector2D a
-pattern Vector2D x y = MkVector2D ( Point2D x y )
-
-data Mat22 a
-  = Mat22 !a !a !a !a
-  deriving stock ( Show, Eq, Generic, Generic1, Functor, Foldable, Traversable )
-  deriving Applicative
-    via Generically1 Mat22
-  deriving anyclass ( NFData, NFData1 )
 
 data Segment p =
   Segment

src/splines/Math/Linear/Dual.hs

@@ -1,5 +1,6 @@
 {-# LANGUAGE AllowAmbiguousTypes   #-}
 {-# LANGUAGE DuplicateRecordFields #-}
+{-# LANGUAGE ScopedTypeVariables   #-}
 {-# LANGUAGE UndecidableInstances  #-}
 
 module Math.Linear.Dual where
@@ -28,30 +29,35 @@ deriving stock instance Functor ( D a ) => Functor ( (~>) a )
 
 -- | @D ( ℝ n ) v@ is \( \mathbb{R}[x_1, \ldots, x_n]/(x_1, \ldots, x_n)^3 \otimes_\mathbb{R} v \)
 type D :: Type -> Type -> Type
-data family D u v
+type family D u
-newtype instance D ( ℝ 0 ) v = D0 { v :: v }
+type instance D ( ℝ 0 ) = Dℝ0
+type instance D ( ℝ 1 ) = Dℝ1
+type instance D ( ℝ 2 ) = Dℝ2
+type instance D ( ℝ 3 ) = Dℝ3
+
+newtype Dℝ0 v = D0 { v :: v }
   deriving stock   ( Show, Eq, Functor, Generic, Generic1 )
   deriving newtype ( Num, Fractional, Floating )
   deriving Applicative
-    via Generically1 ( D ( ℝ 0 ) )
+    via Generically1 Dℝ0
-data instance D ( ℝ 1 ) v = D1 { v :: !v, dx :: !( T v ), ddx :: !( T v ) }
+data Dℝ1 v = D1 { v :: !v, dx :: !( T v ), ddx :: !( T v ) }
   deriving stock ( Show, Eq, Functor, Generic, Generic1 )
   deriving Applicative
-    via Generically1 ( D ( ℝ 1 ) )
+    via Generically1 Dℝ1
-data instance D ( ℝ 2 ) v = D2 { v :: !v, dx, dy :: !( T v ), ddx, dxdy, ddy :: !( T v ) }
+data Dℝ2 v = D2 { v :: !v, dx, dy :: !( T v ), ddx, dxdy, ddy :: !( T v ) }
   deriving stock ( Show, Eq, Functor, Generic, Generic1 )
   deriving Applicative
-    via Generically1 ( D ( ℝ 2 ) )
+    via Generically1 Dℝ2
-data instance D ( ℝ 3 ) v = D3 { v :: !v, dx, dy, dz :: !( T v ), ddx, dxdy, ddy, dxdz, dydz, ddz :: !( T v ) }
+data Dℝ3 v = D3 { v :: !v, dx, dy, dz :: !( T v ), ddx, dxdy, ddy, dxdz, dydz, ddz :: !( T v ) }
   deriving stock ( Show, Eq, Functor, Generic, Generic1 )
   deriving Applicative
-    via Generically1 ( D ( ℝ 3 ) )
+    via Generically1 Dℝ3
 
-instance Num ( D ( ℝ 1 ) Double ) where
+instance Num ( Dℝ1 Double ) where
   (+) = liftA2 (+)
   (-) = liftA2 (-)
   negate = fmap negate
-  fromInteger = konst . fromInteger
+  fromInteger = konst @( ℝ 1 ) . fromInteger
 
   abs    = error "no"
   signum = error "no"
@@ -62,11 +68,11 @@ instance Num ( D ( ℝ 1 ) Double ) where
          ( T $ dx1 * v2 + v1 * dx2 )
          ( T $ dx1 * dx2 + v1 * ddx2 + ddx1 * v2 )
 
-instance Num ( D ( ℝ 2 ) Double ) where
+instance Num ( Dℝ2 Double ) where
   (+) = liftA2 (+)
   (-) = liftA2 (-)
   negate = fmap negate
-  fromInteger = konst . fromInteger
+  fromInteger = konst @( ℝ 2 ) . fromInteger
 
   abs    = error "no"
   signum = error "no"
@@ -81,11 +87,11 @@ instance Num ( D ( ℝ 2 ) Double ) where
          ( T $ dy1 * dy2 + v1 * ddy2 + ddy1 * v2 )
 
 
-instance Num ( D ( ℝ 3 ) Double ) where
+instance Num ( Dℝ3 Double ) where
   (+) = liftA2 (+)
   (-) = liftA2 (-)
   negate = fmap negate
-  fromInteger = konst . fromInteger
+  fromInteger = konst @( ℝ 3 ) . fromInteger
 
   abs    = error "no"
   signum = error "no"
@@ -104,35 +110,35 @@ instance Num ( D ( ℝ 3 ) Double ) where
          ( T $ dz1 * dz2 + v1 * ddz2 + ddz1 * v2)
 
 
-instance Module Double v => Module ( D ( ℝ 0 ) Double ) ( D ( ℝ 0 ) v ) where
+instance Module Double v => Module ( Dℝ0 Double ) ( Dℝ0 v ) where
   (^+^)  = liftA2 (^+^)
   (^-^)  = liftA2 (^-^)
   origin = pure origin
   (*^)   = liftA2 (*^)
 
-instance Module Double v => Module ( D ( ℝ 1 ) Double ) ( D ( ℝ 1 ) v ) where
+instance Module Double v => Module ( Dℝ1 Double ) ( Dℝ1 v ) where
   (^+^)  = liftA2 (^+^)
   (^-^)  = liftA2 (^-^)
   origin = pure origin
   (*^)   = liftA2 (*^)
 
-instance Module Double v => Module ( D ( ℝ 2 ) Double ) ( D ( ℝ 2 ) v ) where
+instance Module Double v => Module ( Dℝ2 Double ) ( Dℝ2 v ) where
   (^+^)  = liftA2 (^+^)
   (^-^)  = liftA2 (^-^)
   origin = pure origin
   (*^)   = liftA2 (*^)
 
-instance Module Double v => Module ( D ( ℝ 3 ) Double ) ( D ( ℝ 3 ) v ) where
+instance Module Double v => Module ( Dℝ3 Double ) ( Dℝ3 v ) where
   (^+^)  = liftA2 (^+^)
   (^-^)  = liftA2 (^-^)
   origin = pure origin
   (*^)   = liftA2 (*^)
 
-instance Fractional ( D ( ℝ 1 ) Double ) where
+instance Fractional ( Dℝ1 Double ) where
-  (/) = error "I haven't yet defined (/) for D ( ℝ 1 )"
+  (/) = error "I haven't yet defined (/) for Dℝ1"
-  fromRational = konst . fromRational
+  fromRational = konst @( ℝ 1 ) . fromRational
-instance Floating ( D ( ℝ 1 ) Double ) where
+instance Floating ( Dℝ1 Double ) where
-  pi = konst pi
+  pi = konst @( ℝ 1 ) pi
   sin ( D1 v ( T dx ) ( T ddx ) )
     = let !s = sin v
           !c = cos v
@@ -143,11 +149,11 @@ instance Floating ( D ( ℝ 1 ) Double ) where
           !c = cos v
       in D1 c ( T $ -s * dx ) ( T $ -2 * s * ddx - c * dx * dx )
 
-instance Fractional ( D ( ℝ 2 ) Double ) where
+instance Fractional ( Dℝ2 Double ) where
-  (/) = error "I haven't yet defined (/) for D ( ℝ 2 )"
+  (/) = error "I haven't yet defined (/) for Dℝ2"
-  fromRational = konst . fromRational
+  fromRational = konst @( ℝ 2 ) . fromRational
-instance Floating ( D ( ℝ 2 ) Double ) where
+instance Floating ( Dℝ2 Double ) where
-  pi = konst pi
+  pi = konst @( ℝ 2 ) pi
   sin ( D2 v ( T dx ) ( T dy ) ( T ddx ) ( T dxdy ) ( T ddy ) )
     = let !s = sin v
           !c = cos v
@@ -166,11 +172,11 @@ instance Floating ( D ( ℝ 2 ) Double ) where
             ( T $ -2 * s * dxdy - 2 * c * dx * dy )
             ( T $ -2 * s * ddy - c * dy * dy )
 
-instance Fractional ( D ( ℝ 3 ) Double ) where
+instance Fractional ( Dℝ3 Double ) where
-  (/) = error "I haven't yet defined (/) for D ( ℝ 3 )"
+  (/) = error "I haven't yet defined (/) for Dℝ3"
-  fromRational = konst . fromRational
+  fromRational = konst @( ℝ 3 ) . fromRational
-instance Floating ( D ( ℝ 3 ) Double ) where
+instance Floating ( Dℝ3 Double ) where
-  pi = konst pi
+  pi = konst @( ℝ 3 ) pi
   sin ( D3 v ( T dx ) ( T dy ) ( T dz ) ( T ddx ) ( T dxdy ) ( T ddy ) ( T dxdz ) ( T dydz ) ( T ddz ) )
     = let !s = sin v
           !c = cos v
@@ -207,7 +213,7 @@ uncurryD ( D b ) = D \ ( ℝ2 t0 s0 ) ->
 
 --------------------------------------------------------------------------------
 
-chainRule :: ( Chain v, Module Double ( T w ) )
+chainRule :: ( Diffy v, Module Double ( T w ) )
           => ( ( ℝ 1 ) ~> v )
           -> ( v ~> w )
           -> ( ( ℝ 1 ) ~> w )
@@ -217,24 +223,31 @@ chainRule ( D f ) ( D g ) =
       df@( D1 { v = f_x } ) ->
         chain df ( g f_x )
 
-type Chain :: Type -> Constraint
+-- | Recover the underlying function, discarding all infinitesimal information.
-class Chain v where
+fun :: forall v w. Diffy v => ( v ~> w ) -> ( v -> w )
+fun ( D f ) = value @v . f
+
+type Diffy :: Type -> Constraint
+class Diffy v where
   chain :: ( Module Double ( T w ) )
-        => D ( ℝ 1 ) v -> D v w -> D ( ℝ 1 ) w
+        => Dℝ1 v -> D v w -> D ( ℝ 1 ) w
   konst :: Module Double ( T w ) => w -> D v w
+  value :: D v w -> w
 
-instance Chain ( ℝ 0 ) where
+instance Diffy ( ℝ 0 ) where
-  chain _ ( D0 v ) = D1 v origin origin
+  chain _ ( D0 w ) = D1 w origin origin
   konst k = D0 k
+  value ( D0 w ) = w
 
-instance Chain ( ℝ 1 ) where
+instance Diffy ( ℝ 1 ) where
   chain ( D1 _ ( T ( ℝ1 x' ) ) ( T ( ℝ1 x'' ) ) ) ( D1 v g_x g_xx )
     = D1 v
          ( x' *^ g_x )
          ( x'' *^ g_x ^+^ ( x' * x' ) *^ g_xx )
   konst k = D1 k origin origin
+  value ( D1 { v } ) = v
 
-instance Chain ( ℝ 2 ) where
+instance Diffy ( ℝ 2 ) where
   chain ( D1 _ ( T ( ℝ2 x' y' ) ) ( T ( ℝ2 x'' y'' ) ) ) ( D2 v g_x g_y g_xx g_xy g_yy )
     = D1 v
          ( x' *^ g_x ^+^ y' *^ g_y )
@@ -242,8 +255,9 @@ instance Chain ( ℝ 2 ) where
             ^+^ ( x' * x' ) *^ g_xx ^+^ ( y' * y' ) *^ g_yy
             ^+^ 2 *^ ( ( x' * y' ) *^ g_xy ) )
   konst k = D2 k origin origin origin origin origin
+  value ( D2 { v } ) = v
 
-instance Chain ( ℝ 3 ) where
+instance Diffy ( ℝ 3 ) where
   chain ( D1 _ ( T ( ℝ3 x' y' z' ) ) ( T ( ℝ3 x'' y'' z'' ) ) )
         ( D3 v g_x g_y g_z g_xx g_xy g_yy g_xz g_yz g_zz )
     = D1 v
@@ -252,6 +266,7 @@ instance Chain ( ℝ 3 ) where
             ^+^ ( x' * x' ) *^ g_xx ^+^ ( y' * y' ) *^ g_yy ^+^ ( z' * z' ) *^ g_zz
             ^+^ 2 *^ ( ( x' * y' ) *^ g_xy ) ^+^ ( x' * z' ) *^ g_xz ^+^ ( y' * z' ) *^ g_yz )
   konst k = D3 k origin origin origin origin origin origin origin origin origin
+  value ( D3 { v } ) = v
 
 --------------------------------------------------------------------------------
 

src/splines/Math/Linear/Solve.hs

@@ -16,12 +16,12 @@ import qualified Eigen.Solver.LA as Eigen
 
 -- MetaBrush
 import Math.Linear
-  ( Vector2D(..), Mat22(..) )
+  ( Mat22(..), ℝ(..), T(..) )
 
 --------------------------------------------------------------------------------
 
-linearSolve :: Mat22 Double -> Vector2D Double -> Vector2D Double
+linearSolve :: Mat22 -> T ( ℝ 2 ) -> T ( ℝ 2 )
-linearSolve ( Mat22 a b c d ) ( Vector2D p q ) = Vector2D u v
+linearSolve ( Mat22 a b c d ) ( V2 p q ) = V2 u v
   where
     [[u],[v]] = Eigen.toList
               $ Eigen.solve Eigen.JacobiSVD

src/splines/Math/Module.hs

@@ -28,10 +28,6 @@ import Data.Act
     ( (-->) )
   )
 
--- groups
-import Data.Group
-  ( invert )
-
 -- MetaBrush
 import Math.Epsilon
   ( epsilon )
@@ -126,21 +122,6 @@ instance Num a => Module a ( Sum a ) where
 instance Num a => Inner a ( Sum a ) where
   Sum a ^.^ Sum b = a * b
 
-
-instance Num a => Module a ( Vector2D a ) where
-
-  origin = pure 0
-
-  (^+^) = (<>)
-  p ^-^ q = p <> invert q
-
-  c *^ p = fmap ( c * ) p
-  p ^* c = fmap ( * c ) p
-
-instance Num a => Inner a ( Vector2D a ) where
-  ( Vector2D x1 y1 ) ^.^ ( Vector2D x2 y2 )
-    = x1 * x2 + y1 * y2
-
 instance Module Double ( T ( ℝ 0 ) ) where
   origin  = T ℝ0
   _ ^+^ _ = T ℝ0
@@ -164,16 +145,18 @@ instance Module Double ( T ( ℝ 3 ) ) where
     T ( ℝ3 ( x1 - x2 ) ( y1 - y2 ) ( z1 - z2 ) )
   k *^ ( T ( ℝ3 a b c ) ) = T ( ℝ3 ( k * a ) ( k * b ) ( k * c ) )
 
+instance Inner Double ( T ( ℝ 2 ) ) where
+  V2 x1 y1 ^.^ V2 x2 y2 = x1 * x2 + y1 * y2
+
 -- | Cross-product of two 2D vectors.
-cross :: Num a => Vector2D a -> Vector2D a -> a
+cross :: T ( ℝ 2 ) -> T ( ℝ 2 ) -> Double
-cross ( Vector2D x1 y1 ) ( Vector2D x2 y2 )
+cross ( V2 x1 y1 ) ( V2 x2 y2 ) = x1 * y2 - x2 * y1
-  = x1 * y2 - x2 * y1
 
 -- | Compute whether two vectors point in the same direction,
 -- that is, whether each vector is a (strictly) positive multiple of the other.
 --
 -- Returns @False@ if either of the vectors is zero.
-strictlyParallel :: RealFloat r => Vector2D r -> Vector2D r -> Bool
+strictlyParallel :: T ( ℝ 2 ) -> T ( ℝ 2 ) -> Bool
 strictlyParallel u v
   =  abs ( u `cross` v ) < epsilon -- vectors are collinear
   &&       u   ^.^   v   > epsilon -- vectors point in the same direction (parallel and not anti-parallel)
@@ -182,12 +165,10 @@ strictlyParallel u v
 --
 -- If so, returns @ t @ in @ [ 0, 1 ] @ such that @ ( 1 - t ) v0 + t v1 @ is a positive multiple of @ u @.
 convexCombination
-  :: forall r
+  :: T ( ℝ 2 ) -- ^ first vector
-  .  RealFloat r
+  -> T ( ℝ 2 ) -- ^ second vector
-  => Vector2D r -- ^ first vector
+  -> T ( ℝ 2 ) -- ^ query vector
-  -> Vector2D r -- ^ second vector
+  -> Maybe Double
-  -> Vector2D r -- ^ query vector
-  -> Maybe r
 convexCombination v0 v1 u
   | abs c10 < epsilon
   = if strictlyParallel u v0
@@ -198,13 +179,13 @@ convexCombination v0 v1 u
   | otherwise
   = do
       let
-        t :: r
+        t :: Double
         t = c0 / c10
       guard ( t > -epsilon && t < 1 + epsilon )
-      guard ( epsilon < u ^.^ ( lerp @( Vector2D r ) t v0 v1 ) )
+      guard ( epsilon < u ^.^ ( lerp @( T ( ℝ 2 ) ) t v0 v1 ) )
       Just $ min 1 ( max 0 t )
 
   where
-    c0, c10 :: r
+    c0, c10 :: Double
     c0  = v0 `cross` u
     c10 = ( v0 ^-^ v1 ) `cross` u

src/splines/Math/Orientation.hs

@@ -39,7 +39,7 @@ import Math.Bezier.Spline
   , ssplineType
   )
 import Math.Linear
-  ( Point2D, Vector2D(..) )
+  ( ℝ(..), T(..) )
 
 --------------------------------------------------------------------------------
 
@@ -53,7 +53,7 @@ reverseOrientation CCW = CW
 reverseOrientation CW  = CCW
 
 -- | Compute an orientation from a sequence of tangent vectors (assumed to have monotone angle).
-convexOrientation :: forall r. RealFloat r => [ Vector2D r ] -> Orientation
+convexOrientation :: [ T ( ℝ 2 ) ] -> Orientation
 convexOrientation ( v1 : v2 : vs )
   | nearZero crossProduct
   = convexOrientation ( v2 : vs )
@@ -62,27 +62,27 @@ convexOrientation ( v1 : v2 : vs )
   | otherwise
   = CW
   where
-    crossProduct :: r
+    crossProduct :: Double
     crossProduct = v1 `cross` v2
 convexOrientation _ = CCW -- default
 
 -- | Compute the orientation of a spline, assuming tangent vectors have a monotone angle.
 splineOrientation
-  :: forall r clo crvData ptData
+  :: forall clo crvData ptData
-  .  ( KnownSplineType clo, RealFloat r, HasType ( Point2D r ) ptData )
+  .  ( KnownSplineType clo, HasType ( ℝ 2 ) ptData )
   => Spline clo crvData ptData
   -> Orientation
-splineOrientation = convexOrientation . splineTangents @r
+splineOrientation = convexOrientation . splineTangents
 
 -- | Compute the sequence of tangent vectors given by the control points of a Bézier spline.
 splineTangents
-  :: forall r clo crvData ptData
+  :: forall clo crvData ptData
-  .  ( Num r, KnownSplineType clo, HasType ( Point2D r ) ptData )
+  .  ( KnownSplineType clo, HasType ( ℝ 2 ) ptData )
   => Spline clo crvData ptData
-  -> [ Vector2D r ]
+  -> [ T ( ℝ 2 ) ]
 splineTangents spline@( Spline { splineStart = sp0, splineCurves = curves } )
   | let
-      p0 :: Point2D r
+      p0 :: ℝ 2
       p0 = view typed sp0
   = case ssplineType @clo of
       SOpen
@@ -93,24 +93,24 @@ splineTangents spline@( Spline { splineStart = sp0, splineCurves = curves } )
         -> go p0 ( cs :|> c )
       _ -> []
   where
-    go :: Point2D r -> Seq ( Curve Open crvData ptData ) -> [ Vector2D r ]
+    go :: ℝ 2 -> Seq ( Curve Open crvData ptData ) -> [ T ( ℝ 2 ) ]
     go _ Empty = []
     go p ( crv :<| crvs ) =
       case crv of
         LineTo { curveEnd = NextPoint sq }
           | let
-              q :: Point2D r
+              q :: ℝ 2
               q = view typed sq
           -> ( p --> q ) : go q crvs
         Bezier2To { controlPoint = scp, curveEnd = NextPoint sq }
           | let
-              cp, q :: Point2D r
+              cp, q :: ℝ 2
               cp = view typed scp
               q  = view typed sq
           -> ( p --> cp ) : ( cp --> q ) : go q crvs
         Bezier3To { controlPoint1 = scp1, controlPoint2 = scp2, curveEnd = NextPoint sq }
           | let
-              cp1, cp2, q :: Point2D r
+              cp1, cp2, q :: ℝ 2
               cp1 = view typed scp1
               cp2 = view typed scp2
               q   = view typed sq
@@ -122,19 +122,17 @@ splineTangents spline@( Spline { splineStart = sp0, splineCurves = curves } )
 -- Returns the proportion of the angle the vector is in between, or @Nothing@ if the query vector
 -- is not in between.
 --
--- >>> between CCW ( Vector2D 1 0 ) ( Vector2D -1 1 ) ( Vector2D 1 1 )
+-- >>> between CCW ( V2 1 0 ) ( V2 -1 1 ) ( V2 1 1 )
 -- Just 0.3333333333333333
 between
-  :: forall r
+  :: Orientation
-  .  RealFloat r
+  -> T ( ℝ 2 ) -- ^ start vector
-  => Orientation
+  -> T ( ℝ 2 ) -- ^ end vector
-  -> Vector2D r -- ^ start vector
+  -> T ( ℝ 2 ) -- ^ query vector: is it in between the start and end vectors w.r.t. the provided orientation?
-  -> Vector2D r -- ^ end vector
+  -> Maybe Double
-  -> Vector2D r -- ^ query vector: is it in between the start and end vectors w.r.t. the provided orientation?
+between CCW ( V2 x1 y1 ) ( V2 x2 y2 ) ( V2 a b ) =
-  -> Maybe r
-between CCW ( Vector2D x1 y1 ) ( Vector2D x2 y2 ) ( Vector2D a b ) =
   let
-    τ, η, φ, θ :: r
+    τ, η, φ, θ :: Double
     τ = 2 * pi
     η = atan2 y1 x1
     φ = ( atan2 y2 x2 - η ) `mod'` τ