Skip to content
New issue

Have a question about this project? Sign up for a free GitHub account to open an issue and contact its maintainers and the community.

By clicking “Sign up for GitHub”, you agree to our terms of service and privacy statement. We’ll occasionally send you account related emails.

Already on GitHub? Sign in to your account

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

Merged
merged 4 commits into from
Nov 2, 2012
Merged
Show file tree
Hide file tree
Changes from all commits
Commits
File filter

Filter by extension

Filter by extension

Conversations
Failed to load comments.
Loading
Jump to
Jump to file
Failed to load files.
Loading
Diff view
Diff view
2 changes: 2 additions & 0 deletions src/Diagrams/TwoD.hs
Original file line number Diff line number Diff line change
Expand Up @@ -87,6 +87,8 @@ module Diagrams.TwoD
, ellipse
, ellipseXY
, arc
, arc'
, arcCW
, wedge

-- ** General polygons
Expand Down
38 changes: 37 additions & 1 deletion src/Diagrams/TwoD/Arc.hs
Original file line number Diff line number Diff line change
Expand Up @@ -14,6 +14,8 @@

module Diagrams.TwoD.Arc
( arc
, arc'
, arcCW
, arcT
, bezierFromSweep

Expand Down Expand Up @@ -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
Expand Down
2 changes: 1 addition & 1 deletion src/Diagrams/TwoD/Shapes.hs
Original file line number Diff line number Diff line change
Expand Up @@ -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
Expand Down
48 changes: 48 additions & 0 deletions test/Arcs.hs
Original file line number Diff line number Diff line change
@@ -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)