mirror of
https://gitlab.com/sheaf/metabrush.git
synced 2024-11-05 14:53:37 +00:00
adjust what is rendered in different modes
This commit is contained in:
parent
9bde44ed42
commit
dfa446254a
|
@ -126,7 +126,10 @@ testDocuments = IntMap.fromList
|
|||
[ PathPoint ( Point2D 0 (-100) ) ( PointData Normal ( ellipse 30 8 $ BrushPointData Normal ) )
|
||||
, ControlPoint ( Point2D 0 ( -30) ) ( PointData Normal ( ellipse 25 6 $ BrushPointData Normal ) )
|
||||
, ControlPoint ( Point2D 0 ( 30) ) ( PointData Normal ( ellipse 15 6 $ BrushPointData Normal ) )
|
||||
, PathPoint ( Point2D 0 ( 100) ) ( PointData Normal ( ellipse 5 2 $ BrushPointData Normal ) )
|
||||
, PathPoint ( Point2D 0 ( 100) ) ( PointData Normal ( ellipse 15 6 $ BrushPointData Normal ) )
|
||||
, ControlPoint ( Point2D 0 ( 150) ) ( PointData Normal ( ellipse 15 6 $ BrushPointData Normal ) )
|
||||
, ControlPoint ( Point2D 0 ( 200) ) ( PointData Normal ( ellipse 15 6 $ BrushPointData Normal ) )
|
||||
, PathPoint ( Point2D 0 ( 250) ) ( PointData Normal ( ellipse 10 1 $ BrushPointData Normal ) )
|
||||
]
|
||||
|
||||
--------------------------------------------------------------------------------
|
||||
|
|
|
@ -15,7 +15,7 @@ module MetaBrush.Render.Document
|
|||
|
||||
-- base
|
||||
import Control.Monad
|
||||
( guard )
|
||||
( guard, when, unless )
|
||||
import Data.Foldable
|
||||
( for_, sequenceA_ )
|
||||
import Data.Functor.Compose
|
||||
|
@ -102,14 +102,6 @@ compositeRenders = sequenceA_
|
|||
toAll :: Cairo.Render () -> Compose Renders Cairo.Render ()
|
||||
toAll action = Compose ( pure action )
|
||||
|
||||
whenPath :: Applicative m => Mode -> m () -> m ()
|
||||
whenPath Path = id
|
||||
whenPath _ = const ( pure () )
|
||||
|
||||
whenBrush :: Applicative m => Mode -> m () -> m ()
|
||||
whenBrush Brush = id
|
||||
whenBrush _ = const ( pure () )
|
||||
|
||||
--------------------------------------------------------------------------------
|
||||
|
||||
renderDocument
|
||||
|
@ -183,7 +175,7 @@ renderStroke :: Colours -> Mode -> Double -> Stroke -> Compose Renders Cairo.Ren
|
|||
renderStroke cols@( Colours { brush } ) mode zoom ( Stroke { strokePoints = pts, strokeVisible } )
|
||||
| strokeVisible
|
||||
= renderStrokePoints cols mode zoom
|
||||
( whenBrush mode . renderBrushShape ( cols { path = brush } ) ( 2 * zoom ) )
|
||||
( when ( mode == Brush ) . renderBrushShape ( cols { path = brush } ) ( 1.5 * zoom ) )
|
||||
pts
|
||||
*> Compose blank { renderStrokes = drawStroke cols ( stroke pts ) }
|
||||
| otherwise
|
||||
|
@ -202,7 +194,7 @@ renderStrokePoints
|
|||
-> Compose Renders Cairo.Render ()
|
||||
renderStrokePoints _ _ _ _ Empty = pure ()
|
||||
renderStrokePoints cols mode zoom renderSubcontent ( pt0 :<| pts ) =
|
||||
Compose blank { renderPPts = whenPath mode $ drawPoint cols zoom pt0 }
|
||||
Compose blank { renderPPts = when ( mode == Path ) $ drawPoint cols zoom pt0 }
|
||||
*> renderSubcontent pt0
|
||||
*> go pt0 pts
|
||||
where
|
||||
|
@ -214,9 +206,9 @@ renderStrokePoints cols mode zoom renderSubcontent ( pt0 :<| pts ) =
|
|||
| PathPoint {} <- p1
|
||||
= Compose blank
|
||||
{ renderPPts
|
||||
= whenPath mode $ drawPoint cols zoom p1
|
||||
= when ( mode == Path ) $ drawPoint cols zoom p1
|
||||
, renderPath
|
||||
= drawLine cols zoom p0 p1
|
||||
= unless ( mode == Meta ) $ drawLine cols zoom p0 p1
|
||||
}
|
||||
*> renderSubcontent p1
|
||||
*> go p1 ps
|
||||
|
@ -226,15 +218,15 @@ renderStrokePoints cols mode zoom renderSubcontent ( pt0 :<| pts ) =
|
|||
, PathPoint {} <- p2
|
||||
= Compose blank
|
||||
{ renderCLines
|
||||
= whenPath mode do
|
||||
= when ( mode == Path ) do
|
||||
drawLine cols zoom p0 p1
|
||||
drawLine cols zoom p1 p2
|
||||
, renderCPts
|
||||
= whenPath mode $ drawPoint cols zoom p1
|
||||
= when ( mode == Path ) $ drawPoint cols zoom p1
|
||||
, renderPPts
|
||||
= whenPath mode $ drawPoint cols zoom p2
|
||||
= when ( mode == Path ) $ drawPoint cols zoom p2
|
||||
, renderPath
|
||||
= drawQuadraticBezier cols zoom ( coords <$> Quadratic.Bezier { p0, p1, p2 } )
|
||||
= unless ( mode == Meta ) $ drawQuadraticBezier cols zoom ( coords <$> Quadratic.Bezier { p0, p1, p2 } )
|
||||
}
|
||||
*> renderSubcontent p1
|
||||
*> renderSubcontent p2
|
||||
|
@ -246,17 +238,17 @@ renderStrokePoints cols mode zoom renderSubcontent ( pt0 :<| pts ) =
|
|||
, PathPoint {} <- p3
|
||||
= Compose blank
|
||||
{ renderCLines
|
||||
= whenPath mode do
|
||||
= when ( mode == Path ) do
|
||||
drawLine cols zoom p0 p1
|
||||
drawLine cols zoom p2 p3
|
||||
, renderCPts
|
||||
= whenPath mode do
|
||||
= when ( mode == Path ) do
|
||||
drawPoint cols zoom p1
|
||||
drawPoint cols zoom p2
|
||||
, renderPPts
|
||||
= whenPath mode $ drawPoint cols zoom p3
|
||||
= when ( mode == Path ) $ drawPoint cols zoom p3
|
||||
, renderPath
|
||||
= drawCubicBezier cols zoom ( coords <$> Cubic.Bezier { p0, p1, p2, p3 } )
|
||||
= unless ( mode == Meta ) $ drawCubicBezier cols zoom ( coords <$> Cubic.Bezier { p0, p1, p2, p3 } )
|
||||
}
|
||||
*> renderSubcontent p1
|
||||
*> renderSubcontent p2
|
||||
|
@ -275,7 +267,7 @@ renderBrushShape cols zoom pt =
|
|||
toAll do
|
||||
Cairo.save
|
||||
Cairo.translate x y
|
||||
*> renderStrokePoints cols Brush zoom ( const $ pure () ) brushPts
|
||||
*> renderStrokePoints cols Path zoom ( const $ pure () ) brushPts
|
||||
*> Compose blank { renderPPts = drawCross cols zoom }
|
||||
*> toAll Cairo.restore
|
||||
|
||||
|
@ -476,10 +468,10 @@ drawCross :: Colours -> Double -> Cairo.Render ()
|
|||
drawCross ( Colours { .. } ) zoom = do
|
||||
Cairo.save
|
||||
|
||||
Cairo.setLineWidth 2
|
||||
Cairo.setLineWidth 1.5
|
||||
withRGBA brushCenter Cairo.setSourceRGBA
|
||||
|
||||
Cairo.scale ( 2 / zoom ) ( 2 / zoom )
|
||||
Cairo.scale ( 1.5 / zoom ) ( 1.5 / zoom )
|
||||
|
||||
Cairo.moveTo -3 -3
|
||||
Cairo.lineTo 3 3
|
||||
|
|
|
@ -44,13 +44,13 @@ import MetaBrush.Render.Util
|
|||
data Tool
|
||||
= Selection
|
||||
| Pen
|
||||
deriving stock Show
|
||||
deriving stock ( Show, Eq )
|
||||
|
||||
data Mode
|
||||
= Path
|
||||
| Brush
|
||||
| Meta
|
||||
deriving stock Show
|
||||
deriving stock ( Show, Eq )
|
||||
|
||||
data ToolBar
|
||||
= ToolBar
|
||||
|
|
|
@ -335,7 +335,7 @@ cubicBezierBrush t ( Cubic.Bezier p0s p1s p2s p3s ) = Seq.zipWith4 f p0s p1s p2s
|
|||
fitCurve
|
||||
:: ( Double -> ( Point2D Double, Vector2D Double ) )
|
||||
-> Seq ( StrokePoint () )
|
||||
fitCurve curve = splinePoints $ fitSpline 2 10 1e-4 1e-5 80 curve
|
||||
fitCurve curve = splinePoints $ fitSpline 1 13 1e-4 1e-5 100 curve
|
||||
|
||||
splinePoints :: Seq ( Cubic.Bezier ( Point2D Double ) ) -> Seq ( StrokePoint () )
|
||||
splinePoints Empty = Empty
|
||||
|
|
Loading…
Reference in a new issue