{-# LANGUAGE ConstraintKinds            #-}
{-# LANGUAGE DeriveFunctor              #-}
{-# LANGUAGE FlexibleContexts           #-}
{-# LANGUAGE FlexibleInstances          #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE MultiParamTypeClasses      #-}
{-# LANGUAGE RankNTypes                 #-}
{-# LANGUAGE TypeFamilies               #-}
{-# LANGUAGE TypeOperators              #-}
-----------------------------------------------------------------------------
-- |
-- Module      :  Diagrams.Angle
-- Copyright   :  (c) 2013 diagrams-lib team (see LICENSE)
-- License     :  BSD-style (see LICENSE)
-- Maintainer  :  diagrams-discuss@googlegroups.com
--
-- Type for representing angles.
--
-----------------------------------------------------------------------------

module Diagrams.Angle
       ( -- * Angle type
         Angle

         -- ** Using angles
       , (@@), rad, turn, deg

         -- ** Common angles
       , fullTurn, halfTurn, quarterTurn

         -- ** Trigonometric functions
       , sinA, cosA, tanA
       , asinA, acosA, atanA, atan2A, atan2A'

         -- ** Angle utilities
       , angleBetween, angleRatio, normalizeAngle

         -- ** Classes
       , HasTheta(..)
       , HasPhi(..)

         -- * Rotation
       , rotation, rotate
       ) where

import           Control.Applicative
import           Control.Lens            (AReview, Iso', Lens', iso, over,
                                          review, (^.))
import           Data.Fixed
import           Data.Monoid             hiding ((<>))
import           Data.Monoid.Action
import           Data.Semigroup
import           Prelude
import           Text.Read

import           Diagrams.Core           (OrderedField)
import           Diagrams.Core.Transform
import           Diagrams.Core.V
import           Diagrams.Points
import           Linear.V2               (V2 (..))

import           Linear.Metric
import           Linear.Vector

-- | Angles can be expressed in a variety of units.  Internally,
--   they are represented in radians.
newtype Angle n = Radians n
  deriving (Angle n -> Angle n -> Bool
forall n. Eq n => Angle n -> Angle n -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Angle n -> Angle n -> Bool
$c/= :: forall n. Eq n => Angle n -> Angle n -> Bool
== :: Angle n -> Angle n -> Bool
$c== :: forall n. Eq n => Angle n -> Angle n -> Bool
Eq, Angle n -> Angle n -> Bool
Angle n -> Angle n -> Ordering
Angle n -> Angle n -> Angle n
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
forall {n}. Ord n => Eq (Angle n)
forall n. Ord n => Angle n -> Angle n -> Bool
forall n. Ord n => Angle n -> Angle n -> Ordering
forall n. Ord n => Angle n -> Angle n -> Angle n
min :: Angle n -> Angle n -> Angle n
$cmin :: forall n. Ord n => Angle n -> Angle n -> Angle n
max :: Angle n -> Angle n -> Angle n
$cmax :: forall n. Ord n => Angle n -> Angle n -> Angle n
>= :: Angle n -> Angle n -> Bool
$c>= :: forall n. Ord n => Angle n -> Angle n -> Bool
> :: Angle n -> Angle n -> Bool
$c> :: forall n. Ord n => Angle n -> Angle n -> Bool
<= :: Angle n -> Angle n -> Bool
$c<= :: forall n. Ord n => Angle n -> Angle n -> Bool
< :: Angle n -> Angle n -> Bool
$c< :: forall n. Ord n => Angle n -> Angle n -> Bool
compare :: Angle n -> Angle n -> Ordering
$ccompare :: forall n. Ord n => Angle n -> Angle n -> Ordering
Ord, Int -> Angle n
Angle n -> Int
Angle n -> [Angle n]
Angle n -> Angle n
Angle n -> Angle n -> [Angle n]
Angle n -> Angle n -> Angle n -> [Angle n]
forall n. Enum n => Int -> Angle n
forall n. Enum n => Angle n -> Int
forall n. Enum n => Angle n -> [Angle n]
forall n. Enum n => Angle n -> Angle n
forall n. Enum n => Angle n -> Angle n -> [Angle n]
forall n. Enum n => Angle n -> Angle n -> Angle n -> [Angle n]
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
enumFromThenTo :: Angle n -> Angle n -> Angle n -> [Angle n]
$cenumFromThenTo :: forall n. Enum n => Angle n -> Angle n -> Angle n -> [Angle n]
enumFromTo :: Angle n -> Angle n -> [Angle n]
$cenumFromTo :: forall n. Enum n => Angle n -> Angle n -> [Angle n]
enumFromThen :: Angle n -> Angle n -> [Angle n]
$cenumFromThen :: forall n. Enum n => Angle n -> Angle n -> [Angle n]
enumFrom :: Angle n -> [Angle n]
$cenumFrom :: forall n. Enum n => Angle n -> [Angle n]
fromEnum :: Angle n -> Int
$cfromEnum :: forall n. Enum n => Angle n -> Int
toEnum :: Int -> Angle n
$ctoEnum :: forall n. Enum n => Int -> Angle n
pred :: Angle n -> Angle n
$cpred :: forall n. Enum n => Angle n -> Angle n
succ :: Angle n -> Angle n
$csucc :: forall n. Enum n => Angle n -> Angle n
Enum, forall a b. a -> Angle b -> Angle a
forall a b. (a -> b) -> Angle a -> Angle b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
<$ :: forall a b. a -> Angle b -> Angle a
$c<$ :: forall a b. a -> Angle b -> Angle a
fmap :: forall a b. (a -> b) -> Angle a -> Angle b
$cfmap :: forall a b. (a -> b) -> Angle a -> Angle b
Functor)

instance Show n => Show (Angle n) where
  showsPrec :: Int -> Angle n -> ShowS
showsPrec Int
d (Radians n
a) = Bool -> ShowS -> ShowS
showParen (Int
d forall a. Ord a => a -> a -> Bool
> Int
5) forall a b. (a -> b) -> a -> b
$
    forall a. Show a => Int -> a -> ShowS
showsPrec Int
6 n
a forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> ShowS
showString String
" @@ rad"

instance Read n => Read (Angle n) where
  readPrec :: ReadPrec (Angle n)
readPrec = forall a. ReadPrec a -> ReadPrec a
parens forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Int -> ReadPrec a -> ReadPrec a
prec Int
5 forall a b. (a -> b) -> a -> b
$ do
    n
x <- forall a. Read a => ReadPrec a
readPrec
    Symbol String
"@@" <- ReadPrec Lexeme
lexP
    Ident String
"rad" <- ReadPrec Lexeme
lexP
    forall (f :: * -> *) a. Applicative f => a -> f a
pure (forall n. n -> Angle n
Radians n
x)

type instance N (Angle n) = n

instance Applicative Angle where
  pure :: forall n. n -> Angle n
pure = forall n. n -> Angle n
Radians
  {-# INLINE pure #-}
  Radians a -> b
f <*> :: forall a b. Angle (a -> b) -> Angle a -> Angle b
<*> Radians a
x = forall n. n -> Angle n
Radians (a -> b
f a
x)
  {-# INLINE (<*>) #-}

instance Additive Angle where
  zero :: forall a. Num a => Angle a
zero = forall (f :: * -> *) a. Applicative f => a -> f a
pure a
0
  {-# INLINE zero #-}

instance Num n => Semigroup (Angle n) where
  <> :: Angle n -> Angle n -> Angle n
(<>) = forall (f :: * -> *) a. (Additive f, Num a) => f a -> f a -> f a
(^+^)
  {-# INLINE (<>) #-}

instance Num n => Monoid (Angle n) where
  mappend :: Angle n -> Angle n -> Angle n
mappend = forall a. Semigroup a => a -> a -> a
(<>)
  mempty :: Angle n
mempty  = forall n. n -> Angle n
Radians n
0

-- | The radian measure of an 'Angle' @a@ can be accessed as @a '^.'
--   rad@. A new 'Angle' can be defined in radians as @pi \@\@
--   rad@.
rad :: Iso' (Angle n) n
rad :: forall n. Iso' (Angle n) n
rad = forall s a b t. (s -> a) -> (b -> t) -> Iso s t a b
iso (\(Radians n
r) -> n
r) forall n. n -> Angle n
Radians
{-# INLINE rad #-}

-- | The measure of an 'Angle' @a@ in full circles can be accessed as
--   @a '^.' turn@.  A new 'Angle' of one-half circle can be defined in as
--   @1/2 \@\@ turn@.
turn :: Floating n => Iso' (Angle n) n
turn :: forall n. Floating n => Iso' (Angle n) n
turn = forall s a b t. (s -> a) -> (b -> t) -> Iso s t a b
iso (\(Radians n
r) -> n
r forall a. Fractional a => a -> a -> a
/ (n
2forall a. Num a => a -> a -> a
*forall a. Floating a => a
pi)) (forall n. n -> Angle n
Radians forall b c a. (b -> c) -> (a -> b) -> a -> c
. (forall a. Num a => a -> a -> a
*(n
2forall a. Num a => a -> a -> a
*forall a. Floating a => a
pi)))
{-# INLINE turn #-}

-- | The degree measure of an 'Angle' @a@ can be accessed as @a
--   '^.' deg@. A new 'Angle' can be defined in degrees as @180 \@\@
--   deg@.
deg :: Floating n => Iso' (Angle n) n
deg :: forall n. Floating n => Iso' (Angle n) n
deg = forall s a b t. (s -> a) -> (b -> t) -> Iso s t a b
iso (\(Radians n
r) -> n
r forall a. Fractional a => a -> a -> a
/ (n
2forall a. Num a => a -> a -> a
*forall a. Floating a => a
piforall a. Fractional a => a -> a -> a
/n
360)) (forall n. n -> Angle n
Radians forall b c a. (b -> c) -> (a -> b) -> a -> c
. ( forall a. Num a => a -> a -> a
* (n
2forall a. Num a => a -> a -> a
*forall a. Floating a => a
piforall a. Fractional a => a -> a -> a
/n
360)))
{-# INLINE deg #-}

-- | An angle representing one full turn.
fullTurn :: Floating v => Angle v
fullTurn :: forall v. Floating v => Angle v
fullTurn = v
1 forall b a. b -> AReview a b -> a
@@ forall n. Floating n => Iso' (Angle n) n
turn

-- | An angle representing a half turn.
halfTurn :: Floating v => Angle v
halfTurn :: forall v. Floating v => Angle v
halfTurn = v
0.5 forall b a. b -> AReview a b -> a
@@ forall n. Floating n => Iso' (Angle n) n
turn

-- | An angle representing a quarter turn.
quarterTurn :: Floating v => Angle v
quarterTurn :: forall v. Floating v => Angle v
quarterTurn = v
0.25 forall b a. b -> AReview a b -> a
@@ forall n. Floating n => Iso' (Angle n) n
turn

-- | Calculate ratio between two angles.
angleRatio :: Floating n => Angle n -> Angle n -> n
angleRatio :: forall n. Floating n => Angle n -> Angle n -> n
angleRatio Angle n
a Angle n
b = (Angle n
a forall s a. s -> Getting a s a -> a
^. forall n. Iso' (Angle n) n
rad) forall a. Fractional a => a -> a -> a
/ (Angle n
b forall s a. s -> Getting a s a -> a
^. forall n. Iso' (Angle n) n
rad)

-- | The sine of the given @Angle@.
sinA :: Floating n => Angle n -> n
sinA :: forall n. Floating n => Angle n -> n
sinA (Radians n
r) = forall a. Floating a => a -> a
sin n
r

-- | The cosine of the given @Angle@.
cosA :: Floating n => Angle n -> n
cosA :: forall n. Floating n => Angle n -> n
cosA (Radians n
r) = forall a. Floating a => a -> a
cos n
r

-- | The tangent function of the given @Angle@.
tanA :: Floating n => Angle n -> n
tanA :: forall n. Floating n => Angle n -> n
tanA (Radians n
r) = forall a. Floating a => a -> a
tan n
r

-- | The @Angle@ with the given sine.
asinA :: Floating n => n -> Angle n
asinA :: forall n. Floating n => n -> Angle n
asinA = forall n. n -> Angle n
Radians forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Floating a => a -> a
asin

-- | The @Angle@ with the given cosine.
acosA :: Floating n => n -> Angle n
acosA :: forall n. Floating n => n -> Angle n
acosA = forall n. n -> Angle n
Radians forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Floating a => a -> a
acos

-- | The @Angle@ with the given tangent.
atanA :: Floating n => n -> Angle n
atanA :: forall n. Floating n => n -> Angle n
atanA = forall n. n -> Angle n
Radians forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Floating a => a -> a
atan

-- | @atan2A y x@ is the angle between the positive x-axis and the vector given
--   by the coordinates (x, y). The 'Angle' returned is in the [-pi,pi] range.
atan2A :: RealFloat n => n -> n -> Angle n
atan2A :: forall n. RealFloat n => n -> n -> Angle n
atan2A n
y n
x = forall n. n -> Angle n
Radians forall a b. (a -> b) -> a -> b
$ forall a. RealFloat a => a -> a -> a
atan2 n
y n
x

-- | Similar to 'atan2A' but without the 'RealFloat' constraint. This means it
--   doesn't handle negative zero cases. However, for most geometric purposes,
--   the outcome will be the same.
atan2A' :: OrderedField n => n -> n -> Angle n
atan2A' :: forall n. OrderedField n => n -> n -> Angle n
atan2A' n
y n
x = forall n. OrderedField n => n -> n -> n
atan2' n
y n
x forall b a. b -> AReview a b -> a
@@ forall n. Iso' (Angle n) n
rad

-- atan2 without negative zero tests
atan2' :: OrderedField n => n -> n -> n
atan2' :: forall n. OrderedField n => n -> n -> n
atan2' n
y n
x
  | n
x forall a. Ord a => a -> a -> Bool
> n
0            =  forall a. Floating a => a -> a
atan (n
yforall a. Fractional a => a -> a -> a
/n
x)
  | n
x forall a. Eq a => a -> a -> Bool
== n
0 Bool -> Bool -> Bool
&& n
y forall a. Ord a => a -> a -> Bool
> n
0  =  forall a. Floating a => a
piforall a. Fractional a => a -> a -> a
/n
2
  | n
x forall a. Ord a => a -> a -> Bool
<  n
0 Bool -> Bool -> Bool
&& n
y forall a. Ord a => a -> a -> Bool
> n
0  =  forall a. Floating a => a
pi forall a. Num a => a -> a -> a
+ forall a. Floating a => a -> a
atan (n
yforall a. Fractional a => a -> a -> a
/n
x)
  | n
x forall a. Ord a => a -> a -> Bool
<= n
0 Bool -> Bool -> Bool
&& n
y forall a. Ord a => a -> a -> Bool
< n
0  = -forall n. OrderedField n => n -> n -> n
atan2' (-n
y) n
x
  | n
y forall a. Eq a => a -> a -> Bool
== n
0 Bool -> Bool -> Bool
&& n
x forall a. Ord a => a -> a -> Bool
< n
0  =  forall a. Floating a => a
pi    -- must be after the previous test on zero y
  | n
xforall a. Eq a => a -> a -> Bool
==n
0 Bool -> Bool -> Bool
&& n
yforall a. Eq a => a -> a -> Bool
==n
0     =  n
y     -- must be after the other double zero tests
  | Bool
otherwise        =  n
x forall a. Num a => a -> a -> a
+ n
y -- x or y is a NaN, return a NaN (via +)

-- | @30 \@\@ deg@ is an 'Angle' of the given measure and units.
--
-- >>> pi @@ rad
-- 3.141592653589793 @@ rad
--
-- >>> 1 @@ turn
-- 6.283185307179586 @@ rad
--
-- >>> 30 @@ deg
-- 0.5235987755982988 @@ rad
--
--   For 'Iso''s, ('@@') reverses the 'Iso'' on its right, and applies
--   the 'Iso'' to the value on the left. 'Angle's are the motivating
--   example where this order improves readability.
--
--   This is the same as a flipped 'review'.
--
-- @
-- ('@@') :: a -> 'Iso''      s a -> s
-- ('@@') :: a -> 'Prism''    s a -> s
-- ('@@') :: a -> 'Review'    s a -> s
-- ('@@') :: a -> 'Equality'' s a -> s
-- @
(@@) :: b -> AReview a b -> a
b
a @@ :: forall b a. b -> AReview a b -> a
@@ AReview a b
i = forall b (m :: * -> *) t. MonadReader b m => AReview t b -> m t
review AReview a b
i b
a

infixl 5 @@

-- | Compute the positive angle between the two vectors in their common
--   plane in the [0,pi] range. For a signed angle see
--   'Diagrams.TwoD.Vector.signedAngleBetween'.
--
--   Returns NaN if either of the vectors are zero.
angleBetween  :: (Metric v, Floating n, Ord n) => v n -> v n -> Angle n
angleBetween :: forall (v :: * -> *) n.
(Metric v, Floating n, Ord n) =>
v n -> v n -> Angle n
angleBetween v n
v1 v n
v2 = forall n. Floating n => n -> Angle n
acosA (forall a. Ord a => a -> a -> a
min n
1 forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Ord a => a -> a -> a
max (-n
1) forall a b. (a -> b) -> a -> b
$ forall (f :: * -> *) a. (Metric f, Floating a) => f a -> f a
signorm v n
v1 forall (f :: * -> *) a. (Metric f, Num a) => f a -> f a -> a
`dot` forall (f :: * -> *) a. (Metric f, Floating a) => f a -> f a
signorm v n
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 :: forall n. (Floating n, Real n) => Angle n -> Angle n
normalizeAngle = forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
over forall n. Iso' (Angle n) n
rad (forall a. Real a => a -> a -> a
`mod'` (n
2 forall a. Num a => a -> a -> a
* forall a. Floating a => a
pi))

------------------------------------------------------------
-- Rotation

-- These functions are defined here (instead of in
-- Diagrams.TwoD.Transform) because the Action instance needs to go
-- here.

-- | Create a transformation which performs a rotation about the local
--   origin by the given angle.  See also 'rotate'.
rotation :: Floating n => Angle n -> Transformation V2 n
rotation :: forall n. Floating n => Angle n -> Transformation V2 n
rotation Angle n
theta = forall (v :: * -> *) n.
(Additive v, Num n) =>
(v n :-: v n) -> (v n :-: v n) -> Transformation v n
fromLinear V2 n :-: V2 n
r (forall u v. (u :-: v) -> v :-: u
linv V2 n :-: V2 n
r)
    where
    c :: n
c = forall n. Floating n => Angle n -> n
cosA Angle n
theta
    s :: n
s = forall n. Floating n => Angle n -> n
sinA Angle n
theta
    r :: V2 n :-: V2 n
r               = forall {a}. Num a => a -> a -> V2 a -> V2 a
rot n
c n
s forall u v. (u -> v) -> (v -> u) -> u :-: v
<-> forall {a}. Num a => a -> a -> V2 a -> V2 a
rot n
c (-n
s)
    rot :: a -> a -> V2 a -> V2 a
rot a
co a
si (V2 a
x a
y) = forall a. a -> a -> V2 a
V2 (a
co forall a. Num a => a -> a -> a
* a
x forall a. Num a => a -> a -> a
- a
si forall a. Num a => a -> a -> a
* a
y)
                            (a
si forall a. Num a => a -> a -> a
* a
x forall a. Num a => a -> a -> a
+ a
co forall a. Num a => a -> a -> a
* a
y)

-- | Rotate about the local origin by the given angle. Positive angles
--   correspond to counterclockwise rotation, negative to
--   clockwise. The angle can be expressed using any of the 'Iso's on
--   'Angle'.  For example, @rotate (1\/4 \@\@ 'turn')@, @rotate
--   (tau\/4 \@\@ rad)@, and @rotate (90 \@\@ deg)@ all
--   represent the same transformation, namely, a counterclockwise
--   rotation by a right angle.  To rotate about some point other than
--   the local origin, see 'rotateAbout'.
--
--   Note that writing @rotate (1\/4)@, with no 'Angle' constructor,
--   will yield an error since GHC cannot figure out which sort of
--   angle you want to use.  In this common situation you can use
--   'rotateBy', which interprets its argument as a number of turns.

rotate :: (InSpace V2 n t, Transformable t, Floating n) => Angle n -> t -> t
rotate :: forall n t.
(InSpace V2 n t, Transformable t, Floating n) =>
Angle n -> t -> t
rotate = forall t. Transformable t => Transformation (V t) (N t) -> t -> t
transform forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall n. Floating n => Angle n -> Transformation V2 n
rotation

-- | Angles act on other things by rotation.
instance (V t ~ V2, N t ~ n, Transformable t, Floating n)
  => Action (Angle n) t where
  act :: Angle n -> t -> t
act = forall n t.
(InSpace V2 n t, Transformable t, Floating n) =>
Angle n -> t -> t
rotate

------------------------------------------------------------
-- Polar Coordinates

-- | The class of types with at least one angle coordinate, called '_theta'.
class HasTheta t where
  _theta :: RealFloat n => Lens' (t n) (Angle n)

-- | The class of types with at least two angle coordinates, the second called
--   '_phi'. '_phi' is the positive angle measured from the z axis.
class HasTheta t => HasPhi t where
  _phi :: RealFloat n => Lens' (t n) (Angle n)

-- Point instances
instance HasTheta v => HasTheta (Point v) where
  _theta :: forall n. RealFloat n => Lens' (Point v n) (Angle n)
_theta = forall (g :: * -> *) a. Lens' (Point g a) (g a)
lensP forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (t :: * -> *) n.
(HasTheta t, RealFloat n) =>
Lens' (t n) (Angle n)
_theta
  {-# INLINE _theta #-}

instance HasPhi v => HasPhi (Point v) where
  _phi :: forall n. RealFloat n => Lens' (Point v n) (Angle n)
_phi = forall (g :: * -> *) a. Lens' (Point g a) (g a)
lensP forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (t :: * -> *) n.
(HasPhi t, RealFloat n) =>
Lens' (t n) (Angle n)
_phi
  {-# INLINE _phi #-}