Refactor arc drawing

shader/twoD/arc.frag

@@ -1,17 +1,12 @@
 #version 430 core
-in vec4 gColor;
-in float gRadIn;
-in vec2 angles;
-in vec2 dist;
+in vec4 vColor;
+in vec3 vparams;
+
 out vec4 fColor;
 
 void main()
 {
-  float sa = angles.x;
-  vec2 sv = vec2 (-sin(sa), cos(sa));
-  float ea = angles.y;
-  vec2 ev = vec2 (-sin(ea), cos(ea));
-  float d = (dist.x * dist.x) + (dist.y * dist.y);
-  if (d > 1 || d < gRadIn || dot(sv, dist) < 0 || dot(ev, dist) > 0) {discard;}
-  fColor = gColor;
+  float d = dot(vec2(vparams.xy),vec2(vparams.xy));
+  if ( d > 1 || d < vparams.z ) {discard;}
+  fColor = vColor;
 }

shader/twoD/arc.vert

@@ -1,15 +1,15 @@
 #version 430 core
 layout (location = 0) in vec3 position;
 layout (location = 1) in vec4 color;
-layout (location = 2) in vec4 saEaRadWdth;
+layout (location = 2) in vec3 boxXboxYwidth;
 out vec4 vColor;
-out vec4 vparams;
+out vec3 vparams;
 
 uniform mat4 worldMat;
 
 void main()
 {
-  gl_Position = vec4(position.xyz,1);
+  gl_Position = worldMat * vec4(position.xyz,1);
   vColor = color;
-  vparams = saEaRadWdth;
+  vparams = boxXboxYwidth;
 }

src/Picture.hs

@@ -225,7 +225,15 @@ arc startA endA rad = thickArc startA endA rad 1
 
 thickArc :: Float -> Float -> Float -> Float -> Picture
 {-# INLINE thickArc #-}
-thickArc = ThickArc 0
+thickArc startA endA rad wdth
+    | endA - startA > pi = pictures 
+        [ thickArc (startA + pi) endA rad wdth
+        , ThickArc 0 startA (startA + pi) r w
+        ]
+    | otherwise = ThickArc 0 startA endA r w
+  where
+    r = rad + 0.5 * wdth
+    w = 1 - wdth / r
 
 withAlpha :: Float -> RGBA -> RGBA
 {-# INLINE withAlpha #-}

src/Picture/Data.hs

@@ -17,7 +17,7 @@ data RenderType
     = RenderPoly [(Point3,Point4)]
     | RenderBezQ [(Point3,Point4,Point4)]
     | RenderText [(Point3,Point4,Point2)]
-    | RenderArc  (Point3,Point4,Point4)
+    | RenderArc  [(Point3,Point4,Point3)]
     | RenderLine [(Point3,Point4)]
     | RenderEllipse [(Point3,Point4)]
     | RenderConst

src/Picture/Tree.hs

@@ -36,8 +36,18 @@ picToLTree mx (Circle i colC colE r) = filtB mx i $ LLeaf $ RenderEllipse
     ,( (-r,-r,0), colE)
     ,( ( r,-r,0), black)
     ]
-picToLTree mx (ThickArc i startA endA rad wdth) 
-    = filtB mx i $ LLeaf $ RenderArc ((0,0,0),black,(startA,endA,rad,wdth))
+picToLTree mx (ThickArc i startA endA rad wdth) = filtB mx i $ LLeaf $ RenderArc 
+    [(  (0,0,0),black,(0,0,wdth))
+    ,((xa,ya,0),black,(1,0,wdth))
+    ,((xb,yb,0),black,(1,1,wdth))
+    ,(  (0,0,0),black,(0,0,wdth))
+    ,((xb,yb,0),black,(1,1,wdth))
+    ,((xc,yc,0),black,(0,1,wdth))
+    ]
+  where
+    (xa,ya) = rotateV startA (rad,0)
+    (xb,yb) = rotateV (0.5 * (startA + endA)) (rad * sqrt 2,0)
+    (xc,yc) = rotateV endA (rad,0)
 picToLTree mx (Line i ps) 
     = filtB mx i $ LLeaf $ RenderLine $ zip (map zeroZ $ doubleLine ps) $ repeat white
 picToLTree mx (LineCol i vs) 
@@ -78,12 +88,11 @@ 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)
+overPos f (RenderArc vs)  = RenderArc $ map (\(a,b,c) -> (f a,b,c)) vs
 overPos _ _ = undefined
 
 overRot :: Float -> RenderType -> RenderType
 {-# INLINE overRot #-}
-overRot ang (RenderArc (a,b,(r,s,t,v))) = RenderArc (a,b,(r+ang,s+ang,t,v))
 overRot _ ren = ren
 
 overCol :: (Point4 -> Point4) -> RenderType -> RenderType
@@ -93,7 +102,7 @@ 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)
+overCol f (RenderArc vs) = RenderArc $ map (\(a,b,c) -> (a,f b,c)) vs
 overCol _ _ = undefined
 
 stringToList :: String -> [(Point3,Point4,Point2)]

src/Preload/Render.hs

@@ -29,7 +29,7 @@ preloadRender = do
 -- 2D draw shaders
     bslist <- makeShader "twoD/basic"   [vert,frag]      [3,4]   Triangles pokeTriStrat
     lslist <- makeShader "twoD/basic"   [vert,frag]      [3,4]   Lines     pokeLineStrat
-    aslist <- makeShader "twoD/arc"     [vert,geom,frag] [3,4,4] Points    pokeArcStrat
+    aslist <- makeShader "twoD/arc"     [vert,frag] [3,4,3] Triangles    pokeArcStrat
     eslist <- makeShader "twoD/ellipse" [vert,geom,frag] [3,4]   Triangles pokeEllStrat
     bezierQuadShader <- makeShader "twoD/bezierQuad" [vert,frag] [3,4,4]  TriangleStrip pokeBezQStrat
     cslist <- makeShader "twoD/character" [vert,frag] [3,4,2] Triangles pokeCharStrat
@@ -177,7 +177,7 @@ pokeLightingFloorStrat _ = undefined
 pokeCharStrat (RenderText vs) = fmap (\(a,b,c) -> concat [flat3 a, flat4 b, flat2 c]) vs
 pokeCharStrat _ = []
 
-pokeArcStrat (RenderArc (a,b,c)) = [concat [flat3 a, flat4 b, flat4 c]]
+pokeArcStrat (RenderArc vs) = fmap (\(a,b,c) -> concat [flat3 a, flat4 b, flat3 c]) vs
 pokeArcStrat _ = []
 
 pokeLineStrat (RenderLine vs) = fmap (\((x,y,z),(r,g,b,a)) -> [x,y,z,r,g,b,a]) vs