{-# LANGUAGE DeriveDataTypeable #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE DeriveTraversable #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE TypeFamilies #-}
module Diagrams.Coordinates.Polar
(
Polar (..)
, mkPolar, polar, unpolar, polarIso, polarV2
, interpPolar
, Radial (..), Circle (..)
, HasX (..), HasY (..), HasR (..)
, er, eθ, etheta,
) where
import Control.Applicative
import qualified Data.Foldable as F
import Control.Lens
import Control.Monad.Fix
import Control.Monad.Zip
import Data.Distributive
import Data.Functor.Rep
import Data.Typeable
import GHC.Generics (Generic1)
import Geometry.Angle
import Geometry.TwoD.Types
import Linear.Affine
import Linear.Metric
import Linear.V3
import Linear.Vector
import Diagrams.Coordinates.Isomorphic
import Prelude
newtype Polar a = Polar (V2 a)
deriving (Monad, Functor, Typeable, MonadFix, Applicative, Traversable,
Generic1, MonadZip, F.Foldable)
makeWrapped ''Polar
instance Distributive Polar where
distribute f = Polar $ V2 (fmap (\(Polar (V2 x _)) -> x) f)
(fmap (\(Polar (V2 _ y)) -> y) f)
instance Representable Polar where
type Rep Polar = E Polar
tabulate f = Polar $ V2 (f er) (f eθ)
index xs (E l) = view l xs
instance Circle Polar where
_azimuth = polarWrapper . _y . from rad
_polar = id
instance HasR Polar where
_r = polarWrapper . _x
mkPolar :: n -> Angle n -> Polar n
mkPolar r θ = Polar $ V2 r (θ^.rad)
polar :: (n, Angle n) -> Polar n
polar = uncurry mkPolar
unpolar :: Polar n -> (n, Angle n)
unpolar (Polar (V2 r θ)) = (r, θ @@ rad)
polarIso :: Iso' (Polar n) (n, Angle n)
polarIso = iso unpolar polar
polarV2 :: RealFloat n => Iso' (Polar n) (V2 n)
polarV2 = iso (\(Polar (V2 r θ)) -> V2 (r * cos θ) (r * sin θ))
(\v@(V2 x y) -> Polar $ V2 (norm v) (atan2 y x))
polarWrapper :: Iso' (Polar a) (V2 a)
polarWrapper = iso (\(Polar v) -> v) Polar
interpPolar :: Num n => n -> Polar n -> Polar n -> Polar n
interpPolar t (Polar a) (Polar b) = Polar (lerp t a b)
class Radial t where
_radial :: Lens' (t a) a
instance Radial Polar where
_radial = polarWrapper . _x
class Radial t => Circle t where
_azimuth :: Lens' (t a) (Angle a)
_polar :: Lens' (t a) (Polar a)
er :: Radial v => E v
er = E _radial
eθ, etheta :: Circle v => E v
eθ = E (_polar . polarWrapper . _y)
etheta = eθ
class HasX t where
x_ :: RealFloat n => Lens' (t n) n
instance HasX v => HasX (Point v) where
x_ = _Point . x_
instance HasX V2 where x_ = _x
instance HasX V3 where x_ = _x
instance HasX Polar where x_ = polarV2 . _x
class HasX t => HasY t where
y_ :: RealFloat n => Lens' (t n) n
y_ = xy_ . _y
xy_ :: RealFloat n => Lens' (t n) (V2 n)
instance HasY v => HasY (Point v) where
xy_ = lensP . xy_
instance HasY V2 where xy_ = _xy
instance HasY V3 where xy_ = _xy
instance HasY Polar where xy_ = polarV2
instance RealFloat n => PointLike V2 n (Polar n) where
pointLike = _Point . from polarV2
{-# INLINE pointLike #-}