Unified angle type

src/Diagrams/ThreeD/Camera.hs

@@ -28,7 +28,7 @@ module Diagrams.ThreeD.Camera
        )
        where
 
-import Control.Lens            (makeLenses)
+import Control.Lens            (makeLenses, (#))
 import Data.Monoid
 import Data.Cross
 
@@ -51,8 +51,8 @@ class CameraLens l where
 
 -- | A perspective projection
 data PerspectiveLens = PerspectiveLens
-                     { _horizontalFieldOfView :: Deg -- ^ Horizontal field of view.
-                     , _verticalFieldOfView   :: Deg -- ^ Vertical field of view.
+                     { _horizontalFieldOfView :: Angle -- ^ Horizontal field of view.
+                     , _verticalFieldOfView   :: Angle -- ^ Vertical field of view.
                      }
 
 makeLenses ''PerspectiveLens
@@ -104,15 +104,15 @@ mm50, mm50Wide, mm50Narrow :: PerspectiveLens
 
 -- | mm50 has the field of view of a 50mm lens on standard 35mm film,
 -- hence an aspect ratio of 3:2.
-mm50 = PerspectiveLens 40.5 27
+mm50 = PerspectiveLens (deg # 40.5) (deg # 27)
 
 -- | mm50Wide has the same vertical field of view as mm50, but an
 -- aspect ratio of 1.6, suitable for wide screen computer monitors.
-mm50Wide = PerspectiveLens 43.2 27
+mm50Wide = PerspectiveLens (deg # 43.2)  (deg # 27)
 
 -- | mm50Narrow has the same vertical field of view as mm50, but an
 -- aspect ratio of 4:3, for VGA and similar computer resulotions.
-mm50Narrow = PerspectiveLens 36 27
+mm50Narrow = PerspectiveLens (deg # 36) (deg # 27)
 
 camForward :: Direction d => Camera l -> d
 camForward = direction . forward

src/Diagrams/ThreeD/Transform.hs

@@ -25,7 +25,7 @@ import           Diagrams.ThreeD.Types
 import           Diagrams.ThreeD.Vector
 import           Diagrams.Coordinates
 
-import           Control.Lens                   ((*~), (//~))
+import           Control.Lens                   (view, (*~), (//~))
 import           Data.Semigroup
 
 import           Data.AffineSpace
@@ -46,48 +46,48 @@ import           Data.VectorSpace
 --   Note that writing @aboutZ (1\/4)@, with no type annotation, will
 --   yield an error since GHC cannot figure out which sort of angle
 --   you want to use.
-aboutZ :: Angle a => a -> T3
+aboutZ :: Angle -> T3
 aboutZ ang = fromLinear r (linv r) where
   r = rot theta <-> rot (-theta)
-  Rad theta = convertAngle ang
+  theta = view rad ang
   rot th (coords -> x :& y :& z) = (cos th * x - sin th * y) ^&
                                    (sin th * x + cos th * y) ^&
                                    z
 
 -- | Like 'aboutZ', but rotates about the X axis, bringing positive y-values
 -- towards the positive z-axis.
-aboutX :: Angle a => a -> T3
+aboutX :: Angle -> T3
 aboutX ang = fromLinear r (linv r) where
   r = rot theta <-> rot (-theta)
-  Rad theta = convertAngle ang
+  theta = view rad ang
   rot th (coords -> x :& y :& z) = (x) ^&
                                    (cos th * y - sin th * z) ^&
                                    (sin th * y + cos th * z)
 
 -- | Like 'aboutZ', but rotates about the Y axis, bringing postive
 -- x-values towards the negative z-axis.
-aboutY :: Angle a => a -> T3
+aboutY :: Angle -> T3
 aboutY ang = fromLinear r (linv r) where
   r = rot theta <-> rot (-theta)
-  Rad theta = convertAngle ang
+  theta = view rad ang
   rot th (coords -> x :& y :& z) = (cos th * x + sin th * z) ^&
                                     y ^&
                                     (-sin th * x + cos th * z)
 
 -- | @rotationAbout p d a@ is a rotation about a line parallel to @d@
 --   passing through @p@.
 rotationAbout
-  :: (Angle a, Direction d)
+  :: Direction d
   => P3     -- ^ origin of rotation
   -> d      -- ^ direction of rotation axis
-  -> a      -- ^ angle of rotation
+  -> Angle      -- ^ angle of rotation
   -> T3
 rotationAbout p d a
   = mconcat [translation (negateV t),
              fromLinear r (linv r),
              translation t] where
     r = rot theta <-> rot (-theta)
-    Rad theta = convertAngle a
+    theta = view rad a
     w = fromDirection d
     rot :: Double -> R3 -> R3
     rot th v = v ^* cos th ^+^
@@ -110,10 +110,10 @@ pointAt a i f = pointAt' (fromDirection a) (fromDirection i) (fromDirection f)
 pointAt' :: R3 -> R3 -> R3 -> T3
 pointAt' about initial final = tilt <> pan where
   inPanPlane    = final ^-^ project final initial
-  panAngle      = angleBetween initial inPanPlane :: Turn
-  pan           = rotationAbout origin (direction about :: Spherical Turn) panAngle
-  tiltAngle     = angleBetween initial inPanPlane :: Turn
-  tiltDir       = direction $ cross3 inPanPlane about :: Spherical Turn
+  panAngle      = angleBetween initial inPanPlane
+  pan           = rotationAbout origin (direction about :: Spherical) panAngle
+  tiltAngle     = angleBetween initial inPanPlane
+  tiltDir       = direction $ cross3 inPanPlane about :: Spherical
   tilt          = rotationAbout origin tiltDir tiltAngle
 
 -- Scaling -------------------------------------------------

src/Diagrams/ThreeD/Types.hs

@@ -29,13 +29,8 @@ module Diagrams.ThreeD.Types
          -- * Two-dimensional angles
          -- | These are defined in "Diagrams.TwoD.Types" but
          --   reëxported here for convenience.
-       , Angle(..)
-       , Turn(Turn), asTurn
-       , CircleFrac
-       , Rad(Rad), asRad
-       , Deg(Deg), asDeg
-
-       , fullTurn, convertAngle, angleRatio
+       , Angle, rad, turn, deg
+       , fullTurn, angleRatio
 
          -- * Directions in 3D
        , Direction(..)
@@ -139,35 +134,28 @@ instance HasCross3 R3 where
 -- based on that of the Angle class in 2D.
 
 class Direction d where
-    -- | Convert to polar angles
-    toSpherical :: Angle a => d -> Spherical a
+    -- | Convert to spherical coördinates
+    toSpherical :: d -> Spherical
 
-    -- | Convert from polar angles
-    fromSpherical :: Angle a => Spherical a -> d
+    -- | Convert from spherical coördinates
+    fromSpherical :: Spherical -> d
 
 -- | A direction expressed as a pair of spherical coordinates.
 -- `Spherical 0 0` is the direction of `unitX`.  The first coordinate
 -- represents rotation about the Z axis, the second rotation towards the Z axis.
-data Spherical a = Spherical a a
+data Spherical = Spherical Angle Angle
                    deriving (Show, Read, Eq)
 
-instance Applicative Spherical where
-    pure a = Spherical a a
-    Spherical a b <*> Spherical c d = Spherical (a c) (b d)
-
-instance Functor Spherical where
-    fmap f s = pure f <*> s
-
-instance (Angle a) => Direction (Spherical a) where
-    toSpherical = fmap convertAngle
-    fromSpherical = fmap convertAngle
+instance Direction Spherical where
+    toSpherical = id
+    fromSpherical = id
 
 -- | The identity function with a restricted type, for conveniently
 -- restricting unwanted polymorphism.  For example, @fromDirection
 -- . asSpherical . camForward@ gives a unit vector pointing in the
 -- direction of the camera view.  Without @asSpherical@, the
 -- intermediate type would be ambiguous.
-asSpherical :: Spherical Turn -> Spherical Turn
+asSpherical :: Spherical -> Spherical
 asSpherical = id
 
 instance HasX R3 where

src/Diagrams/ThreeD/Vector.hs

@@ -20,7 +20,7 @@ module Diagrams.ThreeD.Vector
          direction, fromDirection, angleBetween, angleBetweenDirs
        ) where
 
-import Control.Lens (op)
+import Control.Lens (from, review, (^.))
 import Data.VectorSpace
 import Data.Cross
 
@@ -61,24 +61,24 @@ direction v
   | otherwise = fromSpherical $ Spherical θ φ where
   r = magnitude v
   (x,y,z) = unr3 v
-  φ = Rad . asin $ z / r
-  θ = Rad . atan2 y $ x
-  zero = Rad $ 0
+  φ = (asin $ z / r) ^. from rad
+  θ = (atan2 y $ x) ^. from rad
+  zero = 0^.from rad
 
 -- | @fromDirection d@ is the unit vector in the direction @d@.
 fromDirection :: Direction d => d -> R3
 fromDirection (toSpherical -> (Spherical θ' φ')) = r3 (x,y,z) where
-  θ = op Rad $ θ'
-  φ = op Rad $ φ'
+  θ = θ'^.rad
+  φ = φ'^.rad
   x = cos θ * cos φ
   y = sin θ * cos φ
   z = sin φ
 
 -- | compute the positive angle between the two vectors in their common plane
-angleBetween  :: (Angle a, Num a, Ord a) => R3 -> R3 -> a
-angleBetween v1 v2 = convertAngle . Rad $
+angleBetween  :: R3 -> R3 -> Angle
+angleBetween v1 v2 = review rad $
                      atan2 (magnitude $ cross3 v1 v2) (v1 <.> v2)
 
 -- | compute the positive angle between the two vectors in their common plane
-angleBetweenDirs  :: (Direction d, Angle a, Num a, Ord a) => d -> d -> a
+angleBetweenDirs  :: Direction d => d -> d -> Angle
 angleBetweenDirs d1 d2 = angleBetween (fromDirection d1) (fromDirection d2)

src/Diagrams/TwoD.hs

@@ -70,10 +70,8 @@ module Diagrams.TwoD
          -- * Angles
        , tau
        , Angle(..)
-       , Turn(..), asTurn, CircleFrac
-       , Rad(..), asRad
-       , Deg(..), asDeg
-       , fullTurn, fullCircle, convertAngle
+       , rad, turn, deg
+       , fullTurn, fullCircle, angleRatio
 
          -- * Paths
          -- ** Stroking

src/Diagrams/TwoD/Arc.hs

@@ -33,6 +33,7 @@ import           Diagrams.TwoD.Types
 import           Diagrams.TwoD.Vector    (direction, e, unitX)
 import           Diagrams.Util           (tau, ( # ))
 
+import           Control.Lens            (from, (^.))
 import           Data.AffineSpace        ((.-.))
 import           Data.Semigroup          ((<>))
 import           Data.VectorSpace        (magnitude, negateV, (*^), (^-^))
@@ -45,7 +46,7 @@ import           Diagrams.Coordinates
 --   the positive y direction and sweeps counterclockwise through @s@
 --   radians.  The approximation is only valid for angles in the first
 --   quadrant.
-bezierFromSweepQ1 :: Rad -> Segment Closed R2
+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
         c1                    = ((4-x)/3)  ^&  ((1-x)*(3-x)/(3*y))
@@ -58,14 +59,14 @@ bezierFromSweepQ1 s = fmap (^-^ v) . rotate (s/2) $ bezier3 c2 c1 p0
 --   negative y direction and sweep clockwise.  When @s@ is less than
 --   0.0001 the empty list results.  If the sweep is greater than tau
 --   then it is truncated to tau.
-bezierFromSweep :: Rad -> [Segment Closed R2]
+bezierFromSweep :: Angle -> [Segment Closed R2]
 bezierFromSweep s
-  | s > tau    = bezierFromSweep tau
-  | s < 0      = fmap reflectY . bezierFromSweep $ (-s)
-  | s < 0.0001 = []
-  | s < tau/4  = [bezierFromSweepQ1 s]
-  | otherwise  = bezierFromSweepQ1 (tau/4)
-          : map (rotateBy (1/4)) (bezierFromSweep (max (s - tau/4) 0))
+  | s > fullTurn = bezierFromSweep fullTurn
+  | s < 0          = fmap reflectY . bezierFromSweep $ (-s)
+  | s < 0.0001     = []
+  | s < fullTurn/4      = [bezierFromSweepQ1 s]
+  | otherwise      = bezierFromSweepQ1 (fullTurn/4)
+          : map (rotate (1/4)) (bezierFromSweep (max (s - fullTurn/4) 0))
 
 {-
 ~~~~ Note [segment spacing]
@@ -89,29 +90,29 @@ 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 :: Angle -> Angle -> Trail R2
 arcT start end
-    | end' < start' = arcT start' (end' + fromIntegral d)
-    | otherwise     = (if sweep >= tau then glueTrail else id)
+    | end' < start' = arcT start (end + fromIntegral d)
+    | otherwise     = (if sweep >= fullTurn then glueTrail else id)
                     $ trailFromSegments bs
-  where sweep = convertAngle $ end - start
+  where sweep = 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.
-        start' = convertAngle start :: Turn
-        end'   = convertAngle end
+        start' = start^.turn
+        end'   = end^.turn
         d      = ceiling (start' - end') :: 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, TrailLike t, V t ~ R2) => a -> a -> t
+arc :: (TrailLike t, V t ~ R2) => Angle -> Angle -> t
 arc start end = trailLike $ arcT start end `at` (rotate start $ p2 (1,0))
 
 -- | Like 'arc' but clockwise.
-arcCW :: (Angle a, TrailLike t, V t ~ R2) => a -> a -> t
+arcCW :: (TrailLike t, V t ~ R2) => Angle -> Angle -> t
 arcCW start end = trailLike $
                             -- flipped arguments to get the path we want
                             -- then reverse the trail to get the cw direction.
@@ -131,7 +132,7 @@ arcCW start end = trailLike $
 --
 --   > arc'Ex = mconcat [ arc' r 0 (1/4 :: Turn) | r <- [0.5,-1,1.5] ]
 --   >        # centerXY # pad 1.1
-arc' :: (Angle a, TrailLike p, V p ~ R2) => Double -> a -> a -> p
+arc' :: (TrailLike p, V p ~ R2) => Double -> Angle -> Angle -> p
 arc' r start end = trailLike $ scale (abs r) ts `at` (rotate start $ p2 (abs r,0))
   where ts | r < 0     = reverseTrail $ arcT end start
            | otherwise = arcT start end
@@ -148,7 +149,7 @@ arc' r start end = trailLike $ scale (abs r) ts `at` (rotate start $ p2 (abs r,0
 --   >   ]
 --   >   # fc blue
 --   >   # centerXY # pad 1.1
-wedge :: (Angle a, TrailLike p, V p ~ R2) => Double -> a -> a -> p
+wedge :: (TrailLike p, V p ~ R2) => Double -> Angle -> Angle -> p
 wedge r a1 a2 = trailLike . (`at` origin) . glueTrail . wrapLine
               $ fromOffsets [r *^ e a1]
                 <> arc a1 a2 # scale r
@@ -166,18 +167,18 @@ wedge r a1 a2 = trailLike . (`at` origin) . glueTrail . wrapLine
 --   >   [ arcBetween origin (p2 (2,1)) ht | ht <- [-0.2, -0.1 .. 0.2] ]
 --   >   # centerXY # pad 1.1
 arcBetween :: (TrailLike t, V t ~ R2) => P2 -> P2 -> Double -> t
-arcBetween p q ht = trailLike (a # rotateBy (direction v) # moveTo p)
+arcBetween p q ht = trailLike (a # rotate (direction v) # moveTo p)
   where
     h = abs ht
     isStraight = h < 0.00001
     v = q .-. 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    = tau/4
-        | otherwise = 3*tau/4
-    st  = mid - Rad th
-    end = mid + Rad th
+    mid | ht >= 0    = fullTurn/4
+        | otherwise = 3*fullTurn/4
+    st  = mid - (th^.from rad)
+    end = mid + (th^.from rad)
     a | isStraight
       = fromOffsets [d *^ unitX]
       | otherwise
@@ -200,10 +201,10 @@ arcBetween p q ht = trailLike (a # rotateBy (direction v) # moveTo p)
 --   >   ]
 --   >   # fc blue
 --   >   # centerXY # pad 1.1
-annularWedge :: (Angle a, TrailLike p, V p ~ R2) => Double -> Double -> a -> a -> p
+annularWedge :: (TrailLike p, V p ~ R2) => Double -> Double -> Angle -> Angle -> p
 annularWedge r1' r2' a1 a2 = trailLike . (`at` o) . glueTrail . wrapLine
               $ fromOffsets [(r1'-r2') *^ e a1]
                 <> arc a1 a2 # scale r1'
                 <> fromOffsets [(r1'-r2') *^ negateV (e a2)]
                 <> arcCW a2 a1 # scale r2'
-  where o = origin # translate (r2' *^ e a1)
+  where o = origin # translate (r2' *^ e a1)