mirror of
https://gitlab.com/sheaf/metabrush.git
synced 2024-11-05 14:53:37 +00:00
update render & select for new brush manipulation
This commit is contained in:
sheaf
parent
15d50f8d76
commit
5ff935b4b2
|
|
@ -53,7 +53,7 @@
|
|||
color: rgb(184,80,80);
|
||||
}
|
||||
.brush {
|
||||
color: rgb(235,118,219);
|
||||
color: rgb(106,63,222);
|
||||
}
|
||||
.brushStroke {
|
||||
color: rgba(235,118,219,0.66);
|
||||
|
|
|
|||
|
|
@ -5,7 +5,7 @@ constraints:
|
|||
|
||||
allow-newer:
|
||||
waargonaut:*,
|
||||
*:haskell-gi-base, *:haskell-gi,
|
||||
*:haskell-gi-base, *:haskell-gi
|
||||
|
||||
-- various fixes for 'hmatrix'
|
||||
source-repository-package
|
||||
|
|
|
|||
|
|
@ -3,8 +3,7 @@
|
|||
|
||||
On Windows, we need to install an up-to-date MinGW/MSYS2 toolchain,
|
||||
together with the packages required by the `haskell-gi` libraries (for `GTK`),
|
||||
as well as the `hmatrix` library.
|
||||
|
||||
the `hmatrix` library, as well as `flint` and `msolve`.
|
||||
|
||||
With an `MSYS2` installation, the following environment variables will need to be set (with `MSYS2` installed at `C:\msys64`):
|
||||
|
||||
|
|
@ -16,9 +15,22 @@ With an `MSYS2` installation, the following environment variables will need to b
|
|||
Then we install some necessary packages using the following command:
|
||||
|
||||
```bash
|
||||
pacman -S -q --noconfirm mingw64/mingw-w64-x86_64-pkg-config mingw64/mingw-w64-x86_64-gobject-introspection mingw64/mingw-w64-x86_64-gtksourceview3 mingw64/mingw-w64-x86_64-openblas
|
||||
pacman -S -q --noconfirm mingw64/mingw-w64-x86_64-pkg-config mingw64/mingw-w64-x86_64-gobject-introspection mingw64/mingw-w64-x86_64-openblas
|
||||
```
|
||||
|
||||
Next, `flint`, which `msolve` depends on.
|
||||
|
||||
Build `flint` by downloading it and running the configure script. On Windows (MINGW64):
|
||||
|
||||
```bash
|
||||
./configure ABI=64 --build=${MINGW_CHOST} --prefix=${MINGW_PREFIX} --enable-static --disable-shared --with-gmp=${MINGW_PREFIX} --with-mpfr=${MINGW_PREFIX}
|
||||
make && make install
|
||||
```
|
||||
|
||||
`flint` needs `gmp`, `mpfr`, but these should already be present.
|
||||
|
||||
For `msolve`, the default installation directions (`./autogen.sh`, `./configure`, `make && make install`) seem to work (without having to set any additional options), as of `msolve` version `0.1.3`.
|
||||
|
||||
## Possible errors
|
||||
|
||||
### pkg-config could not be found
|
||||
|
|
|
|||
|
|
@ -103,7 +103,7 @@ import Math.Bezier.Spline
|
|||
import Math.Bezier.Stroke
|
||||
( CachedStroke(..), invalidateCache )
|
||||
import Math.Module
|
||||
( Module((*^)) )
|
||||
( Module((*^)), quadrance )
|
||||
import Math.Vector2D
|
||||
( Point2D(..), Vector2D(..) )
|
||||
import MetaBrush.Context
|
||||
|
|
@ -722,7 +722,13 @@ data MouseClickType
|
|||
| DoubleClick
|
||||
deriving stock Show
|
||||
|
||||
data MouseClick = MouseClick !ActionOrigin !MouseClickType !Word32 !( Point2D Double )
|
||||
data MouseClick =
|
||||
MouseClick
|
||||
{ clickOrigin :: !ActionOrigin
|
||||
, clickType :: !MouseClickType
|
||||
, clickButton :: !Word32
|
||||
, clickCoords :: !( Point2D Double )
|
||||
}
|
||||
deriving stock Show
|
||||
|
||||
instance HandleAction MouseClick where
|
||||
|
|
@ -744,9 +750,6 @@ instance HandleAction MouseClick where
|
|||
pos = toViewport mouseClickCoords
|
||||
STM.writeTVar mousePosTVar ( Just pos )
|
||||
mode <- STM.readTVar modeTVar
|
||||
case mode of
|
||||
BrushMode -> pure Don'tModifyDoc -- TODO: brush parameter modification UI
|
||||
_ ->
|
||||
case actionOrigin of
|
||||
|
||||
ViewportOrigin -> case ty of
|
||||
|
|
@ -766,7 +769,8 @@ instance HandleAction MouseClick where
|
|||
case selectionMode modifiers of
|
||||
-- Drag move: not holding shift or alt, click has selected something.
|
||||
New
|
||||
| Just ( dragMove, newDoc ) <- dragMoveSelect pos doc
|
||||
| PathMode <- mode
|
||||
, Just ( dragMove, newDoc ) <- dragMoveSelect pos doc
|
||||
-> do
|
||||
STM.writeTVar mouseHoldTVar ( Just $ DragMoveHold pos dragMove )
|
||||
case dragMove of
|
||||
|
|
@ -782,7 +786,7 @@ instance HandleAction MouseClick where
|
|||
pure Don'tModifyDoc
|
||||
|
||||
-- Pen tool: start or continue a drawing operation.
|
||||
Pen -> do
|
||||
Pen | PathMode <- mode -> do
|
||||
mbPartialPath <- STM.readTVar partialPathTVar
|
||||
STM.writeTVar mouseHoldTVar ( Just $ DrawHold pos )
|
||||
case mbPartialPath of
|
||||
|
|
@ -811,6 +815,8 @@ instance HandleAction MouseClick where
|
|||
STM.writeTVar partialPathTVar ( Just $ pp { firstPoint = False } )
|
||||
pure Don'tModifyDoc
|
||||
|
||||
_ -> pure Don'tModifyDoc
|
||||
|
||||
DoubleClick -> do
|
||||
tool <- STM.readTVar toolTVar
|
||||
modifs <- STM.readTVar modifiersTVar
|
||||
|
|
@ -940,9 +946,6 @@ instance HandleAction MouseRelease where
|
|||
_ -> do
|
||||
tool <- STM.readTVar toolTVar
|
||||
mode <- STM.readTVar modeTVar
|
||||
case mode of
|
||||
BrushMode -> pure Don'tModifyDoc -- TODO: brush parameter modification UI
|
||||
_ ->
|
||||
case tool of
|
||||
|
||||
Selection -> do
|
||||
|
|
@ -951,8 +954,9 @@ instance HandleAction MouseRelease where
|
|||
selMode = selectionMode modifiers
|
||||
case mbHoldPos of
|
||||
Just hold
|
||||
| DragMoveHold { holdStartPos = pos0, dragAction } <- hold
|
||||
, pos0 /= pos
|
||||
| PathMode <- mode
|
||||
, DragMoveHold { holdStartPos = pos0, dragAction } <- hold
|
||||
, quadrance @( Vector2D Double ) pos0 pos * zoomFactor ^ ( 2 :: Int ) >= 16
|
||||
-> let
|
||||
alternateMode :: Bool
|
||||
alternateMode = any ( \case { Alt _ -> True; _ -> False } ) modifiers
|
||||
|
|
@ -960,10 +964,13 @@ 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
|
||||
-> pure ( UpdateDoc . UpdateDocumentTo . TrivialChange $ selectRectangle selMode pos0 pos doc )
|
||||
_ -> pure ( UpdateDoc . UpdateDocumentTo . TrivialChange $ selectAt selMode pos doc )
|
||||
|
||||
Pen -> do
|
||||
Pen
|
||||
| PathMode <- mode
|
||||
-> do
|
||||
mbPartialPath <- STM.readTVar partialPathTVar
|
||||
case mbPartialPath of
|
||||
-- Normal pen mode mouse click should have created an anchor.
|
||||
|
|
@ -1046,6 +1053,8 @@ instance HandleAction MouseRelease where
|
|||
changeText = "Continue stroke"
|
||||
pure ( UpdateDoc . UpdateDocumentTo $ HistoryChange {..} )
|
||||
|
||||
_ -> pure Don'tModifyDoc
|
||||
|
||||
-- Other mouse buttons: ignored (for the moment at least).
|
||||
_ -> pure ()
|
||||
|
||||
|
|
|
|||
|
|
@ -116,7 +116,13 @@ data ActionOrigin
|
|||
data MouseClickType
|
||||
= SingleClick
|
||||
| DoubleClick
|
||||
data MouseClick = MouseClick !ActionOrigin !MouseClickType !Word32 !( Point2D Double )
|
||||
data MouseClick =
|
||||
MouseClick
|
||||
{ clickOrigin :: !ActionOrigin
|
||||
, clickType :: !MouseClickType
|
||||
, clickButton :: !Word32
|
||||
, clickCoords :: !( Point2D Double )
|
||||
}
|
||||
instance HandleAction MouseClick
|
||||
|
||||
data MouseRelease = MouseRelease !Word32 !( Point2D Double )
|
||||
|
|
|
|||
|
|
@ -177,8 +177,7 @@ selectAt selMode c doc@( Document { zoomFactor } ) =
|
|||
. ( KnownSplineType clo )
|
||||
=> StrokeSpline clo brushParams -> State Bool ( StrokeSpline clo brushParams )
|
||||
updateSpline oldSpline =
|
||||
bitraverseSpline
|
||||
( const pure )
|
||||
traverse
|
||||
( updateSplinePoint strokeVisible )
|
||||
oldSpline
|
||||
|
||||
|
|
|
|||
|
|
@ -159,6 +159,11 @@ compositeRenders = sequenceA_
|
|||
toAll :: Cairo.Render () -> Compose Renders Cairo.Render ()
|
||||
toAll action = Compose ( pure action )
|
||||
|
||||
data RenderMode
|
||||
= RenderingPath
|
||||
| RenderingBrush
|
||||
deriving stock ( Show, Eq )
|
||||
|
||||
--------------------------------------------------------------------------------
|
||||
|
||||
blankRender :: Colours -> Cairo.Render ()
|
||||
|
|
@ -251,7 +256,7 @@ getDocumentRender
|
|||
Cairo.scale zoomFactor zoomFactor
|
||||
Cairo.translate ( -cx ) ( -cy )
|
||||
for_ strokesRenderData
|
||||
( compositeRenders . getCompose . renderStroke cols mbHoverContext mode debug zoomFactor )
|
||||
( compositeRenders . getCompose . renderStroke cols mbHoverContext mode RenderingPath debug zoomFactor )
|
||||
renderSelectionRect
|
||||
Cairo.restore
|
||||
|
||||
|
|
@ -327,16 +332,16 @@ strokeRenderData fitParams
|
|||
= Nothing
|
||||
|
||||
renderStroke
|
||||
:: Colours -> Maybe HoverContext -> Mode -> Bool -> Double
|
||||
:: Colours -> Maybe HoverContext -> Mode -> RenderMode -> Bool -> Double
|
||||
-> StrokeRenderData
|
||||
-> Compose Renders Cairo.Render ()
|
||||
renderStroke cols@( Colours { brush } ) mbHoverContext mode debug zoom = \case
|
||||
renderStroke cols@( Colours { brush } ) mbHoverContext mode rdrMode debug zoom = \case
|
||||
StrokeRenderData { strokeDataSpline } ->
|
||||
renderStrokeSpline cols mode mbHoverContext zoom ( const ( pure () ) ) strokeDataSpline
|
||||
renderStrokeSpline cols mode rdrMode mbHoverContext zoom ( const ( pure () ) ) strokeDataSpline
|
||||
StrokeWithOutlineRenderData strokeDataSpline strokeOutlineData strokeBrushFunction ->
|
||||
renderStrokeSpline cols mode mbHoverContext zoom
|
||||
renderStrokeSpline cols mode rdrMode mbHoverContext zoom
|
||||
( when ( mode == BrushMode )
|
||||
. renderBrushShape ( cols { path = brush } ) mbHoverContext ( 1.5 * zoom ) strokeBrushFunction
|
||||
. renderBrushShape ( cols { path = brush } ) mbHoverContext ( 2 * zoom ) strokeBrushFunction
|
||||
)
|
||||
strokeDataSpline
|
||||
*> Compose blank { renderStrokes = drawOutline cols debug zoom strokeOutlineData }
|
||||
|
|
@ -348,17 +353,21 @@ renderStroke cols@( Colours { brush } ) mbHoverContext mode debug zoom = \case
|
|||
renderStrokeSpline
|
||||
:: forall clo crvData pointData
|
||||
. ( Show pointData, KnownSplineType clo )
|
||||
=> Colours -> Mode -> Maybe HoverContext -> Double
|
||||
=> Colours -> Mode -> RenderMode -> Maybe HoverContext -> Double
|
||||
-> ( PointData pointData -> Compose Renders Cairo.Render () )
|
||||
-> Spline clo crvData ( PointData pointData )
|
||||
-> Compose Renders Cairo.Render ()
|
||||
renderStrokeSpline cols mode mbHover zoom renderSubcontent spline =
|
||||
renderStrokeSpline cols mode rdrMode mbHover zoom renderSubcontent spline =
|
||||
bifoldSpline ( renderSplineCurve ( splineStart spline ) ) renderSplinePoint spline
|
||||
|
||||
where
|
||||
renderSplinePoint :: PointData pointData -> Compose Renders Cairo.Render ()
|
||||
renderSplinePoint sp0
|
||||
= Compose blank { renderPPts = when ( mode == PathMode ) $ drawPoint cols mbHover zoom PathPoint sp0 }
|
||||
= Compose blank
|
||||
{ renderPPts =
|
||||
when ( rdrMode == RenderingPath ) do
|
||||
drawPoint cols mbHover zoom PathPoint sp0
|
||||
}
|
||||
*> renderSubcontent sp0
|
||||
renderSplineCurve
|
||||
:: forall clo'
|
||||
|
|
@ -366,8 +375,7 @@ renderStrokeSpline cols mode mbHover zoom renderSubcontent spline =
|
|||
=> PointData pointData -> PointData pointData -> Curve clo' crvData ( PointData pointData ) -> Compose Renders Cairo.Render ()
|
||||
renderSplineCurve start p0 ( LineTo np1 _ )
|
||||
= Compose blank
|
||||
{ renderPPts =
|
||||
when ( mode == PathMode ) $
|
||||
{ renderPPts = when ( rdrMode == RenderingPath ) do
|
||||
for_ np1 \ p1 ->
|
||||
drawPoint cols mbHover zoom PathPoint p1
|
||||
, renderPath =
|
||||
|
|
@ -378,36 +386,39 @@ renderStrokeSpline cols mode mbHover zoom renderSubcontent spline =
|
|||
renderSplineCurve start p0 ( Bezier2To p1 np2 _ )
|
||||
= Compose blank
|
||||
{ renderCLines
|
||||
= when ( mode == PathMode ) do
|
||||
= when ( rdrMode == RenderingPath ) do
|
||||
drawLine cols zoom ControlPoint p0 p1
|
||||
drawLine cols zoom ControlPoint p1 ( fromNextPoint start np2 )
|
||||
, renderCPts
|
||||
= when ( mode == PathMode ) $ drawPoint cols mbHover zoom ControlPoint p1
|
||||
= when ( rdrMode == RenderingPath ) do
|
||||
drawPoint cols mbHover zoom ControlPoint p1
|
||||
, renderPPts
|
||||
= when ( mode == PathMode ) $
|
||||
= when ( rdrMode == RenderingPath ) do
|
||||
for_ np2 \ p2 ->
|
||||
drawPoint cols mbHover zoom PathPoint p2
|
||||
, renderPath
|
||||
= unless ( mode == MetaMode ) $ drawQuadraticBezier cols zoom ( coords <$> Quadratic.Bezier { p0, p1, p2 = fromNextPoint start np2 } )
|
||||
= unless ( mode == MetaMode ) do
|
||||
drawQuadraticBezier cols zoom ( coords <$> Quadratic.Bezier { p0, p1, p2 = fromNextPoint start np2 } )
|
||||
}
|
||||
*> renderSubcontent p1
|
||||
*> for_ np2 \ p2 -> renderSubcontent p2
|
||||
renderSplineCurve start p0 ( Bezier3To p1 p2 np3 _ )
|
||||
= Compose blank
|
||||
{ renderCLines
|
||||
= when ( mode == PathMode ) do
|
||||
= when ( rdrMode == RenderingPath ) do
|
||||
drawLine cols zoom ControlPoint p0 p1
|
||||
drawLine cols zoom ControlPoint p2 ( fromNextPoint start np3 )
|
||||
, renderCPts
|
||||
= when ( mode == PathMode ) do
|
||||
= when ( rdrMode == RenderingPath ) do
|
||||
drawPoint cols mbHover zoom ControlPoint p1
|
||||
drawPoint cols mbHover zoom ControlPoint p2
|
||||
, renderPPts
|
||||
= when ( mode == PathMode ) $
|
||||
= when ( rdrMode == RenderingPath ) do
|
||||
for_ np3 \ p3 ->
|
||||
drawPoint cols mbHover zoom PathPoint p3
|
||||
, renderPath
|
||||
= unless ( mode == MetaMode ) $ drawCubicBezier cols zoom ( coords <$> Cubic.Bezier { p0, p1, p2, p3 = fromNextPoint start np3 } )
|
||||
= unless ( mode == MetaMode ) do
|
||||
drawCubicBezier cols zoom ( coords <$> Cubic.Bezier { p0, p1, p2, p3 = fromNextPoint start np3 } )
|
||||
}
|
||||
*> renderSubcontent p1
|
||||
*> renderSubcontent p2
|
||||
|
|
@ -430,9 +441,8 @@ renderBrushShape cols mbHoverContext zoom brushFn pt =
|
|||
toAll do
|
||||
Cairo.save
|
||||
Cairo.translate x y
|
||||
*> renderStrokeSpline cols PathMode mbHoverContext' zoom ( const $ pure () )
|
||||
*> renderStrokeSpline cols BrushMode RenderingBrush mbHoverContext' zoom ( const $ pure () )
|
||||
( fmap ( \ p -> PointData p Normal () ) brushPts )
|
||||
*> Compose blank { renderPPts = drawCross cols zoom }
|
||||
*> toAll Cairo.restore
|
||||
|
||||
drawPoint :: Colours -> Maybe HoverContext -> Double -> PointType -> PointData brushData -> Cairo.Render ()
|
||||
|
|
@ -659,6 +669,7 @@ drawSelectionRectangle ( Colours {..} ) zoom ( Point2D x0 y0 ) ( Point2D x1 y1 )
|
|||
|
||||
Cairo.restore
|
||||
|
||||
{-
|
||||
drawCross :: Colours -> Double -> Cairo.Render ()
|
||||
drawCross ( Colours {..} ) zoom = do
|
||||
Cairo.save
|
||||
|
|
@ -677,7 +688,7 @@ drawCross ( Colours {..} ) zoom = do
|
|||
Cairo.stroke
|
||||
|
||||
Cairo.restore
|
||||
|
||||
-}
|
||||
|
||||
hsl2rgb :: Double -> Double -> Double -> ( Double, Double, Double )
|
||||
hsl2rgb h s l = case hc2rgb h c of
|
||||
|
|
|
|||
|
|
@ -1,3 +1,7 @@
|
|||
{-# LANGUAGE DataKinds #-}
|
||||
{-# LANGUAGE DerivingStrategies #-}
|
||||
{-# LANGUAGE NamedFieldPuns #-}
|
||||
{-# LANGUAGE PartialTypeSignatures #-}
|
||||
{-# LANGUAGE ScopedTypeVariables #-}
|
||||
{-# LANGUAGE TypeApplications #-}
|
||||
|
||||
|
|
@ -29,6 +33,163 @@ import Math.Vector2D
|
|||
|
||||
--------------------------------------------------------------------------------
|
||||
|
||||
{-
|
||||
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.Vector2D 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.
|
||||
--
|
||||
|
|
|
|||
|
|
@ -483,7 +483,7 @@ outlineFunctions ptParams brushFn sp0 crv =
|
|||
-> ( brush3, Cubic.bezier @( Vector2D Double ) bez, Cubic.bezier' bez )
|
||||
fwd, bwd :: Double -> ( Point2D Double, Vector2D Double )
|
||||
fwd t
|
||||
= ( offset ( withTangent ( fwd' t ) ( brush t ) ) • f t
|
||||
= ( off t --offset ( withTangent ( fwd' t ) ( brush t ) ) • f t
|
||||
, fwd' t
|
||||
)
|
||||
where
|
||||
|
|
@ -502,7 +502,7 @@ outlineFunctions ptParams brushFn sp0 crv =
|
|||
| otherwise
|
||||
= offTgt u
|
||||
bwd t
|
||||
= ( offset ( withTangent ( (-1) *^ bwd' s ) ( brush s ) ) • f s
|
||||
= ( off s --offset ( withTangent ( (-1) *^ bwd' s ) ( brush s ) ) • f s
|
||||
, bwd' s
|
||||
)
|
||||
where
|
||||
|
|
|
|||
Loading…
Reference in a new issue