mirror of
https://gitlab.com/sheaf/metabrush.git
synced 2024-11-23 15:34:06 +00:00
highlight points for hover/selection
This commit is contained in:
parent
ae0ac23910
commit
8d50c92ca9
1
.gitignore
vendored
1
.gitignore
vendored
|
@ -8,3 +8,4 @@ refs/
|
|||
*.txt
|
||||
*.md
|
||||
*.html
|
||||
hie.yaml
|
||||
|
|
42
app/Main.hs
42
app/Main.hs
|
@ -56,9 +56,8 @@ import MetaBrush.Asset.Colours
|
|||
import MetaBrush.Asset.Logo
|
||||
( drawLogo )
|
||||
import MetaBrush.Document
|
||||
( Document(..)
|
||||
, AABB(..)
|
||||
, Stroke(..)
|
||||
( Document(..), AABB(..)
|
||||
, Stroke(..), StrokePoint(..), PointType(..), FocusState(..)
|
||||
)
|
||||
import MetaBrush.Event
|
||||
( handleEvents )
|
||||
|
@ -88,12 +87,30 @@ testDocuments = IntMap.fromList
|
|||
{ displayName = "Document 1"
|
||||
, filePath = Nothing
|
||||
, unsavedChanges = False
|
||||
, strokes = [ Stroke [ Point2D 0 0 ]
|
||||
, Stroke [ Point2D 100 0, Point2D 105 0, Point2D 110 0 ]
|
||||
, Stroke [ Point2D 0 100 ]
|
||||
, Stroke [ Point2D 100 100, Point2D 105 105, Point2D 110 100 ]
|
||||
, strokes = [ Stroke
|
||||
[ StrokePoint ( Point2D 0 0 ) PathPoint Normal ]
|
||||
"Stroke1"
|
||||
False
|
||||
, Stroke
|
||||
[ StrokePoint ( Point2D 100 0 ) PathPoint Hover
|
||||
, StrokePoint ( Point2D 105 0 ) ControlPoint Normal
|
||||
, StrokePoint ( Point2D 110 0 ) PathPoint Selected
|
||||
]
|
||||
"Stroke2"
|
||||
True
|
||||
, Stroke
|
||||
[ StrokePoint ( Point2D 0 100 ) PathPoint Normal ]
|
||||
"Stroke3"
|
||||
True
|
||||
, Stroke
|
||||
[ StrokePoint ( Point2D 100 100 ) PathPoint Normal
|
||||
, StrokePoint ( Point2D 105 105 ) ControlPoint Selected
|
||||
, StrokePoint ( Point2D 110 100 ) PathPoint Normal
|
||||
]
|
||||
"Stroke4"
|
||||
True
|
||||
]
|
||||
, bounds = AABB ( Point2D 0 0 ) ( Point2D 100 100 )
|
||||
, bounds = AABB ( Point2D 0 0 ) ( Point2D 100 100 )
|
||||
, viewportCenter = Point2D 50 50
|
||||
, zoomFactor = 1
|
||||
}
|
||||
|
@ -101,7 +118,14 @@ testDocuments = IntMap.fromList
|
|||
{ displayName = "Document 2"
|
||||
, filePath = Nothing
|
||||
, unsavedChanges = True
|
||||
, strokes = [ Stroke [ Point2D 0 0, Point2D 10 10, Point2D 20 20 ] ]
|
||||
, strokes = [ Stroke
|
||||
[ StrokePoint ( Point2D 0 0 ) PathPoint Normal
|
||||
, StrokePoint ( Point2D 10 10 ) ControlPoint Normal
|
||||
, StrokePoint ( Point2D 20 20 ) PathPoint Normal
|
||||
]
|
||||
"Stroke1"
|
||||
True
|
||||
]
|
||||
, bounds = AABB ( Point2D 0 0 ) ( Point2D 50 50 )
|
||||
, viewportCenter = Point2D 10 10
|
||||
, zoomFactor = 0.25
|
||||
|
|
|
@ -45,6 +45,12 @@
|
|||
.brushStroke {
|
||||
color: rgb(235,118,219);
|
||||
}
|
||||
.pointHover {
|
||||
color: rgb(225,225,225);
|
||||
}
|
||||
.pointSelected {
|
||||
color: rgb(252,237,120);
|
||||
}
|
||||
.viewport {
|
||||
background-color: rgb(236, 223, 210);
|
||||
-GtkWidget-window-dragging: false;
|
||||
|
|
|
@ -44,6 +44,8 @@ data ColourRecord a
|
|||
, controlPointOutline :: !a
|
||||
, path :: !a
|
||||
, brushStroke :: !a
|
||||
, pointHover :: !a
|
||||
, pointSelected :: !a
|
||||
, viewport :: !a
|
||||
, viewportScrollbar :: !a
|
||||
, tabScrollbar :: !a
|
||||
|
@ -81,6 +83,8 @@ colourNames = Colours
|
|||
, controlPointOutline = ColourName "controlPointStroke" Colour [ GTK.StateFlagsNormal ]
|
||||
, path = ColourName "path" Colour [ GTK.StateFlagsNormal ]
|
||||
, brushStroke = ColourName "brushStroke" Colour [ GTK.StateFlagsNormal ]
|
||||
, pointHover = ColourName "pointHover" Colour [ GTK.StateFlagsNormal ]
|
||||
, pointSelected = ColourName "pointSelected" Colour [ GTK.StateFlagsNormal ]
|
||||
, viewport = ColourName "viewport" BackgroundColour [ GTK.StateFlagsNormal ]
|
||||
, viewportScrollbar = ColourName "viewportScrollbar" BackgroundColour [ GTK.StateFlagsNormal ]
|
||||
, tabScrollbar = ColourName "tabScrollbar" BackgroundColour [ GTK.StateFlagsNormal ]
|
||||
|
|
|
@ -47,9 +47,30 @@ data Document
|
|||
|
||||
data Stroke
|
||||
= Stroke
|
||||
{ strokePoints :: ![ Point2D Double ] }
|
||||
{ strokePoints :: ![ StrokePoint ]
|
||||
, strokeName :: !Text
|
||||
, strokeVisible :: !Bool
|
||||
}
|
||||
deriving stock Show
|
||||
|
||||
data StrokePoint
|
||||
= StrokePoint
|
||||
{ strokePoint :: !( Point2D Double )
|
||||
, pointType :: !PointType
|
||||
, pointState :: !FocusState
|
||||
}
|
||||
deriving stock Show
|
||||
|
||||
data PointType
|
||||
= PathPoint
|
||||
| ControlPoint
|
||||
deriving stock Show
|
||||
|
||||
data FocusState
|
||||
= Normal
|
||||
| Hover
|
||||
| Selected
|
||||
deriving stock Show
|
||||
|
||||
currentDocument :: STM.TVar ( Maybe Int ) -> STM.TVar ( IntMap Document ) -> IO ( Maybe Document )
|
||||
currentDocument activeDocumentTVar openDocumentsTVar = STM.atomically do
|
||||
|
|
|
@ -11,6 +11,9 @@ import Control.Monad
|
|||
( unless )
|
||||
import Data.Foldable
|
||||
( for_ )
|
||||
-- base
|
||||
import Data.Semigroup
|
||||
( Arg(..), Min(..) )
|
||||
import Data.Word
|
||||
( Word32 )
|
||||
|
||||
|
@ -48,7 +51,7 @@ import Math.Vector2D
|
|||
import MetaBrush.Document
|
||||
( Document(..), currentDocument )
|
||||
import MetaBrush.UI.Coordinates
|
||||
( toViewportCoordinates )
|
||||
( closestPoint, toViewportCoordinates )
|
||||
import MetaBrush.UI.InfoBar
|
||||
( InfoBar, InfoData(..), updateInfoBar )
|
||||
|
||||
|
@ -78,30 +81,34 @@ handleEvents activeDocumentTVar openDocumentsTVar pressedKeysTVar window viewpor
|
|||
handleMotionEvent :: STM.TVar ( Maybe Int ) -> STM.TVar ( IntMap Document ) -> GTK.DrawingArea -> InfoBar -> GDK.EventMotion -> IO Bool
|
||||
handleMotionEvent activeDocumentTVar openDocumentsTVar viewportDrawingArea infoBar eventMotion = do
|
||||
|
||||
mbDoc <- currentDocument activeDocumentTVar openDocumentsTVar
|
||||
for_ mbDoc \ ( Document { .. } ) -> do
|
||||
|
||||
----------------------------------------------------------
|
||||
-- Update mouse position in info bar on mouse move event.
|
||||
|
||||
x <- GDK.getEventMotionX eventMotion
|
||||
y <- GDK.getEventMotionY eventMotion
|
||||
viewportWidth <- fromIntegral @_ @Double <$> GTK.widgetGetAllocatedWidth viewportDrawingArea
|
||||
viewportHeight <- fromIntegral @_ @Double <$> GTK.widgetGetAllocatedHeight viewportDrawingArea
|
||||
let
|
||||
toViewport :: Point2D Double -> Point2D Double
|
||||
toViewport = toViewportCoordinates zoomFactor ( viewportWidth, viewportHeight ) viewportCenter
|
||||
infoData :: InfoData
|
||||
infoData =
|
||||
InfoData
|
||||
{ zoom = zoomFactor
|
||||
, mousePos = toViewport ( Point2D x y )
|
||||
, topLeftPos = toViewport ( Point2D 0 0 )
|
||||
, botRightPos = toViewport ( Point2D viewportWidth viewportHeight )
|
||||
}
|
||||
updateInfoBar infoBar infoData
|
||||
|
||||
pure False
|
||||
mbActiveDoc <- STM.readTVarIO activeDocumentTVar
|
||||
for_ mbActiveDoc \ i -> do
|
||||
docs <- STM.readTVarIO openDocumentsTVar
|
||||
for_ ( IntMap.lookup i docs ) \ doc@( Document { .. } ) -> do
|
||||
|
||||
----------------------------------------------------------
|
||||
-- Update mouse position in info bar on mouse move event.
|
||||
|
||||
x <- GDK.getEventMotionX eventMotion
|
||||
y <- GDK.getEventMotionY eventMotion
|
||||
viewportWidth <- fromIntegral @_ @Double <$> GTK.widgetGetAllocatedWidth viewportDrawingArea
|
||||
viewportHeight <- fromIntegral @_ @Double <$> GTK.widgetGetAllocatedHeight viewportDrawingArea
|
||||
let
|
||||
toViewport :: Point2D Double -> Point2D Double
|
||||
toViewport = toViewportCoordinates zoomFactor ( viewportWidth, viewportHeight ) viewportCenter
|
||||
pos :: Point2D Double
|
||||
pos = toViewport ( Point2D x y )
|
||||
infoData :: InfoData
|
||||
infoData =
|
||||
InfoData
|
||||
{ zoom = zoomFactor
|
||||
, mousePos = pos
|
||||
, topLeftPos = toViewport ( Point2D 0 0 )
|
||||
, botRightPos = toViewport ( Point2D viewportWidth viewportHeight )
|
||||
}
|
||||
updateInfoBar infoBar infoData
|
||||
|
||||
pure True
|
||||
|
||||
handleScrollEvent :: STM.TVar ( Maybe Int ) -> STM.TVar ( IntMap Document ) -> STM.TVar [ Word32 ] -> GTK.DrawingArea -> InfoBar -> GDK.EventScroll -> IO Bool
|
||||
handleScrollEvent activeDocumentTVar openDocumentsTVar pressedKeysTVar viewportDrawingArea infoBar scrollEvent = do
|
||||
|
|
|
@ -1,14 +1,19 @@
|
|||
{-# LANGUAGE NamedFieldPuns #-}
|
||||
{-# LANGUAGE NegativeLiterals #-}
|
||||
{-# LANGUAGE RecordWildCards #-}
|
||||
{-# LANGUAGE DeriveFunctor #-}
|
||||
{-# LANGUAGE DerivingStrategies #-}
|
||||
{-# LANGUAGE NamedFieldPuns #-}
|
||||
{-# LANGUAGE NegativeLiterals #-}
|
||||
{-# LANGUAGE PatternSynonyms #-}
|
||||
{-# LANGUAGE RecordWildCards #-}
|
||||
|
||||
module MetaBrush.Render.Document
|
||||
( renderDocument )
|
||||
where
|
||||
|
||||
-- base
|
||||
import Control.Monad
|
||||
( when )
|
||||
import Data.Foldable
|
||||
( traverse_ )
|
||||
import Data.Functor.Compose
|
||||
( Compose(..) )
|
||||
import Data.Int
|
||||
( Int32 )
|
||||
|
||||
|
@ -16,6 +21,8 @@ import Data.Int
|
|||
import qualified GI.Cairo.Render as Cairo
|
||||
|
||||
-- MetaBrush
|
||||
import qualified Math.Bezier.Cubic as Cubic
|
||||
( Bezier(..) )
|
||||
import qualified Math.Bezier.Quadratic as Quadratic
|
||||
( Bezier(..) )
|
||||
import Math.Vector2D
|
||||
|
@ -23,12 +30,31 @@ import Math.Vector2D
|
|||
import MetaBrush.Asset.Colours
|
||||
( Colours, ColourRecord(..) )
|
||||
import MetaBrush.Document
|
||||
( Document(..), Stroke(..) )
|
||||
( Document(..)
|
||||
, Stroke(..), StrokePoint(..), PointType(..), FocusState(..)
|
||||
)
|
||||
import MetaBrush.Render.Util
|
||||
( withRGBA )
|
||||
|
||||
--------------------------------------------------------------------------------
|
||||
|
||||
data Renders a
|
||||
= MkRenders
|
||||
{ mkRenderPoints :: a
|
||||
, mkRenderPaths :: a
|
||||
}
|
||||
deriving stock ( Show, Functor )
|
||||
|
||||
instance Applicative Renders where
|
||||
pure a = MkRenders a a
|
||||
MkRenders f1 f2 <*> MkRenders a1 a2 = MkRenders ( f1 a1 ) ( f2 a2 )
|
||||
|
||||
{-# COMPLETE Renders #-}
|
||||
pattern Renders :: Cairo.Render a -> Cairo.Render a -> Compose Renders Cairo.Render a
|
||||
pattern Renders { renderPoints, renderPaths } = Compose ( MkRenders renderPoints renderPaths )
|
||||
|
||||
--------------------------------------------------------------------------------
|
||||
|
||||
renderDocument :: Colours -> ( Int32, Int32 ) -> Document -> Cairo.Render ()
|
||||
renderDocument cols ( viewportWidth, viewportHeight ) ( Document { viewportCenter = Point2D cx cy, .. } ) = do
|
||||
|
||||
|
@ -38,49 +64,63 @@ renderDocument cols ( viewportWidth, viewportHeight ) ( Document { viewportCente
|
|||
Cairo.translate ( -cx ) ( -cy )
|
||||
|
||||
let
|
||||
( renderPoints, renderPath ) = renderStrokes cols zoomFactor strokes
|
||||
renderPath
|
||||
Renders { renderPoints, renderPaths } = traverse_ ( renderStroke cols zoomFactor ) strokes
|
||||
renderPaths
|
||||
renderPoints
|
||||
|
||||
Cairo.restore
|
||||
|
||||
pure ()
|
||||
|
||||
renderStrokes :: Colours -> Double -> [ Stroke ] -> ( Cairo.Render (), Cairo.Render () )
|
||||
renderStrokes _ _ [] = ( pure (), pure () )
|
||||
renderStrokes cols zoom ( s : ss ) = ( points1 *> points2, path1 *> path2 )
|
||||
renderStroke :: Colours -> Double -> Stroke -> Compose Renders Cairo.Render ()
|
||||
renderStroke cols zoom ( Stroke { strokePoints = ( pt0 : pts ), strokeVisible = True } )
|
||||
= go pt0 pts *> Renders { renderPoints = drawPoint cols zoom pt0, renderPaths = pure () }
|
||||
where
|
||||
( points1, path1 ) = renderStroke cols zoom s
|
||||
( points2, path2 ) = renderStrokes cols zoom ss
|
||||
|
||||
renderStroke :: Colours -> Double -> Stroke -> ( Cairo.Render (), Cairo.Render () )
|
||||
renderStroke cols zoom ( Stroke strokePts ) = go True strokePts
|
||||
where
|
||||
go :: Bool -> [ Point2D Double ] -> ( Cairo.Render (), Cairo.Render () )
|
||||
go drawFirstPoint pts = case pts of
|
||||
[] -> ( pure (), pure () )
|
||||
[p0] -> ( when drawFirstPoint ( drawPoint cols zoom p0 ), pure () )
|
||||
[_,_] -> error "'renderStroke': unexpected pair of points"
|
||||
( p0 : p1 : p2 : ps ) ->
|
||||
let
|
||||
drawPoints, drawNextPoints, drawPath, drawNextPath :: Cairo.Render ()
|
||||
( drawNextPoints, drawNextPath ) = go False ( p2 : ps )
|
||||
drawPoints = do
|
||||
drawControl cols zoom p1
|
||||
drawLine cols zoom p0 p1
|
||||
drawLine cols zoom p1 p2
|
||||
when drawFirstPoint ( drawPoint cols zoom p0 )
|
||||
drawPoint cols zoom p2
|
||||
drawNextPoints
|
||||
drawPath = do
|
||||
drawQuadraticBezier cols zoom ( Quadratic.Bezier p0 p1 p2 )
|
||||
drawNextPath
|
||||
in ( drawPoints, drawPath )
|
||||
|
||||
|
||||
drawPoint, drawControl :: Colours -> Double -> Point2D Double -> Cairo.Render ()
|
||||
drawPoint ( Colours { pathPoint, pathPointOutline } ) zoom ( Point2D x y ) = do
|
||||
go :: StrokePoint -> [ StrokePoint ] -> Compose Renders Cairo.Render ()
|
||||
go _ [] = pure ()
|
||||
-- Line.
|
||||
go p0 ( p1 : ps )
|
||||
| PathPoint <- pointType p1
|
||||
= Renders
|
||||
{ renderPoints = drawPoint cols zoom p1
|
||||
, renderPaths = drawLine cols zoom p0 p1
|
||||
}
|
||||
*> go p1 ps
|
||||
-- Quadratic Bézier curve.
|
||||
go p0 ( p1 : p2 : ps )
|
||||
| ControlPoint <- pointType p1
|
||||
, PathPoint <- pointType p2
|
||||
= Renders
|
||||
{ renderPoints
|
||||
= drawLine cols zoom p0 p1
|
||||
*> drawLine cols zoom p1 p2
|
||||
*> drawPoint cols zoom p1
|
||||
*> drawPoint cols zoom p2
|
||||
, renderPaths = drawQuadraticBezier cols zoom ( fmap strokePoint $ Quadratic.Bezier { p0, p1, p2 } )
|
||||
}
|
||||
*> go p2 ps
|
||||
-- Cubic Bézier curve.
|
||||
go p0 ( p1 : p2 : p3 : ps )
|
||||
| ControlPoint <- pointType p1
|
||||
, ControlPoint <- pointType p1
|
||||
, PathPoint <- pointType p3
|
||||
= Renders
|
||||
{ renderPoints
|
||||
= drawLine cols zoom p0 p1
|
||||
*> drawLine cols zoom p2 p3
|
||||
*> drawPoint cols zoom p1
|
||||
*> drawPoint cols zoom p2
|
||||
*> drawPoint cols zoom p3
|
||||
, renderPaths = drawCubicBezier cols zoom ( fmap strokePoint $ Cubic.Bezier { p0, p1, p2, p3 } )
|
||||
}
|
||||
*> go p2 ps
|
||||
go p0 ps = error $ "renderStroke: unrecognised stroke type\n" <> show ( p0 : ps )
|
||||
renderStroke _ _ _ = pure ()
|
||||
|
||||
drawPoint :: Colours -> Double -> StrokePoint -> Cairo.Render ()
|
||||
drawPoint ( Colours { .. } ) zoom
|
||||
( StrokePoint { strokePoint = Point2D x y, pointType = PathPoint, pointState } )
|
||||
= do
|
||||
let
|
||||
hsqrt3 :: Double
|
||||
hsqrt3 = sqrt 0.75
|
||||
|
@ -97,16 +137,23 @@ drawPoint ( Colours { pathPoint, pathPointOutline } ) zoom ( Point2D x y ) = do
|
|||
Cairo.lineTo 0.5 (-hsqrt3)
|
||||
Cairo.closePath
|
||||
|
||||
Cairo.setLineWidth 0.8
|
||||
withRGBA pathPointOutline Cairo.setSourceRGBA
|
||||
Cairo.setLineWidth 1.0
|
||||
case pointState of
|
||||
Normal -> withRGBA pathPointOutline Cairo.setSourceRGBA
|
||||
_ -> withRGBA pathPoint Cairo.setSourceRGBA
|
||||
Cairo.strokePreserve
|
||||
|
||||
withRGBA pathPoint Cairo.setSourceRGBA
|
||||
case pointState of
|
||||
Normal -> withRGBA pathPoint Cairo.setSourceRGBA
|
||||
Hover -> withRGBA pointHover Cairo.setSourceRGBA
|
||||
Selected -> withRGBA pointSelected Cairo.setSourceRGBA
|
||||
Cairo.fill
|
||||
|
||||
Cairo.restore
|
||||
|
||||
drawControl ( Colours { controlPoint, controlPointOutline } ) zoom ( Point2D x y ) = do
|
||||
drawPoint ( Colours { .. } ) zoom
|
||||
( StrokePoint { strokePoint = Point2D x y, pointType = ControlPoint, pointState } )
|
||||
= do
|
||||
|
||||
Cairo.save
|
||||
Cairo.translate x y
|
||||
|
@ -114,24 +161,40 @@ drawControl ( Colours { controlPoint, controlPointOutline } ) zoom ( Point2D x y
|
|||
|
||||
Cairo.arc 0 0 1 0 ( 2 * pi )
|
||||
|
||||
Cairo.setLineWidth 0.8
|
||||
withRGBA controlPointOutline Cairo.setSourceRGBA
|
||||
Cairo.setLineWidth 1.0
|
||||
case pointState of
|
||||
Normal -> withRGBA controlPointOutline Cairo.setSourceRGBA
|
||||
_ -> withRGBA controlPoint Cairo.setSourceRGBA
|
||||
Cairo.strokePreserve
|
||||
|
||||
case pointState of
|
||||
Normal -> withRGBA controlPoint Cairo.setSourceRGBA
|
||||
Hover -> withRGBA pointHover Cairo.setSourceRGBA
|
||||
Selected -> withRGBA pointSelected Cairo.setSourceRGBA
|
||||
Cairo.fill
|
||||
|
||||
withRGBA controlPoint Cairo.setSourceRGBA
|
||||
Cairo.fill
|
||||
|
||||
Cairo.restore
|
||||
|
||||
drawLine :: Colours -> Double -> Point2D Double -> Point2D Double -> Cairo.Render ()
|
||||
drawLine ( Colours { controlPoint } ) zoom ( Point2D x1 y1 ) ( Point2D x2 y2 ) = do
|
||||
drawLine :: Colours -> Double -> StrokePoint -> StrokePoint -> Cairo.Render ()
|
||||
drawLine ( Colours { path, controlPoint } ) zoom
|
||||
( StrokePoint { strokePoint = Point2D x1 y1, pointType = ty1 } )
|
||||
( StrokePoint { strokePoint = Point2D x2 y2, pointType = ty2 } )
|
||||
= do
|
||||
|
||||
Cairo.save
|
||||
Cairo.moveTo x1 y1
|
||||
Cairo.lineTo x2 y2
|
||||
|
||||
Cairo.setLineWidth ( 3 / zoom )
|
||||
withRGBA controlPoint Cairo.setSourceRGBA
|
||||
case ( ty1, ty2 ) of
|
||||
( PathPoint, PathPoint ) -> do
|
||||
Cairo.setLineWidth ( 6 / zoom )
|
||||
withRGBA path Cairo.setSourceRGBA
|
||||
_ -> do
|
||||
Cairo.setLineWidth ( 3 / zoom )
|
||||
withRGBA controlPoint Cairo.setSourceRGBA
|
||||
Cairo.stroke
|
||||
|
||||
Cairo.restore
|
||||
|
@ -159,3 +222,25 @@ drawQuadraticBezier ( Colours { path } ) zoom
|
|||
Cairo.stroke
|
||||
|
||||
Cairo.restore
|
||||
|
||||
drawCubicBezier :: Colours -> Double -> Cubic.Bezier ( Point2D Double ) -> Cairo.Render ()
|
||||
drawCubicBezier ( Colours { path } ) zoom
|
||||
( Cubic.Bezier
|
||||
{ p0 = Point2D x0 y0
|
||||
, p1 = Point2D x1 y1
|
||||
, p2 = Point2D x2 y2
|
||||
, p3 = Point2D x3 y3
|
||||
}
|
||||
)
|
||||
= do
|
||||
|
||||
Cairo.save
|
||||
|
||||
Cairo.moveTo x0 y0
|
||||
Cairo.curveTo x1 y1 x2 y2 x3 y3
|
||||
|
||||
Cairo.setLineWidth ( 6 / zoom )
|
||||
withRGBA path Cairo.setSourceRGBA
|
||||
Cairo.stroke
|
||||
|
||||
Cairo.restore
|
||||
|
|
|
@ -1,7 +1,14 @@
|
|||
{-# LANGUAGE RecordWildCards #-}
|
||||
{-# LANGUAGE TypeApplications #-}
|
||||
|
||||
module MetaBrush.UI.Coordinates
|
||||
( toViewportCoordinates )
|
||||
( toViewportCoordinates, closestPoint )
|
||||
where
|
||||
|
||||
-- base
|
||||
import Data.Semigroup
|
||||
( ArgMin, Arg(..), Min(..) )
|
||||
|
||||
-- acts
|
||||
import Data.Act
|
||||
( Act
|
||||
|
@ -11,14 +18,33 @@ import Data.Act
|
|||
)
|
||||
|
||||
-- MetaBrush
|
||||
import qualified Math.Bezier.Quadratic as Quadratic
|
||||
( Bezier(..), closestPoint )
|
||||
import Math.Module
|
||||
( (*^) )
|
||||
( (*^), squaredNorm )
|
||||
import Math.Vector2D
|
||||
( Point2D(..), Vector2D(..) )
|
||||
import MetaBrush.Document
|
||||
( Stroke(..) )
|
||||
|
||||
--------------------------------------------------------------------------------
|
||||
|
||||
-- | Convert a position relative to the drawing area into viewport coordinates.
|
||||
toViewportCoordinates :: Double -> ( Double, Double ) -> Point2D Double -> Point2D Double -> Point2D Double
|
||||
toViewportCoordinates zoomFactor ( viewportWidth, viewportHeight ) viewportCenter ( Point2D x y )
|
||||
= ( recip zoomFactor *^ ( Point2D ( 0.5 * viewportWidth ) ( 0.5 * viewportHeight ) --> Point2D x y :: Vector2D Double ) )
|
||||
• viewportCenter
|
||||
|
||||
-- | Find the closest point in a set of strokes.
|
||||
closestPoint :: Point2D Double -> Stroke -> ArgMin Double ( Point2D Double )
|
||||
closestPoint = undefined
|
||||
{-
|
||||
closestPoint c ( Stroke pts ) = go pts
|
||||
where
|
||||
go :: [ Point2D Double ] -> ArgMin Double ( Point2D Double )
|
||||
go [] = error "'closestPoint': empty stroke"
|
||||
go [p] = Min ( Arg ( squaredNorm ( c --> p :: Vector2D Double ) ) p )
|
||||
go (p0:p1:p2:ps)
|
||||
= fmap ( fmap snd ) ( Quadratic.closestPoint @(Vector2D Double) ( Quadratic.Bezier { .. } ) c )
|
||||
<> go (p2:ps)
|
||||
-}
|
|
@ -11,19 +11,10 @@ import Control.Monad
|
|||
import Data.Foldable
|
||||
( for_ )
|
||||
|
||||
-- gi-cairo-connector
|
||||
import qualified GI.Cairo.Render.Connector as Cairo
|
||||
( renderWithContext )
|
||||
|
||||
-- gi-cairo-render
|
||||
import qualified GI.Cairo.Render as Cairo
|
||||
|
||||
-- gi-gtk
|
||||
import qualified GI.Gtk as GTK
|
||||
|
||||
-- MetaBrush
|
||||
import MetaBrush.Asset.Colours
|
||||
( Colours )
|
||||
import MetaBrush.Render.Util
|
||||
( widgetAddClass, widgetAddClasses )
|
||||
|
||||
|
|
|
@ -20,6 +20,8 @@ module Math.Bezier.Quadratic
|
|||
-- base
|
||||
import Data.List.NonEmpty
|
||||
( NonEmpty(..) )
|
||||
import Data.Semigroup
|
||||
( ArgMin, Min(..), Arg(..) )
|
||||
import GHC.Generics
|
||||
( Generic )
|
||||
|
||||
|
@ -69,7 +71,7 @@ subdivide ( Bezier { .. } ) t = ( Bezier p0 q1 pt, Bezier pt r1 p2 )
|
|||
pt = lerp @v t q1 r1
|
||||
|
||||
-- | Finds the closest point to a given point on a quadratic Bézier curve.
|
||||
closestPoint :: forall v r p. ( Torsor v p, Inner r v, RealFloat r ) => Bezier p -> p -> ( r, p )
|
||||
closestPoint :: forall v r p. ( Torsor v p, Inner r v, RealFloat r ) => Bezier p -> p -> ArgMin r ( r, p )
|
||||
closestPoint pts@( Bezier { .. } ) c = pickClosest ( 0 :| 1 : roots )
|
||||
where
|
||||
roots :: [ r ]
|
||||
|
@ -83,17 +85,17 @@ closestPoint pts@( Bezier { .. } ) c = pickClosest ( 0 :| 1 : roots )
|
|||
a0, a1, a2, a3 :: r
|
||||
a0 = v ^.^ v'
|
||||
a1 = v ^.^ v'' + 2 * squaredNorm v'
|
||||
a2 = 3 * ( v' ^.^ v'' )
|
||||
a2 = 3 * v' ^.^ v''
|
||||
a3 = squaredNorm v''
|
||||
|
||||
pickClosest :: NonEmpty r -> ( r, p )
|
||||
pickClosest :: NonEmpty r -> ArgMin r ( r, p )
|
||||
pickClosest ( s :| ss ) = go s q nm0 ss
|
||||
where
|
||||
q :: p
|
||||
q = bezier @v pts s
|
||||
nm0 :: r
|
||||
nm0 = squaredNorm ( c --> q :: v )
|
||||
go t p _ [] = ( t, p )
|
||||
go t p nm [] = Min ( Arg nm ( t, p ) )
|
||||
go t p nm ( t' : ts )
|
||||
| nm' < nm = go t' p' nm' ts
|
||||
| otherwise = go t p nm ts
|
||||
|
|
Loading…
Reference in a new issue