--------------------------------------------------------------------------------
-- |
-- Module      :  HGeometry.Ellipse
-- Copyright   :  (C) Frank Staals
-- License     :  see the LICENSE file
-- Maintainer  :  Frank Staals
--
-- Data type for representing an Ellipse.
--------------------------------------------------------------------------------
module HGeometry.Ellipse(
    Ellipse(Ellipse)
  , affineTransformation
  , ellipseMatrix
  , unitEllipse
  , circleToEllipse, ellipseToCircle, _EllipseCircle
  ) where

import           Control.Lens hiding (elements)
import           HGeometry.Ball
import           HGeometry.Matrix
import qualified HGeometry.Number.Radical as Radical
import           HGeometry.Point
import           HGeometry.Properties
import           HGeometry.Transformation
import           HGeometry.Vector

--------------------------------------------------------------------------------

-- | A type representing planar ellipses
newtype Ellipse r = Ellipse { forall r. Ellipse r -> Transformation 2 r
_affineTransformation :: Transformation 2 r }
                   deriving (Int -> Ellipse r -> ShowS
[Ellipse r] -> ShowS
Ellipse r -> String
(Int -> Ellipse r -> ShowS)
-> (Ellipse r -> String)
-> ([Ellipse r] -> ShowS)
-> Show (Ellipse r)
forall r. Show r => Int -> Ellipse r -> ShowS
forall r. Show r => [Ellipse r] -> ShowS
forall r. Show r => Ellipse r -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: forall r. Show r => Int -> Ellipse r -> ShowS
showsPrec :: Int -> Ellipse r -> ShowS
$cshow :: forall r. Show r => Ellipse r -> String
show :: Ellipse r -> String
$cshowList :: forall r. Show r => [Ellipse r] -> ShowS
showList :: [Ellipse r] -> ShowS
Show,Ellipse r -> Ellipse r -> Bool
(Ellipse r -> Ellipse r -> Bool)
-> (Ellipse r -> Ellipse r -> Bool) -> Eq (Ellipse r)
forall r. Eq r => Ellipse r -> Ellipse r -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: forall r. Eq r => Ellipse r -> Ellipse r -> Bool
== :: Ellipse r -> Ellipse r -> Bool
$c/= :: forall r. Eq r => Ellipse r -> Ellipse r -> Bool
/= :: Ellipse r -> Ellipse r -> Bool
Eq) -- ,Functor,Foldable,Traversable)

-- | Iso to access the transformation (applied on the unit circle)
-- that we use to actually represent the ellipse
affineTransformation :: Iso (Ellipse r) (Ellipse s) (Transformation 2 r) (Transformation 2 s)
affineTransformation :: forall r s (p :: * -> * -> *) (f :: * -> *).
(Profunctor p, Functor f) =>
p (Transformation 2 r) (f (Transformation 2 s))
-> p (Ellipse r) (f (Ellipse s))
affineTransformation = (Ellipse r -> Transformation 2 r)
-> (Transformation 2 s -> Ellipse s)
-> Iso
     (Ellipse r) (Ellipse s) (Transformation 2 r) (Transformation 2 s)
forall s a b t. (s -> a) -> (b -> t) -> Iso s t a b
iso Ellipse r -> Transformation 2 r
forall r. Ellipse r -> Transformation 2 r
_affineTransformation Transformation 2 s -> Ellipse s
forall r. Transformation 2 r -> Ellipse r
Ellipse

type instance Dimension (Ellipse r) = 2
type instance NumType   (Ellipse r) = r

instance Functor Ellipse where
  fmap :: forall a b. (a -> b) -> Ellipse a -> Ellipse b
fmap = ASetter (Ellipse a) (Ellipse b) a b
-> (a -> b) -> Ellipse a -> Ellipse b
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
over (ASetter (Ellipse a) (Ellipse b) a b
 -> (a -> b) -> Ellipse a -> Ellipse b)
-> ASetter (Ellipse a) (Ellipse b) a b
-> (a -> b)
-> Ellipse a
-> Ellipse b
forall a b. (a -> b) -> a -> b
$ (Transformation 2 a -> Identity (Transformation 2 b))
-> Ellipse a -> Identity (Ellipse b)
forall r s (p :: * -> * -> *) (f :: * -> *).
(Profunctor p, Functor f) =>
p (Transformation 2 r) (f (Transformation 2 s))
-> p (Ellipse r) (f (Ellipse s))
affineTransformation((Transformation 2 a -> Identity (Transformation 2 b))
 -> Ellipse a -> Identity (Ellipse b))
-> ((a -> Identity b)
    -> Transformation 2 a -> Identity (Transformation 2 b))
-> ASetter (Ellipse a) (Ellipse b) a b
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(Matrix 3 3 a -> Identity (Matrix 3 3 b))
-> Transformation 2 a -> Identity (Transformation 2 b)
(Matrix (2 + 1) (2 + 1) a -> Identity (Matrix (2 + 1) (2 + 1) b))
-> Transformation 2 a -> Identity (Transformation 2 b)
forall (d :: Nat) r s (p :: * -> * -> *) (f :: * -> *).
(Profunctor p, Functor f) =>
p (Matrix (d + 1) (d + 1) r) (f (Matrix (d + 1) (d + 1) s))
-> p (Transformation d r) (f (Transformation d s))
transformationMatrix((Matrix 3 3 a -> Identity (Matrix 3 3 b))
 -> Transformation 2 a -> Identity (Transformation 2 b))
-> ((a -> Identity b) -> Matrix 3 3 a -> Identity (Matrix 3 3 b))
-> (a -> Identity b)
-> Transformation 2 a
-> Identity (Transformation 2 b)
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(a -> Identity b) -> Matrix 3 3 a -> Identity (Matrix 3 3 b)
(NumType (Matrix 3 3 a) -> Identity (NumType (Matrix 3 3 b)))
-> Matrix 3 3 a -> Identity (Matrix 3 3 b)
forall matrix matrix'.
HasElements matrix matrix' =>
IndexedTraversal1
  (Int, Int) matrix matrix' (NumType matrix) (NumType matrix')
IndexedTraversal1
  (Int, Int)
  (Matrix 3 3 a)
  (Matrix 3 3 b)
  (NumType (Matrix 3 3 a))
  (NumType (Matrix 3 3 b))
elements

instance Foldable Ellipse where
  foldMap :: forall m a. Monoid m => (a -> m) -> Ellipse a -> m
foldMap = Getting m (Ellipse a) a -> (a -> m) -> Ellipse a -> m
forall r s a. Getting r s a -> (a -> r) -> s -> r
foldMapOf (Getting m (Ellipse a) a -> (a -> m) -> Ellipse a -> m)
-> Getting m (Ellipse a) a -> (a -> m) -> Ellipse a -> m
forall a b. (a -> b) -> a -> b
$ (Transformation 2 a -> Const m (Transformation 2 a))
-> Ellipse a -> Const m (Ellipse a)
forall r s (p :: * -> * -> *) (f :: * -> *).
(Profunctor p, Functor f) =>
p (Transformation 2 r) (f (Transformation 2 s))
-> p (Ellipse r) (f (Ellipse s))
affineTransformation((Transformation 2 a -> Const m (Transformation 2 a))
 -> Ellipse a -> Const m (Ellipse a))
-> ((a -> Const m a)
    -> Transformation 2 a -> Const m (Transformation 2 a))
-> Getting m (Ellipse a) a
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(Matrix 3 3 a -> Const m (Matrix 3 3 a))
-> Transformation 2 a -> Const m (Transformation 2 a)
(Matrix (2 + 1) (2 + 1) a -> Const m (Matrix (2 + 1) (2 + 1) a))
-> Transformation 2 a -> Const m (Transformation 2 a)
forall (d :: Nat) r s (p :: * -> * -> *) (f :: * -> *).
(Profunctor p, Functor f) =>
p (Matrix (d + 1) (d + 1) r) (f (Matrix (d + 1) (d + 1) s))
-> p (Transformation d r) (f (Transformation d s))
transformationMatrix((Matrix 3 3 a -> Const m (Matrix 3 3 a))
 -> Transformation 2 a -> Const m (Transformation 2 a))
-> ((a -> Const m a) -> Matrix 3 3 a -> Const m (Matrix 3 3 a))
-> (a -> Const m a)
-> Transformation 2 a
-> Const m (Transformation 2 a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(a -> Const m a) -> Matrix 3 3 a -> Const m (Matrix 3 3 a)
(NumType (Matrix 3 3 a) -> Const m (NumType (Matrix 3 3 a)))
-> Matrix 3 3 a -> Const m (Matrix 3 3 a)
forall matrix matrix'.
HasElements matrix matrix' =>
IndexedTraversal1
  (Int, Int) matrix matrix' (NumType matrix) (NumType matrix')
IndexedTraversal1
  (Int, Int)
  (Matrix 3 3 a)
  (Matrix 3 3 a)
  (NumType (Matrix 3 3 a))
  (NumType (Matrix 3 3 a))
elements

instance Traversable Ellipse where
  traverse :: forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> Ellipse a -> f (Ellipse b)
traverse a -> f b
f Ellipse a
e = Ellipse a
eEllipse a -> (Ellipse a -> f (Ellipse b)) -> f (Ellipse b)
forall a b. a -> (a -> b) -> b
&(a -> f b) -> Ellipse a -> f (Ellipse b)
forall {a} {b}. (a -> f b) -> Ellipse a -> f (Ellipse b)
elements' ((a -> f b) -> Ellipse a -> f (Ellipse b))
-> (a -> f b) -> Ellipse a -> f (Ellipse b)
forall {k} (f :: k -> *) s (t :: k) a (b :: k).
LensLike f s t a b -> LensLike f s t a b
%%~ a -> f b
f
    where
      elements' :: (a -> f b) -> Ellipse a -> f (Ellipse b)
elements' = ATraversal (Ellipse a) (Ellipse b) a b
-> Traversal (Ellipse a) (Ellipse b) a b
forall s t a b. ATraversal s t a b -> Traversal s t a b
cloneTraversal (ATraversal (Ellipse a) (Ellipse b) a b
 -> Traversal (Ellipse a) (Ellipse b) a b)
-> ATraversal (Ellipse a) (Ellipse b) a b
-> Traversal (Ellipse a) (Ellipse b) a b
forall a b. (a -> b) -> a -> b
$ (Transformation 2 a -> Bazaar (->) a b (Transformation 2 b))
-> Ellipse a -> Bazaar (->) a b (Ellipse b)
forall r s (p :: * -> * -> *) (f :: * -> *).
(Profunctor p, Functor f) =>
p (Transformation 2 r) (f (Transformation 2 s))
-> p (Ellipse r) (f (Ellipse s))
affineTransformation((Transformation 2 a -> Bazaar (->) a b (Transformation 2 b))
 -> Ellipse a -> Bazaar (->) a b (Ellipse b))
-> ((a -> Bazaar (->) a b b)
    -> Transformation 2 a -> Bazaar (->) a b (Transformation 2 b))
-> ATraversal (Ellipse a) (Ellipse b) a b
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(Matrix 3 3 a -> Bazaar (->) a b (Matrix 3 3 b))
-> Transformation 2 a -> Bazaar (->) a b (Transformation 2 b)
(Matrix (2 + 1) (2 + 1) a
 -> Bazaar (->) a b (Matrix (2 + 1) (2 + 1) b))
-> Transformation 2 a -> Bazaar (->) a b (Transformation 2 b)
forall (d :: Nat) r s (p :: * -> * -> *) (f :: * -> *).
(Profunctor p, Functor f) =>
p (Matrix (d + 1) (d + 1) r) (f (Matrix (d + 1) (d + 1) s))
-> p (Transformation d r) (f (Transformation d s))
transformationMatrix((Matrix 3 3 a -> Bazaar (->) a b (Matrix 3 3 b))
 -> Transformation 2 a -> Bazaar (->) a b (Transformation 2 b))
-> ((a -> Bazaar (->) a b b)
    -> Matrix 3 3 a -> Bazaar (->) a b (Matrix 3 3 b))
-> (a -> Bazaar (->) a b b)
-> Transformation 2 a
-> Bazaar (->) a b (Transformation 2 b)
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(a -> Bazaar (->) a b b)
-> Matrix 3 3 a -> Bazaar (->) a b (Matrix 3 3 b)
(NumType (Matrix 3 3 a)
 -> Bazaar (->) a b (NumType (Matrix 3 3 b)))
-> Matrix 3 3 a -> Bazaar (->) a b (Matrix 3 3 b)
forall matrix matrix'.
HasElements matrix matrix' =>
IndexedTraversal1
  (Int, Int) matrix matrix' (NumType matrix) (NumType matrix')
IndexedTraversal1
  (Int, Int)
  (Matrix 3 3 a)
  (Matrix 3 3 b)
  (NumType (Matrix 3 3 a))
  (NumType (Matrix 3 3 b))
elements


instance Num r => IsTransformable (Ellipse r) where
  transformBy :: Transformation (Dimension (Ellipse r)) (NumType (Ellipse r))
-> Ellipse r -> Ellipse r
transformBy Transformation (Dimension (Ellipse r)) (NumType (Ellipse r))
t (Ellipse Transformation 2 r
t') = Transformation 2 r -> Ellipse r
forall r. Transformation 2 r -> Ellipse r
Ellipse (Transformation 2 r -> Ellipse r)
-> Transformation 2 r -> Ellipse r
forall a b. (a -> b) -> a -> b
$ Transformation 2 r
Transformation (Dimension (Ellipse r)) (NumType (Ellipse r))
t Transformation 2 r -> Transformation 2 r -> Transformation 2 r
forall r (d :: Nat).
(Num r, OptMatrix_ (d + 1) r) =>
Transformation d r -> Transformation d r -> Transformation d r
|.| Transformation 2 r
t'

-- | Get the matrix describing the ellipse.
ellipseMatrix :: Iso (Ellipse r) (Ellipse s) (Matrix 3 3 r) (Matrix 3 3 s)
ellipseMatrix :: forall r s (p :: * -> * -> *) (f :: * -> *).
(Profunctor p, Functor f) =>
p (Matrix 3 3 r) (f (Matrix 3 3 s))
-> p (Ellipse r) (f (Ellipse s))
ellipseMatrix = p (Transformation 2 r) (f (Transformation 2 s))
-> p (Ellipse r) (f (Ellipse s))
forall r s (p :: * -> * -> *) (f :: * -> *).
(Profunctor p, Functor f) =>
p (Transformation 2 r) (f (Transformation 2 s))
-> p (Ellipse r) (f (Ellipse s))
affineTransformation(p (Transformation 2 r) (f (Transformation 2 s))
 -> p (Ellipse r) (f (Ellipse s)))
-> (p (Matrix 3 3 r) (f (Matrix 3 3 s))
    -> p (Transformation 2 r) (f (Transformation 2 s)))
-> p (Matrix 3 3 r) (f (Matrix 3 3 s))
-> p (Ellipse r) (f (Ellipse s))
forall b c a. (b -> c) -> (a -> b) -> a -> c
.p (Matrix 3 3 r) (f (Matrix 3 3 s))
-> p (Transformation 2 r) (f (Transformation 2 s))
p (Matrix (2 + 1) (2 + 1) r) (f (Matrix (2 + 1) (2 + 1) s))
-> p (Transformation 2 r) (f (Transformation 2 s))
forall (d :: Nat) r s (p :: * -> * -> *) (f :: * -> *).
(Profunctor p, Functor f) =>
p (Matrix (d + 1) (d + 1) r) (f (Matrix (d + 1) (d + 1) s))
-> p (Transformation d r) (f (Transformation d s))
transformationMatrix

-- | Ellipse representing the unit circle
unitEllipse :: Num r => Ellipse r
unitEllipse :: forall r. Num r => Ellipse r
unitEllipse = Transformation 2 r -> Ellipse r
forall r. Transformation 2 r -> Ellipse r
Ellipse (Transformation 2 r -> Ellipse r)
-> Transformation 2 r -> Ellipse r
forall a b. (a -> b) -> a -> b
$ Matrix (2 + 1) (2 + 1) r -> Transformation 2 r
forall (d :: Nat) r. Matrix (d + 1) (d + 1) r -> Transformation d r
Transformation Matrix 3 3 r
Matrix (2 + 1) (2 + 1) r
forall matrix (n :: Nat) (m :: Nat) r.
(Matrix_ matrix n m r, Num r) =>
matrix
identityMatrix

--------------------------------------------------------------------------------
-- | Converting between ellipses and circles

-- | Prims to convert between an Ellipse and a Circle.
_EllipseCircle :: (Radical.Radical r, Eq r) => Prism' (Ellipse r) (Circle (Point 2 r))
_EllipseCircle :: forall r.
(Radical r, Eq r) =>
Prism' (Ellipse r) (Circle (Point 2 r))
_EllipseCircle = (Circle (Point 2 r) -> Ellipse r)
-> (Ellipse r -> Maybe (Circle (Point 2 r)))
-> Prism
     (Ellipse r) (Ellipse r) (Circle (Point 2 r)) (Circle (Point 2 r))
forall b s a. (b -> s) -> (s -> Maybe a) -> Prism s s a b
prism' Circle (Point 2 r) -> Ellipse r
forall r point.
(Radical r, Point_ point 2 r) =>
Circle point -> Ellipse r
circleToEllipse Ellipse r -> Maybe (Circle (Point 2 r))
forall r. (Num r, Eq r) => Ellipse r -> Maybe (Circle (Point 2 r))
ellipseToCircle

-- | Try to Convert a circle into an ellipse. Returns a Nothing if the
-- ellipse is not an actual circle.
ellipseToCircle   :: (Num r, Eq r) => Ellipse r -> Maybe (Circle (Point 2 r))
ellipseToCircle :: forall r. (Num r, Eq r) => Ellipse r -> Maybe (Circle (Point 2 r))
ellipseToCircle Ellipse r
e = case Ellipse r
eEllipse r
-> Getting (Matrix 3 3 r) (Ellipse r) (Matrix 3 3 r)
-> Matrix 3 3 r
forall s a. s -> Getting a s a -> a
^.Getting (Matrix 3 3 r) (Ellipse r) (Matrix 3 3 r)
forall r s (p :: * -> * -> *) (f :: * -> *).
(Profunctor p, Functor f) =>
p (Matrix 3 3 r) (f (Matrix 3 3 s))
-> p (Ellipse r) (f (Ellipse s))
ellipseMatrix of
      Matrix (Vector3 (Vector3 r
sx r
0 r
x)
                      (Vector3 r
0 r
sy r
y)
                      (Vector3 r
0 r
0  r
1)
             )
           | r
sx r -> r -> Bool
forall a. Eq a => a -> a -> Bool
== r
sy -> Circle (Point 2 r) -> Maybe (Circle (Point 2 r))
forall a. a -> Maybe a
Just (Circle (Point 2 r) -> Maybe (Circle (Point 2 r)))
-> Circle (Point 2 r) -> Maybe (Circle (Point 2 r))
forall a b. (a -> b) -> a -> b
$ Point 2 r -> NumType (Point 2 r) -> Circle (Point 2 r)
forall point. point -> NumType point -> Circle point
Circle (r -> r -> Point 2 r
forall r. r -> r -> Point 2 r
Point2 r
x r
y) (r
sxr -> r -> r
forall a. Num a => a -> a -> a
*r
sx)
      Matrix 3 3 r
_               -> Maybe (Circle (Point 2 r))
forall a. Maybe a
Nothing

-- | Convert a circle to an ellipse
circleToEllipse                            :: ( Radical.Radical r
                                              , Point_ point 2 r
                                              ) => Circle point -> Ellipse r
circleToEllipse :: forall r point.
(Radical r, Point_ point 2 r) =>
Circle point -> Ellipse r
circleToEllipse (Circle point
p NumType point
rr) =
  Transformation 2 r -> Ellipse r
forall r. Transformation 2 r -> Ellipse r
Ellipse (Transformation 2 r -> Ellipse r)
-> Transformation 2 r -> Ellipse r
forall a b. (a -> b) -> a -> b
$ Vector 2 r -> Transformation 2 r
forall (d :: Nat) r vector.
(Num r, Vector_ vector d r, TransformationConstraints d r,
 d <= ((d + 1) - 1)) =>
vector -> Transformation d r
translation (point
ppoint -> Getting (Vector 2 r) point (Vector 2 r) -> Vector 2 r
forall s a. s -> Getting a s a -> a
^.Getting (Vector 2 r) point (Vector 2 r)
forall (d :: Nat) r s.
(Dimension point ~ d, NumType point ~ r, Dimension point ~ d,
 NumType point ~ s) =>
Lens point point (Vector d r) (Vector d s)
forall point point' (d :: Nat) r s.
(HasVector point point', Dimension point ~ d, NumType point ~ r,
 Dimension point' ~ d, NumType point' ~ s) =>
Lens point point' (Vector d r) (Vector d s)
Lens point point (Vector 2 r) (Vector 2 r)
vector) Transformation 2 r -> Transformation 2 r -> Transformation 2 r
forall r (d :: Nat).
(Num r, OptMatrix_ (d + 1) r) =>
Transformation d r -> Transformation d r -> Transformation d r
|.| r -> Transformation 2 r
forall (d :: Nat) r.
(Num r, TransformationConstraints d r) =>
r -> Transformation d r
uniformScaling (r -> r
forall r. Radical r => r -> r
Radical.sqrt r
NumType point
rr)