{-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE GeneralizedNewtypeDeriving #-} {-# LANGUAGE MultiParamTypeClasses #-} {-# LANGUAGE TypeFamilies #-} {-# LANGUAGE TypeOperators #-} {-# LANGUAGE TypeSynonymInstances #-} {-# LANGUAGE ViewPatterns #-} {-# OPTIONS_GHC -fno-warn-orphans #-} ----------------------------------------------------------------------------- -- | -- Module : Diagrams.ThreeD.Types -- Copyright : (c) 2011 diagrams-lib team (see LICENSE) -- License : BSD-style (see LICENSE) -- Maintainer : diagrams-discuss@googlegroups.com -- -- Basic types for three-dimensional Euclidean space. -- ----------------------------------------------------------------------------- module Diagrams.ThreeD.Types ( -- * 3D Euclidean space R3, r3, unr3, mkR3 , P3, p3, unp3, mkP3 , T3 , r3Iso, p3Iso -- * Two-dimensional angles -- | These are defined in "Diagrams.TwoD.Types" but -- reëxported here for convenience. , Angle, rad, turn, deg, (@@) , fullTurn, angleRatio -- * Directions in 3D , Direction(..) , Spherical(..) , asSpherical ) where import Control.Lens (Iso', iso, over, Wrapped(..), Rewrapped , _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 ------------------------------------------------------------ -- 3D Euclidean space -- | The three-dimensional Euclidean vector space R^3. newtype R3 = R3 { unR3 :: (Double, Double, Double) } deriving (AdditiveGroup, Eq, Ord, Show, Read) r3Iso :: Iso' R3 (Double, Double, Double) r3Iso = iso unR3 R3 -- | Construct a 3D vector from a triple of components. r3 :: (Double, Double, Double) -> R3 r3 = R3 -- | Curried version of `r3`. mkR3 :: Double -> Double -> Double -> R3 mkR3 x y z = r3 (x, y, z) -- | Convert a 3D vector back into a triple of components. unr3 :: R3 -> (Double, Double, Double) unr3 = unR3 -- | Lens wrapped isomorphisms for R3. instance Wrapped R3 where type Unwrapped R3 = (Double, Double, Double) _Wrapped' = iso unr3 r3 {-# INLINE _Wrapped' #-} instance Rewrapped R3 R3 type instance V R3 = R3 instance VectorSpace R3 where type Scalar R3 = Double (*^) = over r3Iso . (*^) instance HasBasis R3 where type Basis R3 = Either () (Either () ()) -- = Basis (Double, Double, Double) 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 -- | Points in R^3. type P3 = Point R3 -- | Construct a 3D point from a triple of coordinates. p3 :: (Double, Double, Double) -> P3 p3 = P . R3 -- | Convert a 3D point back into a triple of coordinates. unp3 :: P3 -> (Double, Double, Double) unp3 = unR3 . unPoint p3Iso :: Iso' P3 (Double, Double, Double) p3Iso = iso unp3 p3 -- | Curried version of `r3`. mkP3 :: Double -> Double -> Double -> P3 mkP3 x y z = p3 (x, y, z) -- | Transformations in R^3. type T3 = Transformation R3 instance Transformable R3 where transform = apply instance HasCross3 R3 where cross3 u v = r3 \$ cross3 (unr3 u) (unr3 v) -------------------------------------------------------------------------------- -- Direction -- | Direction is a type class representing directions in R3. The interface is -- based on that of the Angle class in 2D. class Direction d where -- | Convert to spherical coördinates toSpherical :: d -> Spherical -- | Convert from spherical coördinates fromSpherical :: Spherical -> d -- | A direction expressed as a pair of spherical coordinates. -- `Spherical 0 0` is the direction of `unitX`. The first coordinate -- represents rotation about the Z axis, the second rotation towards the Z axis. data Spherical = Spherical Angle Angle deriving (Show, Read, Eq) instance Direction Spherical where toSpherical = id fromSpherical = id -- | The identity function with a restricted type, for conveniently -- restricting unwanted polymorphism. For example, @fromDirection -- . asSpherical . camForward@ gives a unit vector pointing in the -- direction of the camera view. Without @asSpherical@, the -- intermediate type would be ambiguous. asSpherical :: Spherical -> Spherical 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