Skip to content

HTTPS clone URL

Subversion checkout URL

You can clone with
or
.
Download ZIP

Loading…

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

Merged
merged 4 commits into from

2 participants

@fryguybob
Owner

Also added a few new functions for making arcs. I still have to fix roundedRect, but that should be fast once I have some tests. Wait to pull until then.

src/Diagrams/TwoD/Arc.hs
((6 lines not shown))
arcT :: Angle a => a -> a -> Trail R2
-arcT start end = Trail bs (sweep >= tau)
+arcT start end
+ | e < s = arcT s (e + 1) -- Try again closer to CCW
@byorgey Owner
byorgey added a note

Wouldn't arcT s (e + ceiling (s - e)) be better in the (admittedly rare) case when s and e differ by much more than 1?

@fryguybob Owner

Yeah, I'll switch to that.

@fryguybob Owner

I'm assuming there isn't some edge case with Double where e < s and ceiling (s - e) == 0.

@byorgey Owner
byorgey added a note

If there is, it serves people right for calling arcT with those arguments. I doubt such an arc would be visible anyway.

Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment
@byorgey byorgey merged commit 8d79138 into diagrams:master

1 check passed

Details default The Travis build passed
@byorgey byorgey referenced this pull request
Closed

Enhancements for `arc`s. #54

Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment
Commits on Oct 30, 2012
  1. @fryguybob

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

    fryguybob authored
    Also added a few new functions for making arcs.
  2. @fryguybob
  3. @fryguybob
Commits on Oct 31, 2012
  1. @fryguybob
This page is out of date. Refresh to see the latest.
View
2  src/Diagrams/TwoD.hs
@@ -87,6 +87,8 @@ module Diagrams.TwoD
, ellipse
, ellipseXY
, arc
+ , arc'
+ , arcCW
, wedge
-- ** General polygons
View
38 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
View
2  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
View
48 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)
Something went wrong with that request. Please try again.