hashirama/metabrush
1
0
Fork 0
mirror of https://gitlab.com/sheaf/metabrush.git synced 2024-11-23 15:34:06 +00:00
Code Issues Actions Projects Releases Wiki Activity

adjust what is rendered in different modes

Browse source
This commit is contained in:
sheaf 2020-08-29 20:50:02 +02:00
parent 9bde44ed42
commit dfa446254a
4 changed files with 23 additions and 28 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

5
app/Main.hs
View file

@ -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 ) )
]
--------------------------------------------------------------------------------

40
src/app/MetaBrush/Render/Document.hs
View file

@ -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

4
src/app/MetaBrush/UI/ToolBar.hs
View file

@ -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

2
src/lib/Math/Bezier/Stroke.hs
View file

@ -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