Merge pull request #56 from fryguybob/arc-enhancements

Fixed `arc` and `arcT` so they are always CCW.

src/Diagrams/TwoD.hs

@@ -87,6 +87,8 @@ module Diagrams.TwoD
        , ellipse
        , ellipseXY
        , arc
+       , arc'
+       , arcCW
        , wedge
 
          -- ** General polygons

src/Diagrams/TwoD/Arc.hs

@@ -14,6 +14,8 @@
 
 module Diagrams.TwoD.Arc
     ( arc
+    , arc'
+    , arcCW
     , arcT
     , bezierFromSweep
 
@@ -82,18 +84,52 @@ across a situation with large enough arcs that they can actually see
 the approximation error.
 -}
 
+-- | Given a start angle @s@ and an end angle @e@, @'arcT' s e@ is the
+--   'Trail' of a radius one arc counterclockwise between the two angles.
 arcT :: Angle a => a -> a -> Trail R2
-arcT start end = Trail bs (sweep >= tau)
+arcT start end
+    | e < s     = arcT s (e + fromIntegral d)
+    | otherwise = Trail bs (sweep >= tau)
   where sweep = convertAngle $ end - start
         bs    = map (rotate start) . bezierFromSweep $ sweep
+
+        -- We want to compare the start and the end and in case
+        -- there isn't some law about 'Angle' ordering, we use a
+        -- known 'Angle' for that.
+        s = convertAngle start :: CircleFrac
+        e = convertAngle end
+        d = ceiling (s - e) :: Integer
 
 -- | Given a start angle @s@ and an end angle @e@, @'arc' s e@ is the
 --   path of a radius one arc counterclockwise between the two angles.
+--   The origin of the arc is its center.
 arc :: (Angle a, PathLike p, V p ~ R2) => a -> a -> p
 arc start end = pathLike (rotate start $ p2 (1,0))
                          False
                          (trailSegments $ arcT start end)
 
+-- | Like 'arc' but clockwise.
+arcCW :: (Angle a, PathLike p, V p ~ R2) => a -> a -> p
+arcCW start end = pathLike (rotate start $ p2 (1,0))
+                           False
+                           -- flipped arguments to get the path we want
+                           -- then reverse the trail to get the cw direction.
+                           (trailSegments . reverseTrail $ arcT end start)
+                   -- We could just have `arcCW = reversePath . flip arc`
+                   -- but that wouldn't be `PathLike`.
+
+-- | Given a radus @r@, a start angle @s@ and an end angle @e@,
+--   @'arc'' r s e@ is the path of a radius @(abs r)@ arc between 
+--   the two angles.  If a negative radius is given, the arc will
+--   be clockwise, otherwise it will be counterclockwise. The origin 
+--   of the arc is its center.
+arc' :: (Angle a, PathLike p, V p ~ R2) => Double -> a -> a -> p
+arc' r start end = pathLike (rotate start $ p2 (abs r,0))
+                   False
+                   (trailSegments . scale (abs r) $ ts)
+  where ts | r < 0     = reverseTrail $ arcT end start
+           | otherwise = arcT start end
+
 -- | Create a circular wedge of the given radius, beginning at the
 --   first angle and extending counterclockwise to the second.
 wedge :: (Angle a, PathLike p, V p ~ R2) => Double -> a -> a -> p

src/Diagrams/TwoD/Shapes.hs

@@ -205,7 +205,7 @@ roundedRect' w h opts
         mkCorner k r | r == 0    = mempty
                      | r < 0     = doArc 3 2
                      | otherwise = doArc 0 1
-                     where doArc d d' = arc ((k+d)/4) ((k+d')/4:: CircleFrac) # scale (abs r)
+                     where doArc d d' = arc' r ((k+d)/4) ((k+d')/4:: CircleFrac)
 
 data RoundedRectOpts = RoundedRectOpts { radiusTL :: Double
                                        , radiusTR :: Double

test/Arcs.hs

@@ -0,0 +1,48 @@
+import Diagrams.Prelude
+import Diagrams.Backend.Postscript
+import Diagrams.Backend.Postscript.CmdLine
+
+import Diagrams.TwoD.Arc
+
+exampleArc f r = (vertLabel |||) . centerXY . (horzLabel ===) . centerXY $ hcat 
+    [ vcat 
+      [  phantom (circle (1.05 * abs r) :: D R2) 
+      <> s # lc green # lw 0.01
+      <> e # lc red   # lw 0.01
+      <> (lw 0.01 . stroke $ f r (n/8) (m/8))
+      | n <- rs
+      , let s = rotateBy (n/8) (origin ~~ (3 & 0))
+      , let e = rotateBy (m/8) (origin ~~ (3 & 0))
+      ] 
+    | m <- rs
+    ]
+  where
+    rs = [0..7 :: CircleFrac]
+    horzLabel = centerX                  $ rect 5 10 # lw 0 <> (text "start angle" # scale 0.4)
+    vertLabel = centerY . rotateBy (1/4) $ rect 5 10 # lw 0 <> (text "end angle"   # scale 0.4)
+
+exampleRR :: Diagram Postscript R2
+exampleRR = (vertLabel |||) . centerXY . (horzLabel ===) . centerXY $ hcat 
+    [ vcat 
+      [  phantom (pad 1.1 $ rect 10 15 :: D R2) 
+      <> (origin ~~ (0 & r)) # lc red   # lw 0.01
+      <> (fc lightblue . lw 0.01 . stroke $ roundedRect' 10 15 o)
+      | o <- [ RoundedRectOpts 0 r 0 0
+             , RoundedRectOpts r 0 0 0
+             , RoundedRectOpts 0 0 r 0
+             , RoundedRectOpts 0 0 0 r
+             ]
+      ] 
+    | r <- [-4..4]
+    ]
+  where
+    horzLabel = centerX                  $ rect 5 10 # lw 0 <> (text "radius [-4..4]" # scale 0.4)
+    vertLabel = centerY . rotateBy (1/4) $ rect 5 10 # lw 0 <> (text "corner"         # scale 0.4)
+
+arcs = [ ("arc'  CCW", exampleArc arc' 3)
+       , ("arc'  CW" , exampleArc arc' (-3))
+       , ("arc   CCW", exampleArc (\r s e -> arc s e # scale r) 3)
+       , ("arcCW CCW", exampleArc (\r s e -> arcCW s e # scale (abs r)) (-3))
+       ] :: [(String, Diagram Postscript R2)]
+
+main = defaultMain (vcat (map snd arcs) === exampleRR)