    {-# LANGUAGE ConstraintKinds #-}
    {-# LANGUAGE DeriveDataTypeable    #-}
    {-# LANGUAGE FlexibleContexts      #-}
    {-# LANGUAGE MultiParamTypeClasses #-}
    {-# LANGUAGE TypeFamilies          #-}
    {-# LANGUAGE UndecidableInstances  #-}

    -----------------------------------------------------------------------------
    -- |
    -- 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           Data.Typeable

    import           Diagrams.Core
    import           Diagrams.Direction
    import           Diagrams.ThreeD.Types

    -- | A @PointLight@ radiates uniformly in all directions from a given
    -- point.
    data PointLight n = PointLight (Point V3 n) (Colour Double)
      deriving Typeable

    type instance V (PointLight n) = V3
    type instance N (PointLight n) = n

    -- | A @ParallelLight@ casts parallel rays in the specified direction,
    -- from some distant location outside the scene.
    data ParallelLight n = ParallelLight (V3 n) (Colour Double)
      deriving Typeable

    type instance V (ParallelLight n) = V3
    type instance N (ParallelLight n) = n

    instance Fractional n => Transformable (PointLight n) where
      transform :: Transformation (V (PointLight n)) (N (PointLight n))
    -> PointLight n -> PointLight n
    transform Transformation (V (PointLight n)) (N (PointLight n))
    t (PointLight Point V3 n
    p Colour Double
    c) = Point V3 n -> Colour Double -> PointLight n
    forall n. Point V3 n -> Colour Double -> PointLight n
    PointLight (Transformation (V (Point V3 n)) (N (Point V3 n))
    -> Point V3 n -> Point V3 n
    forall t. Transformable t => Transformation (V t) (N t) -> t -> t
    transform Transformation (V (Point V3 n)) (N (Point V3 n))
    Transformation (V (PointLight n)) (N (PointLight n))
    t Point V3 n
    p) Colour Double
    c

    instance Transformable (ParallelLight n) where
      transform :: Transformation (V (ParallelLight n)) (N (ParallelLight n))
    -> ParallelLight n -> ParallelLight n
    transform Transformation (V (ParallelLight n)) (N (ParallelLight n))
    t (ParallelLight V3 n
    v Colour Double
    c) = V3 n -> Colour Double -> ParallelLight n
    forall n. V3 n -> Colour Double -> ParallelLight n
    ParallelLight (Transformation (V (V3 n)) (N (V3 n)) -> V3 n -> V3 n
    forall t. Transformable t => Transformation (V t) (N t) -> t -> t
    transform Transformation (V (V3 n)) (N (V3 n))
    Transformation (V (ParallelLight n)) (N (ParallelLight n))
    t V3 n
    v) Colour Double
    c

    -- | Construct a Diagram with a single PointLight at the origin, which
    -- takes up no space.
    pointLight :: (Typeable n, Num n, Ord n, Renderable (PointLight n) b)
                  => Colour Double -- ^ The color of the light
                  -> QDiagram b V3 n Any
    pointLight :: forall n b.
    (Typeable n, Num n, Ord n, Renderable (PointLight n) b) =>
    Colour Double -> QDiagram b V3 n Any
    pointLight Colour Double
    c = Prim b V3 n
    -> Envelope V3 n
    -> Trace V3 n
    -> SubMap b V3 n Any
    -> Query V3 n Any
    -> QDiagram b V3 n Any
    forall b (v :: * -> *) n m.
    Prim b v n
    -> Envelope v n
    -> Trace v n
    -> SubMap b v n m
    -> Query v n m
    -> QDiagram b v n m
    mkQD (PointLight n -> Prim b (V (PointLight n)) (N (PointLight n))
    forall p b.
    (Transformable p, Typeable p, Renderable p b) =>
    p -> Prim b (V p) (N p)
    Prim (PointLight n -> Prim b (V (PointLight n)) (N (PointLight n)))
    -> PointLight n -> Prim b (V (PointLight n)) (N (PointLight n))
    forall a b. (a -> b) -> a -> b
    $ Point V3 n -> Colour Double -> PointLight n
    forall n. Point V3 n -> Colour Double -> PointLight n
    PointLight Point V3 n
    forall (f :: * -> *) a. (Additive f, Num a) => Point f a
    origin Colour Double
    c) Envelope V3 n
    forall a. Monoid a => a
    mempty Trace V3 n
    forall a. Monoid a => a
    mempty SubMap b V3 n Any
    forall a. Monoid a => a
    mempty
                   ((Point V3 n -> Any) -> Query V3 n Any
    forall (v :: * -> *) n m. (Point v n -> m) -> Query v n m
    Query ((Point V3 n -> Any) -> Query V3 n Any)
    -> (Bool -> Point V3 n -> Any) -> Bool -> Query V3 n Any
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Any -> Point V3 n -> Any
    forall a b. a -> b -> a
    const (Any -> Point V3 n -> Any)
    -> (Bool -> Any) -> Bool -> Point V3 n -> Any
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Bool -> Any
    Any (Bool -> Query V3 n Any) -> Bool -> Query V3 n Any
    forall a b. (a -> b) -> a -> b
    $ Bool
    False)

    -- | Construct a Diagram with a single ParallelLight, which takes up no space.
    parallelLight :: (Typeable n, OrderedField n, Renderable (ParallelLight n) b)
                     => Direction V3 n -- ^ The direction in which the light travels.
                     -> Colour Double  -- ^ The color of the light.
                     -> QDiagram b V3 n Any
    parallelLight :: forall n b.
    (Typeable n, OrderedField n, Renderable (ParallelLight n) b) =>
    Direction V3 n -> Colour Double -> QDiagram b V3 n Any
    parallelLight Direction V3 n
    d Colour Double
    c = Prim b V3 n
    -> Envelope V3 n
    -> Trace V3 n
    -> SubMap b V3 n Any
    -> Query V3 n Any
    -> QDiagram b V3 n Any
    forall b (v :: * -> *) n m.
    Prim b v n
    -> Envelope v n
    -> Trace v n
    -> SubMap b v n m
    -> Query v n m
    -> QDiagram b v n m
    mkQD (ParallelLight n
    -> Prim b (V (ParallelLight n)) (N (ParallelLight n))
    forall p b.
    (Transformable p, Typeable p, Renderable p b) =>
    p -> Prim b (V p) (N p)
    Prim (ParallelLight n
     -> Prim b (V (ParallelLight n)) (N (ParallelLight n)))
    -> ParallelLight n
    -> Prim b (V (ParallelLight n)) (N (ParallelLight n))
    forall a b. (a -> b) -> a -> b
    $ V3 n -> Colour Double -> ParallelLight n
    forall n. V3 n -> Colour Double -> ParallelLight n
    ParallelLight (Direction V3 n -> V3 n
    forall (v :: * -> *) n.
    (Metric v, Floating n) =>
    Direction v n -> v n
    fromDirection Direction V3 n
    d) Colour Double
    c)
                        Envelope V3 n
    forall a. Monoid a => a
    mempty Trace V3 n
    forall a. Monoid a => a
    mempty SubMap b V3 n Any
    forall a. Monoid a => a
    mempty ((Point V3 n -> Any) -> Query V3 n Any
    forall (v :: * -> *) n m. (Point v n -> m) -> Query v n m
    Query ((Point V3 n -> Any) -> Query V3 n Any)
    -> (Bool -> Point V3 n -> Any) -> Bool -> Query V3 n Any
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Any -> Point V3 n -> Any
    forall a b. a -> b -> a
    const (Any -> Point V3 n -> Any)
    -> (Bool -> Any) -> Bool -> Point V3 n -> Any
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Bool -> Any
    Any (Bool -> Query V3 n Any) -> Bool -> Query V3 n Any
    forall a b. (a -> b) -> a -> b
    $ Bool
    False)