module Diagrams.ThreeD.Types
(
R3, r3, unr3, mkR3
, P3, p3, unp3, mkP3
, T3
, r3Iso, p3Iso
, Angle(..)
, Turn(Turn), asTurn
, CircleFrac
, Rad(Rad), asRad
, Deg(Deg), asDeg
, fullTurn, convertAngle, angleRatio
, Direction(..)
, Spherical(..)
, asSpherical
) where
import Control.Applicative
import Control.Lens (Iso', iso, over, Wrapped, wrapped, _1, _2, _3)
import Diagrams.Core
import Diagrams.TwoD.Types
import Diagrams.Coordinates
import Data.AffineSpace.Point
import Data.Basis
import Data.Cross
import Data.VectorSpace
newtype R3 = R3 { unR3 :: (Double, Double, Double) }
deriving (AdditiveGroup, Eq, Ord, Show, Read)
r3Iso :: Iso' R3 (Double, Double, Double)
r3Iso = iso unR3 R3
r3 :: (Double, Double, Double) -> R3
r3 = R3
mkR3 :: Double -> Double -> Double -> R3
mkR3 x y z = r3 (x, y, z)
unr3 :: R3 -> (Double, Double, Double)
unr3 = unR3
instance Wrapped (Double, Double, Double) (Double, Double, Double) R3 R3 where
wrapped = iso r3 unr3
type instance V R3 = R3
instance VectorSpace R3 where
type Scalar R3 = Double
(*^) = over r3Iso . (*^)
instance HasBasis R3 where
type Basis R3 = Either () (Either () ())
basisValue = R3 . basisValue
decompose = decompose . unR3
decompose' = decompose' . unR3
instance InnerSpace R3 where
(unR3 -> vec1) <.> (unR3 -> vec2) = vec1 <.> vec2
instance Coordinates R3 where
type FinalCoord R3 = Double
type PrevDim R3 = R2
type Decomposition R3 = Double :& Double :& Double
(coords -> x :& y) ^& z = r3 (x,y,z)
coords (unR3 -> (x,y,z)) = x :& y :& z
type P3 = Point R3
p3 :: (Double, Double, Double) -> P3
p3 = P . R3
unp3 :: P3 -> (Double, Double, Double)
unp3 = unR3 . unPoint
p3Iso :: Iso' P3 (Double, Double, Double)
p3Iso = iso unp3 p3
mkP3 :: Double -> Double -> Double -> P3
mkP3 x y z = p3 (x, y, z)
type T3 = Transformation R3
instance Transformable R3 where
transform = apply
instance HasCross3 R3 where
cross3 u v = r3 $ cross3 (unr3 u) (unr3 v)
class Direction d where
toSpherical :: Angle a => d -> Spherical a
fromSpherical :: Angle a => Spherical a -> d
data Spherical a = Spherical a a
deriving (Show, Read, Eq)
instance Applicative Spherical where
pure a = Spherical a a
Spherical a b <*> Spherical c d = Spherical (a c) (b d)
instance Functor Spherical where
fmap f s = pure f <*> s
instance (Angle a) => Direction (Spherical a) where
toSpherical = fmap convertAngle
fromSpherical = fmap convertAngle
asSpherical :: Spherical Turn -> Spherical Turn
asSpherical = id
instance HasX R3 where
_x = r3Iso . _1
instance HasX P3 where
_x = p3Iso . _1
instance HasY R3 where
_y = r3Iso . _2
instance HasY P3 where
_y = p3Iso . _2
instance HasZ R3 where
_z = r3Iso . _3
instance HasZ P3 where
_z = p3Iso . _3