diff --git a/MetaBrush.cabal b/MetaBrush.cabal index c1cc4f8..e71a20e 100644 --- a/MetaBrush.cabal +++ b/MetaBrush.cabal @@ -98,7 +98,8 @@ executable MetaBrush Main.hs other-modules: - MetaBrush.Asset.Colours + MetaBrush.Asset.Brushes + , MetaBrush.Asset.Colours , MetaBrush.Asset.Cursor , MetaBrush.Asset.InfoBar , MetaBrush.Asset.Logo diff --git a/app/Main.hs b/app/Main.hs index 4ec353d..57d7dad 100644 --- a/app/Main.hs +++ b/app/Main.hs @@ -58,6 +58,8 @@ import Math.Bezier.Stroke ( StrokePoint(..) ) import Math.Vector2D ( Point2D(..) ) +import MetaBrush.Asset.Brushes + ( ellipse, rect ) import MetaBrush.Asset.Colours ( getColours ) import MetaBrush.Asset.Logo @@ -102,7 +104,7 @@ testDocuments = IntMap.fromList { displayName = "Document 1" , filePath = Nothing , unsavedChanges = False - , strokes = [ Stroke ( circle ( PointData Normal ( rect $ BrushPointData Normal ) ) ) "Circle" True ( unsafeUnique 0 ) + , strokes = [ Stroke ( ellipse 150 100 ( PointData Normal ( rect 30 6 $ BrushPointData Normal ) ) ) "Ellipse" True ( unsafeUnique 0 ) ] , bounds = AABB ( Point2D 0 0 ) ( Point2D 100 100 ) , viewportCenter = Point2D 50 50 @@ -112,62 +114,20 @@ testDocuments = IntMap.fromList { displayName = "Document 2" , filePath = Nothing , unsavedChanges = True - , strokes = [ ] + , strokes = [ Stroke linePts "Line" True ( unsafeUnique 1 ) ] , bounds = AABB ( Point2D 0 0 ) ( Point2D 50 50 ) - , viewportCenter = Point2D 10 10 - , zoomFactor = 0.25 + , viewportCenter = Point2D 0 0 + , zoomFactor = 1 } ] - -circle :: forall a. a -> Seq ( StrokePoint a ) -circle d = Seq.fromList - [ pp ( Point2D 0 1 ) - , cp ( Point2D a 1 ) - , cp ( Point2D 1 a ) - , pp ( Point2D 1 0 ) - , cp ( Point2D 1 (-a) ) - , cp ( Point2D a (-1) ) - , pp ( Point2D 0 (-1) ) - , cp ( Point2D (-a) (-1) ) - , cp ( Point2D (-1) (-a) ) - , pp ( Point2D (-1) 0 ) - , cp ( Point2D (-1) a ) - , cp ( Point2D (-a) 1 ) - , pp ( Point2D 0 1 ) - ] where - a :: Double - a = 0.551915024494 - pp, cp :: Point2D Double -> StrokePoint a - pp p = PathPoint ( fmap ( * 100 ) p ) d - cp p = ControlPoint ( fmap ( * 100 ) p ) d - -razor :: forall a. a -> Seq ( StrokePoint a ) -razor d = Seq.fromList - [ pp ( Point2D 30 0 ) - , cp ( Point2D 30 -6 ) - , cp ( Point2D -30 -6 ) - , pp ( Point2D -30 0 ) - , cp ( Point2D -30 3 ) - , cp ( Point2D 30 3 ) - , pp ( Point2D 30 0 ) - ] - where - pp, cp :: Point2D Double -> StrokePoint a - pp p = PathPoint p d - cp p = ControlPoint p d - -rect :: forall a. a -> Seq ( StrokePoint a ) -rect d = Seq.fromList - [ pp ( Point2D 20 5 ) - , pp ( Point2D 20 -5 ) - , pp ( Point2D -20 -5 ) - , pp ( Point2D -20 5 ) - , pp ( Point2D 20 5 ) - ] - where - pp :: Point2D Double -> StrokePoint a - pp p = PathPoint p d + linePts :: Seq ( StrokePoint PointData ) + linePts = Seq.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 ) ) + ] -------------------------------------------------------------------------------- diff --git a/src/app/MetaBrush/Asset/Brushes.hs b/src/app/MetaBrush/Asset/Brushes.hs new file mode 100644 index 0000000..4a3e83c --- /dev/null +++ b/src/app/MetaBrush/Asset/Brushes.hs @@ -0,0 +1,70 @@ +{-# LANGUAGE NegativeLiterals #-} +{-# LANGUAGE ScopedTypeVariables #-} + +module MetaBrush.Asset.Brushes + ( ellipse, blob, rect ) + where + +-- containers +import Data.Sequence + ( Seq(..) ) +import qualified Data.Sequence as Seq + ( fromList ) + +-- MetaBrush +import Math.Bezier.Stroke + ( StrokePoint(..) ) +import Math.Vector2D + ( Point2D(..) ) + +-------------------------------------------------------------------------------- + +ellipse :: forall d. Double -> Double -> d -> Seq ( StrokePoint d ) +ellipse w h d = Seq.fromList + [ pp ( Point2D 0 1 ) + , cp ( Point2D a 1 ) + , cp ( Point2D 1 a ) + , pp ( Point2D 1 0 ) + , cp ( Point2D 1 (-a) ) + , cp ( Point2D a (-1) ) + , pp ( Point2D 0 (-1) ) + , cp ( Point2D (-a) (-1) ) + , cp ( Point2D (-1) (-a) ) + , pp ( Point2D (-1) 0 ) + , cp ( Point2D (-1) a ) + , cp ( Point2D (-a) 1 ) + , pp ( Point2D 0 1 ) + ] + where + a :: Double + a = 0.551915024494 + pp, cp :: Point2D Double -> StrokePoint d + pp ( Point2D x y ) = PathPoint ( Point2D ( w * x ) ( h * y ) ) d + cp ( Point2D x y ) = ControlPoint ( Point2D ( w * x ) ( h * y ) ) d + +blob :: forall d. Double -> Double -> d -> Seq ( StrokePoint d ) +blob w h d = Seq.fromList + [ pp ( Point2D 1 0 ) + , cp ( Point2D 1 -1 ) + , cp ( Point2D -1 -1 ) + , pp ( Point2D -1 0 ) + , cp ( Point2D -1 1 ) + , cp ( Point2D 1 1 ) + , pp ( Point2D 1 0 ) + ] + where + pp, cp :: Point2D Double -> StrokePoint d + pp ( Point2D x y ) = PathPoint ( Point2D ( w * x ) ( h * y ) ) d + cp ( Point2D x y ) = ControlPoint ( Point2D ( w * x ) ( h * y ) ) d + +rect :: forall d. Double -> Double -> d -> Seq ( StrokePoint d ) +rect w h d = Seq.fromList + [ pp ( Point2D 1 1 ) + , pp ( Point2D 1 -1 ) + , pp ( Point2D -1 -1 ) + , pp ( Point2D -1 1 ) + , pp ( Point2D 1 1 ) + ] + where + pp :: Point2D Double -> StrokePoint d + pp ( Point2D x y ) = PathPoint ( Point2D ( w * x ) ( h * y ) ) d diff --git a/src/lib/Math/Bezier/Stroke.hs b/src/lib/Math/Bezier/Stroke.hs index eb8bba4..af72bff 100644 --- a/src/lib/Math/Bezier/Stroke.hs +++ b/src/lib/Math/Bezier/Stroke.hs @@ -115,18 +115,17 @@ stroke allPts@( spt0 :<| spt1 :<| spts ) | isClosed = Right ( fwdPts, bwdPts ) | otherwise - = Left ( fwdPts <> bwdPts ) + = Left ( startingCap <> fwdPts <> bwdPts ) where startOffset, endOffset :: Vector2D Double tgt_start, tgt_end :: Vector2D Double + brush_start, brush_end :: Seq ( StrokePoint x ) startOffset = Point2D 0 0 --> coords spt0 tgt_start = coords spt0 --> coords spt1 - ( tgt_end, endOffset ) = case allPts of - _ :|> sptnm1 :|> sptn -> ( coords sptnm1 --> coords sptn, Point2D 0 0 --> coords sptn ) + ( tgt_end, endOffset, brush_end ) = case allPts of + _ :|> sptnm1 :|> sptn -> ( coords sptnm1 --> coords sptn, Point2D 0 0 --> coords sptn, brushShape sptn ) _ -> error "impossible" - - brush_start :: Seq ( StrokePoint x ) brush_start = brushShape spt0 isClosed :: Bool @@ -149,19 +148,6 @@ stroke 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 ) -> ( Seq ( StrokePoint () ), Seq ( StrokePoint () ) ) - joinAndContinue _ _ Empty - -- Closed curve. - | isClosed - = 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 - ) - -- Open curve. - | otherwise - = ( endOffset • joinWithBrush ( withTangent tgt_end brush_start ) ( withTangent ( (-1) *^ tgt_end ) brush_start ) brush_start - , startOffset • joinWithBrush ( withTangent ( (-1) *^ tgt_start ) brush_start ) ( withTangent tgt_start brush_start ) brush_start - ) joinAndContinue tgt sp0 ( sp1 :<| sps ) | tgt' `parallel` tgt = go sp0 ( sp1 :<| sps ) @@ -177,6 +163,24 @@ stroke allPts@( spt0 :<| spt1 :<| spts ) tgt' = coords sp0 --> coords sp1 brush0 :: Seq ( StrokePoint () ) brush0 = removePointData $ brushShape @x sp0 + joinAndContinue _ _ Empty + -- Closed curve. + | isClosed + = 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 + ) + -- Open curve. + | otherwise + = ( endOffset • joinWithBrush ( withTangent tgt_end brush_end ) ( withTangent ( (-1) *^ tgt_end ) brush_end ) brush_end + , Empty -- handled separately: see 'startingCap' below + ) + + -- Final cap for an open curve. Handled separately for correct stroke order. + startingCap :: Seq ( StrokePoint () ) + startingCap + = startOffset • joinWithBrush ( withTangent ( (-1) *^ tgt_start ) brush_start ) ( withTangent tgt_start brush_start ) brush_start go :: StrokePoint d -> Seq ( StrokePoint d ) -> ( Seq ( StrokePoint () ), Seq ( StrokePoint () ) ) go _ Empty = ( Empty, Empty )