justin/loop
1
0
Fork 0
Code Issues Pull Requests 1 Packages Projects Releases Wiki Activity

Implement color for quadratic bezier curves

Browse Source
This commit is contained in:
justin
2021-03-12 19:10:14 +01:00
parent 4ed72e263b
commit 918f7d23b8
8 changed files with 38 additions and 14 deletions
Download Patch File Download Diff File Expand all files Collapse all files
src/Picture/Tree.hs
+6 -4
View File
@@ -17,8 +17,10 @@ picToLTree mx (Polygon i ps)
picToLTree mx (PolygonCol i vs)
= filtB mx i $ LLeaf $ RenderPoly $ zip (map zeroZ $ polyToTris ps) $ polyToTris cs
where (ps,cs) = unzip vs
picToLTree mx (BezierQuad i ps)
= filtB mx i $ LLeaf $ RenderBezQ $ zip (map zeroZ $ ps) $ repeat black
picToLTree mx (BezierQuad i vs)
= filtB mx i $ LLeaf $ RenderBezQ $ zip3 (map zeroZ ps) cols rs
where (ps,cols,rs) = unzip3 vs
picToLTree mx (Circle i colC colE r)
= filtB mx i $ LLeaf $ RenderEllipse [( (-r, r,0), colC)
,( (-r,-r,0), colE)
@@ -68,9 +70,9 @@ scaleT (x,y) (a,b,(o,s,t)) = (a,b,(o,s*x,t*y))
overPos :: (Point3 -> Point3) -> RenderType -> RenderType
{-# INLINE overPos #-}
overPos f (RenderPoly vs) = RenderPoly $ map (first $ f) vs
overPos f (RenderBezQ vs) = RenderBezQ $ map (first $ f) vs
overPos f (RenderLine vs) = RenderLine $ map (first $ f) vs
overPos f (RenderText vs) = RenderText $ map (\(a,b,c) -> (f a,b,c)) vs
overPos f (RenderBezQ vs) = RenderBezQ $ map (\(a,b,c) -> (f a,b,c)) vs
overPos f (RenderEllipse vs) = RenderEllipse $ map (first f) vs
overPos f (RenderArc (a,b,c)) = RenderArc (f a,b,c)
@@ -82,10 +84,10 @@ overRot _ ren = ren
overCol :: (Point4 -> Point4) -> RenderType -> RenderType
{-# INLINE overCol #-}
overCol f (RenderPoly vs) = RenderPoly $ map (second $ f) vs
overCol f (RenderBezQ vs) = RenderBezQ $ map (second $ f) vs
overCol f (RenderLine vs) = RenderLine $ map (second $ f) vs
overCol f (RenderEllipse vs) = RenderEllipse $ map (second $ f) vs
overCol f (RenderText vs) = RenderText $ map (\(a,b,c) -> (a,f b,c)) vs
overCol f (RenderBezQ vs) = RenderBezQ $ map (\(a,b,c) -> (a,f b,c)) vs
overCol f (RenderArc (a,b,c)) = RenderArc (a,f b,c)
overSca :: (Point2 -> Point2) -> RenderType -> RenderType