Implement arcs with variable width and color

src/Picture/Base.hs

@@ -15,6 +15,7 @@ module Picture.Base (
     arc,
     arcSolid,
     thickArc,
+    thickArcFull,
     thickCircle,
     thickLine,
     lineThick,
@@ -153,7 +154,7 @@ extrapolate (V2 ox oy) (V2 ax ay) (V2 bx by) (V2 x y) =
 
 color :: RGBA -> Picture -> Picture
 {-# INLINE color #-}
-color c = picMap $ overCol (const c)
+color = picMap . overCol . const
 
 translateH :: Float -> Float -> Point3 -> Point3
 {-# INLINE translateH #-}
@@ -326,6 +327,27 @@ arc ::
 arc startA endA rad = thickArc startA endA rad 1
 {-# INLINE arc #-}
 
+thickArcFull :: Float -> Float -> Color -> Float -> Float -> Color -> Float -> Picture
+{-# INLINE thickArcFull #-}
+thickArcFull sa sw sc ea ew ec rad 
+    | difference sa ea > pi / 2 = thickArcFull sa sw sc ma mw mc rad <> thickArcFull ma mw mc ea ew ec rad
+    | otherwise = map f
+            [ (V3 0 0 0, mc, V3 0 0 mw)
+            , (V3 xa ya 0, sc, V3 1 0 sw)
+            , (V3 xb yb 0, mc, V3 1 1 mw)
+            , (V3 0 0 0, sc, V3 0 0 sw)
+            , (V3 xb yb 0, mc, V3 1 1 mw)
+            , (V3 xc yc 0, ec, V3 0 1 ew)
+            ]
+  where
+    (V2 xa ya) = rotateV sa (V2 rad 0)
+    (V2 xb yb) = rotateV (0.5 * (sa + ea)) (V2 (rad * sqrt 2) 0)
+    (V2 xc yc) = rotateV ea (V2 rad 0)
+    f (pos, col, V3 a b c) = Verx pos col [a, b, c] BottomLayer arcNum
+    ma = 0.5 * (sa + ea)
+    mw = 0.5 * (sw + ew)
+    mc = mixColors 0.5 0.5 sc ec
+
 thickArc :: Float -> Float -> Float -> Float -> Picture
 {-# INLINE thickArc #-}
 thickArc startA endA rad wdth
@@ -355,7 +377,6 @@ thickArcHelp startA endA rad wdth =
   where
     (V2 xa ya) = rotateV startA (V2 rad 0)
     (V2 xb yb) = rotateV (0.5 * (startA + endA)) (V2 (rad * sqrt 2) 0)
-    --(V2 xb yb) = rotateV (0.5 * (startA + endA)) (V2 (rad * 2) 0)
     (V2 xc yc) = rotateV endA (V2 rad 0)
     f (pos, col, V3 a b c) = Verx pos col [a, b, c] BottomLayer arcNum