Render bezier curves using distance fields

shader/bezierQuad.frag

@@ -1,32 +1,18 @@
 #version 430 core
-in vec4 gColor;
+in vec4 vColor;
-in vec3 gBoundingBox;
+in vec2 boxOut;
-in vec2 box2;
+in vec2 boxIn;
-in float wStart;
-in float wEnd;
-// the width is calculated along the line a-c
-// this should instead be along the lines a-b (for start width)
-// and b-c (for end width)
 
 out vec4 fColor;
 
-float x = gBoundingBox.x;
-float y = gBoundingBox.y;
-float z = gBoundingBox.z;
-
-float f (float a, float b)
-{   
-    float c = 1 / (1 - 2*b) ;
-    return c * (a - 0.5) + 0.5 ;
-}
 void main()
 {
   //float d = x - y - 1 + 2* sqrt(y);
-  float d = sqrt(x) + sqrt(y) - 1;
+  float d = sqrt(boxOut.x) + sqrt(boxOut.y) - 1;
 //  float e = sqrt(f(x,wStart)) + sqrt(f(y,wEnd)) - 1.0;
-  float e = sqrt(box2.x) + sqrt(box2.y) - 1.0;
+  float e = sqrt(boxIn.x) + sqrt(boxIn.y) - 1.0;
 //  if ( d < 0 || e > 0) { discard; }
-  fColor = gColor;
+  fColor = vColor;
 //  if ( d < 0 || e > 0) { fColor = vec4(0,0,1,1); }
   if ( d < 0 || e > 0) { fColor = vec4(0,0,1,1); }
 }

shader/bezierQuad.vert

@@ -1,10 +1,10 @@
 #version 430 core
 layout (location = 0) in vec3 position;
 layout (location = 1) in vec4 color;
-layout (location = 2) in vec3 radVec;
+layout (location = 2) in vec4 boxes;
 out vec4 vColor;
-out vec2 vPosOff;
+out vec2 boxOut;
-out float vRadMag;
+out vec2 boxIn;
 
 uniform vec2 winSize;
 uniform float zoom;
@@ -16,6 +16,6 @@ void main()
 {
   gl_Position = worldMat * vec4(position.xyz,1);
   vColor  = color;
-  vPosOff = ( worldMat * vec4(radVec.xy,0,1) ).xy ;
+  boxOut = boxes.xy ;
-  vRadMag = radVec.z ;
+  boxIn = boxes.zw ;
 }

src/Picture.hs

@@ -71,23 +71,49 @@ 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, aX +.+ aRadVec , fracRadA  )
+bezierQuad cola colc ra rc a b c = BezierQuad 0 [-- ( (0,0) , cola, (0,0), (0,0) )
-                                                ,(bX, colb, (0,0)          , 0 )
+                                                 (aIn, cola, (fa aIn,fc aIn) , (1,0) )
-                                                ,(cX, colc, cX +.+ cRadVec , fracRadC )
+                                                ,(aIn, cola, (fa aIn,fc aIn) , (1,0) )
+                                                ,(cIn, colc, (fa cIn,fc cIn) , (0,1) )
+                                                ,( aX, cola, (1,0) , (fa' aX,fc' aX)  )
+                                                ,( cX, colc, (0,1) , (fa' cX,fc' cX)  )
+                                                ,( bX, colb, (0,0) , (fa' bX,fc' bX)  )
+                                                ,( bX, colb, (0,0) , (fa' bX,fc' bX)  )
                                                 ]
     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
+          aX  = a -.- 0.5 *.* aRadVec
+          aIn = a +.+ 0.5 *.* aRadVec
           b2c | isLHS a b c = b -.- c
               | otherwise   = c -.- b
           cRadVec = rc *.* (normalizeV $ vNormal b2c)
-          cX = c -.- 0.5 *.* cRadVec
+          cX  = c -.- 0.5 *.* cRadVec
+          cIn = c +.+ 0.5 *.* cRadVec
           bX = (b -.- (0.5 *.* aRadVec) )
                   -.- (0.5 *.* cRadVec)
-          fracRadA = ra / magV (aX -.- cX)
+          bIn = b +.+ (0.5 *.* aRadVec) 
-          fracRadC = rc / magV (aX -.- cX)
+                  +.+ (0.5 *.* cRadVec)
+          fa = extrapolate aX cX bX 
+          fc = extrapolate cX aX bX
+          fa' = extrapolate aIn cIn bIn
+          fc' = extrapolate cIn aIn bIn
+
+-- given a one and two zeros of a linear function over x and y,
+-- determine the function
+-- so if f(ox,oy) = 1 and f(ax,ay) = f(bx,by) = 0, determines f
+extrapolate :: Point2 -> Point2 -> Point2 -> Point2 -> Float
+extrapolate (ox,oy) (ax,ay) (bx,by) (x,y) = 
+    (       x * ( ay - by )
+        +   y * ( bx - ax )
+        +   (ax * by - bx * ay)
+    ) 
+    / 
+    (       ox * ( ay - by )
+        +   ax * ( by - oy )
+        +   bx * ( oy - ay )
+    )
 
 color :: RGBA -> Picture -> Picture
 {-# INLINE color #-}

src/Picture/Data.hs

@@ -22,7 +22,7 @@ import Data.Traversable
 
 data RenderType
     = RenderPoly [(Point3,Point4)]
-    | RenderBezQ [(Point3,Point4,Point3)]
+    | RenderBezQ [(Point3,Point4,Point4)]
     | 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,RGBA,Point2,Float)]
+    | BezierQuad Int [(Point2,RGBA,Point2,Point2)]
     | PolygonCol Int [(Point2,RGBA)]
     | Circle Int RGBA RGBA Float
     | ThickArc Int Float Float Float Float

src/Picture/Preload.hs

@@ -50,7 +50,7 @@ preloadRender = do
                                 "data/texture/charMap.png"
 
     bezierQuadShader
-           <- makeShader "bezierQuad" [vert,geom,frag] [(0,3),(1,4),(2,3)]    Triangles pokeBezQStrat
+           <- makeShader "bezierQuad" [vert,frag] [(0,3),(1,4),(2,4)]    TriangleStrip pokeBezQStrat
 
 --the following vbo is set up to contain one fixed vertex
     dummyvbo <- genObjectName
@@ -84,7 +84,9 @@ cleanUpRenderPreload pd = do
 
 {-# INLINE pokeBezQStrat #-}
 pokeBezQStrat :: RenderType -> [[[Float]]]
-pokeBezQStrat (RenderBezQ vs) = fmap (\((x,y,z),(r,g,b,a),(s,t,v)) -> [[x,y,z],[r,g,b,a],[s,t,v]]) vs
+pokeBezQStrat (RenderBezQ vs) = fmap (\((x,y,z),(r,g,b,a),(s,t,u,v)) -> [[x,y,z],[r,g,b,a],[s,t,u,v]]
+                                     ) 
+                                     vs
 pokeBezQStrat _ = []
 
 {-# INLINE pokeTriStrat #-}

src/Picture/Tree.hs

@@ -20,7 +20,7 @@ picToLTree mx (PolygonCol i vs)
 picToLTree mx (BezierQuad i vs) 
     = filtB mx i $ LLeaf $ RenderBezQ $ zip3 (map zeroZ ps) cols rs
         where (ps,cols,offps,rads) = unzip4 vs
-              rs = zipWith (\(x,y) z -> (x,y,z)) offps rads
+              rs = zipWith (\(x,y) (z,w) -> (x,y,z,w)) offps rads
                                       
 picToLTree mx (Circle i colC colE r)
     = filtB mx i $ LLeaf $ RenderEllipse [( (-r, r,0), colC)