Merge pull request #221 from diagrams/arcCCW

Add arcCCW and friends.  Fix offset joins.

src/Diagrams/Angle.hs

@@ -28,16 +28,17 @@ module Diagrams.Angle
        , asinA, acosA, atanA, atan2A, atan2A'
 
          -- ** Angle utilities
-       , angleBetween, angleRatio
+       , angleBetween, angleRatio, normalizeAngle
 
          -- ** Classes
        , HasTheta(..)
        , HasPhi(..)
        ) where
 
 import           Control.Applicative
-import           Control.Lens        (Iso', Lens', iso, review, (^.))
+import           Control.Lens        (Iso', Lens', iso, review, (^.), over)
 import           Data.Monoid         hiding ((<>))
+import           Data.Fixed
 import           Data.Semigroup
 
 import           Diagrams.Core.V
@@ -172,8 +173,8 @@ angleBetween v1 v2 = acosA (signorm v1 `dot` signorm v2)
 -- N.B.: Currently discards the common plane information.
 
 -- | Normalize an angle so that it lies in the [0,tau) range.
--- normalizeAngle :: (Floating n, Real n) => Angle n -> Angle n
--- normalizeAngle = over rad (`mod'` (2 * pi))
+normalizeAngle :: (Floating n, Real n) => Angle n -> Angle n
+normalizeAngle = over rad (`mod'` (2 * pi))
 
 ------------------------------------------------------------
 -- Polar Coordinates

src/Diagrams/Direction.hs

@@ -1,3 +1,4 @@
+{-# LANGUAGE DeriveFunctor        #-}
 {-# LANGUAGE FlexibleContexts     #-}
 {-# LANGUAGE TypeFamilies         #-}
 {-# LANGUAGE UndecidableInstances #-}
@@ -15,15 +16,18 @@
 module Diagrams.Direction
        ( Direction
        , _Dir
-       , direction, fromDirection
+       , direction, dir, fromDirection, fromDir
        , angleBetweenDirs
+       , dirBetween
        ) where
 
 import           Control.Lens   (Iso', iso)
 
 import           Diagrams.Angle
 import           Diagrams.Core
 
+import           Linear.Affine
+import           Linear.Vector
 import           Linear.Metric
 
 --------------------------------------------------------------------------------
@@ -33,14 +37,14 @@ import           Linear.Metric
 -- can think of a @Direction@ as a vector that has forgotten its
 -- magnitude.  @Direction@s can be used with 'fromDirection' and the
 -- lenses provided by its instances.
-newtype Direction v n = Direction (v n)
-  deriving (Read, Show, Eq, Ord) -- todo: special instances
+newtype Direction v n = Dir (v n)
+  deriving (Read, Show, Eq, Ord, Functor) -- todo: special instances
 
 type instance V (Direction v n) = v
 type instance N (Direction v n) = n
 
 instance (V (v n) ~ v, N (v n) ~ n, Transformable (v n)) => Transformable (Direction v n) where
-  transform t (Direction v) = Direction (transform t v)
+  transform t (Dir v) = Dir (transform t v)
 
 instance HasTheta v => HasTheta (Direction v) where
   _theta = _Dir . _theta
@@ -49,22 +53,34 @@ instance HasPhi v => HasPhi (Direction v) where
   _phi = _Dir . _phi
 
 -- | _Dir is provided to allow efficient implementations of functions
--- in particular vector-spaces, but should be used with care as it
--- exposes too much information.
+--   in particular vector-spaces, but should be used with care as it
+--   exposes too much information.
 _Dir :: Iso' (Direction v n) (v n)
-_Dir = iso (\(Direction v) -> v) Direction
+_Dir = iso (\(Dir v) -> v) Dir
 
 -- | @direction v@ is the direction in which @v@ points.  Returns an
 --   unspecified value when given the zero vector as input.
 direction :: v n -> Direction v n
-direction = Direction
+direction = Dir
+
+-- | Synonym for 'direction'.
+dir :: v n -> Direction v n
+dir = Dir
 
 -- | @fromDirection d@ is the unit vector in the direction @d@.
 fromDirection :: (Metric v, Floating n) => Direction v n -> v n
-fromDirection (Direction v) = signorm v
+fromDirection (Dir v) = signorm v
+
+-- | Synonym for 'fromDirection'.
+fromDir :: (Metric v, Floating n) => Direction v n -> v n
+fromDir (Dir v) = signorm v
 
 -- | compute the positive angle between the two directions in their common plane
 angleBetweenDirs :: (Metric v, Floating n)
   => Direction v n -> Direction v n -> Angle n
 angleBetweenDirs d1 d2 = angleBetween (fromDirection d1) (fromDirection d2)
 
+-- | @dirBetween p q@ returns the directions from @p@ to @q@
+dirBetween :: (Additive v, Num n) => Point v n -> Point v n -> Direction v n
+dirBetween p q = dir $ p .-. q
+

src/Diagrams/TwoD/Arc.hs

@@ -1,5 +1,6 @@
 {-# LANGUAGE ConstraintKinds  #-}
 {-# LANGUAGE FlexibleContexts #-}
+{-# LANGUAGE ViewPatterns     #-}
 {-# LANGUAGE TypeFamilies     #-}
 -----------------------------------------------------------------------------
 -- |
@@ -16,6 +17,10 @@ module Diagrams.TwoD.Arc
     ( arc
     , arc'
     , arcT
+
+    , arcCCW
+    , arcCW
+
     , bezierFromSweep
 
     , wedge
@@ -32,7 +37,7 @@ import           Diagrams.Trail
 import           Diagrams.TrailLike
 import           Diagrams.TwoD.Transform
 import           Diagrams.TwoD.Types
-import           Diagrams.TwoD.Vector    (unitX, unitY, unit_Y)
+import           Diagrams.TwoD.Vector    (unitX, unitY, unit_Y, e)
 import           Diagrams.Util           (( # ))
 
 import           Control.Lens            ((&), (<>~), (^.))
@@ -50,11 +55,10 @@ import           Linear.Vector
 --  angle @s@.  The approximation is only valid for angles in the
 --  first quadrant.
 bezierFromSweepQ1 :: Floating n => Angle n -> Segment Closed V2 n
-bezierFromSweepQ1 s = mapSegmentVectors (^-^ v) . rotate (s ^/ 2) $ bezier3 c2 c1 p0
-  where p0@(V2 x y) = rotate (s ^/ 2) v
+bezierFromSweepQ1 s = mapSegmentVectors (^-^ unitX) . rotate (s ^/ 2) $ bezier3 c2 c1 p0
+  where p0@(V2 x y) = e (s ^/ 2)
         c1          = V2 ((4-x)/3) ((1-x)*(3-x)/(3*y))
         c2          = reflectY c1
-        v           = unitX
 
 -- | @bezierFromSweep s@ constructs a series of 'Cubic' segments that
 --   start in the positive y direction and sweep counter clockwise
@@ -94,17 +98,17 @@ the approximation error.
 --   is the 'Trail' of a radius one arc starting at @d@ and sweeping out
 --   the angle @s@ counterclockwise (for positive s).  The resulting
 --   @Trail@ is allowed to wrap around and overlap itself.
-arcT :: RealFloat n => Direction V2 n -> Angle n -> Trail V2 n
+arcT :: OrderedField n => Direction V2 n -> Angle n -> Trail V2 n
 arcT start sweep = trailFromSegments bs
   where
-    bs = map (rotate $ start ^. _theta) . bezierFromSweep $ sweep
+    bs = map (rotateTo start) . bezierFromSweep $ sweep
 
 -- | Given a start direction @d@ and a sweep angle @s@, @'arc' d s@ is the
 --   path of a radius one arc starting at @d@ and sweeping out the angle
 --   @s@ counterclockwise (for positive s).  The resulting
 --   @Trail@ is allowed to wrap around and overlap itself.
-arc :: (TrailLike t, V t ~ V2, N t ~ n, RealFloat n) => Direction V2 n -> Angle n -> t
-arc start sweep = trailLike $ arcT start sweep `at` rotate (start ^. _theta) (p2 (1,0))
+arc :: (InSpace V2 n t, OrderedField n, TrailLike t) => Direction V2 n -> Angle n -> t
+arc start sweep = trailLike $ arcT start sweep `at` P (fromDirection start)
 
 -- | Given a radus @r@, a start direction @d@ and an angle @s@,
 --   @'arc'' r d s@ is the path of a radius @(abs r)@ arc starting at
@@ -115,10 +119,29 @@ arc start sweep = trailLike $ arcT start sweep `at` rotate (start ^. _theta) (p2
 --
 --   > arc'Ex = mconcat [ arc' r (0 @@ turn) (1/4 @@ turn) | r <- [0.5,-1,1.5] ]
 --   >        # centerXY # pad 1.1
-arc' :: (TrailLike t, V t ~ V2, N t ~ n, RealFloat n) => n -> Direction V2 n -> Angle n -> t
-arc' r start sweep = trailLike $ scale (abs r) ts `at` rotate (start ^. _theta) (p2 (abs r,0))
+arc' :: (InSpace V2 n t, OrderedField n, TrailLike t) => n -> Direction V2 n -> Angle n -> t
+arc' (abs -> r) start sweep = trailLike $ scale r ts `at` P (r *^ fromDirection start)
   where ts = arcT start sweep
 
+arcCCWT :: RealFloat n => Direction V2 n -> Direction V2 n -> Trail V2 n
+arcCCWT start end = trailFromSegments bs
+  where
+    bs    = map (rotateTo start) . bezierFromSweep $ sweep
+    sweep = normalizeAngle $ end ^. _theta ^-^ start ^. _theta
+
+-- | Given a start direction @s@ and end direction @e@, @arcCCW s e@ is the
+--   path of a radius one arc counterclockwise between the two directions.
+--   The origin of the arc is its center.
+arcCCW :: (InSpace V2 n t, RealFloat n, TrailLike t) => Direction V2 n -> Direction V2 n -> t
+arcCCW start end = trailLike $ arcCCWT start end `at` P (fromDirection start)
+
+-- | Like 'arcAngleCCW' but clockwise.
+arcCW :: (InSpace V2 n t, RealFloat n, TrailLike t) => Direction V2 n -> Direction V2 n -> t
+arcCW start end = trailLike $
+  -- flipped arguments to get the path we want
+  -- then reverse the trail to get the cw direction.
+  reverseTrail (arcCCWT end start) `at` P (fromDirection start)
+
 -- | Create a circular wedge of the given radius, beginning at the
 --   given direction and extending through the given angle.
 --
@@ -131,7 +154,7 @@ arc' r start sweep = trailLike $ scale (abs r) ts `at` rotate (start ^. _theta)
 --   >   ]
 --   >   # fc blue
 --   >   # centerXY # pad 1.1
-wedge :: (TrailLike t, V t ~ V2, N t ~ n, RealFloat n) => n -> Direction V2 n -> Angle n -> t
+wedge :: (InSpace V2 n t, OrderedField n, TrailLike t) => n -> Direction V2 n -> Angle n -> t
 wedge r d s = trailLike . (`at` origin) . glueTrail . wrapLine
               $ fromOffsets [r *^ fromDirection d]
                 <> arc d s # scale r

src/Diagrams/TwoD/Arrow.hs

@@ -120,7 +120,7 @@ import           Diagrams.Core.Types      (QDiaLeaf (..), mkQD')
 
 import           Diagrams.Angle
 import           Diagrams.Attributes
-import           Diagrams.Direction
+import           Diagrams.Direction       hiding (dir)
 import           Diagrams.Located         (Located(..), unLoc)
 import           Diagrams.Parametric
 import           Diagrams.Path

src/Diagrams/TwoD/Offset.hs

@@ -51,9 +51,8 @@ import           Data.Default.Class
 
 import           Diagrams.Core
 
-import           Diagrams.Angle
 import           Diagrams.Attributes
-import           Diagrams.Direction      (direction)
+import           Diagrams.Direction
 import           Diagrams.Located
 import           Diagrams.Parametric
 import           Diagrams.Path
@@ -470,16 +469,8 @@ capSquare _r c a b = unLoc $ fromVertices [ a, a .+^ v, b .+^ v, b ]
 capArc :: RealFloat n => n -> Point V2 n -> Point V2 n -> Point V2 n -> Trail V2 n
 capArc r c a b = trailLike . moveTo c $ fs
   where
-    fs | r < 0     = scale (-r) $ arcVCW (a .-. c) (b .-. c)
-       | otherwise = scale r    $ arcV   (a .-. c) (b .-. c)
-
--- Arc helpers
--- always picks the shorter arc (< τ/2)
-arcV :: (OrderedField n, RealFloat n, TrailLike t, V t ~ V2, N t ~ n) => V2 n -> V2 n -> t
-arcV u v = arc (direction u) (angleBetween v u)
-
-arcVCW :: (OrderedField n, RealFloat n, TrailLike t, V t ~ V2, N t ~ n) => V2 n -> V2 n -> t
-arcVCW u v = arc (direction u) (negated $ angleBetween v u)
+    fs | r < 0     = scale (-r) $ arcCW  (dirBetween a c) (dirBetween b c)
+       | otherwise = scale r    $ arcCCW (dirBetween a c) (dirBetween b c)
 
 -- | Join together a list of located trails with the given join style.  The
 --   style is given as a function to compute the join given the local information

src/Diagrams/TwoD/Transform.hs

@@ -2,6 +2,7 @@
 {-# LANGUAGE FlexibleContexts      #-}
 {-# LANGUAGE FlexibleInstances     #-}
 {-# LANGUAGE MultiParamTypeClasses #-}
+{-# LANGUAGE ViewPatterns          #-}
 {-# LANGUAGE TypeFamilies          #-}
 {-# LANGUAGE TypeOperators         #-}
 -----------------------------------------------------------------------------
@@ -53,11 +54,12 @@ module Diagrams.TwoD.Transform
 import           Diagrams.Angle
 import           Diagrams.Core
 import           Diagrams.Core.Transform
+import           Diagrams.Direction
 import           Diagrams.Transform
 import           Diagrams.TwoD.Types
 import           Diagrams.TwoD.Vector
 
-import           Control.Lens            (review, (&), (*~), (.~), (//~))
+import           Control.Lens            (review, view, (&), (*~), (.~), (//~))
 import           Data.Semigroup
 
 import           Linear.Affine
@@ -109,13 +111,13 @@ rotateAround :: (InSpace V2 n t, Transformable t, Floating n) => P2 n -> Angle n
 rotateAround p angle = rotate angle `under` translation (origin .-. p)
 
 -- | The rotation that aligns the x-axis with the given non-zero vector.
-rotationTo :: OrderedField n => V2 n -> T2 n
-rotationTo (V2 x y) = rotation (atan2A' y x)
+rotationTo :: OrderedField n => Direction V2 n -> T2 n
+rotationTo (view _Dir -> V2 x y) = rotation (atan2A' y x)
 -- could be done with Direction
 
 -- | Rotate around the local origin such that the x axis aligns with the
 --   given direction.
-rotateTo :: (InSpace V2 n t, OrderedField n, Transformable t) => V2 n -> t -> t
+rotateTo :: (InSpace V2 n t, OrderedField n, Transformable t) => Direction V2 n -> t -> t
 rotateTo = transform . rotationTo
 
 -- Scaling -------------------------------------------------
@@ -216,7 +218,7 @@ reflectY = transform reflectionY
 --   the point @p@ and vector @v@.
 reflectionAbout :: OrderedField n => P2 n -> V2 n -> T2 n
 reflectionAbout p v =
-  conjugate (rotationTo (negated v) <> translation (origin .-. p))
+  conjugate (rotationTo (direction $ negated v) <> translation (origin .-. p))
             reflectionY
 
 -- | @reflectAbout p v@ reflects a diagram in the line determined by

src/Diagrams/TwoD/Vector.hs

@@ -14,11 +14,10 @@ module Diagrams.TwoD.Vector
          unitX, unitY, unit_X, unit_Y
 
          -- * Converting between vectors and angles
-       , e, xDir
+       , e, xDir, angleDir
 
          -- * 2D vector utilities
        , perp, leftTurn
-         -- * Synonym for R2 things
        ) where
 
 import           Control.Lens       (view, (&), (.~))
@@ -46,16 +45,19 @@ unitY = zero & _y .~ 1
 unit_Y :: (R2 v, Additive v, Num n) => v n
 unit_Y = zero & _y .~ (-1)
 
--- | The origin of the direction AffineSpace.  For all d, @d .-. xDir
--- = d^._theta@.
+-- | A 'Direction' pointing in the X direction.
 xDir :: (R1 v, Additive v, Num n) => Direction v n
-xDir = direction unitX
+xDir = dir unitX
 
--- | A unit vector at a specified angle counterclockwise from the
--- positive X axis.
+-- | A unit vector at a specified angle counter-clockwise from the
+--   positive X axis.
 e :: Floating n => Angle n -> V2 n
 e = angle . view rad
 
+-- | A direction at a specified angle counter-clockwise from the 'xDir'.
+angleDir :: Floating n => Angle n -> Direction V2 n
+angleDir = dir . e
+
 -- | @leftTurn v1 v2@ tests whether the direction of @v2@ is a left
 --   turn from @v1@ (that is, if the direction of @v2@ can be obtained
 --   from that of @v1@ by adding an angle 0 <= theta <= tau/2).