Merge pull request #150 from diagrams/angle

Remove Num instance for Angle

src/Diagrams/TwoD/Arc.hs

@@ -36,7 +36,7 @@ import           Diagrams.Util           (( # ))
 import           Control.Lens            ((^.))
 import           Data.AffineSpace        ((.-.))
 import           Data.Semigroup          ((<>))
-import           Data.VectorSpace        (magnitude, negateV, (*^), (^-^))
+import           Data.VectorSpace
 import           Diagrams.Coordinates
 
 -- For details of this approximation see:
@@ -47,8 +47,8 @@ import           Diagrams.Coordinates
 --   radians.  The approximation is only valid for angles in the first
 --   quadrant.
 bezierFromSweepQ1 :: Angle -> Segment Closed R2
-bezierFromSweepQ1 s = fmap (^-^ v) . rotate (s/2) $ bezier3 c2 c1 p0
-  where p0@(coords -> x :& y) = rotate (s/2) v
+bezierFromSweepQ1 s = fmap (^-^ v) . rotate (s ^/ 2) $ bezier3 c2 c1 p0
+  where p0@(coords -> x :& y) = rotate (s ^/ 2) v
         c1                    = ((4-x)/3)  ^&  ((1-x)*(3-x)/(3*y))
         c2                    = reflectY c1
         v                     = unitX
@@ -62,11 +62,11 @@ bezierFromSweepQ1 s = fmap (^-^ v) . rotate (s/2) $ bezier3 c2 c1 p0
 bezierFromSweep :: Angle -> [Segment Closed R2]
 bezierFromSweep s
   | s > fullTurn = bezierFromSweep fullTurn
-  | s < 0          = fmap reflectY . bezierFromSweep $ (-s)
-  | s < 0.0001     = []
-  | s < fullTurn/4      = [bezierFromSweepQ1 s]
-  | otherwise      = bezierFromSweepQ1 (fullTurn/4)
-          : map (rotateBy (1/4)) (bezierFromSweep (max (s - fullTurn/4) 0))
+  | s < zeroV      = fmap reflectY . bezierFromSweep $ (negateV s)
+  | s < 0.0001 @@ rad     = []
+  | s < fullTurn^/4      = [bezierFromSweepQ1 s]
+  | otherwise      = bezierFromSweepQ1 (fullTurn^/4)
+          : map (rotateBy (1/4)) (bezierFromSweep (max (s ^-^ fullTurn^/4) zeroV))
 
 {-
 ~~~~ Note [segment spacing]
@@ -92,10 +92,10 @@ the approximation error.
 --   'Trail' of a radius one arc counterclockwise between the two angles.
 arcT :: Angle -> Angle -> Trail R2
 arcT start end
-    | end' < start' = arcT start (end + (fromIntegral d @@ turn))
+    | end' < start' = arcT start (end ^+^ (fromIntegral d @@ turn))
     | otherwise     = (if sweep >= fullTurn then glueTrail else id)
                     $ trailFromSegments bs
-  where sweep = end - start
+  where sweep = end ^-^ start
         bs    = map (rotate start) . bezierFromSweep $ sweep
 
         -- We want to compare the start and the end and in case
@@ -175,10 +175,10 @@ arcBetween p q ht = trailLike (a # rotate (direction v) # moveTo p)
     d = magnitude (q .-. p)
     th  = acos ((d*d - 4*h*h)/(d*d + 4*h*h))
     r = d/(2*sin th)
-    mid | ht >= 0    = fullTurn/4
-        | otherwise = 3*fullTurn/4
-    st  = mid - (th @@ rad)
-    end = mid + (th @@ rad)
+    mid | ht >= 0    = fullTurn ^/ 4
+        | otherwise = 3 *^ fullTurn ^/ 4
+    st  = mid ^-^ (th @@ rad)
+    end = mid ^+^ (th @@ rad)
     a | isStraight
       = fromOffsets [d *^ unitX]
       | otherwise

src/Diagrams/TwoD/Arrow.hs

@@ -383,7 +383,7 @@ arrow' opts len = mkQD' (DelayedLeaf delayedArrow)
     -- Build an arrow and set its endpoints to the image under tr of origin and (len,0).
     dArrow sty tr ln = (h' <> t' <> shaft)
                # moveOriginBy (tWidth *^ (unit_X # rotate tAngle))
-               # rotate (direction (q .-. p) - dir)
+               # rotate (direction (q .-. p) ^-^ dir)
                # moveTo p
       where
 
@@ -407,7 +407,7 @@ arrow' opts len = mkQD' (DelayedLeaf delayedArrow)
         shaftTrail
           = rawShaftTrail
             -- rotate it so it is pointing in the positive X direction
-          # rotate (- direction (trailOffset rawShaftTrail))
+          # rotate (negateV direction (trailOffset rawShaftTrail))
             -- apply the context transformation -- in case it includes
             -- things like flips and shears (the possibility of shears
             -- is why we must rotate it to a neutral position first)

src/Diagrams/TwoD/Arrowheads.hs

@@ -111,7 +111,7 @@ arrowheadTriangle theta = aHead
   where
     aHead size _ = (p, mempty)
       where
-        p = polygon (def & polyType .~ PolyPolar [theta, (-2 * theta)]
+        p = polygon (def & polyType .~ PolyPolar [theta, (negateV 2 *^ theta)]
             (repeat (htRadius * size)) & polyOrient .~ NoOrient)  # alignL
 
 -- | Isoceles triangle with linear concave base. Inkscape type 1 - dart like.
@@ -122,7 +122,7 @@ arrowheadDart theta = aHead
       where
         r = htRadius * size
         dartP = polygon
-                ( def & polyType .~ PolyPolar [theta, (1/2 @@ turn) - theta, (1/2 @@ turn) - theta]
+                ( def & polyType .~ PolyPolar [theta, (1/2 @@ turn) ^-^ theta, (1/2 @@ turn) ^-^ theta]
                                               [r, r, 0.1 * size, r]
                       & polyOrient .~ NoOrient
                 )
@@ -146,11 +146,11 @@ arrowheadSpike theta = aHead
         a' = reflectY a
         l1 = trailFromSegments [straight (unit_X2 ^+^ a)]
         l2 = trailFromSegments [reverseSegment . straight $ (unit_X2 ^+^ a')]
-        c  = reflectX $ arc' htRadius theta (-theta)
+        c  = reflectX $ arc' htRadius theta (negateV theta)
         barb = (closedPath $ (l1 <> c <> l2)) # scale size
         m = xWidth barb --c `atParam` 0.5
         b =  asin ((shaftWidth / 2) / (htRadius  * size)) @@ rad
-        c' = arc' htRadius (-b ) b # scale size
+        c' = arc' htRadius (negateV b) b # scale size
         joint = (closedPath $ (c')) # centerY # alignR
         xWidth p = pa + pb
           where
@@ -167,7 +167,7 @@ arrowheadThorn theta r = aHead
         c1 = curvedSide theta
         l1 = straight $ (reflectY a) ^-^ (unit_X2 # scale r)
         l2 = straight $ unit_X2 # scale r ^-^ a
-        c2 = c1 # rotate (-theta)
+        c2 = c1 # rotate (negateV theta)
         thornP = (closedPath $ trailFromSegments [c1, l1, l2, c2]) # scale size
         thornVertices =  (concat . pathVertices) $ thornP
         m = magnitude (thornVertices !! 1 .-. thornVertices !! 3)

src/Diagrams/TwoD/Ellipse.hs

@@ -22,6 +22,8 @@ module Diagrams.TwoD.Ellipse
     , ellipseXY
     ) where
 
+import           Data.AdditiveGroup
+
 import           Diagrams.Core
 
 import           Diagrams.Located        (at)
@@ -33,7 +35,7 @@ import           Diagrams.Util
 
 -- | A circle of radius 1, with center at the origin.
 unitCircle :: (TrailLike t, V t ~ R2) => t
-unitCircle = trailLike $ arcT 0 fullTurn `at` (p2 (1,0))
+unitCircle = trailLike $ arcT zeroV fullTurn `at` (p2 (1,0))
 
 -- | A circle of the given radius, centered at the origin.  As a path,
 --   it begins at (r,0).

src/Diagrams/TwoD/Polygons.hs

@@ -46,7 +46,7 @@ module Diagrams.TwoD.Polygons(
     ) where
 
 import           Control.Lens            (Lens', generateSignatures, lensRules,
-                                          makeLensesWith, (.~), (^.))
+                                          makeLensesWith, (.~), (^.), view)
 import           Control.Monad           (forM, liftM)
 import           Control.Monad.ST        (ST, runST)
 import           Data.Array.ST           (STUArray, newArray, readArray,
@@ -58,8 +58,7 @@ import           Data.Ord                (comparing)
 
 import           Data.AffineSpace        ((.+^), (.-.))
 import           Data.Default.Class
-import           Data.VectorSpace        (magnitude, normalized, project, (<.>),
-                                          (^*))
+import           Data.VectorSpace
 
 import           Diagrams.Core
 import           Diagrams.Located
@@ -190,7 +189,7 @@ polyPolarTrail ans (r:rs) = tr `at` p1
     tr = closeTrail . trailFromVertices $
            zipWith
              (\a l -> rotate a . scale l $ p2 (1,0))
-             (scanl (+) 0 ans)
+             (scanl (^+^) zeroV ans)
              (r:rs)
 
 -- | Generate the vertices of a polygon specified by side length and
@@ -199,15 +198,15 @@ polyPolarTrail ans (r:rs) = tr `at` p1
 polySidesTrail :: [Angle] -> [Double] -> Located (Trail R2)
 polySidesTrail ans ls = tr `at` (centroid ps # scale (-1))
   where
-    ans'    = scanl (+) 0 ans
+    ans'    = scanl (^+^) zeroV ans
     offsets = zipWith rotate ans' (map (unitY ^*) ls)
     ps      = scanl (.+^) origin offsets
     tr      = closeTrail . trailFromOffsets $ offsets
 
 -- | Generate the vertices of a regular polygon.  See 'PolyRegular'.
 polyRegularTrail :: Int -> Double -> Located (Trail R2)
 polyRegularTrail n r = polyPolarTrail
-                         (take (n-1) . repeat $ fullTurn / fromIntegral n)
+                         (take (n-1) . repeat $ fullTurn ^/ fromIntegral n)
                          (repeat r)
 
 -- | Generate a transformation to orient a trail.  @orient v t@
@@ -224,14 +223,18 @@ orientPoints v xs = rotation a
                   (zip3 (tail (cycle xs)) xs (last xs : init xs))
     distAlong w ((.-. origin) -> p) = signum (w <.> p) * magnitude (project w p)
     sndOf3 (_,b,_) = b
-    a = minimumBy (comparing abs) . map (angleFromNormal . (.-. x)) $ [n1,n2]
+    a :: Angle
+    a = minimumBy (comparing $ abs . view rad)
+        . map (angleFromNormal . (.-. x)) $ [n1,n2]
     v' = normalized v
+    angleFromNormal :: R2 -> Angle
     angleFromNormal o
       | leftTurn o' v' = phi
-      | otherwise      = negate phi
+      | otherwise      = negateV phi
       where
         o' = normalized o
         theta = acos (v' <.> o')
+        phi :: Angle
         phi
           | theta <= tau/4 = tau/4 - theta @@ rad
           | otherwise      = theta - tau/4 @@ rad

src/Diagrams/TwoD/Segment.hs

@@ -93,7 +93,7 @@ instance Traced (FixedSegment R2) where
     let
       bez'@(FCubic x1 c1 c2 x2) =
         bez # moveOriginTo p1
-            # rotate (negate (direction v1))
+            # rotate (negateV (direction v1))
             # scale (1/magnitude v1)
       [y0,y1,y2,y3] = map (snd . unp2) [x1,c1,c2,x2]
       a  = -y0 + 3*y1 - 3*y2 + y3

src/Diagrams/TwoD/Transform.hs

@@ -59,6 +59,7 @@ import           Diagrams.TwoD.Types
 import           Diagrams.TwoD.Vector    (direction)
 import           Diagrams.Coordinates
 
+import           Data.AdditiveGroup
 import           Data.AffineSpace
 import           Data.Semigroup
 import           Control.Lens            (review, (^.))
@@ -204,7 +205,7 @@ reflectY = transform reflectionY
 --   the point @p@ and vector @v@.
 reflectionAbout :: P2 -> R2 -> T2
 reflectionAbout p v =
-  conjugate (rotation (-direction v) <> translation (origin .-. p))
+  conjugate (rotation (negateV $ direction v) <> translation (origin .-. p))
             reflectionY
 
 -- | @reflectAbout p v@ reflects a diagram in the line determined by

src/Diagrams/TwoD/Transform/ScaleInv.hs

@@ -20,6 +20,7 @@ module Diagrams.TwoD.Transform.ScaleInv
     where
 
 import           Control.Lens            (makeLenses, view)
+import           Data.AdditiveGroup
 import           Data.AffineSpace        ((.-.))
 import           Data.Semigroup
 
@@ -82,7 +83,7 @@ instance (V t ~ R2, HasOrigin t) => HasOrigin (ScaleInv t) where
 instance (V t ~ R2, Transformable t) => Transformable (ScaleInv t) where
   transform tr (ScaleInv t v l) = ScaleInv (trans . rot $ t) (rot v) l'
     where
-      angle = direction (transform tr v) - direction v
+      angle = direction (transform tr v) ^-^ direction v
       rot :: (Transformable t, V t ~ R2) => t -> t
       rot = rotateAbout l angle
       l'  = transform tr l

src/Diagrams/TwoD/Types.hs

@@ -239,7 +239,7 @@ instance HasY P2 where
 -- | Angles can be expressed in a variety of units.  Internally,
 -- they are represented in radians.
 newtype Angle = Radians Double
-              deriving (Read, Show, Eq, Ord, Enum, Fractional, Num, Real, RealFrac, AdditiveGroup)
+              deriving (Read, Show, Eq, Ord, Enum, AdditiveGroup)
 
 instance VectorSpace Angle where
   type Scalar Angle = Double

src/Diagrams/TwoD/Vector.hs

@@ -23,6 +23,7 @@ module Diagrams.TwoD.Vector
        ) where
 
 import           Control.Lens         ((^.))
+import           Data.AdditiveGroup
 import           Data.VectorSpace     ((<.>))
 import           Diagrams.TwoD.Types
 import           Diagrams.Coordinates
@@ -52,8 +53,8 @@ direction (coords -> x :& y) = atan2 y x @@ rad
 -- | Compute the counterclockwise angle from the first vector to the second.
 angleBetween :: R2 -> R2 -> Angle
 angleBetween v1 v2
-  | d2 > d1   = d2 - d1
-  | otherwise = fullTurn + d2 - d1
+  | d2 > d1   = d2 ^-^ d1
+  | otherwise = fullTurn ^+^ d2 ^-^ d1
   where
     d1 = direction v1
     d2 = direction v2