mirror of
https://gitlab.com/sheaf/metabrush.git
synced 2024-11-23 15:34:06 +00:00
add parallelism for brush outline computation
* also enable varying the fitting parameters (UI todo)
This commit is contained in:
parent
44c41d49e0
commit
a459467ed0
|
@ -76,10 +76,14 @@ library
|
|||
, Math.Vector2D
|
||||
|
||||
build-depends:
|
||||
groups-generic
|
||||
deepseq
|
||||
^>= 1.4.4.0
|
||||
, groups-generic
|
||||
^>= 0.1.0.0
|
||||
, hmatrix
|
||||
^>= 0.20.0.0
|
||||
, monad-par
|
||||
^>= 0.3.5
|
||||
, vector
|
||||
^>= 0.12.1.2
|
||||
|
||||
|
|
28
app/Main.hs
28
app/Main.hs
|
@ -20,6 +20,8 @@ import Data.Int
|
|||
( Int32 )
|
||||
import System.Exit
|
||||
( exitSuccess )
|
||||
import GHC.Conc
|
||||
( getNumProcessors, setNumCapabilities )
|
||||
|
||||
-- containers
|
||||
import Data.Map.Strict
|
||||
|
@ -60,6 +62,8 @@ import qualified Data.Text as Text
|
|||
( pack )
|
||||
|
||||
-- MetaBrush
|
||||
import Math.Bezier.Cubic.Fit
|
||||
( FitParameters(..) )
|
||||
import Math.Bezier.Stroke
|
||||
( StrokePoint(..) )
|
||||
import Math.Vector2D
|
||||
|
@ -169,6 +173,18 @@ testDocuments = uniqueMapFromList
|
|||
main :: IO ()
|
||||
main = do
|
||||
|
||||
procs <- getNumProcessors
|
||||
let
|
||||
caps :: Int
|
||||
caps
|
||||
| procs >= 6
|
||||
= procs - 2
|
||||
| procs >= 2
|
||||
= procs - 1
|
||||
| otherwise
|
||||
= procs
|
||||
setNumCapabilities caps
|
||||
|
||||
---------------------------------------------------------
|
||||
-- Initialise state
|
||||
|
||||
|
@ -183,6 +199,15 @@ main = do
|
|||
partialPathTVar <- STM.newTVarIO @( Maybe PartialPath ) Nothing
|
||||
fileBarTabsTVar <- STM.newTVarIO @( Map Unique GTK.Box ) Map.empty
|
||||
showGuidesTVar <- STM.newTVarIO @Bool True
|
||||
fitParametersTVar <- STM.newTVarIO @FitParameters
|
||||
( FitParameters
|
||||
{ maxSubdiv = 2
|
||||
, nbSegments = 13
|
||||
, dist_tol = 2e-3
|
||||
, t_tol = 5e-4
|
||||
, maxIters = 500
|
||||
}
|
||||
)
|
||||
|
||||
-- Put all these stateful variables in a record for conciseness.
|
||||
let
|
||||
|
@ -300,9 +325,10 @@ main = do
|
|||
mbPartialPath <- STM.readTVar partialPathTVar
|
||||
mode <- STM.readTVar modeTVar
|
||||
showGuides <- STM.readTVar showGuidesTVar
|
||||
fitParameters <- STM.readTVar fitParametersTVar
|
||||
pure do
|
||||
renderDocument
|
||||
colours mode ( viewportWidth, viewportHeight )
|
||||
colours fitParameters mode ( viewportWidth, viewportHeight )
|
||||
mbMousePos mbHoldAction mbPartialPath
|
||||
doc
|
||||
renderRuler
|
||||
|
|
|
@ -62,6 +62,8 @@ import Control.Monad.Trans.Maybe
|
|||
( MaybeT(..) )
|
||||
|
||||
-- MetaBrush
|
||||
import Math.Bezier.Cubic.Fit
|
||||
( FitParameters )
|
||||
import Math.Vector2D
|
||||
( Point2D )
|
||||
import MetaBrush.Asset.Colours
|
||||
|
@ -112,6 +114,7 @@ data Variables
|
|||
, partialPathTVar :: !( STM.TVar ( Maybe PartialPath ) )
|
||||
, fileBarTabsTVar :: !( STM.TVar ( Map Unique GTK.Box ) )
|
||||
, showGuidesTVar :: !( STM.TVar Bool )
|
||||
, fitParametersTVar :: !( STM.TVar FitParameters )
|
||||
}
|
||||
|
||||
--------------------------------------------------------------------------------
|
||||
|
|
|
@ -61,6 +61,8 @@ import Control.Lens
|
|||
-- MetaBrush
|
||||
import qualified Math.Bezier.Cubic as Cubic
|
||||
( Bezier(..) )
|
||||
import Math.Bezier.Cubic.Fit
|
||||
( FitParameters )
|
||||
import qualified Math.Bezier.Quadratic as Quadratic
|
||||
( Bezier(..) )
|
||||
import Math.Bezier.Stroke
|
||||
|
@ -110,12 +112,12 @@ blankRender :: Colours -> Cairo.Render ()
|
|||
blankRender ( Colours {..} ) = pure ()
|
||||
|
||||
renderDocument
|
||||
:: Colours -> Mode -> ( Int32, Int32 )
|
||||
:: Colours -> FitParameters -> Mode -> ( Int32, Int32 )
|
||||
-> Maybe ( Point2D Double ) -> Maybe HoldAction -> Maybe PartialPath
|
||||
-> Document
|
||||
-> Cairo.Render ()
|
||||
renderDocument
|
||||
cols mode ( viewportWidth, viewportHeight )
|
||||
cols params mode ( viewportWidth, viewportHeight )
|
||||
mbMousePos mbHoldEvent mbPartialPath
|
||||
doc@( Document { viewportCenter = Point2D cx cy, zoomFactor } )
|
||||
= do
|
||||
|
@ -171,20 +173,20 @@ renderDocument
|
|||
| otherwise
|
||||
= strokes doc
|
||||
|
||||
for_ modifiedStrokes ( compositeRenders . getCompose . renderStroke cols mode zoomFactor )
|
||||
for_ modifiedStrokes ( compositeRenders . getCompose . renderStroke cols params mode zoomFactor )
|
||||
renderSelectionRect
|
||||
|
||||
Cairo.restore
|
||||
|
||||
pure ()
|
||||
|
||||
renderStroke :: Colours -> Mode -> Double -> Stroke -> Compose Renders Cairo.Render ()
|
||||
renderStroke cols@( Colours { brush } ) mode zoom ( Stroke { strokePoints = pts, strokeVisible } )
|
||||
renderStroke :: Colours -> FitParameters -> Mode -> Double -> Stroke -> Compose Renders Cairo.Render ()
|
||||
renderStroke cols@( Colours { brush } ) params mode zoom ( Stroke { strokePoints = pts, strokeVisible } )
|
||||
| strokeVisible
|
||||
= renderStrokePoints cols mode zoom
|
||||
( when ( mode == Brush ) . renderBrushShape ( cols { path = brush } ) ( 1.5 * zoom ) )
|
||||
pts
|
||||
*> Compose blank { renderStrokes = drawStroke cols ( stroke pts ) }
|
||||
*> Compose blank { renderStrokes = drawStroke cols ( stroke params pts ) }
|
||||
| otherwise
|
||||
= pure ()
|
||||
|
||||
|
|
|
@ -1,4 +1,5 @@
|
|||
{-# LANGUAGE AllowAmbiguousTypes #-}
|
||||
{-# LANGUAGE DeriveAnyClass #-}
|
||||
{-# LANGUAGE DeriveGeneric #-}
|
||||
{-# LANGUAGE DeriveTraversable #-}
|
||||
{-# LANGUAGE DerivingVia #-}
|
||||
|
@ -35,6 +36,10 @@ import Data.Act
|
|||
( (-->) )
|
||||
)
|
||||
|
||||
-- deepseq
|
||||
import Control.DeepSeq
|
||||
( NFData, NFData1 )
|
||||
|
||||
-- generic-data
|
||||
import Generic.Data
|
||||
( GenericProduct(..), Generically1(..) )
|
||||
|
@ -71,6 +76,7 @@ data Bezier p
|
|||
via GenericProduct ( Bezier p )
|
||||
deriving Applicative
|
||||
via Generically1 Bezier
|
||||
deriving anyclass ( NFData, NFData1 )
|
||||
|
||||
deriving via Ap Bezier p
|
||||
instance Act v p => Act v ( Bezier p )
|
||||
|
|
|
@ -1,10 +1,12 @@
|
|||
{-# LANGUAGE BlockArguments #-}
|
||||
{-# LANGUAGE NamedFieldPuns #-}
|
||||
{-# LANGUAGE RecordWildCards #-}
|
||||
{-# LANGUAGE ScopedTypeVariables #-}
|
||||
{-# LANGUAGE TypeApplications #-}
|
||||
|
||||
module Math.Bezier.Cubic.Fit
|
||||
( fitSpline, fitPiece )
|
||||
( FitParameters(..)
|
||||
, fitSpline, fitPiece
|
||||
)
|
||||
where
|
||||
|
||||
-- base
|
||||
|
@ -67,6 +69,16 @@ import Math.Vector2D
|
|||
|
||||
--------------------------------------------------------------------------------
|
||||
|
||||
-- | Parameters to the curve fitting algorithm.
|
||||
data FitParameters
|
||||
= FitParameters
|
||||
{ maxSubdiv :: !Int -- ^ maximum subdivision recursion number
|
||||
, nbSegments :: !Int -- ^ number of segments to split the curve into for fitting,
|
||||
, dist_tol :: !Double -- ^ tolerance for the distance
|
||||
, t_tol :: !Double -- ^ the tolerance for the Bézier parameter (for the fitting process)
|
||||
, maxIters :: !Int -- ^ maximum number of iterations (for the fitting process)
|
||||
}
|
||||
|
||||
-- | Fits a cubic Bézier spline to the given curve \( t \mapsto C(t), 0 \leqslant t \leqslant 1 \),
|
||||
-- assumed to be G1-continuous.
|
||||
--
|
||||
|
@ -79,14 +91,10 @@ import Math.Vector2D
|
|||
-- See 'fitPiece' for more information on the fitting process,
|
||||
-- including the meaning of \( \texttt{t_tol} \) and \( \texttt{maxIters} \).
|
||||
fitSpline
|
||||
:: Int -- ^ \( \texttt{maxSubdiv} \), the maximum subdivision recursion number
|
||||
-> Int -- ^ \( \texttt{nbSegments} \), number of segments to split the curve into for fitting,
|
||||
-> Double -- ^ \( \texttt{dist_tol} \), tolerance for the distance
|
||||
-> Double -- ^ \( \texttt{t_tol} \), the tolerance for the Bézier parameter (for the fitting process)
|
||||
-> Int -- ^ \( \texttt{maxIters} \), maximum number of iterations (for the fitting process)
|
||||
:: FitParameters
|
||||
-> ( Double -> ( Point2D Double, Vector2D Double ) ) -- ^ curve \( t \mapsto ( C(t), C'(t) ) \) to fit
|
||||
-> Seq ( Cubic.Bezier ( Point2D Double ) )
|
||||
fitSpline maxSubdiv nbSegments dist_tol t_tol maxIters = go 0
|
||||
fitSpline ( FitParameters {..} ) = go 0
|
||||
where
|
||||
dt :: Double
|
||||
dt = recip ( fromIntegral nbSegments )
|
||||
|
|
|
@ -1,4 +1,5 @@
|
|||
{-# LANGUAGE AllowAmbiguousTypes #-}
|
||||
{-# LANGUAGE DeriveAnyClass #-}
|
||||
{-# LANGUAGE DeriveGeneric #-}
|
||||
{-# LANGUAGE DeriveTraversable #-}
|
||||
{-# LANGUAGE DerivingVia #-}
|
||||
|
@ -35,6 +36,10 @@ import Data.Act
|
|||
( (-->) )
|
||||
)
|
||||
|
||||
-- deepseq
|
||||
import Control.DeepSeq
|
||||
( NFData, NFData1 )
|
||||
|
||||
-- generic-data
|
||||
import Generic.Data
|
||||
( GenericProduct(..), Generically1(..) )
|
||||
|
@ -69,6 +74,7 @@ data Bezier p
|
|||
via GenericProduct ( Bezier p )
|
||||
deriving Applicative
|
||||
via Generically1 Bezier
|
||||
deriving anyclass ( NFData, NFData1 )
|
||||
|
||||
deriving via Ap Bezier p
|
||||
instance Act v p => Act v ( Bezier p )
|
||||
|
|
|
@ -1,6 +1,7 @@
|
|||
{-# LANGUAGE AllowAmbiguousTypes #-}
|
||||
{-# LANGUAGE BlockArguments #-}
|
||||
{-# LANGUAGE DataKinds #-}
|
||||
{-# LANGUAGE DeriveAnyClass #-}
|
||||
{-# LANGUAGE DeriveGeneric #-}
|
||||
{-# LANGUAGE DerivingStrategies #-}
|
||||
{-# LANGUAGE FlexibleContexts #-}
|
||||
|
@ -47,6 +48,10 @@ import qualified Data.Sequence as Seq
|
|||
, zipWith, zipWith3, zipWith4
|
||||
)
|
||||
|
||||
-- deepseq
|
||||
import Control.DeepSeq
|
||||
( NFData )
|
||||
|
||||
-- generic-lens
|
||||
import Data.Generics.Product.Fields
|
||||
( field, field' )
|
||||
|
@ -55,10 +60,16 @@ import Data.Generics.Product.Typed
|
|||
import Data.GenericLens.Internal
|
||||
( set, over, view )
|
||||
|
||||
-- monad-par
|
||||
import Control.Monad.Par
|
||||
( Par )
|
||||
import qualified Control.Monad.Par as Par
|
||||
( get, runPar, spawn, spawnP )
|
||||
|
||||
-- MetaBrush
|
||||
import qualified Math.Bezier.Cubic as Cubic
|
||||
import Math.Bezier.Cubic.Fit
|
||||
( fitSpline )
|
||||
( FitParameters, fitSpline )
|
||||
import qualified Math.Bezier.Quadratic as Quadratic
|
||||
import Math.Epsilon
|
||||
( epsilon )
|
||||
|
@ -80,7 +91,8 @@ data StrokePoint d
|
|||
{ coords :: !( Point2D Double )
|
||||
, pointData :: d
|
||||
}
|
||||
deriving stock ( Show, Generic )
|
||||
deriving stock ( Show, Generic )
|
||||
deriving anyclass NFData
|
||||
|
||||
instance Act ( Vector2D Double ) ( StrokePoint d ) where
|
||||
(•) v = over ( field' @"coords" ) ( v • )
|
||||
|
@ -98,7 +110,8 @@ data Offset
|
|||
, offset :: !( Vector2D Double )
|
||||
--, curvature :: !Double
|
||||
}
|
||||
deriving stock Show
|
||||
deriving stock ( Show, Generic )
|
||||
deriving anyclass NFData
|
||||
|
||||
--------------------------------------------------------------------------------
|
||||
|
||||
|
@ -107,11 +120,12 @@ stroke
|
|||
. ( Show x, Show d
|
||||
, HasType ( Seq ( StrokePoint x ) ) d
|
||||
)
|
||||
=> Seq ( StrokePoint d )
|
||||
=> FitParameters
|
||||
-> Seq ( StrokePoint d )
|
||||
-> Either ( Seq ( StrokePoint () ) ) ( Seq ( StrokePoint () ), Seq ( StrokePoint () ) )
|
||||
stroke Empty = Left Empty
|
||||
stroke ( spt0 :<| Empty ) = Left . removePointData $ ( Point2D 0 0 --> coords spt0 :: Vector2D Double ) • brushShape @x spt0
|
||||
stroke allPts@( spt0 :<| spt1 :<| spts )
|
||||
stroke _ Empty = Left Empty
|
||||
stroke _ ( spt0 :<| Empty ) = Left . removePointData $ ( Point2D 0 0 --> coords spt0 :: Vector2D Double ) • brushShape @x spt0
|
||||
stroke params allPts@( spt0 :<| spt1 :<| spts )
|
||||
| isClosed
|
||||
= if null ( brushShape @x spt0 )
|
||||
then Right ( Empty, Empty )
|
||||
|
@ -140,7 +154,7 @@ stroke allPts@( spt0 :<| spt1 :<| spts )
|
|||
_ -> False
|
||||
|
||||
fwdPts, bwdPts :: Seq ( StrokePoint () )
|
||||
( fwdPts, bwdPts ) = go spt0 ( spt1 :<| spts )
|
||||
( fwdPts, bwdPts ) = Par.runPar $ go spt0 ( spt1 :<| spts )
|
||||
|
||||
(<~>)
|
||||
:: ( Monoid a, Monoid b )
|
||||
|
@ -151,17 +165,21 @@ stroke allPts@( spt0 :<| spt1 :<| spts )
|
|||
|
||||
-- Connecting paths at a point of discontinuity of the tangent vector direction (G1 discontinuity).
|
||||
-- This happens at corners of the brush path (including endpoints of an open brush path, where the tangent flips direction).
|
||||
joinAndContinue :: Vector2D Double -> StrokePoint d -> Seq ( StrokePoint d ) -> ( Seq ( StrokePoint () ), Seq ( StrokePoint () ) )
|
||||
joinAndContinue :: Vector2D Double -> StrokePoint d -> Seq ( StrokePoint d ) -> Par ( Seq ( StrokePoint () ), Seq ( StrokePoint () ) )
|
||||
joinAndContinue tgt sp0 ( sp1 :<| sps )
|
||||
| tgt' `parallel` tgt
|
||||
= go sp0 ( sp1 :<| sps )
|
||||
| let
|
||||
ptOffset :: Vector2D Double
|
||||
ptOffset = Point2D 0 0 --> coords sp0
|
||||
= ( ptOffset • joinWithBrush ( withTangent tgt brush0 ) ( withTangent tgt' brush0 ) brush0
|
||||
, ptOffset • joinWithBrush ( withTangent ( (-1) *^ tgt' ) brush0 ) ( withTangent ( (-1) *^ tgt ) brush0 ) brush0
|
||||
)
|
||||
<~> go sp0 ( sp1 :<| sps )
|
||||
= do
|
||||
let
|
||||
brushJoin =
|
||||
( ptOffset • joinWithBrush ( withTangent tgt brush0 ) ( withTangent tgt' brush0 ) brush0
|
||||
, ptOffset • joinWithBrush ( withTangent ( (-1) *^ tgt' ) brush0 ) ( withTangent ( (-1) *^ tgt ) brush0 ) brush0
|
||||
)
|
||||
next <- go sp0 ( sp1 :<| sps )
|
||||
pure ( brushJoin <~> next )
|
||||
where
|
||||
tgt' :: Vector2D Double
|
||||
tgt' = coords sp0 --> coords sp1
|
||||
|
@ -170,14 +188,16 @@ stroke allPts@( spt0 :<| spt1 :<| spts )
|
|||
joinAndContinue _ _ Empty
|
||||
-- Closed curve.
|
||||
| isClosed
|
||||
= if parallel tgt_start tgt_end
|
||||
= pure $
|
||||
if parallel tgt_start tgt_end
|
||||
then ( Empty, Empty )
|
||||
else ( startOffset • joinWithBrush ( withTangent tgt_start brush_start ) ( withTangent tgt_end brush_start ) brush_start
|
||||
, startOffset • joinWithBrush ( withTangent ( (-1) *^ tgt_start ) brush_start ) ( withTangent ( (-1) *^ tgt_end ) brush_start ) brush_start
|
||||
)
|
||||
-- Open curve.
|
||||
| otherwise
|
||||
= ( endOffset • joinWithBrush ( withTangent tgt_end brush_end ) ( withTangent ( (-1) *^ tgt_end ) brush_end ) brush_end
|
||||
= pure
|
||||
( endOffset • joinWithBrush ( withTangent tgt_end brush_end ) ( withTangent ( (-1) *^ tgt_end ) brush_end ) brush_end
|
||||
, Empty -- handled separately: see 'startingCap' below
|
||||
)
|
||||
|
||||
|
@ -186,8 +206,8 @@ stroke allPts@( spt0 :<| spt1 :<| spts )
|
|||
startingCap
|
||||
= startOffset • joinWithBrush ( withTangent ( (-1) *^ tgt_start ) brush_start ) ( withTangent tgt_start brush_start ) brush_start
|
||||
|
||||
go :: StrokePoint d -> Seq ( StrokePoint d ) -> ( Seq ( StrokePoint () ), Seq ( StrokePoint () ) )
|
||||
go _ Empty = ( Empty, Empty )
|
||||
go :: StrokePoint d -> Seq ( StrokePoint d ) -> Par ( Seq ( StrokePoint () ), Seq ( StrokePoint () ) )
|
||||
go _ Empty = pure ( Empty, Empty )
|
||||
-- Line.
|
||||
go sp0 ( sp1 :<| sps )
|
||||
| PathPoint {} <- sp1
|
||||
|
@ -213,8 +233,14 @@ stroke allPts@( spt0 :<| spt1 :<| spts )
|
|||
where
|
||||
s :: Double
|
||||
s = 1 - t
|
||||
= ( fitCurve fwd, fitCurve bwd )
|
||||
<~> joinAndContinue tgt sp1 sps
|
||||
= do
|
||||
fwdIVar <- Par.spawnP ( fitCurve fwd )
|
||||
bwdIVar <- Par.spawnP ( fitCurve bwd )
|
||||
nextIVar <- Par.spawn ( joinAndContinue tgt sp1 sps )
|
||||
fwdCurve <- Par.get fwdIVar
|
||||
bwdCurve <- Par.get bwdIVar
|
||||
next <- Par.get nextIVar
|
||||
pure $ ( fwdCurve, bwdCurve ) <~> next
|
||||
-- Quadratic Bézier curve.
|
||||
go sp0 ( sp1 :<| sp2 :<| sps )
|
||||
| ControlPoint {} <- sp1
|
||||
|
@ -245,8 +271,14 @@ stroke allPts@( spt0 :<| spt1 :<| spts )
|
|||
where
|
||||
s :: Double
|
||||
s = 1 - t
|
||||
= ( fitCurve fwd, fitCurve bwd )
|
||||
<~> joinAndContinue tgt2 sp2 sps
|
||||
= do
|
||||
fwdIVar <- Par.spawnP ( fitCurve fwd )
|
||||
bwdIVar <- Par.spawnP ( fitCurve bwd )
|
||||
nextIVar <- Par.spawn ( joinAndContinue tgt2 sp2 sps )
|
||||
fwdCurve <- Par.get fwdIVar
|
||||
bwdCurve <- Par.get bwdIVar
|
||||
next <- Par.get nextIVar
|
||||
pure $ ( fwdCurve, bwdCurve ) <~> next
|
||||
-- Cubic Bézier curve.
|
||||
go sp0 ( sp1 :<| sp2 :<| sp3 :<| sps )
|
||||
| ControlPoint {} <- sp1
|
||||
|
@ -279,10 +311,21 @@ stroke allPts@( spt0 :<| spt1 :<| spts )
|
|||
where
|
||||
s :: Double
|
||||
s = 1 - t
|
||||
= ( fitCurve fwd, fitCurve bwd )
|
||||
<~> joinAndContinue tgt3 sp3 sps
|
||||
= do
|
||||
fwdIVar <- Par.spawnP ( fitCurve fwd )
|
||||
bwdIVar <- Par.spawnP ( fitCurve bwd )
|
||||
nextIVar <- Par.spawn ( joinAndContinue tgt3 sp3 sps )
|
||||
fwdCurve <- Par.get fwdIVar
|
||||
bwdCurve <- Par.get bwdIVar
|
||||
next <- Par.get nextIVar
|
||||
pure $ ( fwdCurve, bwdCurve ) <~> next
|
||||
go p0 ps = error $ "stroke: unrecognised stroke type\n" <> show ( p0 :<| ps )
|
||||
|
||||
fitCurve
|
||||
:: ( Double -> ( Point2D Double, Vector2D Double ) )
|
||||
-> Seq ( StrokePoint () )
|
||||
fitCurve = splinePoints . fitSpline params
|
||||
|
||||
-----------------------------------
|
||||
-- Various utility functions
|
||||
-- used in the "stroke" function.
|
||||
|
@ -336,10 +379,6 @@ cubicBezierBrush t ( Cubic.Bezier p0s p1s p2s p3s ) = Seq.zipWith4 f p0s p1s p2s
|
|||
= CP $ Cubic.bezier @( Vector2D Double ) ( Cubic.Bezier {..} ) t
|
||||
f p1 p2 p3 p4 = error $ "stroke: incompatible brushes " <> show [ p1, p2, p3, p4 ]
|
||||
|
||||
fitCurve
|
||||
:: ( Double -> ( Point2D Double, Vector2D Double ) )
|
||||
-> Seq ( StrokePoint () )
|
||||
fitCurve curve = splinePoints $ fitSpline 1 13 1e-4 1e-5 100 curve
|
||||
|
||||
splinePoints :: Seq ( Cubic.Bezier ( Point2D Double ) ) -> Seq ( StrokePoint () )
|
||||
splinePoints Empty = Empty
|
||||
|
|
|
@ -1,3 +1,4 @@
|
|||
{-# LANGUAGE DeriveAnyClass #-}
|
||||
{-# LANGUAGE DeriveGeneric #-}
|
||||
{-# LANGUAGE DeriveTraversable #-}
|
||||
{-# LANGUAGE DerivingVia #-}
|
||||
|
@ -22,6 +23,10 @@ import GHC.Generics
|
|||
import Data.Act
|
||||
( Act, Torsor )
|
||||
|
||||
-- deepseq
|
||||
import Control.DeepSeq
|
||||
( NFData, NFData1 )
|
||||
|
||||
-- generic-data
|
||||
import Generic.Data
|
||||
( Generically1(..), GenericProduct(..) )
|
||||
|
@ -46,10 +51,11 @@ data Point2D a = Point2D !a !a
|
|||
via Vector2D a
|
||||
deriving Applicative
|
||||
via Generically1 Point2D
|
||||
deriving anyclass ( NFData, NFData1 )
|
||||
|
||||
newtype Vector2D a = MkVector2D { tip :: Point2D a }
|
||||
deriving stock ( Show, Generic, Generic1, Foldable, Traversable )
|
||||
deriving newtype ( Eq, Functor, Applicative )
|
||||
deriving newtype ( Eq, Functor, Applicative, NFData, NFData1 )
|
||||
deriving ( Semigroup, Monoid, Group )
|
||||
via GenericProduct ( Point2D ( Sum a ) )
|
||||
|
||||
|
@ -77,3 +83,4 @@ data Mat22 a
|
|||
deriving stock ( Show, Eq, Generic, Generic1, Functor, Foldable, Traversable )
|
||||
deriving Applicative
|
||||
via Generically1 Mat22
|
||||
deriving anyclass ( NFData, NFData1 )
|
||||
|
|
Loading…
Reference in a new issue