{-# 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) = 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 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) =
      forall (l :: * -> *) n.
Point V3 n -> V3 n -> V3 n -> l n -> Camera l n
Camera (forall t. Transformable t => Transformation (V t) (N t) -> t -> t
transform Transformation (V (Camera l n)) (N (Camera l n))
t Point V3 n
p)
             (forall t. Transformable t => Transformation (V t) (N t) -> t -> t
transform Transformation (V (Camera l n)) (N (Camera l n))
t V3 n
f)
             (forall t. Transformable t => Transformation (V t) (N t) -> t -> t
transform 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
_ = 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 = 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 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 = 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 (forall p b.
(Transformable p, Typeable p, Renderable p b) =>
p -> Prim b (V p) (N p)
Prim forall a b. (a -> b) -> a -> b
$ forall (l :: * -> *) n.
Point V3 n -> V3 n -> V3 n -> l n -> Camera l n
Camera forall (f :: * -> *) a. (Additive f, Num a) => Point f a
origin forall (v :: * -> *) n. (R3 v, Additive v, Num n) => v n
unit_Z forall (v :: * -> *) n. (R2 v, Additive v, Num n) => v n
unitY l n
l)
        forall a. Monoid a => a
mempty forall a. Monoid a => a
mempty forall a. Monoid a => a
mempty (forall (v :: * -> *) n m. (Point v n -> m) -> Query v n m
Query forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. a -> b -> a
const forall b c a. (b -> c) -> (a -> b) -> a -> c
. Bool -> Any
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 = forall n. Angle n -> Angle n -> PerspectiveLens n
PerspectiveLens (n
40.5 forall b a. b -> AReview a b -> a
@@ forall n. Floating n => Iso' (Angle n) n
deg) (n
27 forall b a. b -> AReview a b -> a
@@ forall n. Floating 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 = forall n. Angle n -> Angle n -> PerspectiveLens n
PerspectiveLens (n
43.2 forall b a. b -> AReview a b -> a
@@ forall n. Floating n => Iso' (Angle n) n
deg)  (n
27 forall b a. b -> AReview a b -> a
@@ forall n. Floating 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 = forall n. Angle n -> Angle n -> PerspectiveLens n
PerspectiveLens (n
36 forall b a. b -> AReview a b -> a
@@ forall n. Floating n => Iso' (Angle n) n
deg) (n
27 forall b a. b -> AReview a b -> a
@@ forall n. Floating n => Iso' (Angle n) n
deg)

camForward :: Camera l n -> Direction V3 n
camForward :: forall (l :: * -> *) n. Camera l n -> Direction V3 n
camForward = forall (v :: * -> *) n. v n -> Direction v n
direction forall b c a. (b -> c) -> (a -> b) -> a -> c
. 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 = forall (v :: * -> *) n. v n -> Direction v n
direction forall b c a. (b -> c) -> (a -> b) -> a -> c
. 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 = forall (v :: * -> *) n. v n -> Direction v n
direction V3 n
right where
  right :: V3 n
right = forall a. Num a => V3 a -> V3 a -> V3 a
cross (forall (l :: * -> *) n. Camera l n -> V3 n
forward Camera l n
c) (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 = 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 = forall (l :: * -> *) n. (CameraLens l, Floating n) => l n -> n
aspect forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (l :: * -> *) n. Camera l n -> l n
camLens