    {-# LANGUAGE DeriveDataTypeable    #-}
    {-# LANGUAGE FlexibleContexts      #-}
    {-# LANGUAGE MultiParamTypeClasses #-}
    {-# LANGUAGE ScopedTypeVariables   #-}
    {-# LANGUAGE TemplateHaskell       #-}
    {-# LANGUAGE TypeFamilies          #-}
    {-# LANGUAGE UndecidableInstances  #-}

    -----------------------------------------------------------------------------
    -- |
    -- 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
            -- These are safe to construct manually
           , PerspectiveLens(..), OrthoLens(..)
           , horizontalFieldOfView, verticalFieldOfView
           , orthoWidth, orthoHeight
           , camLoc, camForward, camUp, camRight, camLens
           , facing_ZCamera, mm50Camera
           , mm50, mm50Wide, mm50Narrow
           , aspect, camAspect
           )
           where

    import           Control.Lens           (makeLenses)
    import           Data.Monoid
    import           Data.Typeable

    import           Diagrams.Angle
    import           Diagrams.Core
    import           Diagrams.Direction
    import           Diagrams.ThreeD.Vector

    import           Linear.V3

    -- Parameterize Camera on the lens type, so that Backends can express which
    -- lenses they handle.
    data Camera l n = Camera
        { forall (l :: * -> *) n. Camera l n -> Point V3 n
    camLoc  :: Point V3 n
        , forall (l :: * -> *) n. Camera l n -> V3 n
    forward :: V3 n
        , forall (l :: * -> *) n. Camera l n -> V3 n
    up      :: V3 n
        , forall (l :: * -> *) n. Camera l n -> l n
    lens    :: l n
        }
      deriving Typeable

    type instance V (Camera l n) = V3
    type instance N (Camera l n) = n

    class Typeable l => CameraLens l where
      -- | The natural aspect ratio of the projection.
      aspect :: Floating n => l n -> n

    -- | A perspective projection
    data PerspectiveLens n = PerspectiveLens
      { forall n. PerspectiveLens n -> Angle n
    _horizontalFieldOfView :: Angle n -- ^ Horizontal field of view.
      , forall n. PerspectiveLens n -> Angle n
    _verticalFieldOfView   :: Angle n -- ^ Vertical field of view.
      }
      deriving Typeable

    makeLenses ''PerspectiveLens

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

    instance CameraLens PerspectiveLens where
      aspect :: forall n. Floating n => PerspectiveLens n -> n
    aspect (PerspectiveLens Angle n
    h Angle n
    v) = Angle n -> Angle n -> n
    forall n. Floating n => Angle n -> Angle n -> n
    angleRatio Angle n
    h Angle n
    v

    -- | An orthographic projection
    data OrthoLens n = OrthoLens
                   { forall n. OrthoLens n -> n
    _orthoWidth  :: n -- ^ Width
                   , forall n. OrthoLens n -> n
    _orthoHeight :: n -- ^ Height
                   }
      deriving Typeable

    makeLenses ''OrthoLens

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

    instance CameraLens OrthoLens where
      aspect :: forall n. Floating n => OrthoLens n -> n
    aspect (OrthoLens n
    h n
    v) = n
    h n -> n -> n
    forall a. Fractional a => a -> a -> a
    / n
    v

    instance Num n => Transformable (Camera l n) where
      transform :: Transformation (V (Camera l n)) (N (Camera l n))
    -> Camera l n -> Camera l n
    transform Transformation (V (Camera l n)) (N (Camera l n))
    t (Camera Point V3 n
    p V3 n
    f V3 n
    u l n
    l) =
          Point V3 n -> V3 n -> V3 n -> l n -> Camera l n
    forall (l :: * -> *) n.
    Point V3 n -> V3 n -> V3 n -> l n -> Camera l n
    Camera (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 (Camera l n)) (N (Camera l n))
    t Point V3 n
    p)
                 (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 (Camera l n)) (N (Camera l n))
    t V3 n
    f)
                 (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 (Camera l n)) (N (Camera l n))
    t V3 n
    u)
                 l n
    l

    instance Num n => Renderable (Camera l n) NullBackend where
      render :: NullBackend
    -> Camera l n
    -> Render NullBackend (V (Camera l n)) (N (Camera l n))
    render NullBackend
    _ Camera l n
    _ = Render NullBackend (V (Camera l n)) (N (Camera l n))
    Render NullBackend V3 n
    forall a. Monoid a => a
    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 :: (Typeable n, Floating n, Ord n, Renderable (Camera PerspectiveLens n) b)
               => QDiagram b V3 n Any
    mm50Camera :: forall n b.
    (Typeable n, Floating n, Ord n,
     Renderable (Camera PerspectiveLens n) b) =>
    QDiagram b V3 n Any
    mm50Camera = PerspectiveLens n -> QDiagram b V3 n Any
    forall n (l :: * -> *) b.
    (Floating n, Ord n, Typeable n, CameraLens l,
     Renderable (Camera l n) b) =>
    l n -> QDiagram b V3 n Any
    facing_ZCamera PerspectiveLens n
    forall n. Floating n => PerspectiveLens n
    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 :: (Floating n, Ord n, Typeable n, CameraLens l, Renderable (Camera l n) b) =>
                      l n -> QDiagram b V3 n Any
    facing_ZCamera :: forall n (l :: * -> *) b.
    (Floating n, Ord n, Typeable n, CameraLens l,
     Renderable (Camera l n) b) =>
    l n -> QDiagram b V3 n Any
    facing_ZCamera l n
    l = 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 (Camera l n -> Prim b (V (Camera l n)) (N (Camera l n))
    forall p b.
    (Transformable p, Typeable p, Renderable p b) =>
    p -> Prim b (V p) (N p)
    Prim (Camera l n -> Prim b (V (Camera l n)) (N (Camera l n)))
    -> Camera l n -> Prim b (V (Camera l n)) (N (Camera l n))
    forall a b. (a -> b) -> a -> b
    $ Point V3 n -> V3 n -> V3 n -> l n -> Camera l n
    forall (l :: * -> *) n.
    Point V3 n -> V3 n -> V3 n -> l n -> Camera l n
    Camera Point V3 n
    forall (f :: * -> *) a. (Additive f, Num a) => Point f a
    origin V3 n
    forall (v :: * -> *) n. (R3 v, Additive v, Num n) => v n
    unit_Z V3 n
    forall (v :: * -> *) n. (R2 v, Additive v, Num n) => v n
    unitY l n
    l)
            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)
    {-# ANN facing_ZCamera ("HLint: ignore Use camelCase" :: String) #-}

    mm50, mm50Wide, mm50Narrow :: Floating n => PerspectiveLens n

    -- | mm50 has the field of view of a 50mm lens on standard 35mm film,
    -- hence an aspect ratio of 3:2.
    mm50 :: forall n. Floating n => PerspectiveLens n
    mm50 = Angle n -> Angle n -> PerspectiveLens n
    forall n. Angle n -> Angle n -> PerspectiveLens n
    PerspectiveLens (n
    40.5 n -> AReview (Angle n) n -> Angle n
    forall b a. b -> AReview a b -> a
    @@ AReview (Angle n) n
    forall n. Floating n => Iso' (Angle n) n
    Iso' (Angle n) n
    deg) (n
    27 n -> AReview (Angle n) n -> Angle n
    forall b a. b -> AReview a b -> a
    @@ AReview (Angle n) n
    forall n. Floating n => Iso' (Angle n) n
    Iso' (Angle n) n
    deg)

    -- | mm50blWide has the same vertical field of view as mm50, but an
    -- aspect ratio of 1.6, suitable for wide screen computer monitors.
    mm50Wide :: forall n. Floating n => PerspectiveLens n
    mm50Wide = Angle n -> Angle n -> PerspectiveLens n
    forall n. Angle n -> Angle n -> PerspectiveLens n
    PerspectiveLens (n
    43.2 n -> AReview (Angle n) n -> Angle n
    forall b a. b -> AReview a b -> a
    @@ AReview (Angle n) n
    forall n. Floating n => Iso' (Angle n) n
    Iso' (Angle n) n
    deg)  (n
    27 n -> AReview (Angle n) n -> Angle n
    forall b a. b -> AReview a b -> a
    @@ AReview (Angle n) n
    forall n. Floating n => Iso' (Angle n) n
    Iso' (Angle n) n
    deg)

    -- | mm50Narrow has the same vertical field of view as mm50, but an
    -- aspect ratio of 4:3, for VGA and similar computer resolutions.
    mm50Narrow :: forall n. Floating n => PerspectiveLens n
    mm50Narrow = Angle n -> Angle n -> PerspectiveLens n
    forall n. Angle n -> Angle n -> PerspectiveLens n
    PerspectiveLens (n
    36 n -> AReview (Angle n) n -> Angle n
    forall b a. b -> AReview a b -> a
    @@ AReview (Angle n) n
    forall n. Floating n => Iso' (Angle n) n
    Iso' (Angle n) n
    deg) (n
    27 n -> AReview (Angle n) n -> Angle n
    forall b a. b -> AReview a b -> a
    @@ AReview (Angle n) n
    forall n. Floating n => Iso' (Angle n) n
    Iso' (Angle n) n
    deg)

    camForward :: Camera l n -> Direction V3 n
    camForward :: forall (l :: * -> *) n. Camera l n -> Direction V3 n
    camForward = V3 n -> Direction V3 n
    forall (v :: * -> *) n. v n -> Direction v n
    direction (V3 n -> Direction V3 n)
    -> (Camera l n -> V3 n) -> Camera l n -> Direction V3 n
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Camera l n -> V3 n
    forall (l :: * -> *) n. Camera l n -> V3 n
    forward

    camUp :: Camera l n -> Direction V3 n
    camUp :: forall (l :: * -> *) n. Camera l n -> Direction V3 n
    camUp = V3 n -> Direction V3 n
    forall (v :: * -> *) n. v n -> Direction v n
    direction (V3 n -> Direction V3 n)
    -> (Camera l n -> V3 n) -> Camera l n -> Direction V3 n
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Camera l n -> V3 n
    forall (l :: * -> *) n. Camera l n -> V3 n
    up

    camRight :: Fractional n => Camera l n -> Direction V3 n
    camRight :: forall n (l :: * -> *).
    Fractional n =>
    Camera l n -> Direction V3 n
    camRight Camera l n
    c = V3 n -> Direction V3 n
    forall (v :: * -> *) n. v n -> Direction v n
    direction V3 n
    right where
      right :: V3 n
    right = V3 n -> V3 n -> V3 n
    forall a. Num a => V3 a -> V3 a -> V3 a
    cross (Camera l n -> V3 n
    forall (l :: * -> *) n. Camera l n -> V3 n
    forward Camera l n
    c) (Camera l n -> V3 n
    forall (l :: * -> *) n. Camera l n -> V3 n
    up Camera l n
    c)

    camLens :: Camera l n -> l n
    camLens :: forall (l :: * -> *) n. Camera l n -> l n
    camLens = Camera l n -> l n
    forall (l :: * -> *) n. Camera l n -> l n
    lens

    camAspect :: (Floating n, CameraLens l) => Camera l n -> n
    camAspect :: forall n (l :: * -> *).
    (Floating n, CameraLens l) =>
    Camera l n -> n
    camAspect = l n -> n
    forall n. Floating n => l n -> n
    forall (l :: * -> *) n. (CameraLens l, Floating n) => l n -> n
    aspect (l n -> n) -> (Camera l n -> l n) -> Camera l n -> n
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Camera l n -> l n
    forall (l :: * -> *) n. Camera l n -> l n
    camLens