Cleanup arc drawing

src/Dodge/Render/ShapePicture.hs

@@ -2,7 +2,7 @@ module Dodge.Render.ShapePicture (
     worldSPic,
 ) where
 
-import Picture.Test
+import Picture.Arc
 import Dodge.Viewpoints
 import Dodge.Render.Label
 import Dodge.WorldEvent.ThingsHit
@@ -79,7 +79,7 @@ drawSweep cr cfig w = fromMaybe mempty $ do
 --        $ arc (rot + a) (rot + _crDir cr) (dist mwp p * campos ^. camZoom)
         $ color white (circle 100)
            -- <> arcTest (3*pi/4) 100 green 0 1 red 100
-            <> arcTest 0 5 green (3*pi/4) 50 red 100 white
+            <> arcFull 0 5 green (3*pi/4) 50 red 100 white
             -- <> f green 0 (pi/2) 100
 --            <> f red 2 3 100
             <> f blue 4 4.5 100 white
@@ -87,7 +87,7 @@ drawSweep cr cfig w = fromMaybe mempty $ do
           --  <> f 3 0 220 <> f 4 0 240
           --  <> f (-0.5) 0.5 260 <> f 0.5 (-0.5) 280
   where
-    f col a b c = arcTest a 25 col b 1 red c
+    f col a b c = arcFull a 25 col b 1 red c
     --f a b c = thickArc a b c 5
     --rot = campos ^. camRot
     p = _crPos cr

src/Picture/Arc.hs

@@ -0,0 +1,49 @@
+module Picture.Arc where
+
+import Color
+import Geometry
+import Picture.Data
+
+-- this should work regardless of which angle is larger, though swapping the
+-- angles will affect the winding of the drawn triangles
+arcFull :: Float -> Float -> Color -> Float -> Float -> Color -> Float -> Color -> Picture
+arcFull startA swidth scol endA ewidth ecol r centercol
+    | abs (difference startA endA) > pi / 2 =
+        arcFull startA swidth scol midA mw mc r centercol
+            <> arcFull midA mw mc endA ewidth ecol r centercol
+    | otherwise = arcPart startA swidth scol endA ewidth ecol r centercol
+  where
+    midA = 0.5 * (startA + endA)
+    mw = 0.5 * (swidth + ewidth)
+    mc = mixColors 0.5 0.5 scol ecol
+
+-- should work if the angles are pi/2 or less apart.
+arcPart :: Float -> Float -> Color -> Float -> Float -> Color -> Float -> Color -> Picture
+arcPart startA sw sc endA ew ec r centercol =
+    map
+        f
+        [ (V3 0 0 0, centercol, V3 0 0 mwdth)
+        , (V3 xa ya 0, sc, V3 ad op wdth)
+        , (V3 xb yb 0, mc, V3 1 1 mwdth)
+        , (V3 0 0 0, centercol, V3 0 0 mwdth)
+        , (V3 xb yb 0, mc, V3 1 1 mwdth)
+        , (V3 xc yc 0, ec, V3 ad op ewdth)
+        ]
+  where
+    mc = mixColors 0.5 0.5 sc ec
+    ang = endA - startA
+    -- imagine that the arc is centered on the diagonal of the first quadrant
+    -- then the x-y values for the start and end of the arc are the following
+    op = sin ((pi / 2 - ang) / 2)
+    ad = cos ((pi / 2 - ang) / 2)
+    -- for most of the drawn triangles, the "width" value is interpolated towards the center
+    wdth = (wdth' + (wdth' - 1) * mwdth) / wdth'
+    wdth' = 1 - sw / r
+    -- along the middle line the "width" value is the following constant
+    mwdth = 1 - (0.5 * (sw + ew)) / r
+    ewdth' = 1 - ew / r
+    ewdth = (ewdth' + (ewdth' - 1) * mwdth) / ewdth'
+    (V2 xa ya) = rotateV startA (V2 r 0)
+    (V2 xb yb) = rotateV (0.5 * (startA + endA)) (V2 (r * sqrt 2) 0)
+    (V2 xc yc) = rotateV endA (V2 r 0)
+    f (pos, col, V3 a b c) = Verx pos col [a, b, c] BottomLayer arcNum

src/Picture/Base.hs

@@ -3,6 +3,7 @@
 
 module Picture.Base (
     module Picture.Data,
+    module Picture.Arc,
     module Color,
     blank,
     polygon,
@@ -15,7 +16,7 @@ module Picture.Base (
     arc,
     arcSolid,
     thickArc,
-    thickArcFull,
+    --thickArcFull,
     thickCircle,
     thickLine,
     lineThick,
@@ -51,6 +52,7 @@ import Color
 import Data.Foldable
 import Geometry
 import Picture.Data
+import Picture.Arc
 
 blank :: Picture
 {-# INLINE blank #-}
@@ -327,58 +329,59 @@ arc ::
 arc startA endA rad = thickArc startA endA rad 1
 {-# INLINE arc #-}
 
-thickArcFull :: Float -> Float -> Color -> Float -> Float -> Color -> Float -> Picture
+--thickArcFull :: Float -> Float -> Color -> Float -> Float -> Color -> Float -> Picture
-{-# INLINE thickArcFull #-}
+--{-# INLINE thickArcFull #-}
-thickArcFull sa sw sc ea ew ec rad 
+--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
+--    | difference sa ea > pi / 2 = thickArcFull sa sw sc ma mw mc rad <> thickArcFull ma mw mc ea ew ec rad
-    | otherwise = map f
+--    | otherwise = map f
-            [ (V3 0 0 0, mc, V3 0 0 mw)
+--            [ (V3 0 0 0, mc, V3 0 0 mw)
-            , (V3 xa ya 0, sc, V3 1 0 sw)
+--            , (V3 xa ya 0, sc, V3 1 0 sw)
-            , (V3 xb yb 0, mc, V3 1 1 mw)
+--            , (V3 xb yb 0, mc, V3 1 1 mw)
-            , (V3 0 0 0, sc, V3 0 0 sw)
+--            , (V3 0 0 0, sc, V3 0 0 sw)
-            , (V3 xb yb 0, mc, V3 1 1 mw)
+--            , (V3 xb yb 0, mc, V3 1 1 mw)
-            , (V3 xc yc 0, ec, V3 0 1 ew)
+--            , (V3 xc yc 0, ec, V3 0 1 ew)
-            ]
+--            ]
-  where
+--  where
-    (V2 xa ya) = rotateV sa (V2 rad 0)
+--    (V2 xa ya) = rotateV sa (V2 rad 0)
-    (V2 xb yb) = rotateV (0.5 * (sa + ea)) (V2 (rad * sqrt 2) 0)
+--    (V2 xb yb) = rotateV (0.5 * (sa + ea)) (V2 (rad * sqrt 2) 0)
-    (V2 xc yc) = rotateV ea (V2 rad 0)
+--    (V2 xc yc) = rotateV ea (V2 rad 0)
-    f (pos, col, V3 a b c) = Verx pos col [a, b, c] BottomLayer arcNum
+--    f (pos, col, V3 a b c) = Verx pos col [a, b, c] BottomLayer arcNum
-    ma = 0.5 * (sa + ea)
+--    ma = 0.5 * (sa + ea)
-    mw = 0.5 * (sw + ew)
+--    mw = 0.5 * (sw + ew)
-    mc = mixColors 0.5 0.5 sc ec
+--    mc = mixColors 0.5 0.5 sc ec
 
 thickArc :: Float -> Float -> Float -> Float -> Picture
 {-# INLINE thickArc #-}
-thickArc startA endA rad wdth
+thickArc startA endA rad wdth = arcFull startA wdth white endA wdth white rad white
-    | endA - startA > (pi / 2) =
+--thickArc startA endA rad wdth
-        pictures
+--    | endA - startA > (pi / 2) =
-            [ thickArc (startA + pi / 2) endA rad wdth
+--        pictures
-            , thickArcHelp startA (startA + pi / 2) r w
+--            [ thickArc (startA + pi / 2) endA rad wdth
-            ]
+--            , thickArcHelp startA (startA + pi / 2) r w
-    | otherwise = thickArcHelp startA endA r w
+--            ]
-  where
+--    | otherwise = thickArcHelp startA endA r w
-    r = rad + 0.5 * wdth
+--  where
-    w = 1 - wdth / r
+--    r = rad + 0.5 * wdth
+--    w = 1 - wdth / r
 
-thickArcHelp :: Float -> Float -> Float -> Float -> Picture
+--thickArcHelp :: Float -> Float -> Float -> Float -> Picture
-{-# INLINE thickArcHelp #-}
+--{-# INLINE thickArcHelp #-}
-thickArcHelp startA endA rad wdth =
+--thickArcHelp startA endA rad wdth =
-    picFormat $
+--    picFormat $
-        map
+--        map
-            f
+--            f
-            [ (V3 0 0 0, black, V3 0 0 wdth)
+--            [ (V3 0 0 0, black, V3 0 0 wdth)
-            , (V3 xa ya 0, black, V3 1 0 wdth)
+--            , (V3 xa ya 0, black, V3 1 0 wdth)
-            , (V3 xb yb 0, black, V3 1 1 wdth)
+--            , (V3 xb yb 0, black, V3 1 1 wdth)
-            , (V3 0 0 0, black, V3 0 0 wdth)
+--            , (V3 0 0 0, black, V3 0 0 wdth)
-            , (V3 xb yb 0, black, V3 1 1 wdth)
+--            , (V3 xb yb 0, black, V3 1 1 wdth)
-            , (V3 xc yc 0, black, V3 0 1 wdth)
+--            , (V3 xc yc 0, black, V3 0 1 wdth)
-            ]
+--            ]
-  where
+--  where
-    (V2 xa ya) = rotateV startA (V2 rad 0)
+--    (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 * sqrt 2) 0)
-    (V2 xc yc) = rotateV endA (V2 rad 0)
+--    (V2 xc yc) = rotateV endA (V2 rad 0)
-    f (pos, col, V3 a b c) = Verx pos col [a, b, c] BottomLayer arcNum
+--    f (pos, col, V3 a b c) = Verx pos col [a, b, c] BottomLayer arcNum
 
 -- Currently the lens version is much slower
 overPos :: (Point3 -> Point3) -> Verx -> Verx

src/Picture/Test.hs

@@ -1,19 +1,23 @@
 module Picture.Test where
 
-import Picture.Data
-import Geometry
 import Color
+import Geometry
+import Picture.Data
 
+-- this should work regardless of which angle is larger, though swapping the
+-- angles will affect the winding of the drawn triangles
 arcTest :: Float -> Float -> Color -> Float -> Float -> Color -> Float -> Color -> Picture
-arcTest startA sw sc endA ew ec r centercol
+arcTest startA swidth scol endA ewidth ecol r centercol
-    | abs (difference startA endA) > pi / 2 = arcTest startA sw sc midA mw mc r centercol
+    | abs (difference startA endA) > pi / 2 =
-        <> arcTest midA mw mc endA ew ec r centercol
+        arcTest startA swidth scol midA mw mc r centercol
-    | otherwise = arcTest' startA sw sc endA ew ec r centercol
+            <> arcTest midA mw mc endA ewidth ecol r centercol
+    | otherwise = arcTest' startA swidth scol endA ewidth ecol r centercol
   where
     midA = 0.5 * (startA + endA)
-    mw = 0.5 * (sw + ew)
+    mw = 0.5 * (swidth + ewidth)
-    mc = mixColors 0.5 0.5 sc ec
+    mc = mixColors 0.5 0.5 scol ecol
 
+-- should work if the angles are pi/2 or less apart.
 arcTest' :: Float -> Float -> Color -> Float -> Float -> Color -> Float -> Color -> Picture
 arcTest' startA sw sc endA ew ec r centercol =
     map
@@ -28,10 +32,14 @@ arcTest' startA sw sc endA ew ec r centercol =
   where
     mc = mixColors 0.5 0.5 sc ec
     ang = endA - startA
+    -- imagine that the arc is centered on the diagonal of the first quadrant
+    -- then the x-y values for the start and end of the arc are the following
     op = sin ((pi / 2 - ang) / 2)
     ad = cos ((pi / 2 - ang) / 2)
+    -- for most of the drawn triangles, the "width" value is interpolated towards the center
     wdth = (wdth' + (wdth' - 1) * mwdth) / wdth'
     wdth' = 1 - sw / r
+    -- along the middle line the "width" value is the following constant
     mwdth = 1 - (0.5 * (sw + ew)) / r
     ewdth' = 1 - ew / r
     ewdth = (ewdth' + (ewdth' - 1) * mwdth) / ewdth'