diff --git a/diagrams-lib.cabal b/diagrams-lib.cabal index 04b31b97..e23c4bcf 100644 --- a/diagrams-lib.cabal +++ b/diagrams-lib.cabal @@ -72,6 +72,8 @@ Library Diagrams.ThreeD.Shapes, Diagrams.ThreeD.Vector, Diagrams.ThreeD.Transform, + Diagrams.ThreeD.Camera, + Diagrams.ThreeD.Light, Diagrams.Animation, Diagrams.Animation.Active, Diagrams.Util, diff --git a/src/Diagrams/ThreeD/Camera.hs b/src/Diagrams/ThreeD/Camera.hs new file mode 100644 index 00000000..8c55d2be --- /dev/null +++ b/src/Diagrams/ThreeD/Camera.hs @@ -0,0 +1,119 @@ +{-# LANGUAGE TypeFamilies #-} +{-# LANGUAGE MultiParamTypeClasses #-} +{-# LANGUAGE FlexibleContexts #-} +{-# LANGUAGE GADTs #-} + +----------------------------------------------------------------------------- +-- | +-- Module : Diagrams.ThreeD.Camera +-- Copyright : (c) 2013 diagrams-lib team (see LICENSE) +-- License : BSD-style (see LICENSE) +-- Maintainer : diagrams-discuss@googlegroups.com +-- +-- Types to specify viewpoint for 3D rendering. +-- +----------------------------------------------------------------------------- + +module Diagrams.ThreeD.Camera + ( Camera -- do not export constructor + , PerspectiveLens(..), OrthoLens(..) -- These are safe to construct manually + , camLoc, camForward, camUp, camRight, camLens + , facing_ZCamera, mm50Camera + , mm50, mm50Wide, mm50Narrow + , aspect, camAspect + ) + where + +import Data.Monoid + +import Data.Cross + +import Diagrams.Core +import Diagrams.ThreeD.Types +import Diagrams.ThreeD.Vector + +-- Parameterize Camera on the lens type, so that Backends can express which +-- lenses they handle. +data Camera l = Camera + { camLoc :: P3 + , forward :: R3 + , up :: R3 + , lens :: l + } + +class CameraLens l where + -- | The natural aspect ratio of the projection. + aspect :: l -> Double + +data PerspectiveLens = PerspectiveLens -- ^ A perspective projection + Deg -- ^ Horizontal field of view. + Deg -- ^ Vertical field of view. + +instance CameraLens PerspectiveLens where + aspect (PerspectiveLens h v) = angleRatio h v + +data OrthoLens = OrthoLens -- ^ An orthographic projection + Double -- ^ Width + Double -- ^ Height + +instance CameraLens OrthoLens where + aspect (OrthoLens h v) = h / v + +type instance V (Camera l) = R3 + +instance Transformable (Camera l) where + transform t (Camera p f u l) = + Camera (transform t p) + (transform t f) + (transform t u) + l + +instance IsPrim (Camera l) + +instance Renderable (Camera l) NullBackend where + render _ _ = mempty + +-- | A camera at the origin facing along the negative Z axis, with its +-- up-axis coincident with the positive Y axis. The field of view is +-- chosen to match a 50mm camera on 35mm film. Note that Cameras take +-- up no space in the Diagram. +mm50Camera :: (Backend b R3, Renderable (Camera PerspectiveLens) b) => Diagram b R3 +mm50Camera = facing_ZCamera mm50 + +-- | 'facing_ZCamera l' is a camera at the origin facing along the +-- negative Z axis, with its up-axis coincident with the positive Y +-- axis, with the projection defined by l. +facing_ZCamera :: (CameraLens l, Backend b R3, Renderable (Camera l) b) => + l -> Diagram b R3 +facing_ZCamera l = mkQD (Prim $ Camera origin unit_Z unitY l) + mempty mempty mempty (Query . const . Any $ False) + +mm50, mm50Wide, mm50Narrow :: PerspectiveLens + +-- | mm50 has the field of view of a 50mm lens on standard 35mm film, +-- hence an aspect ratio of 3:2. +mm50 = PerspectiveLens 40.5 27 + +-- | mm50Wide has the same vertical field of view as mm50, but an +-- aspect ratio of 1.6, suitable for wide screen computer monitors. +mm50Wide = PerspectiveLens 43.2 27 + +-- | mm50Narrow has the same vertical field of view as mm50, but an +-- aspect ratio of 4:3, for VGA and similar computer resulotions. +mm50Narrow = PerspectiveLens 36 27 + +camForward :: Direction d => Camera l -> d +camForward = direction . forward + +camUp :: Direction d => Camera l -> d +camUp = direction . up + +camRight :: Direction d => Camera l -> d +camRight c = direction right where + right = cross3 (forward c) (up c) + +camLens :: Camera l -> l +camLens = lens + +camAspect :: CameraLens l => Camera l -> Double +camAspect = aspect . camLens diff --git a/src/Diagrams/ThreeD/Light.hs b/src/Diagrams/ThreeD/Light.hs new file mode 100644 index 00000000..8c939f02 --- /dev/null +++ b/src/Diagrams/ThreeD/Light.hs @@ -0,0 +1,55 @@ +{-# LANGUAGE TypeFamilies #-} +{-# LANGUAGE MultiParamTypeClasses #-} +{-# LANGUAGE FlexibleContexts #-} + +----------------------------------------------------------------------------- +-- | +-- Module : Diagrams.ThreeD.Render +-- Copyright : (c) 2013 diagrams-lib team (see LICENSE) +-- License : BSD-style (see LICENSE) +-- Maintainer : diagrams-discuss@googlegroups.com +-- +-- Types to specify lighting for 3D rendering. +-- +----------------------------------------------------------------------------- + +module Diagrams.ThreeD.Light where + +import Data.Colour +import Data.Monoid + +import Diagrams.Core +import Diagrams.ThreeD.Types +import Diagrams.ThreeD.Vector + +data PointLight = PointLight P3 (Colour Double) + +data ParallelLight = ParallelLight R3 (Colour Double) + +type instance V PointLight = R3 +type instance V ParallelLight = R3 + +instance Transformable PointLight where + transform t (PointLight p c) = PointLight (transform t p) c + +instance Transformable ParallelLight where + transform t (ParallelLight v c) = ParallelLight (transform t v) c + +instance IsPrim PointLight +instance IsPrim ParallelLight + +-- | Construct a Diagram with a single PointLight at the origin, which +-- takes up no space. +pointLight :: (Backend b R3, Renderable PointLight b) + => Colour Double -- ^ The color of the light + -> Diagram b R3 +pointLight c = mkQD (Prim $ PointLight origin c) mempty mempty mempty + (Query . const . Any $ False) + +-- | Construct a Diagram with a single ParallelLight, which takes up no space. +parallelLight :: (Direction d, Backend b R3, Renderable ParallelLight b) + => d -- ^ The direction in which the light travels. + -> Colour Double -- ^ The color of the light. + -> Diagram b R3 +parallelLight d c = mkQD (Prim $ ParallelLight (fromDirection d) c) + mempty mempty mempty (Query . const . Any $ False) diff --git a/src/Diagrams/ThreeD/Types.hs b/src/Diagrams/ThreeD/Types.hs index 80b77504..82ef02e4 100644 --- a/src/Diagrams/ThreeD/Types.hs +++ b/src/Diagrams/ThreeD/Types.hs @@ -36,8 +36,11 @@ module Diagrams.ThreeD.Types -- * Directions in 3D , Direction(..) , Spherical(..) + , asSpherical ) where +import Control.Applicative + import Diagrams.Coordinates import Diagrams.TwoD.Types import Diagrams.Core @@ -116,24 +119,34 @@ instance HasCross3 R3 where -- | Direction is a type class representing directions in R3. The interface is -- based on that of the Angle class in 2D. -class AdditiveGroup d => Direction d where +class Direction d where -- | Convert to polar angles toSpherical :: Angle a => d -> Spherical a -- | Convert from polar angles fromSpherical :: Angle a => Spherical a -> d -instance Angle a => AdditiveGroup (Spherical a) where - zeroV = Spherical 0 0 - (Spherical θ φ) ^+^ (Spherical θ' φ') = Spherical (θ+θ') (φ+φ') - negateV (Spherical θ φ) = Spherical (-θ) (-φ) - -instance Angle a => Direction (Spherical a) where - toSpherical (Spherical θ φ) = Spherical (convertAngle θ) (convertAngle φ) - fromSpherical (Spherical θ φ) = Spherical (convertAngle θ) (convertAngle φ) - -- | 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 Angle a => Spherical a = Spherical a a - deriving (Show) +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 + +-- | 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 Turn -> Spherical Turn +asSpherical = id diff --git a/src/Diagrams/TwoD/Types.hs b/src/Diagrams/TwoD/Types.hs index 3d3a7e93..2a7fd3a6 100644 --- a/src/Diagrams/TwoD/Types.hs +++ b/src/Diagrams/TwoD/Types.hs @@ -196,7 +196,7 @@ instance Transformable R2 where -- | Newtype wrapper used to represent angles as fractions of a -- circle. For example, 1\/3 turn = tau\/3 radians = 120 degrees. newtype Turn = Turn { getTurn :: Double } - deriving (Read, Show, Eq, Ord, Enum, Fractional, Num, Real, RealFrac) + deriving (Read, Show, Eq, Ord, Enum, Fractional, Num, Real, RealFrac, AdditiveGroup) -- | The identity function with a restricted type, for conveniently -- declaring that some value should have type 'Turn'. For example, @@ -211,7 +211,7 @@ type CircleFrac = Turn -- | Newtype wrapper for representing angles in radians. newtype Rad = Rad { getRad :: Double } - deriving (Read, Show, Eq, Ord, Enum, Floating, Fractional, Num, Real, RealFloat, RealFrac) + deriving (Read, Show, Eq, Ord, Enum, Floating, Fractional, Num, Real, RealFloat, RealFrac, AdditiveGroup) -- | The identity function with a restricted type, for conveniently -- declaring that some value should have type 'Rad'. For example, @@ -223,7 +223,7 @@ asRad = id -- | Newtype wrapper for representing angles in degrees. newtype Deg = Deg { getDeg :: Double } - deriving (Read, Show, Eq, Ord, Enum, Fractional, Num, Real, RealFrac) + deriving (Read, Show, Eq, Ord, Enum, Fractional, Num, Real, RealFrac, AdditiveGroup) -- | The identity function with a restricted type, for conveniently -- declaring that some value should have type 'Deg'. For example,