hashirama/metabrush
1
0
Fork 0
mirror of https://gitlab.com/sheaf/metabrush.git synced 2024-12-23 22:04:07 +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 testDocuments = IntMap.fromList
$ zip [0..] $ zip [0..]
[ Document [ Document
{ displayName = "Document 1" { displayName = "Closed"
, filePath = Nothing , filePath = Nothing
, unsavedChanges = False , unsavedChanges = False
, strokes = [ Stroke ( ellipse 150 100 ( PointData Normal ( rect 30 6 $ BrushPointData Normal ) ) ) "Ellipse" True ( unsafeUnique 0 ) , 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 , zoomFactor = 1
} }
, Document , Document
{ displayName = "Document 2" { displayName = "Line"
, filePath = Nothing , filePath = Nothing
, unsavedChanges = True , unsavedChanges = True
, strokes = [ Stroke linePts "Line" True ( unsafeUnique 1 ) ] , strokes = [ Stroke linePts "Line" True ( unsafeUnique 1 ) ]
@ -119,17 +119,32 @@ testDocuments = IntMap.fromList
, viewportCenter = Point2D 0 0 , viewportCenter = Point2D 0 0
, zoomFactor = 1 , 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 where
linePts :: Seq ( StrokePoint PointData ) linePts :: Seq ( StrokePoint PointData )
linePts = Seq.fromList linePts = Seq.fromList
[ PathPoint ( Point2D 0 (-100) ) ( PointData Normal ( ellipse 30 8 $ 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 25 6 $ BrushPointData Normal ) )
, ControlPoint ( Point2D 0 ( 30) ) ( PointData Normal ( ellipse 15 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 ) ) , 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 150 ) ( PointData Normal ( ellipse 15 6 $ BrushPointData Normal ) )
, ControlPoint ( Point2D 0 ( 200) ) ( 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 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(..) ) ( Seq(..) )
import qualified Data.Sequence as Seq import qualified Data.Sequence as Seq
( splitAt, drop, dropWhileL ( splitAt, drop, dropWhileL
, zipWith3, zipWith4 , zipWith, zipWith3, zipWith4
) )
-- generic-lens -- generic-lens
@ -275,7 +275,7 @@ stroke allPts@( spt0 :<| spt1 :<| spts )
where where
s :: Double s :: Double
s = 1 - t s = 1 - t
= ( fitCurve fwd, fitCurve bwd ) -- fitCurve bwd ) = ( fitCurve fwd, fitCurve bwd )
<~> joinAndContinue tgt3 sp3 sps <~> joinAndContinue tgt3 sp3 sps
go p0 ps = error $ "stroke: unrecognised stroke type\n" <> show ( p0 :<| ps ) 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" ) () ) removePointData = fmap ( set ( field @"pointData" ) () )
lerpBrush :: forall d. Show d => Double -> Seq ( StrokePoint d ) -> Seq ( StrokePoint d ) -> Seq ( StrokePoint () ) 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 where
f :: StrokePoint d -> StrokePoint d -> StrokePoint () f :: StrokePoint d -> StrokePoint d -> StrokePoint ()
f ( PathPoint { coords = p0 } ) f ( PathPoint { coords = p0 } )