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

Improve bezier curve rendering

Browse Source
This commit is contained in:
justin
2021-03-13 14:09:49 +01:00
parent 8f3b5d0bfe
commit 152d017e39
7 changed files with 40 additions and 42 deletions
Download Patch File Download Diff File Expand all files Collapse all files
src/Picture.hs
+17 -15
View File
@@ -71,21 +71,23 @@ polygonCol = PolygonCol 0
-- note that much of work computing the width of the bezier curve is done here
bezierQuad :: Color -> Color -> Float -> Float -> Point2 -> Point2 -> Point2 -> Picture
bezierQuad cola colc ra rc a b c = BezierQuad 0 [(aX,cola ,raX)
,(bX,mixColors 0.5 0.5 cola colc,1)
,(cX,colc ,rcX)]
where b2a | isLHS a b c = b -.- a
| otherwise = a -.- b
nb2a = normalizeV $ vNormal b2a
aX = a +.+ ra * 0.5 *.* nb2a
b2c | isLHS a b c = c -.- b
| otherwise = b -.- c
nb2c = normalizeV $ vNormal b2c
cX = c +.+ rc * 0.5 *.* nb2c
raX = ra / magV (aX -.- bX)
rcX = rc / magV (cX -.- bX)
bX = b +.+ (0.5 * ra *.* nb2a)
+.+ (0.5 * rc *.* nb2c)
bezierQuad cola colc ra rc a b c = BezierQuad 0 [(aX, cola, aX +.+ aRadVec , fracRadA )
,(bX, colb, (0,0) , 0 )
,(cX, colc, cX +.+ cRadVec , fracRadC )
]
where colb = mixColors 0.5 0.5 cola colc
b2a | isLHS a b c = a -.- b
| otherwise = b -.- a
aRadVec = ra *.* (normalizeV $ vNormal b2a)
aX = a -.- 0.5 *.* aRadVec
b2c | isLHS a b c = b -.- c
| otherwise = c -.- b
cRadVec = rc *.* (normalizeV $ vNormal b2c)
cX = c -.- 0.5 *.* cRadVec
bX = (b -.- (0.5 * ra *.* aRadVec) )
-.- (0.5 * rc *.* cRadVec)
fracRadA = ra / magV (aX -.- cX)
fracRadC = rc / magV (aX -.- cX)
color :: RGBA -> Picture -> Picture
{-# INLINE color #-}