{-# LANGUAGE TemplateHaskell #-}
--------------------------------------------------------------------------------
-- |
-- Module      :  Data.Geometry.Ellipse
-- Copyright   :  (C) Frank Staals
-- License     :  see the LICENSE file
-- Maintainer  :  Frank Staals
--------------------------------------------------------------------------------
module Data.Geometry.Ellipse(
    Ellipse(Ellipse)
  , affineTransformation
  , ellipseMatrix
  , unitEllipse
  , circleToEllipse, ellipseToCircle, _EllipseCircle
  ) where

import Control.Lens
import Data.Ext
import Data.Geometry.Ball
import Data.Geometry.Matrix
import Data.Geometry.Transformation
import Data.Geometry.Point
import Data.Geometry.Properties
import Data.Geometry.Vector

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

-- | A type representing planar ellipses
newtype Ellipse r = Ellipse { 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
showList :: [Ellipse r] -> ShowS
$cshowList :: forall r. Show r => [Ellipse r] -> ShowS
show :: Ellipse r -> String
$cshow :: forall r. Show r => Ellipse r -> String
showsPrec :: Int -> Ellipse r -> ShowS
$cshowsPrec :: forall r. Show r => Int -> 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
/= :: Ellipse r -> Ellipse r -> Bool
$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
Eq,a -> Ellipse b -> Ellipse a
(a -> b) -> Ellipse a -> Ellipse b
(forall a b. (a -> b) -> Ellipse a -> Ellipse b)
-> (forall a b. a -> Ellipse b -> Ellipse a) -> Functor Ellipse
forall a b. a -> Ellipse b -> Ellipse a
forall a b. (a -> b) -> Ellipse a -> Ellipse b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
<$ :: a -> Ellipse b -> Ellipse a
$c<$ :: forall a b. a -> Ellipse b -> Ellipse a
fmap :: (a -> b) -> Ellipse a -> Ellipse b
$cfmap :: forall a b. (a -> b) -> Ellipse a -> Ellipse b
Functor,a -> Ellipse a -> Bool
Ellipse m -> m
Ellipse a -> [a]
Ellipse a -> Bool
Ellipse a -> Int
Ellipse a -> a
Ellipse a -> a
Ellipse a -> a
Ellipse a -> a
(a -> m) -> Ellipse a -> m
(a -> m) -> Ellipse a -> m
(a -> b -> b) -> b -> Ellipse a -> b
(a -> b -> b) -> b -> Ellipse a -> b
(b -> a -> b) -> b -> Ellipse a -> b
(b -> a -> b) -> b -> Ellipse a -> b
(a -> a -> a) -> Ellipse a -> a
(a -> a -> a) -> Ellipse a -> a
(forall m. Monoid m => Ellipse m -> m)
-> (forall m a. Monoid m => (a -> m) -> Ellipse a -> m)
-> (forall m a. Monoid m => (a -> m) -> Ellipse a -> m)
-> (forall a b. (a -> b -> b) -> b -> Ellipse a -> b)
-> (forall a b. (a -> b -> b) -> b -> Ellipse a -> b)
-> (forall b a. (b -> a -> b) -> b -> Ellipse a -> b)
-> (forall b a. (b -> a -> b) -> b -> Ellipse a -> b)
-> (forall a. (a -> a -> a) -> Ellipse a -> a)
-> (forall a. (a -> a -> a) -> Ellipse a -> a)
-> (forall a. Ellipse a -> [a])
-> (forall a. Ellipse a -> Bool)
-> (forall a. Ellipse a -> Int)
-> (forall a. Eq a => a -> Ellipse a -> Bool)
-> (forall a. Ord a => Ellipse a -> a)
-> (forall a. Ord a => Ellipse a -> a)
-> (forall a. Num a => Ellipse a -> a)
-> (forall a. Num a => Ellipse a -> a)
-> Foldable Ellipse
forall a. Eq a => a -> Ellipse a -> Bool
forall a. Num a => Ellipse a -> a
forall a. Ord a => Ellipse a -> a
forall m. Monoid m => Ellipse m -> m
forall a. Ellipse a -> Bool
forall a. Ellipse a -> Int
forall a. Ellipse a -> [a]
forall a. (a -> a -> a) -> Ellipse a -> a
forall m a. Monoid m => (a -> m) -> Ellipse a -> m
forall b a. (b -> a -> b) -> b -> Ellipse a -> b
forall a b. (a -> b -> b) -> b -> Ellipse a -> b
forall (t :: * -> *).
(forall m. Monoid m => t m -> m)
-> (forall m a. Monoid m => (a -> m) -> t a -> m)
-> (forall m a. Monoid m => (a -> m) -> t a -> m)
-> (forall a b. (a -> b -> b) -> b -> t a -> b)
-> (forall a b. (a -> b -> b) -> b -> t a -> b)
-> (forall b a. (b -> a -> b) -> b -> t a -> b)
-> (forall b a. (b -> a -> b) -> b -> t a -> b)
-> (forall a. (a -> a -> a) -> t a -> a)
-> (forall a. (a -> a -> a) -> t a -> a)
-> (forall a. t a -> [a])
-> (forall a. t a -> Bool)
-> (forall a. t a -> Int)
-> (forall a. Eq a => a -> t a -> Bool)
-> (forall a. Ord a => t a -> a)
-> (forall a. Ord a => t a -> a)
-> (forall a. Num a => t a -> a)
-> (forall a. Num a => t a -> a)
-> Foldable t
product :: Ellipse a -> a
$cproduct :: forall a. Num a => Ellipse a -> a
sum :: Ellipse a -> a
$csum :: forall a. Num a => Ellipse a -> a
minimum :: Ellipse a -> a
$cminimum :: forall a. Ord a => Ellipse a -> a
maximum :: Ellipse a -> a
$cmaximum :: forall a. Ord a => Ellipse a -> a
elem :: a -> Ellipse a -> Bool
$celem :: forall a. Eq a => a -> Ellipse a -> Bool
length :: Ellipse a -> Int
$clength :: forall a. Ellipse a -> Int
null :: Ellipse a -> Bool
$cnull :: forall a. Ellipse a -> Bool
toList :: Ellipse a -> [a]
$ctoList :: forall a. Ellipse a -> [a]
foldl1 :: (a -> a -> a) -> Ellipse a -> a
$cfoldl1 :: forall a. (a -> a -> a) -> Ellipse a -> a
foldr1 :: (a -> a -> a) -> Ellipse a -> a
$cfoldr1 :: forall a. (a -> a -> a) -> Ellipse a -> a
foldl' :: (b -> a -> b) -> b -> Ellipse a -> b
$cfoldl' :: forall b a. (b -> a -> b) -> b -> Ellipse a -> b
foldl :: (b -> a -> b) -> b -> Ellipse a -> b
$cfoldl :: forall b a. (b -> a -> b) -> b -> Ellipse a -> b
foldr' :: (a -> b -> b) -> b -> Ellipse a -> b
$cfoldr' :: forall a b. (a -> b -> b) -> b -> Ellipse a -> b
foldr :: (a -> b -> b) -> b -> Ellipse a -> b
$cfoldr :: forall a b. (a -> b -> b) -> b -> Ellipse a -> b
foldMap' :: (a -> m) -> Ellipse a -> m
$cfoldMap' :: forall m a. Monoid m => (a -> m) -> Ellipse a -> m
foldMap :: (a -> m) -> Ellipse a -> m
$cfoldMap :: forall m a. Monoid m => (a -> m) -> Ellipse a -> m
fold :: Ellipse m -> m
$cfold :: forall m. Monoid m => Ellipse m -> m
Foldable,Functor Ellipse
Foldable Ellipse
Functor Ellipse
-> Foldable Ellipse
-> (forall (f :: * -> *) a b.
    Applicative f =>
    (a -> f b) -> Ellipse a -> f (Ellipse b))
-> (forall (f :: * -> *) a.
    Applicative f =>
    Ellipse (f a) -> f (Ellipse a))
-> (forall (m :: * -> *) a b.
    Monad m =>
    (a -> m b) -> Ellipse a -> m (Ellipse b))
-> (forall (m :: * -> *) a.
    Monad m =>
    Ellipse (m a) -> m (Ellipse a))
-> Traversable Ellipse
(a -> f b) -> Ellipse a -> f (Ellipse b)
forall (t :: * -> *).
Functor t
-> Foldable t
-> (forall (f :: * -> *) a b.
    Applicative f =>
    (a -> f b) -> t a -> f (t b))
-> (forall (f :: * -> *) a. Applicative f => t (f a) -> f (t a))
-> (forall (m :: * -> *) a b.
    Monad m =>
    (a -> m b) -> t a -> m (t b))
-> (forall (m :: * -> *) a. Monad m => t (m a) -> m (t a))
-> Traversable t
forall (m :: * -> *) a. Monad m => Ellipse (m a) -> m (Ellipse a)
forall (f :: * -> *) a.
Applicative f =>
Ellipse (f a) -> f (Ellipse a)
forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> Ellipse a -> m (Ellipse b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> Ellipse a -> f (Ellipse b)
sequence :: Ellipse (m a) -> m (Ellipse a)
$csequence :: forall (m :: * -> *) a. Monad m => Ellipse (m a) -> m (Ellipse a)
mapM :: (a -> m b) -> Ellipse a -> m (Ellipse b)
$cmapM :: forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> Ellipse a -> m (Ellipse b)
sequenceA :: Ellipse (f a) -> f (Ellipse a)
$csequenceA :: forall (f :: * -> *) a.
Applicative f =>
Ellipse (f a) -> f (Ellipse a)
traverse :: (a -> f b) -> Ellipse a -> f (Ellipse b)
$ctraverse :: forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> Ellipse a -> f (Ellipse b)
$cp2Traversable :: Foldable Ellipse
$cp1Traversable :: Functor Ellipse
Traversable)
makeLenses ''Ellipse

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

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, Arity (d + 1)) =>
Transformation d r -> Transformation d r -> Transformation d r
|.| Transformation 2 r
t'


ellipseMatrix :: Iso (Ellipse r) (Ellipse s) (Matrix 3 3 r) (Matrix 3 3 s)
ellipseMatrix :: 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 r.
Iso
  (Ellipse r) (Ellipse r) (Transformation 2 r) (Transformation 2 r)
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))
forall (d :: Nat) r s.
Iso
  (Transformation d r)
  (Transformation d s)
  (Matrix (d + 1) (d + 1) r)
  (Matrix (d + 1) (d + 1) s)
transformationMatrix

-- | Ellipse representing the unit circle
unitEllipse :: Num r => Ellipse r
unitEllipse :: 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 (2 + 1) (2 + 1) r
forall (d :: Nat) r. (Arity d, Num r) => Matrix d d r
identityMatrix

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

_EllipseCircle :: (Floating r, Eq r) => Prism' (Ellipse r) (Circle () r)
_EllipseCircle :: Prism' (Ellipse r) (Circle () r)
_EllipseCircle = (Circle () r -> Ellipse r)
-> (Ellipse r -> Maybe (Circle () r))
-> Prism' (Ellipse r) (Circle () r)
forall b s a. (b -> s) -> (s -> Maybe a) -> Prism s s a b
prism' Circle () r -> Ellipse r
forall r p. Floating r => Circle p r -> Ellipse r
circleToEllipse Ellipse r -> Maybe (Circle () r)
forall r. (Num r, Eq r) => Ellipse r -> Maybe (Circle () r)
ellipseToCircle

ellipseToCircle   :: (Num r, Eq r) => Ellipse r -> Maybe (Circle () r)
ellipseToCircle :: Ellipse r -> Maybe (Circle () 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.
Iso (Ellipse r) (Ellipse s) (Matrix 3 3 r) (Matrix 3 3 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 () r -> Maybe (Circle () r)
forall a. a -> Maybe a
Just (Circle () r -> Maybe (Circle () r))
-> Circle () r -> Maybe (Circle () r)
forall a b. (a -> b) -> a -> b
$ (Point 2 r :+ ()) -> r -> Circle () r
forall r p. (Point 2 r :+ p) -> r -> Circle p r
Circle (Point 2 r -> Point 2 r :+ ()
forall a. a -> a :+ ()
ext (Point 2 r -> Point 2 r :+ ()) -> Point 2 r -> Point 2 r :+ ()
forall a b. (a -> b) -> a -> b
$ 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 () r)
forall a. Maybe a
Nothing

circleToEllipse                            :: Floating r => Circle p r -> Ellipse r
circleToEllipse :: Circle p r -> Ellipse r
circleToEllipse (Circle (Point Vector 2 r
v :+ p
_) r
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 r (d :: Nat).
(Num r, Arity d, Arity (d + 1)) =>
Vector d r -> Transformation d r
translation Vector 2 r
v Transformation 2 r -> Transformation 2 r -> Transformation 2 r
forall r (d :: Nat).
(Num r, Arity (d + 1)) =>
Transformation d r -> Transformation d r -> Transformation d r
|.| r -> Transformation 2 r
forall r (d :: Nat).
(Num r, Arity d, Arity (d + 1)) =>
r -> Transformation d r
uniformScaling (r -> r
forall a. Floating a => a -> a
sqrt r
rr)