{-# LANGUAGE ConstraintKinds       #-}
{-# LANGUAGE FlexibleContexts      #-}
{-# LANGUAGE FlexibleInstances     #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE RankNTypes            #-}
{-# LANGUAGE TypeFamilies          #-}

-----------------------------------------------------------------------------
-- |
-- Module      :  Diagrams.ThreeD.Projection
-- Copyright   :  (c) 2014 diagrams team (see LICENSE)
-- License     :  BSD-style (see LICENSE)
-- Maintainer  :  diagrams-discuss@googlegroups.com
--
-- 3D projections are a way of viewing a three-dimensional objects on a
-- two-dimensional plane.
--
-- This module can be used with the functions in "Linear.Projection".
--
-- Disclaimer: This module should be considered experimental and is
-- likely to change.
--
-----------------------------------------------------------------------------

module Diagrams.ThreeD.Projection
  ( -- * Orthographic projections

    -- $orthographic
    -- ** Parallel projections
    facingXY
  , facingXZ
  , facingYZ

    -- ** axonometric
    -- $axonometric

    -- *** Isometric projections
    -- $isometric
  , isometricApply
  , isometric

  , lookingAt

    -- ** Affine maps
  , m44AffineApply
  , m44AffineMap
  , m33AffineApply
  , m33AffineMap

    -- * Perspective projections
    -- $perspective
    -- ** Perspective deformations
  , m44Deformation
  , module Linear.Projection
  ) where

import           Control.Lens           hiding (transform)
import           Data.Functor.Rep

import           Diagrams.Core
import           Diagrams.Deform
import           Diagrams.Direction
import           Diagrams.LinearMap
import           Diagrams.ThreeD.Types  (P3)
import           Diagrams.ThreeD.Vector

import           Linear                 as L
import           Linear.Affine
import           Linear.Projection

------------------------------------------------------------------------
-- Orthographic projections
------------------------------------------------------------------------

-- $orthographic
-- Orthographic projections are a form of parallel projections where are
-- projection lines are orthogonal to the projection plane.

-- Parallel projections

-- | Look at the xy-plane with y as the up direction.
facingXY :: (Epsilon n, Floating n) => AffineMap V3 V2 n
facingXY :: forall n. (Epsilon n, Floating n) => AffineMap V3 V2 n
facingXY = forall n.
(Epsilon n, Floating n) =>
P3 n -> P3 n -> Direction V3 n -> AffineMap V3 V2 n
lookingAt forall (v :: * -> *) n. (R3 v, Additive v, Num n) => v n
unitZ forall (f :: * -> *) a. (Additive f, Num a) => Point f a
origin forall (v :: * -> *) n. (R2 v, Additive v, Num n) => Direction v n
yDir

-- | Look at the xz-plane with z as the up direction.
facingXZ :: (Epsilon n, Floating n) => AffineMap V3 V2 n
facingXZ :: forall n. (Epsilon n, Floating n) => AffineMap V3 V2 n
facingXZ = forall n.
(Epsilon n, Floating n) =>
P3 n -> P3 n -> Direction V3 n -> AffineMap V3 V2 n
lookingAt forall (v :: * -> *) n. (R2 v, Additive v, Num n) => v n
unitY forall (f :: * -> *) a. (Additive f, Num a) => Point f a
origin forall (v :: * -> *) n. (R3 v, Additive v, Num n) => Direction v n
zDir

-- | Look at the yz-plane with z as the up direction.
facingYZ :: (Epsilon n, Floating n) => AffineMap V3 V2 n
facingYZ :: forall n. (Epsilon n, Floating n) => AffineMap V3 V2 n
facingYZ = forall n.
(Epsilon n, Floating n) =>
P3 n -> P3 n -> Direction V3 n -> AffineMap V3 V2 n
lookingAt forall (v :: * -> *) n. (R1 v, Additive v, Num n) => v n
unitX forall (f :: * -> *) a. (Additive f, Num a) => Point f a
origin forall (v :: * -> *) n. (R3 v, Additive v, Num n) => Direction v n
zDir

-- $axonometric
-- Axonometric projections are a type of orthographic projection where
-- the object is rotated along one or more of its axes relative to the
-- plane of projection.

-- $isometric
-- Isometric projections are when the scale along each axis of the
-- projection is the same and the angle between any axis is 120
-- degrees.

-- | Apply an isometric projection given the up direction
isometricApply :: (InSpace V3 n a, InSpace V2 n b, AffineMappable a b, Floating n, Epsilon n)
               => Direction V3 n -> a -> b
isometricApply :: forall n a b.
(InSpace V3 n a, InSpace V2 n b, AffineMappable a b, Floating n,
 Epsilon n) =>
Direction V3 n -> a -> b
isometricApply Direction V3 n
up = forall a b.
(AffineMappable a b, Additive (V a), Foldable (V a),
 Additive (V b), Num (N b)) =>
AffineMap (V a) (V b) (N b) -> a -> b
amap (forall n.
(Floating n, Epsilon n) =>
Direction V3 n -> AffineMap V3 V2 n
isometric Direction V3 n
up)

-- | Make an isometric affine map with the given up direction.
isometric :: (Floating n, Epsilon n) => Direction V3 n -> AffineMap V3 V2 n
isometric :: forall n.
(Floating n, Epsilon n) =>
Direction V3 n -> AffineMap V3 V2 n
isometric Direction V3 n
up = forall n. Num n => M44 n -> AffineMap V3 V2 n
m44AffineMap M44 n
m
  where
    m :: M44 n
m = forall a. (Epsilon a, Floating a) => V3 a -> V3 a -> V3 a -> M44 a
lookAt (forall a. a -> a -> a -> V3 a
V3 n
1 n
1 n
1) forall (f :: * -> *) a. (Additive f, Num a) => f a
zero (forall (v :: * -> *) n.
(Metric v, Floating n) =>
Direction v n -> v n
fromDirection Direction V3 n
up)

lookingAt :: (Epsilon n, Floating n)
          => P3 n -- ^ Eye
          -> P3 n -- ^ Center
          -> Direction V3 n -- ^ Up
          -> AffineMap V3 V2 n
lookingAt :: forall n.
(Epsilon n, Floating n) =>
P3 n -> P3 n -> Direction V3 n -> AffineMap V3 V2 n
lookingAt (P V3 n
cam) (P V3 n
center) Direction V3 n
d = forall n. Num n => M44 n -> AffineMap V3 V2 n
m44AffineMap M44 n
m
  where
    m :: M44 n
m = forall a. (Epsilon a, Floating a) => V3 a -> V3 a -> V3 a -> M44 a
lookAt V3 n
cam V3 n
center (Direction V3 n
dforall s a. s -> Getting a s a -> a
^.forall (v :: * -> *) n. Iso' (Direction v n) (v n)
_Dir)

-- | Apply the affine part of a homogeneous matrix.
m44AffineApply :: (InSpace V3 n a, InSpace V2 n b, AffineMappable a b)
               => M44 n -> a -> b
m44AffineApply :: forall n a b.
(InSpace V3 n a, InSpace V2 n b, AffineMappable a b) =>
M44 n -> a -> b
m44AffineApply = forall a b.
(AffineMappable a b, Additive (V a), Foldable (V a),
 Additive (V b), Num (N b)) =>
AffineMap (V a) (V b) (N b) -> a -> b
amap forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall n. Num n => M44 n -> AffineMap V3 V2 n
m44AffineMap

-- | Create an 'AffineMap' from a 4x4 homogeneous matrix, ignoring any
--   perspective transforms.
m44AffineMap :: Num n => M44 n -> AffineMap V3 V2 n
m44AffineMap :: forall n. Num n => M44 n -> AffineMap V3 V2 n
m44AffineMap M44 n
m = forall (v :: * -> *) (u :: * -> *) n.
LinearMap v u n -> u n -> AffineMap v u n
AffineMap (forall (v :: * -> *) (u :: * -> *) n.
(v n -> u n) -> LinearMap v u n
LinearMap V3 n -> V2 n
f) (V3 n -> V2 n
f V3 n
v)
  where
    f :: V3 n -> V2 n
f  = forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view forall (t :: * -> *) a. R2 t => Lens' (t a) (V2 a)
_xy forall b c a. (b -> c) -> (a -> b) -> a -> c
. (M33 n
m' forall (m :: * -> *) (r :: * -> *) a.
(Functor m, Foldable r, Additive r, Num a) =>
m (r a) -> r a -> m a
!*)
    m' :: M33 n
m' = M44 n
m forall s a. s -> Getting a s a -> a
^. forall (u :: * -> *) (v :: * -> *) n.
(Representable u, R3 v, R3 u) =>
Lens' (u (v n)) (M33 n)
linearTransform
    v :: V3 n
v  = M44 n
m forall s a. s -> Getting a s a -> a
^. forall (t :: * -> *) (v :: * -> *) a.
(Representable t, R3 t, R4 v) =>
Lens' (t (v a)) (V3 a)
L.translation

-- | Apply a transformation matrix and translation.
m33AffineApply :: (InSpace V3 n a, InSpace V2 n b, AffineMappable a b)
               => M33 n -> V2 n -> a -> b
m33AffineApply :: forall n a b.
(InSpace V3 n a, InSpace V2 n b, AffineMappable a b) =>
M33 n -> V2 n -> a -> b
m33AffineApply M33 n
m = forall a b.
(AffineMappable a b, Additive (V a), Foldable (V a),
 Additive (V b), Num (N b)) =>
AffineMap (V a) (V b) (N b) -> a -> b
amap forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall n. Num n => M33 n -> V2 n -> AffineMap V3 V2 n
m33AffineMap M33 n
m

-- | Create an 'AffineMap' from a 3x3 transformation matrix and a
--   translation vector.
m33AffineMap :: Num n => M33 n -> V2 n -> AffineMap V3 V2 n
m33AffineMap :: forall n. Num n => M33 n -> V2 n -> AffineMap V3 V2 n
m33AffineMap M33 n
m = forall (v :: * -> *) (u :: * -> *) n.
LinearMap v u n -> u n -> AffineMap v u n
AffineMap (forall (v :: * -> *) (u :: * -> *) n.
(v n -> u n) -> LinearMap v u n
LinearMap V3 n -> V2 n
f)
  where
    f :: V3 n -> V2 n
f = forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view forall (t :: * -> *) a. R2 t => Lens' (t a) (V2 a)
_xy forall b c a. (b -> c) -> (a -> b) -> a -> c
. (M33 n
m forall (m :: * -> *) (r :: * -> *) a.
(Functor m, Foldable r, Additive r, Num a) =>
m (r a) -> r a -> m a
!*)

-- | Extract the linear transform part of a homogeneous matrix.
linearTransform :: (Representable u, R3 v, R3 u) => Lens' (u (v n)) (M33 n)
linearTransform :: forall (u :: * -> *) (v :: * -> *) n.
(Representable u, R3 v, R3 u) =>
Lens' (u (v n)) (M33 n)
linearTransform = forall (f :: * -> *) a b s t.
Representable f =>
LensLike (Context a b) s t a b -> Lens (f s) (f t) (f a) (f b)
column forall (t :: * -> *) a. R3 t => Lens' (t a) (V3 a)
_xyz forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (t :: * -> *) a. R3 t => Lens' (t a) (V3 a)
_xyz

------------------------------------------------------------------------
-- Perspective transforms
------------------------------------------------------------------------

-- For the time being projective transforms use the deformable class.
-- Eventually we would like to replace this with a more specialised
-- method.

-- $perspective
-- Perspective projections are when closer objects appear bigger.

-- | Make a deformation from a 4x4 homogeneous matrix.
m44Deformation :: Fractional n => M44 n -> Deformation V3 V2 n
m44Deformation :: forall n. Fractional n => M44 n -> Deformation V3 V2 n
m44Deformation M44 n
m =
  forall (v :: * -> *) (u :: * -> *) n.
(Point v n -> Point u n) -> Deformation v u n
Deformation (forall (f :: * -> *) a. f a -> Point f a
P forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view forall (t :: * -> *) a. R2 t => Lens' (t a) (V2 a)
_xy forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Fractional a => V4 a -> V3 a
normalizePoint forall b c a. (b -> c) -> (a -> b) -> a -> c
. (M44 n
m forall (m :: * -> *) (r :: * -> *) a.
(Functor m, Foldable r, Additive r, Num a) =>
m (r a) -> r a -> m a
!*) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Num a => V3 a -> V4 a
point forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view forall (f :: * -> *) a (g :: * -> *) b.
Iso (Point f a) (Point g b) (f a) (g b)
_Point)