{-# 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 :: 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 :: 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)