diff --git a/src/Diagrams/TwoD.hs b/src/Diagrams/TwoD.hs index e040a856..3078d6c2 100644 --- a/src/Diagrams/TwoD.hs +++ b/src/Diagrams/TwoD.hs @@ -87,6 +87,8 @@ module Diagrams.TwoD , ellipse , ellipseXY , arc + , arc' + , arcCW , wedge -- ** General polygons diff --git a/src/Diagrams/TwoD/Arc.hs b/src/Diagrams/TwoD/Arc.hs index bbd9b886..46a75268 100644 --- a/src/Diagrams/TwoD/Arc.hs +++ b/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 diff --git a/src/Diagrams/TwoD/Shapes.hs b/src/Diagrams/TwoD/Shapes.hs index ac8ed354..c20f8030 100644 --- a/src/Diagrams/TwoD/Shapes.hs +++ b/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 diff --git a/test/Arcs.hs b/test/Arcs.hs new file mode 100644 index 00000000..24c5c068 --- /dev/null +++ b/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) \ No newline at end of file