{-# 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
    { Camera l n -> Point V3 n
camLoc  :: Point V3 n
    , Camera l n -> V3 n
forward :: V3 n
    , Camera l n -> V3 n
up      :: V3 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
  { PerspectiveLens n -> Angle n
_horizontalFieldOfView :: Angle n -- ^ Horizontal field of view.
  , 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 :: 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
               { OrthoLens n -> n
_orthoWidth  :: n -- ^ Width
               , 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 :: 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))
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 :: 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 :: 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 :: 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
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
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 :: 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
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
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 :: 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
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
deg)

camForward :: Camera l n -> Direction V3 n
camForward :: 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 :: 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 :: 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 :: 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 :: Camera l n -> n
camAspect = 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