hashirama/metabrush
1
0
Fork 0
mirror of https://gitlab.com/sheaf/metabrush.git synced 2024-11-05 14:53:37 +00:00
Code Issues Actions Projects Releases Wiki Activity

use correct applicative operation for brush lerp

Browse source
This commit is contained in:
sheaf 2020-08-31 01:59:14 +02:00
parent 9e73da9fff
commit 9c5f8b1198
2 changed files with 27 additions and 12 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

33
app/Main.hs
View file

@ -101,7 +101,7 @@ testDocuments :: IntMap Document
testDocuments = IntMap.fromList
$ zip [0..]
[ Document
{ displayName = "Document 1"
{ displayName = "Closed"
, filePath = Nothing
, unsavedChanges = False
, strokes = [ Stroke ( ellipse 150 100 ( PointData Normal ( rect 30 6 $ BrushPointData Normal ) ) ) "Ellipse" True ( unsafeUnique 0 )
@ -111,7 +111,7 @@ testDocuments = IntMap.fromList
, zoomFactor = 1
}
, Document
{ displayName = "Document 2"
{ displayName = "Line"
, filePath = Nothing
, unsavedChanges = True
, strokes = [ Stroke linePts "Line" True ( unsafeUnique 1 ) ]
@ -119,17 +119,32 @@ testDocuments = IntMap.fromList
, viewportCenter = Point2D 0 0
, zoomFactor = 1
}
, Document
{ displayName = "Short line"
, filePath = Nothing
, unsavedChanges = False
, strokes = [ Stroke linePts2 "ShortLine" True ( unsafeUnique 2 ) ]
, bounds = AABB ( Point2D 0 0 ) ( Point2D 50 50 )
, viewportCenter = Point2D 0 0
, zoomFactor = 1
}
]
where
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 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 ) )
[ 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 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 ) )
]
linePts2 :: Seq ( StrokePoint PointData )
linePts2 = Seq.fromList
[ PathPoint ( Point2D 0 -100 ) ( PointData Normal ( ellipse 20 8 $ BrushPointData Normal ) )
--, ControlPoint ( Point2D 0 0 ) ( PointData Normal ( ellipse 140 8 $ BrushPointData Normal ) )
, PathPoint ( Point2D 0 100 ) ( PointData Normal ( ellipse 20 8 $ BrushPointData Normal ) )
]
--------------------------------------------------------------------------------

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

@ -44,7 +44,7 @@ import Data.Sequence
( Seq(..) )
import qualified Data.Sequence as Seq
( splitAt, drop, dropWhileL
, zipWith3, zipWith4
, zipWith, zipWith3, zipWith4
)
-- generic-lens
@ -275,7 +275,7 @@ stroke allPts@( spt0 :<| spt1 :<| spts )
where
s :: Double
s = 1 - t
= ( fitCurve fwd, fitCurve bwd ) -- fitCurve bwd )
= ( fitCurve fwd, fitCurve bwd )
<~> joinAndContinue tgt3 sp3 sps
go p0 ps = error $ "stroke: unrecognised stroke type\n" <> show ( p0 :<| ps )
@ -291,7 +291,7 @@ removePointData :: Seq ( StrokePoint d ) -> Seq ( StrokePoint () )
removePointData = fmap ( set ( field @"pointData" ) () )
lerpBrush :: forall d. Show d => Double -> Seq ( StrokePoint d ) -> Seq ( StrokePoint d ) -> Seq ( StrokePoint () )
lerpBrush t p0s p1s = f <$> p0s <*> p1s
lerpBrush t p0s p1s = Seq.zipWith f p0s p1s
where
f :: StrokePoint d -> StrokePoint d -> StrokePoint ()
f ( PathPoint { coords = p0 } )