{-# LANGUAGE FlexibleContexts      #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE TypeFamilies          #-}
{-# LANGUAGE TypeOperators         #-}
{-# LANGUAGE TypeSynonymInstances  #-}
-----------------------------------------------------------------------------
-- |
-- Module      :  Diagrams.TwoD.Ellipse
-- Copyright   :  (c) 2011 diagrams-lib team (see LICENSE)
-- License     :  BSD-style (see LICENSE)
-- Maintainer  :  diagrams-discuss@googlegroups.com
--
-- Two-dimensional ellipses (and, as a special case, circles).
--
-----------------------------------------------------------------------------

module Diagrams.TwoD.Ellipse
    (
      -- * Ellipse and circle diagrams
      unitCircle
    , circle
    , ellipse
    , ellipseXY
    ) where

import           Diagrams.Core

import           Diagrams.Angle
import           Diagrams.Located        (at)
import           Diagrams.Trail          (glueTrail)
import           Diagrams.TrailLike
import           Diagrams.TwoD.Arc
import           Diagrams.TwoD.Transform
import           Diagrams.TwoD.Types
import           Diagrams.TwoD.Vector    (xDir)
import           Diagrams.Util

-- | A circle of radius 1, with center at the origin.
unitCircle :: (TrailLike t, V t ~ V2, N t ~ n) => t
unitCircle :: forall t n. (TrailLike t, V t ~ V2, N t ~ n) => t
unitCircle = Located (Trail (V t) (N t)) -> t
forall t. TrailLike t => Located (Trail (V t) (N t)) -> t
trailLike (Located (Trail (V t) (N t)) -> t)
-> Located (Trail (V t) (N t)) -> t
forall a b. (a -> b) -> a -> b
$ Trail V2 n -> Trail V2 n
forall (v :: * -> *) n.
(Metric v, OrderedField n) =>
Trail v n -> Trail v n
glueTrail (Direction V2 n -> Angle n -> Trail V2 n
forall n. OrderedField n => Direction V2 n -> Angle n -> Trail V2 n
arcT Direction V2 n
forall (v :: * -> *) n. (R1 v, Additive v, Num n) => Direction v n
xDir Angle n
forall v. Floating v => Angle v
fullTurn) Trail V2 n
-> Point (V (Trail V2 n)) (N (Trail V2 n)) -> Located (Trail V2 n)
forall a. a -> Point (V a) (N a) -> Located a
`at` (n, n) -> P2 n
forall n. (n, n) -> P2 n
p2 (n
1,n
0)

-- | A circle of the given radius, centered at the origin.  As a path,
--   it begins at (r,0).
circle :: (TrailLike t, V t ~ V2, N t ~ n, Transformable t) => n -> t
circle :: forall t n.
(TrailLike t, V t ~ V2, N t ~ n, Transformable t) =>
n -> t
circle n
d = t
forall t n. (TrailLike t, V t ~ V2, N t ~ n) => t
unitCircle t -> (t -> t) -> t
forall a b. a -> (a -> b) -> b
# n -> t -> t
forall (v :: * -> *) n a.
(InSpace v n a, Eq n, Fractional n, Transformable a) =>
n -> a -> a
scale n
d

-- | @ellipse e@ constructs an ellipse with eccentricity @e@ by
--   scaling the unit circle in the X direction.  The eccentricity must
--   be within the interval [0,1).
ellipse :: (TrailLike t, V t ~ V2, N t ~ n, Transformable t) => n -> t
ellipse :: forall t n.
(TrailLike t, V t ~ V2, N t ~ n, Transformable t) =>
n -> t
ellipse n
e
    | n
e n -> n -> Bool
forall a. Ord a => a -> a -> Bool
>= n
0 Bool -> Bool -> Bool
&& n
e n -> n -> Bool
forall a. Ord a => a -> a -> Bool
< n
1  = n -> t -> t
forall (v :: * -> *) n t.
(InSpace v n t, R2 v, Fractional n, Transformable t) =>
n -> t -> t
scaleX (n -> n
forall a. Floating a => a -> a
sqrt (n
1 n -> n -> n
forall a. Num a => a -> a -> a
- n
en -> n -> n
forall a. Num a => a -> a -> a
*n
e)) t
forall t n. (TrailLike t, V t ~ V2, N t ~ n) => t
unitCircle
    | Bool
otherwise        = [Char] -> t
forall a. HasCallStack => [Char] -> a
error [Char]
"Eccentricity of ellipse must be >= 0 and < 1."

-- | @ellipseXY x y@ creates an axis-aligned ellipse, centered at the
--   origin, with radius @x@ along the x-axis and radius @y@ along the
--   y-axis.
ellipseXY :: (TrailLike t, V t ~ V2, N t ~ n, Transformable t) => n -> n -> t
ellipseXY :: forall t n.
(TrailLike t, V t ~ V2, N t ~ n, Transformable t) =>
n -> n -> t
ellipseXY n
x n
y = t
forall t n. (TrailLike t, V t ~ V2, N t ~ n) => t
unitCircle t -> (t -> t) -> t
forall a b. a -> (a -> b) -> b
# n -> t -> t
forall (v :: * -> *) n t.
(InSpace v n t, R2 v, Fractional n, Transformable t) =>
n -> t -> t
scaleX n
x t -> (t -> t) -> t
forall a b. a -> (a -> b) -> b
# n -> t -> t
forall (v :: * -> *) n t.
(InSpace v n t, R2 v, Fractional n, Transformable t) =>
n -> t -> t
scaleY n
y