mirror of
https://gitlab.com/sheaf/metabrush.git
synced 2024-11-05 14:53:37 +00:00
add debug mode to visualise fitting algorithm
This commit is contained in:
sheaf
parent
087c29aef3
commit
e3d920573d
18
app/Main.hs
18
app/Main.hs
|
|
@ -207,17 +207,18 @@ main = do
|
|||
modifiersTVar <- STM.newTVarIO @( Set Modifier ) Set.empty
|
||||
toolTVar <- STM.newTVarIO @Tool Selection
|
||||
modeTVar <- STM.newTVarIO @Mode Path
|
||||
debugTVar <- STM.newTVarIO @Bool False
|
||||
partialPathTVar <- STM.newTVarIO @( Maybe PartialPath ) Nothing
|
||||
fileBarTabsTVar <- STM.newTVarIO @( Map Unique ( GTK.Box, GTK.RadioButton ) ) Map.empty
|
||||
showGuidesTVar <- STM.newTVarIO @Bool True
|
||||
maxHistorySizeTVar <- STM.newTVarIO @Int 1000
|
||||
fitParametersTVar <- STM.newTVarIO @FitParameters
|
||||
( FitParameters
|
||||
{ maxSubdiv = 2
|
||||
, nbSegments = 13
|
||||
, dist_tol = 2e-3
|
||||
, t_tol = 5e-4
|
||||
, maxIters = 500
|
||||
{ maxSubdiv = 3
|
||||
, nbSegments = 30
|
||||
, dist_tol = 5e-4
|
||||
, t_tol = 1e-4
|
||||
, maxIters = 100
|
||||
}
|
||||
)
|
||||
|
||||
|
|
@ -243,7 +244,7 @@ main = do
|
|||
GTK.setWindowResizable window True
|
||||
GTK.setWindowDecorated window False
|
||||
GTK.setWindowTitle window "MetaBrush"
|
||||
GTK.windowSetDefaultSize window 800 600
|
||||
GTK.windowSetDefaultSize window 1024 768
|
||||
GTK.widgetAddEvents window
|
||||
[ GDK.EventMaskKeyPressMask, GDK.EventMaskKeyReleaseMask ]
|
||||
|
||||
|
|
@ -336,11 +337,12 @@ main = do
|
|||
mbHoldAction <- STM.readTVar mouseHoldTVar
|
||||
mbPartialPath <- STM.readTVar partialPathTVar
|
||||
mode <- STM.readTVar modeTVar
|
||||
debug <- STM.readTVar debugTVar
|
||||
showGuides <- STM.readTVar showGuidesTVar
|
||||
fitParameters <- STM.readTVar fitParametersTVar
|
||||
pure do
|
||||
renderDocument
|
||||
colours fitParameters mode ( viewportWidth, viewportHeight )
|
||||
colours fitParameters mode debug ( viewportWidth, viewportHeight )
|
||||
mbMousePos mbHoldAction mbPartialPath
|
||||
doc
|
||||
renderRuler
|
||||
|
|
@ -378,7 +380,7 @@ main = do
|
|||
---------------------------------------------------------
|
||||
-- Tool bar
|
||||
|
||||
_ <- createToolBar toolTVar modeTVar colours viewportDrawingArea toolBar
|
||||
_ <- createToolBar variables colours viewportDrawingArea toolBar
|
||||
|
||||
---------------------------------------------------------
|
||||
-- Info bar
|
||||
|
|
|
|||
|
|
@ -78,6 +78,12 @@
|
|||
.tabScrollbar {
|
||||
background-color: rgba(48, 45, 38, 0.66);
|
||||
}
|
||||
.ruler {
|
||||
background-color: rgb(237, 226, 154);
|
||||
min-width: 16px;
|
||||
min-height: 16px;
|
||||
background-size: 16px 16px;
|
||||
}
|
||||
.rulerTick {
|
||||
color: black;
|
||||
}
|
||||
|
|
@ -151,13 +157,6 @@ tooltip {
|
|||
|
||||
|
||||
/* Rulers */
|
||||
.ruler {
|
||||
background-color: rgb(237, 226, 154);
|
||||
min-width: 16px;
|
||||
min-height: 16px;
|
||||
background-size: 16px 16px;
|
||||
}
|
||||
|
||||
.leftRuler {
|
||||
border-right: 1px solid black;
|
||||
min-width: 16px;
|
||||
|
|
@ -435,6 +434,7 @@ tooltip {
|
|||
|
||||
.panel {
|
||||
background-color: rgb(72,70,61);
|
||||
min-height: 20px;
|
||||
}
|
||||
|
||||
/* Info bar */
|
||||
|
|
|
|||
|
|
@ -37,7 +37,7 @@ data ColourRecord a
|
|||
, path, brush, brushStroke, brushCenter
|
||||
, pointHover, pointSelected
|
||||
, viewport, viewportScrollbar, tabScrollbar
|
||||
, guide, rulerTick, magnifier, glass
|
||||
, guide, rulerBg, rulerTick, magnifier, glass
|
||||
, selected, selectedOutline :: !a
|
||||
}
|
||||
deriving stock ( Show, Functor, Foldable, Traversable )
|
||||
|
|
@ -80,6 +80,7 @@ colourNames = Colours
|
|||
, viewport = ColourName "viewport" BackgroundColour [ GTK.StateFlagsNormal ]
|
||||
, viewportScrollbar = ColourName "viewportScrollbar" BackgroundColour [ GTK.StateFlagsNormal ]
|
||||
, tabScrollbar = ColourName "tabScrollbar" BackgroundColour [ GTK.StateFlagsNormal ]
|
||||
, rulerBg = ColourName "ruler" BackgroundColour [ GTK.StateFlagsNormal ]
|
||||
, rulerTick = ColourName "rulerTick" Colour [ GTK.StateFlagsNormal ]
|
||||
, guide = ColourName "guide" Colour [ GTK.StateFlagsNormal ]
|
||||
, magnifier = ColourName "magnifier" Colour [ GTK.StateFlagsNormal ]
|
||||
|
|
|
|||
|
|
@ -2,7 +2,7 @@
|
|||
{-# LANGUAGE RecordWildCards #-}
|
||||
|
||||
module MetaBrush.Asset.Tools
|
||||
( drawBrush, drawMeta, drawPath, drawPen )
|
||||
( drawBrush, drawBug, drawMeta, drawPath, drawPen )
|
||||
where
|
||||
|
||||
-- gi-cairo-render
|
||||
|
|
@ -31,7 +31,7 @@ drawBrush ( Colours { base, splash } ) = do
|
|||
|
||||
Cairo.setLineWidth 1
|
||||
withRGBA base Cairo.setSourceRGBA
|
||||
Cairo.strokePreserve
|
||||
Cairo.stroke
|
||||
|
||||
-- Brush body
|
||||
|
||||
|
|
@ -48,7 +48,7 @@ drawBrush ( Colours { base, splash } ) = do
|
|||
Cairo.closePath
|
||||
|
||||
withRGBA splash Cairo.setSourceRGBA
|
||||
Cairo.fillPreserve
|
||||
Cairo.fill
|
||||
|
||||
-- Brush tip
|
||||
Cairo.newPath
|
||||
|
|
@ -63,7 +63,7 @@ drawBrush ( Colours { base, splash } ) = do
|
|||
Cairo.closePath
|
||||
|
||||
withRGBA base Cairo.setSourceRGBA
|
||||
Cairo.fillPreserve
|
||||
Cairo.fill
|
||||
|
||||
pure True
|
||||
|
||||
|
|
@ -94,7 +94,7 @@ drawMeta ( Colours { splash } ) = do
|
|||
Cairo.closePath
|
||||
|
||||
withRGBA splash Cairo.setSourceRGBA
|
||||
Cairo.fillPreserve
|
||||
Cairo.fill
|
||||
|
||||
pure True
|
||||
|
||||
|
|
@ -204,7 +204,7 @@ drawPen ( Colours { base, splash } ) = do
|
|||
Cairo.curveTo 21.449219 27.46875 21.308594 26.394531 21.308594 26.394531
|
||||
Cairo.curveTo 21.179688 22.230469 24.476563 16.863281 24.476563 16.863281
|
||||
Cairo.closePath
|
||||
Cairo.fillPreserve
|
||||
Cairo.fill
|
||||
|
||||
withRGBA splash Cairo.setSourceRGBA
|
||||
Cairo.newPath
|
||||
|
|
@ -219,6 +219,200 @@ drawPen ( Colours { base, splash } ) = do
|
|||
Cairo.lineTo 26.640625 13.464844
|
||||
Cairo.lineTo 28.875 9.597656
|
||||
Cairo.closePath
|
||||
Cairo.fillPreserve
|
||||
Cairo.fill
|
||||
|
||||
pure True
|
||||
pure True
|
||||
|
||||
|
||||
-- | Bug icon. Width = 40, height = 40.
|
||||
drawBug :: Colours -> Cairo.Render Bool
|
||||
drawBug ( Colours {..} ) = do
|
||||
|
||||
withRGBA splash Cairo.setSourceRGBA
|
||||
|
||||
-- Main butterfly shape (fill).
|
||||
Cairo.newPath
|
||||
Cairo.moveTo 16.996094 23.980469
|
||||
Cairo.curveTo 16.996094 23.980469 16.222656 26.507813 15.796875 28.203125
|
||||
Cairo.curveTo 15.4375 29.644531 15.527344 31.308594 16.335938 32.453125
|
||||
Cairo.curveTo 16.8125 33.128906 17.414063 33.683594 18.234375 33.613281
|
||||
Cairo.curveTo 20.246094 33.441406 23.480469 32.308594 25.085938 31.679688
|
||||
Cairo.curveTo 25.648438 31.457031 26.0625 30.730469 25.542969 29.425781
|
||||
Cairo.curveTo 25.023438 28.117188 23.886719 26.554688 23.886719 26.554688
|
||||
Cairo.curveTo 24.746094 27.292969 25.777344 28.53125 26.8125 28.6875
|
||||
Cairo.curveTo 27.351563 28.769531 29.625 28.847656 30.128906 28.632813
|
||||
Cairo.curveTo 32.265625 27.71875 33.246094 26.621094 34.417969 25.539063
|
||||
Cairo.curveTo 35.289063 24.730469 35.078125 23.976563 34.5625 23.472656
|
||||
Cairo.curveTo 34.511719 23.421875 34.453125 23.371094 34.394531 23.324219
|
||||
Cairo.curveTo 28.414063 18.578125 20.386719 21.746094 20.386719 21.746094
|
||||
Cairo.lineTo 19.09375 20.449219
|
||||
Cairo.curveTo 19.09375 20.449219 22.257813 12.421875 17.511719 6.441406
|
||||
Cairo.curveTo 17.464844 6.382813 17.417969 6.328125 17.363281 6.273438
|
||||
Cairo.curveTo 16.859375 5.761719 16.105469 5.546875 15.296875 6.421875
|
||||
Cairo.curveTo 14.214844 7.589844 13.117188 8.574219 12.207031 10.710938
|
||||
Cairo.curveTo 11.992188 11.210938 12.066406 13.484375 12.148438 14.023438
|
||||
Cairo.curveTo 12.308594 15.058594 13.546875 16.09375 14.28125 16.949219
|
||||
Cairo.curveTo 14.28125 16.949219 12.722656 15.8125 11.410156 15.292969
|
||||
Cairo.curveTo 10.105469 14.777344 9.378906 15.1875 9.160156 15.75
|
||||
Cairo.curveTo 8.53125 17.355469 7.394531 20.589844 7.222656 22.601563
|
||||
Cairo.curveTo 7.152344 23.421875 7.707031 24.027344 8.382813 24.5
|
||||
Cairo.curveTo 9.527344 25.308594 11.191406 25.398438 12.632813 25.039063
|
||||
Cairo.curveTo 14.328125 24.613281 16.855469 23.839844 16.855469 23.839844
|
||||
Cairo.closePath
|
||||
Cairo.fill
|
||||
|
||||
-- Wing highlights.
|
||||
withRGBA viewport Cairo.setSourceRGBA
|
||||
|
||||
Cairo.newPath
|
||||
Cairo.moveTo 14.78125 17.980469
|
||||
Cairo.curveTo 14.78125 17.980469 8.765625 17.734375 8.136719 19.316406
|
||||
Cairo.curveTo 8.488281 17.304688 9.316406 15.464844 9.316406 15.464844
|
||||
Cairo.curveTo 12.179688 14.21875 13.199219 16.65625 14.78125 17.980469
|
||||
Cairo.closePath
|
||||
Cairo.fill
|
||||
|
||||
Cairo.newPath
|
||||
Cairo.moveTo 22.917969 26.117188
|
||||
Cairo.curveTo 22.917969 26.117188 23.164063 32.132813 21.582031 32.761719
|
||||
Cairo.curveTo 23.59375 32.410156 25.433594 31.578125 25.433594 31.578125
|
||||
Cairo.curveTo 26.679688 28.71875 24.238281 27.695313 22.917969 26.117188
|
||||
Cairo.closePath
|
||||
Cairo.moveTo 22.917969 26.117188
|
||||
Cairo.fill
|
||||
|
||||
Cairo.newPath
|
||||
Cairo.moveTo 21.308594 24.167969
|
||||
Cairo.lineTo 19.574219 22.433594
|
||||
Cairo.curveTo 23.222656 20.144531 30.460938 20.058594 34.640625 23.632813
|
||||
Cairo.curveTo 35.484375 24.4375 34.882813 25.175781 34.027344 25.902344
|
||||
Cairo.curveTo 32.550781 23.214844 24.875 20.945313 21.308594 24.167969
|
||||
Cairo.closePath
|
||||
Cairo.moveTo 21.308594 24.167969
|
||||
Cairo.fill
|
||||
|
||||
Cairo.newPath
|
||||
Cairo.moveTo 18.375 33.636719
|
||||
Cairo.lineTo 18.523438 23.6875
|
||||
Cairo.lineTo 17.152344 22.3125
|
||||
Cairo.lineTo 7.199219 22.460938
|
||||
Cairo.curveTo 8.683594 26.9375 13.039063 24.925781 16.988281 23.828125
|
||||
Cairo.curveTo 15.542969 28.855469 15.066406 33.492188 18.375 33.636719
|
||||
Cairo.closePath
|
||||
Cairo.fill
|
||||
|
||||
Cairo.newPath
|
||||
Cairo.moveTo 16.734375 19.59375
|
||||
Cairo.lineTo 18.46875 21.328125
|
||||
Cairo.curveTo 20.757813 17.679688 20.84375 10.441406 17.269531 6.261719
|
||||
Cairo.curveTo 16.464844 5.417969 15.726563 6.019531 15 6.875
|
||||
Cairo.curveTo 17.6875 8.351563 19.957031 16.027344 16.734375 19.59375
|
||||
Cairo.closePath
|
||||
Cairo.fill
|
||||
|
||||
|
||||
-- Inner stroke lines.
|
||||
withRGBA pathPointOutline Cairo.setSourceRGBA
|
||||
Cairo.setLineWidth 0.7
|
||||
Cairo.newPath
|
||||
Cairo.moveTo 33.964844 25.773438
|
||||
Cairo.curveTo 31.613281 23.15625 28.257813 22.132813 23.363281 22.984375
|
||||
Cairo.stroke
|
||||
Cairo.newPath
|
||||
Cairo.moveTo 24.085938 26.734375
|
||||
Cairo.lineTo 21.511719 24.238281
|
||||
Cairo.stroke
|
||||
|
||||
Cairo.newPath
|
||||
Cairo.moveTo 15.0625 6.875
|
||||
Cairo.curveTo 17.679688 9.222656 18.703125 12.582031 17.855469 17.472656
|
||||
Cairo.stroke
|
||||
|
||||
Cairo.newPath
|
||||
Cairo.moveTo 14.101563 16.753906
|
||||
Cairo.lineTo 16.597656 19.324219
|
||||
Cairo.stroke
|
||||
|
||||
-- Main butterfly shape (stroke).
|
||||
Cairo.setLineWidth 1
|
||||
Cairo.newPath
|
||||
Cairo.moveTo 16.996094 23.980469
|
||||
Cairo.curveTo 16.996094 23.980469 16.222656 26.507813 15.796875 28.203125
|
||||
Cairo.curveTo 15.4375 29.644531 15.527344 31.308594 16.335938 32.453125
|
||||
Cairo.curveTo 16.8125 33.128906 17.414063 33.683594 18.234375 33.613281
|
||||
Cairo.curveTo 20.246094 33.441406 23.480469 32.308594 25.085938 31.679688
|
||||
Cairo.curveTo 25.648438 31.457031 26.0625 30.730469 25.542969 29.425781
|
||||
Cairo.curveTo 25.023438 28.117188 23.886719 26.554688 23.886719 26.554688
|
||||
Cairo.curveTo 24.746094 27.292969 25.777344 28.53125 26.8125 28.6875
|
||||
Cairo.curveTo 27.351563 28.769531 29.625 28.847656 30.128906 28.632813
|
||||
Cairo.curveTo 32.265625 27.71875 33.246094 26.621094 34.417969 25.539063
|
||||
Cairo.curveTo 35.289063 24.730469 35.078125 23.976563 34.5625 23.472656
|
||||
Cairo.curveTo 34.511719 23.421875 34.453125 23.371094 34.394531 23.324219
|
||||
Cairo.curveTo 28.414063 18.578125 20.386719 21.746094 20.386719 21.746094
|
||||
Cairo.lineTo 19.09375 20.449219
|
||||
Cairo.curveTo 19.09375 20.449219 22.257813 12.421875 17.511719 6.441406
|
||||
Cairo.curveTo 17.464844 6.382813 17.417969 6.328125 17.363281 6.273438
|
||||
Cairo.curveTo 16.859375 5.761719 16.105469 5.546875 15.296875 6.421875
|
||||
Cairo.curveTo 14.214844 7.589844 13.117188 8.574219 12.207031 10.710938
|
||||
Cairo.curveTo 11.992188 11.210938 12.066406 13.484375 12.148438 14.023438
|
||||
Cairo.curveTo 12.308594 15.058594 13.546875 16.09375 14.28125 16.949219
|
||||
Cairo.curveTo 14.28125 16.949219 12.722656 15.8125 11.410156 15.292969
|
||||
Cairo.curveTo 10.105469 14.777344 9.378906 15.1875 9.160156 15.75
|
||||
Cairo.curveTo 8.53125 17.355469 7.394531 20.589844 7.222656 22.601563
|
||||
Cairo.curveTo 7.152344 23.421875 7.707031 24.027344 8.382813 24.5
|
||||
Cairo.curveTo 9.527344 25.308594 11.191406 25.398438 12.632813 25.039063
|
||||
Cairo.curveTo 14.328125 24.613281 16.855469 23.839844 16.855469 23.839844
|
||||
Cairo.closePath
|
||||
Cairo.stroke
|
||||
|
||||
-- Antennae.
|
||||
withRGBA pathPointOutline Cairo.setSourceRGBA
|
||||
Cairo.newPath
|
||||
Cairo.moveTo 21.863281 18.566406
|
||||
Cairo.curveTo 21.988281 18.363281 25.179688 13.878906 24.394531 9.574219
|
||||
Cairo.curveTo 24.394531 9.558594 24.328125 9.144531 24.050781 8.867188
|
||||
Cairo.curveTo 23.777344 8.59375 23.191406 8.59375 22.898438 8.886719
|
||||
Cairo.curveTo 22.605469 9.179688 22.585938 9.644531 22.863281 9.917969
|
||||
Cairo.curveTo 23.042969 10.097656 23.542969 10.09375 23.554688 10.40625
|
||||
Cairo.curveTo 24.234375 14.113281 21.546875 18.210938 21.519531 18.257813
|
||||
Cairo.curveTo 21.433594 18.398438 21.761719 18.738281 21.863281 18.566406
|
||||
Cairo.closePath
|
||||
Cairo.fillPreserve
|
||||
Cairo.stroke
|
||||
|
||||
Cairo.newPath
|
||||
Cairo.moveTo 22.214844 18.917969
|
||||
Cairo.curveTo 22.417969 18.792969 26.902344 15.601563 31.207031 16.386719
|
||||
Cairo.curveTo 31.222656 16.386719 31.636719 16.453125 31.914063 16.730469
|
||||
Cairo.curveTo 32.1875 17.003906 32.1875 17.589844 31.894531 17.882813
|
||||
Cairo.curveTo 31.601563 18.175781 31.136719 18.191406 30.859375 17.917969
|
||||
Cairo.curveTo 30.683594 17.738281 30.6875 17.238281 30.375 17.226563
|
||||
Cairo.curveTo 26.667969 16.546875 22.570313 19.230469 22.519531 19.261719
|
||||
Cairo.curveTo 22.382813 19.347656 22.042969 19.019531 22.214844 18.917969
|
||||
Cairo.closePath
|
||||
Cairo.fillPreserve
|
||||
Cairo.stroke
|
||||
|
||||
-- Butterfly body & head.
|
||||
withRGBA path Cairo.setSourceRGBA
|
||||
Cairo.newPath
|
||||
Cairo.moveTo 20.351563 22.605469
|
||||
Cairo.curveTo 18.414063 24.546875 14.851563 27.230469 14.3125 26.691406
|
||||
Cairo.curveTo 13.777344 26.152344 16.265625 22.398438 18.207031 20.460938
|
||||
Cairo.curveTo 20.144531 18.519531 20.597656 19.691406 20.894531 19.988281
|
||||
Cairo.curveTo 21.191406 20.289063 22.292969 20.667969 20.351563 22.605469
|
||||
Cairo.closePath
|
||||
Cairo.fillPreserve
|
||||
Cairo.stroke
|
||||
|
||||
Cairo.newPath
|
||||
Cairo.moveTo 22.789063 19.429688
|
||||
Cairo.curveTo 22.789063 18.722656 22.222656 18.148438 21.527344 18.148438
|
||||
Cairo.curveTo 20.832031 18.148438 20.269531 18.722656 20.269531 19.429688
|
||||
Cairo.curveTo 20.269531 20.140625 20.832031 20.714844 21.527344 20.714844
|
||||
Cairo.curveTo 22.222656 20.714844 22.789063 20.140625 22.789063 19.429688
|
||||
Cairo.closePath
|
||||
Cairo.fillPreserve
|
||||
Cairo.stroke
|
||||
|
||||
pure True
|
||||
|
|
|
|||
|
|
@ -45,7 +45,7 @@ import {-# SOURCE #-} MetaBrush.UI.InfoBar
|
|||
( InfoBar )
|
||||
import {-# SOURCE #-} MetaBrush.UI.Menu
|
||||
( Menu, ResourceType(Object) )
|
||||
import MetaBrush.UI.ToolBar
|
||||
import {-# SOURCE #-} MetaBrush.UI.ToolBar
|
||||
( Tool, Mode )
|
||||
import MetaBrush.UI.Viewport
|
||||
( Viewport(..), Ruler(..) )
|
||||
|
|
@ -76,6 +76,7 @@ data Variables
|
|||
, modifiersTVar :: !( STM.TVar ( Set Modifier ) )
|
||||
, toolTVar :: !( STM.TVar Tool )
|
||||
, modeTVar :: !( STM.TVar Mode )
|
||||
, debugTVar :: !( STM.TVar Bool )
|
||||
, partialPathTVar :: !( STM.TVar ( Maybe PartialPath ) )
|
||||
, fileBarTabsTVar :: !( STM.TVar ( Map Unique ( GTK.Box, GTK.RadioButton ) ) )
|
||||
, showGuidesTVar :: !( STM.TVar Bool )
|
||||
|
|
|
|||
|
|
@ -19,8 +19,10 @@ module MetaBrush.Render.Document
|
|||
-- base
|
||||
import Control.Monad
|
||||
( guard, when, unless )
|
||||
import Data.Fixed
|
||||
( mod' )
|
||||
import Data.Foldable
|
||||
( for_, sequenceA_ )
|
||||
( for_, sequenceA_, traverse_ )
|
||||
import Data.Functor.Compose
|
||||
( Compose(..) )
|
||||
import Data.Int
|
||||
|
|
@ -59,11 +61,17 @@ import qualified GI.Cairo.Render as Cairo
|
|||
import Control.Lens
|
||||
( view )
|
||||
|
||||
-- transformers
|
||||
import Control.Monad.Trans.Class
|
||||
( lift )
|
||||
import Control.Monad.Trans.State.Strict
|
||||
( StateT, evalStateT, get, put )
|
||||
|
||||
-- MetaBrush
|
||||
import qualified Math.Bezier.Cubic as Cubic
|
||||
( Bezier(..) )
|
||||
import Math.Bezier.Cubic.Fit
|
||||
( FitParameters )
|
||||
( FitPoint(..), FitParameters )
|
||||
import qualified Math.Bezier.Quadratic as Quadratic
|
||||
( Bezier(..) )
|
||||
import Math.Bezier.Stroke
|
||||
|
|
@ -115,12 +123,12 @@ blankRender :: Colours -> Cairo.Render ()
|
|||
blankRender ( Colours {..} ) = pure ()
|
||||
|
||||
renderDocument
|
||||
:: Colours -> FitParameters -> Mode -> ( Int32, Int32 )
|
||||
:: Colours -> FitParameters -> Mode -> Bool -> ( Int32, Int32 )
|
||||
-> Maybe ( Point2D Double ) -> Maybe HoldAction -> Maybe PartialPath
|
||||
-> Document
|
||||
-> Cairo.Render ()
|
||||
renderDocument
|
||||
cols params mode ( viewportWidth, viewportHeight )
|
||||
cols params mode debug ( viewportWidth, viewportHeight )
|
||||
mbMousePos mbHoldEvent mbPartialPath
|
||||
doc@( Document { viewportCenter = Point2D cx cy, zoomFactor, documentContent = content } )
|
||||
= do
|
||||
|
|
@ -177,20 +185,20 @@ renderDocument
|
|||
| otherwise
|
||||
= strokes content
|
||||
|
||||
for_ modifiedStrokes ( compositeRenders . getCompose . renderStroke cols mbHoverContext params mode zoomFactor )
|
||||
for_ modifiedStrokes ( compositeRenders . getCompose . renderStroke cols mbHoverContext params mode debug zoomFactor )
|
||||
renderSelectionRect
|
||||
|
||||
Cairo.restore
|
||||
|
||||
pure ()
|
||||
|
||||
renderStroke :: Colours -> Maybe HoverContext -> FitParameters -> Mode -> Double -> Stroke -> Compose Renders Cairo.Render ()
|
||||
renderStroke cols@( Colours { brush } ) mbHoverContext params mode zoom ( Stroke { strokePoints = pts, strokeVisible } )
|
||||
renderStroke :: Colours -> Maybe HoverContext -> FitParameters -> Mode -> Bool -> Double -> Stroke -> Compose Renders Cairo.Render ()
|
||||
renderStroke cols@( Colours { brush } ) mbHoverContext params mode debug zoom ( Stroke { strokePoints = pts, strokeVisible } )
|
||||
| strokeVisible
|
||||
= renderStrokePoints cols mode mbHoverContext zoom
|
||||
( when ( mode == Brush ) . renderBrushShape ( cols { path = brush } ) mbHoverContext ( 1.5 * zoom ) )
|
||||
pts
|
||||
*> Compose blank { renderStrokes = drawStroke cols ( stroke params pts ) }
|
||||
*> Compose blank { renderStrokes = drawStroke cols debug zoom ( stroke params pts ) }
|
||||
| otherwise
|
||||
= pure ()
|
||||
|
||||
|
|
@ -418,18 +426,25 @@ drawCubicBezier ( Colours { path } ) zoom
|
|||
|
||||
Cairo.restore
|
||||
|
||||
drawStroke :: Colours -> Either ( Seq ( StrokePoint () ) ) ( Seq ( StrokePoint () ), Seq ( StrokePoint () ) ) -> Cairo.Render ()
|
||||
drawStroke ( Colours { brushStroke } ) strokeData = do
|
||||
drawStroke
|
||||
:: Colours -> Bool -> Double
|
||||
-> ( Either ( Seq ( StrokePoint () ) ) ( Seq ( StrokePoint () ), Seq ( StrokePoint () ) ), Seq FitPoint )
|
||||
-> Cairo.Render ()
|
||||
drawStroke cols@( Colours { brushStroke } ) debug zoom strokeData = do
|
||||
Cairo.save
|
||||
withRGBA brushStroke Cairo.setSourceRGBA
|
||||
Cairo.setLineWidth 3
|
||||
case strokeData of
|
||||
Left outline -> do
|
||||
( Left outline, fitPts ) -> do
|
||||
go outline
|
||||
Right ( fwd, bwd ) -> do
|
||||
Cairo.fill
|
||||
when debug do
|
||||
( `evalStateT` 0 ) $ traverse_ ( drawFitPoint cols zoom ) fitPts
|
||||
( Right ( fwd, bwd ), fitPts ) -> do
|
||||
go fwd
|
||||
go bwd
|
||||
Cairo.fill
|
||||
Cairo.fill
|
||||
when debug do
|
||||
( `evalStateT` 0 ) $ traverse_ ( drawFitPoint cols zoom ) fitPts
|
||||
Cairo.restore
|
||||
|
||||
where
|
||||
|
|
@ -459,6 +474,41 @@ drawStroke ( Colours { brushStroke } ) strokeData = do
|
|||
go' p3 ps
|
||||
go' p0 ps = error $ "drawStroke: unrecognised stroke type\n" <> show ( p0 :<| ps )
|
||||
|
||||
drawFitPoint :: Colours -> Double -> FitPoint -> StateT Double Cairo.Render ()
|
||||
drawFitPoint ( Colours {..} ) zoom ( FitPoint { fitPoint = Point2D x y } ) = do
|
||||
|
||||
hue <- get
|
||||
put ( hue + 0.01 )
|
||||
let
|
||||
r, g, b :: Double
|
||||
( r, g, b ) = hsl2rgb hue 0.9 0.4
|
||||
lift do
|
||||
Cairo.save
|
||||
Cairo.translate x y
|
||||
Cairo.arc 0 0 ( 2 / zoom ) 0 ( 2 * pi )
|
||||
Cairo.setSourceRGBA r g b 1
|
||||
Cairo.fill
|
||||
Cairo.restore
|
||||
|
||||
drawFitPoint ( Colours {..} ) zoom ( FitTangent { fitPoint = Point2D x y, fitTangent = Vector2D tx ty } ) = do
|
||||
|
||||
hue <- get
|
||||
put ( hue + 0.01 )
|
||||
let
|
||||
r, g, b :: Double
|
||||
( r, g, b ) = hsl2rgb hue 0.9 0.4
|
||||
lift do
|
||||
Cairo.save
|
||||
Cairo.translate x y
|
||||
Cairo.moveTo 0 0
|
||||
Cairo.lineTo ( 0.05 * tx ) ( 0.05 * ty )
|
||||
Cairo.setLineWidth ( 1 / zoom )
|
||||
Cairo.setSourceRGBA r g b 1
|
||||
Cairo.stroke
|
||||
Cairo.arc 0 0 ( 2 / zoom ) 0 ( 2 * pi )
|
||||
Cairo.fill
|
||||
Cairo.restore
|
||||
|
||||
drawSelectionRectangle :: Colours -> Double -> Point2D Double -> Point2D Double -> Cairo.Render ()
|
||||
drawSelectionRectangle ( Colours {..} ) zoom ( Point2D x0 y0 ) ( Point2D x1 y1 ) = do
|
||||
|
||||
|
|
@ -497,3 +547,25 @@ drawCross ( Colours {..} ) zoom = do
|
|||
Cairo.stroke
|
||||
|
||||
Cairo.restore
|
||||
|
||||
|
||||
hsl2rgb :: Double -> Double -> Double -> ( Double, Double, Double )
|
||||
hsl2rgb h s l = case hc2rgb h c of
|
||||
( r, g, b ) -> ( r + m, g + m, b + m )
|
||||
where
|
||||
c = ( 1 - abs ( 2 * l - 1 ) ) * s
|
||||
m = l - c / 2
|
||||
|
||||
hc2rgb :: Double -> Double -> ( Double, Double, Double )
|
||||
hc2rgb h c
|
||||
| h' <= 1 = ( c, x, 0 )
|
||||
| h' <= 2 = ( x, c, 0 )
|
||||
| h' <= 3 = ( 0, c, x )
|
||||
| h' <= 4 = ( 0, x, c )
|
||||
| h' <= 5 = ( x, 0, c )
|
||||
| otherwise = ( c, 0, x )
|
||||
where
|
||||
h' = ( h * 6 ) `mod'` 6
|
||||
hTrunc = truncate h' :: Int
|
||||
hMod2 = fromIntegral ( hTrunc `mod` 2 ) + ( h' - fromIntegral hTrunc )
|
||||
x = c * ( 1 - abs ( hMod2 - 1 ) )
|
||||
|
|
|
|||
|
|
@ -41,21 +41,24 @@ createPanelBar panelBox = do
|
|||
strokesPanel <- GTK.boxNew GTK.OrientationVertical 0
|
||||
brushesPanel <- GTK.boxNew GTK.OrientationVertical 0
|
||||
transformPanel <- GTK.boxNew GTK.OrientationVertical 0
|
||||
historyPanel <- GTK.boxNew GTK.OrientationVertical 0
|
||||
|
||||
strokesTab <- GTK.labelNew ( Just "Strokes" )
|
||||
brushesTab <- GTK.labelNew ( Just "Brushes" )
|
||||
transformTab <- GTK.labelNew ( Just "Transform" )
|
||||
historyTab <- GTK.labelNew ( Just "History" )
|
||||
|
||||
for_ [ strokesTab, brushesTab, transformTab ] \ tab -> do
|
||||
for_ [ strokesTab, brushesTab, transformTab, historyTab ] \ tab -> do
|
||||
widgetAddClasses tab [ "plain", "text", "panelTab" ]
|
||||
|
||||
for_ [ strokesPanel, brushesPanel, transformPanel ] \ panel -> do
|
||||
for_ [ strokesPanel, brushesPanel, transformPanel, historyPanel ] \ panel -> do
|
||||
widgetAddClass panel "panel"
|
||||
|
||||
void $ GTK.notebookAppendPage panels1 strokesPanel ( Just strokesTab )
|
||||
void $ GTK.notebookAppendPage panels1 brushesPanel ( Just brushesTab )
|
||||
|
||||
void $ GTK.notebookAppendPage panels2 transformPanel ( Just transformTab )
|
||||
void $ GTK.notebookAppendPage panels2 historyPanel ( Just historyTab )
|
||||
|
||||
GTK.notebookSetTabReorderable panels1 strokesPanel True
|
||||
GTK.notebookSetTabDetachable panels1 strokesPanel True
|
||||
|
|
@ -64,13 +67,17 @@ createPanelBar panelBox = do
|
|||
|
||||
GTK.notebookSetTabReorderable panels2 transformPanel True
|
||||
GTK.notebookSetTabDetachable panels2 transformPanel True
|
||||
GTK.notebookSetTabReorderable panels2 historyPanel True
|
||||
GTK.notebookSetTabDetachable panels2 historyPanel True
|
||||
|
||||
strokesContent <- GTK.labelNew ( Just "Strokes tab content..." )
|
||||
brushesContent <- GTK.labelNew ( Just "Brushes tab content..." )
|
||||
transformContent <- GTK.labelNew ( Just "Transform tab content..." )
|
||||
historyContent <- GTK.labelNew ( Just "History tab content..." )
|
||||
|
||||
GTK.boxPackStart strokesPanel strokesContent True True 0
|
||||
GTK.boxPackStart brushesPanel brushesContent True True 0
|
||||
GTK.boxPackStart transformPanel transformContent True True 0
|
||||
GTK.boxPackStart historyPanel historyContent True True 0
|
||||
|
||||
pure ()
|
||||
|
|
|
|||
|
|
@ -27,7 +27,7 @@ import qualified GI.Gtk as GTK
|
|||
import qualified Control.Concurrent.STM as STM
|
||||
( atomically )
|
||||
import qualified Control.Concurrent.STM.TVar as STM
|
||||
( TVar, writeTVar )
|
||||
( writeTVar )
|
||||
|
||||
-- MetaBrush
|
||||
import MetaBrush.Asset.Colours
|
||||
|
|
@ -35,7 +35,9 @@ import MetaBrush.Asset.Colours
|
|||
import MetaBrush.Asset.Cursor
|
||||
( drawCursorIcon )
|
||||
import MetaBrush.Asset.Tools
|
||||
( drawBrush, drawMeta, drawPath, drawPen )
|
||||
( drawBug, drawBrush, drawMeta, drawPath, drawPen )
|
||||
import MetaBrush.Context
|
||||
( Variables(..) )
|
||||
import MetaBrush.Util
|
||||
( widgetAddClass )
|
||||
|
||||
|
|
@ -54,10 +56,11 @@ data Mode
|
|||
|
||||
data ToolBar
|
||||
= ToolBar
|
||||
{ selectionTool, penTool, pathTool, brushTool, metaTool :: !GTK.RadioButton }
|
||||
{ selectionTool, penTool, pathTool, brushTool, metaTool :: !GTK.RadioButton
|
||||
, debugTool :: !GTK.ToggleButton }
|
||||
|
||||
createToolBar :: STM.TVar Tool -> STM.TVar Mode -> Colours -> GTK.DrawingArea -> GTK.Box -> IO ToolBar
|
||||
createToolBar toolTVar modeTVar colours drawingArea toolBar = do
|
||||
createToolBar :: Variables -> Colours -> GTK.DrawingArea -> GTK.Box -> IO ToolBar
|
||||
createToolBar ( Variables {..} ) colours drawingArea toolBar = do
|
||||
|
||||
widgetAddClass toolBar "toolBar"
|
||||
|
||||
|
|
@ -89,36 +92,53 @@ createToolBar toolTVar modeTVar colours drawingArea toolBar = do
|
|||
GTK.widgetQueueDraw drawingArea
|
||||
|
||||
|
||||
toolSep2 <- GTK.boxNew GTK.OrientationVertical 0
|
||||
|
||||
debugTool <- GTK.toggleButtonNew
|
||||
|
||||
_ <- GTK.onButtonClicked debugTool do
|
||||
clicked <- GTK.toggleButtonGetActive debugTool
|
||||
STM.atomically $ STM.writeTVar debugTVar clicked
|
||||
GTK.widgetQueueDraw drawingArea
|
||||
|
||||
GTK.boxPackStart toolBar selectionTool True True 0
|
||||
GTK.boxPackStart toolBar penTool True True 0
|
||||
GTK.boxPackStart toolBar toolSep1 True True 0
|
||||
GTK.boxPackStart toolBar pathTool True True 0
|
||||
GTK.boxPackStart toolBar brushTool True True 0
|
||||
GTK.boxPackStart toolBar metaTool True True 0
|
||||
GTK.boxPackStart toolBar toolSep2 True True 0
|
||||
GTK.boxPackStart toolBar debugTool True True 0
|
||||
|
||||
for_ [ selectionTool, penTool, pathTool, brushTool, metaTool ] \ tool -> do
|
||||
GTK.toggleButtonSetMode tool False -- don't display radio indicator
|
||||
widgetAddClass tool "toolItem"
|
||||
|
||||
widgetAddClass toolSep1 "toolBarSeparator"
|
||||
widgetAddClass debugTool "toolItem"
|
||||
|
||||
for_ [ toolSep1, toolSep2 ] \ sep -> do
|
||||
widgetAddClass sep "toolBarSeparator"
|
||||
|
||||
GTK.widgetSetTooltipText selectionTool ( Just "Select" )
|
||||
GTK.widgetSetTooltipText penTool ( Just "Draw" )
|
||||
GTK.widgetSetTooltipText pathTool ( Just "Brush path" )
|
||||
GTK.widgetSetTooltipText brushTool ( Just "Brushes" )
|
||||
GTK.widgetSetTooltipText metaTool ( Just "Meta-parameters" )
|
||||
GTK.widgetSetTooltipText debugTool ( Just "Debug mode" )
|
||||
|
||||
selectionToolArea <- GTK.drawingAreaNew
|
||||
penToolArea <- GTK.drawingAreaNew
|
||||
pathToolArea <- GTK.drawingAreaNew
|
||||
brushToolArea <- GTK.drawingAreaNew
|
||||
metaToolArea <- GTK.drawingAreaNew
|
||||
debugToolArea <- GTK.drawingAreaNew
|
||||
|
||||
GTK.containerAdd selectionTool selectionToolArea
|
||||
GTK.containerAdd penTool penToolArea
|
||||
GTK.containerAdd pathTool pathToolArea
|
||||
GTK.containerAdd brushTool brushToolArea
|
||||
GTK.containerAdd metaTool metaToolArea
|
||||
GTK.containerAdd debugTool debugToolArea
|
||||
|
||||
void $ GTK.onWidgetDraw selectionToolArea
|
||||
$ Cairo.renderWithContext
|
||||
|
|
@ -140,4 +160,8 @@ createToolBar toolTVar modeTVar colours drawingArea toolBar = do
|
|||
$ Cairo.renderWithContext
|
||||
( drawMeta colours )
|
||||
|
||||
void $ GTK.onWidgetDraw debugToolArea
|
||||
$ Cairo.renderWithContext
|
||||
( drawBug colours )
|
||||
|
||||
pure ( ToolBar {..} )
|
||||
|
|
|
|||
25
src/app/MetaBrush/UI/ToolBar.hs-boot
Normal file
25
src/app/MetaBrush/UI/ToolBar.hs-boot
Normal file
|
|
@ -0,0 +1,25 @@
|
|||
module MetaBrush.UI.ToolBar
|
||||
( Tool(..), Mode(..)
|
||||
, ToolBar(..)
|
||||
)
|
||||
where
|
||||
|
||||
-- gi-gtk
|
||||
import qualified GI.Gtk as GTK
|
||||
|
||||
--------------------------------------------------------------------------------
|
||||
|
||||
data Tool
|
||||
= Selection
|
||||
| Pen
|
||||
|
||||
data Mode
|
||||
= Path
|
||||
| Brush
|
||||
| Meta
|
||||
|
||||
data ToolBar
|
||||
= ToolBar
|
||||
{ selectionTool, penTool, pathTool, brushTool, metaTool :: !GTK.RadioButton
|
||||
, debugTool :: !GTK.ToggleButton
|
||||
}
|
||||
|
|
@ -1,10 +1,13 @@
|
|||
{-# LANGUAGE BlockArguments #-}
|
||||
{-# LANGUAGE DeriveAnyClass #-}
|
||||
{-# LANGUAGE DeriveGeneric #-}
|
||||
{-# LANGUAGE DerivingStrategies #-}
|
||||
{-# LANGUAGE RecordWildCards #-}
|
||||
{-# LANGUAGE ScopedTypeVariables #-}
|
||||
{-# LANGUAGE TypeApplications #-}
|
||||
|
||||
module Math.Bezier.Cubic.Fit
|
||||
( FitParameters(..)
|
||||
( FitParameters(..), FitPoint(..)
|
||||
, fitSpline, fitPiece
|
||||
)
|
||||
where
|
||||
|
|
@ -24,6 +27,8 @@ import Data.Functor
|
|||
( ($>) )
|
||||
import Data.Semigroup
|
||||
( Arg(..), Max(..), ArgMax )
|
||||
import GHC.Generics
|
||||
( Generic )
|
||||
|
||||
-- acts
|
||||
import Data.Act
|
||||
|
|
@ -33,9 +38,13 @@ import Data.Act
|
|||
|
||||
-- containers
|
||||
import Data.Sequence
|
||||
( Seq )
|
||||
( Seq(..) )
|
||||
import qualified Data.Sequence as Seq
|
||||
( singleton )
|
||||
( fromList, singleton )
|
||||
|
||||
-- deepseq
|
||||
import Control.DeepSeq
|
||||
( NFData )
|
||||
|
||||
-- transformers
|
||||
import Control.Monad.Trans.State.Strict
|
||||
|
|
@ -78,10 +87,23 @@ data FitParameters
|
|||
, t_tol :: !Double -- ^ the tolerance for the Bézier parameter (for the fitting process)
|
||||
, maxIters :: !Int -- ^ maximum number of iterations (for the fitting process)
|
||||
}
|
||||
deriving stock Show
|
||||
|
||||
data FitPoint
|
||||
= FitPoint
|
||||
{ fitPoint :: Point2D Double }
|
||||
| FitTangent
|
||||
{ fitPoint :: Point2D Double
|
||||
, fitTangent :: Vector2D Double
|
||||
}
|
||||
deriving stock ( Show, Generic )
|
||||
deriving anyclass NFData
|
||||
|
||||
-- | Fits a cubic Bézier spline to the given curve \( t \mapsto C(t), 0 \leqslant t \leqslant 1 \),
|
||||
-- assumed to be G1-continuous.
|
||||
--
|
||||
-- Additionally returns the points that were used to perform the fit, for debugging purposes.
|
||||
--
|
||||
-- Subdivides the given curve into the specified number of segments \( \texttt{nbSegments} \),
|
||||
-- and tries to fit the resulting points with a cubic Bézier curve using 'fitPiece'.
|
||||
--
|
||||
|
|
@ -93,7 +115,7 @@ data FitParameters
|
|||
fitSpline
|
||||
:: FitParameters
|
||||
-> ( Double -> ( Point2D Double, Vector2D Double ) ) -- ^ curve \( t \mapsto ( C(t), C'(t) ) \) to fit
|
||||
-> Seq ( Cubic.Bezier ( Point2D Double ) )
|
||||
-> ( Seq ( Cubic.Bezier ( Point2D Double ) ), Seq FitPoint )
|
||||
fitSpline ( FitParameters {..} ) = go 0
|
||||
where
|
||||
dt :: Double
|
||||
|
|
@ -101,7 +123,7 @@ fitSpline ( FitParameters {..} ) = go 0
|
|||
go
|
||||
:: Int
|
||||
-> ( Double -> ( Point2D Double, Vector2D Double ) )
|
||||
-> Seq ( Cubic.Bezier ( Point2D Double ) )
|
||||
-> ( Seq ( Cubic.Bezier ( Point2D Double ) ), Seq FitPoint )
|
||||
go subdiv curve =
|
||||
let
|
||||
p, r :: Point2D Double
|
||||
|
|
@ -115,10 +137,10 @@ fitSpline ( FitParameters {..} ) = go 0
|
|||
( bez, Max ( Arg t_split sq_d ) )
|
||||
| subdiv >= maxSubdiv
|
||||
|| sq_d <= dist_tol ^ ( 2 :: Int )
|
||||
-> Seq.singleton bez
|
||||
-> ( Seq.singleton bez, ( FitTangent p tp :<| Seq.fromList ( map FitPoint qs ) ) :|> FitTangent r tr )
|
||||
| otherwise
|
||||
-> go ( subdiv + 1 ) ( \ t -> curve ( t * t_split ) )
|
||||
<> go ( subdiv + 1 ) ( \ t -> curve ( t_split + t * ( 1 - t_split ) ) )
|
||||
-> go ( subdiv + 1 ) ( \ t -> curve $ t * t_split )
|
||||
<> go ( subdiv + 1 ) ( \ t -> curve $ t_split + t * ( 1 - t_split ) )
|
||||
|
||||
-- | Fits a single cubic Bézier curve to the given data.
|
||||
--
|
||||
|
|
|
|||
|
|
@ -69,7 +69,7 @@ import qualified Control.Monad.Par as Par
|
|||
-- MetaBrush
|
||||
import qualified Math.Bezier.Cubic as Cubic
|
||||
import Math.Bezier.Cubic.Fit
|
||||
( FitParameters, fitSpline )
|
||||
( FitPoint, FitParameters, fitSpline )
|
||||
import qualified Math.Bezier.Quadratic as Quadratic
|
||||
import Math.Epsilon
|
||||
( epsilon )
|
||||
|
|
@ -122,18 +122,18 @@ stroke
|
|||
)
|
||||
=> 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
|
||||
-> ( Either ( Seq ( StrokePoint () ) ) ( Seq ( StrokePoint () ), Seq ( StrokePoint () ) ), Seq FitPoint )
|
||||
stroke _ Empty = ( Left Empty, Empty )
|
||||
stroke _ ( spt0 :<| Empty ) = ( Left . removePointData $ ( Point2D 0 0 --> coords spt0 :: Vector2D Double ) • brushShape @x spt0, Empty )
|
||||
stroke params allPts@( spt0 :<| spt1 :<| spts )
|
||||
| isClosed
|
||||
= if null ( brushShape @x spt0 )
|
||||
then Right ( Empty, Empty )
|
||||
else Right ( fwdPts, bwdPts )
|
||||
then ( Right mempty, mempty )
|
||||
else ( Right ( fwdPts, bwdPts ), fwdFits <> bwdFits )
|
||||
| otherwise
|
||||
= if null ( brushShape @x spt0 )
|
||||
then Left Empty
|
||||
else Left ( startingCap <> fwdPts <> bwdPts )
|
||||
then ( Left Empty, Empty )
|
||||
else ( Left ( startingCap <> fwdPts <> bwdPts ), fwdFits <> bwdFits )
|
||||
where
|
||||
|
||||
startOffset, endOffset :: Vector2D Double
|
||||
|
|
@ -154,7 +154,8 @@ stroke params allPts@( spt0 :<| spt1 :<| spts )
|
|||
_ -> False
|
||||
|
||||
fwdPts, bwdPts :: Seq ( StrokePoint () )
|
||||
( fwdPts, bwdPts ) = Par.runPar $ go spt0 ( spt1 :<| spts )
|
||||
fwdFits, bwdFits :: Seq FitPoint
|
||||
( ( fwdPts, fwdFits ), ( bwdPts, bwdFits ) ) = Par.runPar $ go spt0 ( spt1 :<| spts )
|
||||
|
||||
(<~>)
|
||||
:: ( Monoid a, Monoid b )
|
||||
|
|
@ -165,7 +166,11 @@ stroke params 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 ) -> Par ( Seq ( StrokePoint () ), Seq ( StrokePoint () ) )
|
||||
joinAndContinue
|
||||
:: Vector2D Double
|
||||
-> StrokePoint d
|
||||
-> Seq ( StrokePoint d )
|
||||
-> Par ( ( Seq ( StrokePoint () ), Seq FitPoint ), ( Seq ( StrokePoint () ), Seq FitPoint ) )
|
||||
joinAndContinue tgt sp0 ( sp1 :<| sps )
|
||||
| tgt' `parallel` tgt
|
||||
= go sp0 ( sp1 :<| sps )
|
||||
|
|
@ -174,9 +179,10 @@ stroke params allPts@( spt0 :<| spt1 :<| spts )
|
|||
ptOffset = Point2D 0 0 --> coords sp0
|
||||
= do
|
||||
let
|
||||
brushJoin :: ( ( Seq ( StrokePoint () ), Seq FitPoint ), ( Seq ( StrokePoint () ), Seq FitPoint ) )
|
||||
brushJoin =
|
||||
( ptOffset • joinWithBrush ( withTangent tgt brush0 ) ( withTangent tgt' brush0 ) brush0
|
||||
, ptOffset • joinWithBrush ( withTangent ( (-1) *^ tgt' ) brush0 ) ( withTangent ( (-1) *^ tgt ) brush0 ) brush0
|
||||
( ( ptOffset • joinWithBrush ( withTangent tgt brush0 ) ( withTangent tgt' brush0 ) brush0, Empty )
|
||||
, ( ptOffset • joinWithBrush ( withTangent ( (-1) *^ tgt' ) brush0 ) ( withTangent ( (-1) *^ tgt ) brush0 ) brush0, Empty )
|
||||
)
|
||||
next <- go sp0 ( sp1 :<| sps )
|
||||
pure ( brushJoin <~> next )
|
||||
|
|
@ -190,15 +196,15 @@ stroke params allPts@( spt0 :<| spt1 :<| spts )
|
|||
| isClosed
|
||||
= 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
|
||||
then mempty
|
||||
else ( ( startOffset • joinWithBrush ( withTangent tgt_start brush_start ) ( withTangent tgt_end brush_start ) brush_start, Empty )
|
||||
, ( startOffset • joinWithBrush ( withTangent ( (-1) *^ tgt_start ) brush_start ) ( withTangent ( (-1) *^ tgt_end ) brush_start ) brush_start, Empty )
|
||||
)
|
||||
-- Open curve.
|
||||
| otherwise
|
||||
= pure
|
||||
( endOffset • joinWithBrush ( withTangent tgt_end brush_end ) ( withTangent ( (-1) *^ tgt_end ) brush_end ) brush_end
|
||||
, Empty -- handled separately: see 'startingCap' below
|
||||
( ( endOffset • joinWithBrush ( withTangent tgt_end brush_end ) ( withTangent ( (-1) *^ tgt_end ) brush_end ) brush_end, Empty )
|
||||
, ( Empty, Empty ) -- handled separately: see 'startingCap' below
|
||||
)
|
||||
|
||||
-- Final cap for an open curve. Handled separately for correct stroke order.
|
||||
|
|
@ -206,8 +212,8 @@ stroke params 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 ) -> Par ( Seq ( StrokePoint () ), Seq ( StrokePoint () ) )
|
||||
go _ Empty = pure ( Empty, Empty )
|
||||
go :: StrokePoint d -> Seq ( StrokePoint d ) -> Par ( ( Seq ( StrokePoint () ), Seq FitPoint ), ( Seq ( StrokePoint () ), Seq FitPoint ) )
|
||||
go _ Empty = pure mempty
|
||||
-- Line.
|
||||
go sp0 ( sp1 :<| sps )
|
||||
| PathPoint {} <- sp1
|
||||
|
|
@ -323,8 +329,8 @@ stroke params allPts@( spt0 :<| spt1 :<| spts )
|
|||
|
||||
fitCurve
|
||||
:: ( Double -> ( Point2D Double, Vector2D Double ) )
|
||||
-> Seq ( StrokePoint () )
|
||||
fitCurve = splinePoints . fitSpline params
|
||||
-> ( Seq ( StrokePoint () ), Seq FitPoint )
|
||||
fitCurve = first splinePoints . fitSpline params
|
||||
|
||||
-----------------------------------
|
||||
-- Various utility functions
|
||||
|
|
|
|||
Loading…
Reference in a new issue