Improve bezier curve rendering

shader/bezierQuad.frag

@@ -1,8 +1,8 @@
 #version 430 core
 in vec4 gColor;
 in vec3 gBoundingBox;
-in float gRadStart;
+in float wStart;
-in float gRadEnd;
+in float wEnd;
 
 out vec4 fColor;
 
@@ -10,9 +10,6 @@ float x = gBoundingBox.x;
 float y = gBoundingBox.y;
 float z = gBoundingBox.z;
 
-float w = gRadEnd;
-float w2 = gRadStart;
-
 float f (float a, float b)
 {   
     float c = 1 / (1 - 2*b) ;
@@ -22,7 +19,7 @@ void main()
 {
   //float d = x - y - 1 + 2* sqrt(y);
   float d = sqrt(x) + sqrt(y) - 1;
-  float e = sqrt(f(x,w)) + sqrt(f(y,w2)) - 1.0;
+  float e = sqrt(f(x,wStart)) + sqrt(f(y,wEnd)) - 1.0;
 //  if ( d < 0 || e > 0) { discard; }
   fColor = gColor;
   if ( d < 0 || e > 0) { fColor = vec4(0,0,1,1); }

shader/bezierQuad.geom

@@ -2,10 +2,11 @@
 layout (triangles) in;
 layout (triangle_strip, max_vertices = 5) out;
 in vec4 vColor[];
-in float vRad[];
+in vec2 vPosOff[];
+in float vRadMag[];
 out vec4 gColor;
-out float gRadStart;
+out float wStart;
-out float gRadEnd;
+out float wEnd;
 out vec3 gBoundingBox;
 
 vec2 normV2 (vec2 v)
@@ -21,21 +22,16 @@ void main()
   vec3 pb = gl_in[1].gl_Position.xyz;
   vec3 pc = gl_in[2].gl_Position.xyz;
 
-  gRadStart = vRad[0];
+  wStart = vRadMag [0];
-  gRadEnd   = vRad[2];
+  wEnd   = vRadMag [2];
-
-  vec2 ab = (pa.xy - pb.xy);
-  vec2 cb = (pc.xy - pb.xy);
-  float dir = lhs( cb,ab);
 
   gBoundingBox = vec3 (0.9,0.1,0);
   gColor = vColor[0];
-  gl_Position = vec4 (pa.xy + dir * 2 * gRadStart * normV2(ab) , pa.z , 1);
+  gl_Position = vec4 (vPosOff[0] , pa.z , 1);
   EmitVertex();
   gBoundingBox = vec3 (0.1,0.9,0);
   gColor = vColor[2];
-//  gl_Position = vec4 (pc.xy + dir * gRadEnd * (normV2 (pb.xy-pc.xy)), pa.z , 1);
+  gl_Position = vec4 (vPosOff[2] , pc.z , 1);
-  gl_Position = vec4 (pc.xy - dir * 2 * gRadEnd * normV2(cb) , pc.z , 1);
   EmitVertex();
   gBoundingBox = vec3 (1,0,1);
   gColor = vColor[0];

shader/bezierQuad.vert

@@ -1,9 +1,10 @@
 #version 430 core
 layout (location = 0) in vec3 position;
 layout (location = 1) in vec4 color;
-layout (location = 2) in float rad;
+layout (location = 2) in vec3 radVec;
 out vec4 vColor;
-out float vRad;
+out vec2 vPosOff;
+out float vRadMag;
 
 uniform vec2 winSize;
 uniform float zoom;
@@ -14,6 +15,7 @@ uniform mat4 worldMat;
 void main()
 {
   gl_Position = worldMat * vec4(position.xyz,1);
-  vColor = color;
+  vColor  = color;
-  vRad   = rad;
+  vPosOff = ( worldMat * vec4(radVec.xy,0,1) ).xy ;
+  vRadMag = radVec.z ;
 }

src/Picture.hs

@@ -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)
+bezierQuad cola colc ra rc a b c = BezierQuad 0 [(aX, cola, aX +.+ aRadVec , fracRadA  )
-                                                ,(bX,mixColors 0.5 0.5 cola colc,1)
+                                                ,(bX, colb, (0,0)          , 0 )
-                                                ,(cX,colc                 ,rcX)]
+                                                ,(cX, colc, cX +.+ cRadVec , fracRadC )
-    where b2a | isLHS a b c = b -.- a
+                                                ]
-              | otherwise   = a -.- b
+    where colb = mixColors 0.5 0.5 cola colc
-          nb2a = normalizeV $ vNormal b2a
+          b2a | isLHS a b c = a -.- b
-          aX = a +.+ ra * 0.5 *.* nb2a
+              | otherwise   = b -.- a
-          b2c | isLHS a b c = c -.- b
+          aRadVec = ra *.* (normalizeV $ vNormal b2a)
-              | otherwise   = b -.- c
+          aX = a -.- 0.5 *.* aRadVec
-          nb2c = normalizeV $ vNormal b2c
+          b2c | isLHS a b c = b -.- c
-          cX = c +.+ rc * 0.5 *.* nb2c
+              | otherwise   = c -.- b
-          raX = ra / magV (aX -.- bX)
+          cRadVec = rc *.* (normalizeV $ vNormal b2c)
-          rcX = rc / magV (cX -.- bX)
+          cX = c -.- 0.5 *.* cRadVec
-          bX = b +.+ (0.5 * ra *.* nb2a)
+          bX = (b -.- (0.5 * ra *.* aRadVec) )
-                 +.+ (0.5 * rc *.* nb2c)
+                  -.- (0.5 * rc *.* cRadVec)
+          fracRadA = ra / magV (aX -.- cX)
+          fracRadC = rc / magV (aX -.- cX)
 
 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,Float)]
+    | RenderBezQ [(Point3,Point4,Point3)]
     | 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,Float)]
+    | BezierQuad Int [(Point2,RGBA,Point2,Float)]
     | 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,1)]    Triangles pokeBezQStrat
+           <- makeShader "bezierQuad" [vert,geom,frag] [(0,3),(1,4),(2,3)]    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),s) -> [[x,y,z],[r,g,b,a],[s]]) vs
+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 _ = []
 
 {-# INLINE pokeTriStrat #-}

src/Picture/Tree.hs

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