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/Data.hs
+2 -2
View File
@@ -22,7 +22,7 @@ import Data.Traversable
data RenderType
= RenderPoly [(Point3,Point4)]
| RenderBezQ [(Point3,Point4)]
| RenderBezQ [(Point3,Point4,Float)]
| RenderText [(Point3,Point4,Point3)]
| RenderArc (Point3,Point4,Point4)
| RenderLine [(Point3,Point4)]
@@ -75,7 +75,7 @@ data Picture
= Blank
| Text Int String
| Polygon Int [Point2]
| BezierQuad Int [Point2]
| BezierQuad Int [(Point2,RGBA,Float)]
| PolygonCol Int [(Point2,RGBA)]
| Circle Int RGBA RGBA Float
| ThickArc Int Float Float Float Float
src/Picture/Preload.hs
+2 -2
View File
@@ -50,7 +50,7 @@ preloadRender = do
"data/texture/charMap.png"
bezierQuadShader
<- makeShader "bezierQuad" [vert,geom,frag] [(0,3),(1,4)] Triangles pokeBezQStrat
<- makeShader "bezierQuad" [vert,geom,frag] [(0,3),(1,4),(2,1)] Triangles pokeBezQStrat
--the following vbo is set up to contain one fixed vertex
dummyvbo <- genObjectName
@@ -84,7 +84,7 @@ cleanUpRenderPreload pd = do
{-# INLINE pokeBezQStrat #-}
pokeBezQStrat :: RenderType -> [[[Float]]]
pokeBezQStrat (RenderBezQ vs) = fmap (\((x,y,z),(r,g,b,a)) -> [[x,y,z],[r,g,b,a]]) vs
pokeBezQStrat (RenderBezQ vs) = fmap (\((x,y,z),(r,g,b,a),s) -> [[x,y,z],[r,g,b,a],[s]]) vs
pokeBezQStrat _ = []
{-# INLINE pokeTriStrat #-}
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