3d color & lighting, more solids, Angle utilities

diagrams-lib.cabal

@@ -28,6 +28,7 @@ Library
   Exposed-modules:     Diagrams.Prelude,
                        Diagrams.Prelude.ThreeD,
                        Diagrams.Align,
+                       Diagrams.Angle,
                        Diagrams.Combinators,
                        Diagrams.Coordinates,
                        Diagrams.Attributes,
@@ -75,6 +76,7 @@ Library
                        Diagrams.TwoD.Image,
                        Diagrams.TwoD.Adjust,
                        Diagrams.ThreeD.Align,
+                       Diagrams.ThreeD.Attributes,
                        Diagrams.ThreeD.Camera,
                        Diagrams.ThreeD.Deform,
                        Diagrams.ThreeD.Light,

src/Diagrams/Angle.hs

@@ -0,0 +1,113 @@
+{-# LANGUAGE GeneralizedNewtypeDeriving #-}
+{-# LANGUAGE RankNTypes                 #-}
+{-# LANGUAGE TypeFamilies               #-}
+-----------------------------------------------------------------------------
+-- |
+-- Module      :  Diagrams.Angle
+-- Copyright   :  (c) 2013 diagrams-lib team (see LICENSE)
+-- License     :  BSD-style (see LICENSE)
+-- Maintainer  :  diagrams-discuss@googlegroups.com
+--
+-- Type for representing angles, independent of vector-space
+--
+-----------------------------------------------------------------------------
+
+module Diagrams.Angle
+       (
+         Angle
+       , rad, turn, deg
+       , fullTurn, fullCircle, angleRatio
+       , sinA, cosA, tanA, asinA, acosA, atanA
+       , (@@)
+       , angleBetween
+       , HasTheta(..)
+       ) where
+
+import           Control.Lens            (Iso', Lens', iso, review, (^.))
+                                         -- , review , (^.), _1, _2, Lens', lens)
+
+import           Data.VectorSpace
+
+-- | Angles can be expressed in a variety of units.  Internally,
+-- they are represented in radians.
+newtype Angle = Radians Double
+              deriving (Read, Show, Eq, Ord, Enum, AdditiveGroup)
+
+instance VectorSpace Angle where
+  type Scalar Angle = Double
+  s *^ Radians t = Radians (s*t)
+
+-- | The radian measure of an @Angle@ @a@ can be accessed as @a
+-- ^. rad@.  A new @Angle@ can be defined in radians as @pi \@\@ rad@.
+rad :: Iso' Angle Double
+rad = iso (\(Radians r) -> r) Radians
+
+-- | The measure of an @Angle@ @a@ in full circles can be accessed as
+-- @a ^. turn@.  A new @Angle@ of one-half circle can be defined in as
+-- @1/2 \@\@ turn@.
+turn :: Iso' Angle Double
+turn = iso (\(Radians r) -> r/2/pi) (Radians . (*(2*pi)))
+
+-- | The degree measure of an @Angle@ @a@ can be accessed as @a
+-- ^. deg@.  A new @Angle@ can be defined in degrees as @180 \@\@
+-- deg@.
+deg :: Iso' Angle Double
+deg = iso (\(Radians r) -> r/2/pi*360) (Radians . (*(2*pi/360)))
+
+-- | An angle representing one full turn.
+fullTurn :: Angle
+fullTurn = 1 @@ turn
+
+-- | Deprecated synonym for 'fullTurn', retained for backwards compatibility.
+fullCircle :: Angle
+fullCircle = fullTurn
+
+-- | Calculate ratio between two angles.
+angleRatio :: Angle -> Angle -> Double
+angleRatio a b = (a^.rad) / (b^.rad)
+
+-- | The sine of the given @Angle@.
+sinA :: Angle -> Double
+sinA (Radians r) = sin r
+
+-- | The cosine of the given @Angle@.
+cosA :: Angle -> Double
+cosA (Radians r) = cos r
+
+-- | The tangent function of the given @Angle@.
+tanA :: Angle -> Double
+tanA (Radians r) = tan r
+
+-- | The @Angle@ with the given sine.
+asinA :: Double -> Angle
+asinA = Radians . asin
+
+-- | The @Angle@ with the given cosine.
+acosA :: Double -> Angle
+acosA = Radians . acos
+
+-- | The @Angle@ with the given tangent.
+atanA :: Double -> Angle
+atanA = Radians . atan
+
+-- | @30 \@\@ deg@ is an @Angle@ of the given measure and units.
+--
+-- More generally, @\@\@@ reverses the @Iso\'@ on its right, and
+-- applies the @Iso\'@ to the value on the left.  @Angle@s are the
+-- motivating example where this order improves readability.
+(@@) :: b -> Iso' a b -> a
+-- The signature above is slightly specialized, in favor of readability
+a @@ i = review i a
+
+infixl 5 @@
+
+-- | compute the positive angle between the two vectors in their common plane
+angleBetween  :: (InnerSpace v, Scalar v ~ Double) => v -> v -> Angle
+angleBetween v1 v2 = acos (normalized v1 <.> normalized v2) @@ rad
+
+------------------------------------------------------------
+-- Polar Coordinates
+
+-- | The class of types with at least one angle coordinate, called _theta.
+class HasTheta t where
+    _theta :: Lens' t Angle

src/Diagrams/Combinators.hs

@@ -1,3 +1,4 @@
+{-# LANGUAGE CPP #-}
 {-# LANGUAGE FlexibleContexts      #-}
 {-# LANGUAGE MultiParamTypeClasses #-}
 {-# LANGUAGE Rank2Types            #-}
@@ -45,7 +46,9 @@ import           Control.Lens       (Lens', generateSignatures, lensField,
 import           Data.AdditiveGroup
 import           Data.AffineSpace   ((.+^))
 import           Data.Default.Class
+#if __GLASGOW_HASKELL__ < 707
 import           Data.Proxy
+#endif
 import           Data.Semigroup
 import           Data.VectorSpace
 

src/Diagrams/Coordinates.hs

@@ -16,7 +16,7 @@ module Diagrams.Coordinates
     ( (:&)(..), Coordinates(..)
 
     -- * Lenses for particular axes
-    , HasX(..), HasY(..), HasZ(..)
+    , HasX(..), HasY(..), HasZ(..), HasR(..)
     )
     where
 
@@ -121,3 +121,8 @@ class HasY t where
 -- | The class of types with at least three coordinates, the third called _z.
 class HasZ t where
     _z :: Lens' t Double
+
+-- | The class of types with a single length coordinate _r.  _r is
+-- magnitude of a vector, or the distance from the origin of a point.
+class HasR t where
+    _r :: Lens' t Double

src/Diagrams/Prelude.hs

@@ -84,8 +84,10 @@ module Diagrams.Prelude
          -- | Utilities for working with points.
        , module Diagrams.Points
 
+         -- | Angles
+       , module Diagrams.Angle
          -- | Convenience infix operators for working with coordinates.
-        , module Diagrams.Coordinates
+       , module Diagrams.Coordinates
 
          -- | A wide range of things (shapes, transformations,
          --   combinators) specific to creating two-dimensional
@@ -123,6 +125,7 @@ module Diagrams.Prelude
 import           Diagrams.Core
 
 import           Diagrams.Align
+import           Diagrams.Angle
 import           Diagrams.Animation
 import           Diagrams.Attributes
 import           Diagrams.Combinators

src/Diagrams/Prelude/ThreeD.hs

@@ -80,8 +80,11 @@ module Diagrams.Prelude.ThreeD
          -- | Utilities for working with points.
        , module Diagrams.Points
 
+         -- | Angles
+       , module Diagrams.Angle
+
          -- | Convenience infix operators for working with coordinates.
-        , module Diagrams.Coordinates
+       , module Diagrams.Coordinates
 
          -- | things (shapes, transformations, combinators) specific
          -- to creating three-dimensional diagrams.
@@ -118,6 +121,7 @@ module Diagrams.Prelude.ThreeD
 import           Diagrams.Core
 
 import           Diagrams.Align
+import           Diagrams.Angle
 import           Diagrams.Animation
 import           Diagrams.Attributes
 import           Diagrams.Combinators

src/Diagrams/ThreeD.hs

@@ -31,7 +31,9 @@
 --     for rendering 3D geometry to (2D) images.
 -----------------------------------------------------------------------------
 module Diagrams.ThreeD
-       ( module Diagrams.ThreeD.Align
+       (
+         module Diagrams.ThreeD.Align
+       , module Diagrams.ThreeD.Attributes
        , module Diagrams.ThreeD.Camera
        , module Diagrams.ThreeD.Light
        , module Diagrams.ThreeD.Shapes
@@ -41,6 +43,7 @@ module Diagrams.ThreeD
        ) where
 
 import Diagrams.ThreeD.Align
+import Diagrams.ThreeD.Attributes
 import Diagrams.ThreeD.Camera
 import Diagrams.ThreeD.Light
 import Diagrams.ThreeD.Shapes

src/Diagrams/ThreeD/Attributes.hs

@@ -0,0 +1,104 @@
+{-# LANGUAGE DeriveDataTypeable         #-}
+{-# LANGUAGE ExistentialQuantification  #-}
+{-# LANGUAGE GeneralizedNewtypeDeriving #-}
+{-# LANGUAGE TemplateHaskell            #-}
+-----------------------------------------------------------------------------
+-- |
+-- Module      :  Diagrams.ThreeD.Attributes
+-- Copyright   :  (c) 2014 diagrams-lib team (see LICENSE)
+-- License     :  BSD-style (see LICENSE)
+-- Maintainer  :  diagrams-discuss@googlegroups.com
+--
+-- Diagrams may have /attributes/ which affect the way they are
+-- rendered.  This module defines some common attributes relevant in
+-- 3D; particular backends may also define more backend-specific
+-- attributes.
+--
+-- Every attribute type must have a /semigroup/ structure, that is, an
+-- associative binary operation for combining two attributes into one.
+-- Unless otherwise noted, all the attributes defined here use the
+-- 'Last' structure, that is, combining two attributes simply keeps
+-- the second one and throws away the first.  This means that child
+-- attributes always override parent attributes.
+--
+-----------------------------------------------------------------------------
+
+module Diagrams.ThreeD.Attributes where
+
+import Control.Lens
+import Data.Semigroup
+import Data.Typeable
+
+import Data.Colour
+
+import Diagrams.Core
+
+-- | @SurfaceColor@ is the inherent pigment of an object, assumed to
+-- be opaque.
+newtype SurfaceColor = SurfaceColor (Last (Colour Double))
+                     deriving (Typeable, Semigroup)
+instance AttributeClass SurfaceColor
+
+surfaceColor :: Iso' SurfaceColor (Colour Double)
+surfaceColor = iso (\(SurfaceColor (Last c)) -> c) (SurfaceColor . Last)
+
+-- | Set the surface color.
+sc :: HasStyle d => Colour Double -> d -> d
+sc = applyAttr . review surfaceColor
+
+-- | @Diffuse@ is the fraction of incident light reflected diffusely,
+-- that is, in all directions.  The actual light reflected is the
+-- product of this value, the incident light, and the @SurfaceColor@
+-- Attribute.  For physical reasonableness, @Diffuse@ should have a
+-- value between 0 and 1; this is not checked.
+newtype Diffuse = Diffuse (Last Double)
+                deriving (Typeable, Semigroup)
+instance AttributeClass Diffuse
+
+_Diffuse :: Iso' Diffuse Double
+_Diffuse = iso (\(Diffuse (Last d)) -> d) (Diffuse . Last)
+
+-- | Set the diffuse reflectance.
+diffuse :: HasStyle d => Double -> d -> d
+diffuse = applyAttr . review _Diffuse
+
+-- | @Ambient@ is an ad-hoc representation of indirect lighting.  The
+-- product of @Ambient@ and @SurfaceColor@ is added to the light
+-- leaving an object due to diffuse and specular terms.  @Ambient@ can
+-- be set per-object, and can be loosely thought of as the product of
+-- indirect lighting incident on that object and the diffuse
+-- reflectance.
+newtype Ambient = Ambient (Last Double)
+                deriving (Typeable, Semigroup)
+instance AttributeClass Ambient
+
+_Ambient :: Iso' Ambient Double
+_Ambient = iso (\(Ambient (Last d)) -> d) (Ambient . Last)
+
+-- | Set the emittance due to ambient light.
+ambient :: HasStyle d => Double -> d -> d
+ambient = applyAttr . review _Ambient
+
+-- | A specular highlight has two terms, the intensity, between 0 and
+-- 1, and the size.  The highlight size is assumed to be the exponent
+-- in a Phong shading model (though Backends are free to use a
+-- different shading model).  In this model, reasonable values are
+-- between 1 and 50 or so, with higher values for shinier objects.
+-- Physically, the intensity and the value of @Diffuse@ must add up to
+-- less than 1; this is not enforced.
+data Specular = Specular { _specularIntensity :: Double
+                         , _specularSize :: Double
+                         }
+
+makeLenses ''Specular
+
+newtype Highlight = Highlight (Last Specular)
+                    deriving (Typeable, Semigroup)
+instance AttributeClass Highlight
+
+_Highlight :: Iso' Highlight Specular
+_Highlight = iso (\(Highlight (Last s)) -> s) (Highlight . Last)
+
+-- | Set the specular highlight.
+highlight :: HasStyle d => Specular -> d -> d
+highlight = applyAttr . review _Highlight

src/Diagrams/ThreeD/Camera.hs

@@ -34,6 +34,7 @@ import           Data.Cross
 import           Data.Monoid
 import           Data.Typeable
 
+import           Diagrams.Angle
 import           Diagrams.Core
 import           Diagrams.ThreeD.Types
 import           Diagrams.ThreeD.Vector
@@ -119,13 +120,13 @@ mm50Wide = PerspectiveLens (43.2 @@ deg)  (27 @@ deg)
 -- aspect ratio of 4:3, for VGA and similar computer resulotions.
 mm50Narrow = PerspectiveLens (36 @@ deg) (27 @@ deg)
 
-camForward :: Direction d => Camera l -> d
+camForward :: Camera l -> Direction
 camForward = direction . forward
 
-camUp :: Direction d => Camera l -> d
+camUp :: Camera l -> Direction
 camUp = direction . up
 
-camRight :: Direction d => Camera l -> d
+camRight :: Camera l -> Direction
 camRight c = direction right where
   right = cross3 (forward c) (up c)
 

src/Diagrams/ThreeD/Light.hs

@@ -22,7 +22,6 @@ import           Data.Typeable
 
 import           Diagrams.Core
 import           Diagrams.ThreeD.Types
-import           Diagrams.ThreeD.Vector
 
 data PointLight = PointLight P3 (Colour Double)
   deriving Typeable
@@ -51,8 +50,8 @@ 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.
+parallelLight :: (Backend b R3, Renderable ParallelLight b)
+                 => Direction -- ^ 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)