mirror of
https://gitlab.com/sheaf/metabrush.git
synced 2024-11-05 14:53:37 +00:00
use correct applicative operation for brush lerp
This commit is contained in:
parent
9e73da9fff
commit
9c5f8b1198
33
app/Main.hs
33
app/Main.hs
|
@ -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 ) )
|
||||
]
|
||||
|
||||
--------------------------------------------------------------------------------
|
||||
|
|
|
@ -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 } )
|
||||
|
|
Loading…
Reference in a new issue