{-# LANGUAGE CPP #-}
---------------------------------------------------------------------------
-- |
-- Copyright   :  (C) 2015 Edward Kmett
-- License     :  BSD-style (see the file LICENSE)
--
-- Maintainer  :  Edward Kmett <ekmett@gmail.com>
-- Stability   :  experimental
-- Portability :  non-portable
--
-- Common projection matrices: e.g. perspective/orthographic transformation
-- matrices.
--
-- Analytically derived inverses are also supplied, because they can be
-- much more accurate in practice than computing them through general
-- purpose means
---------------------------------------------------------------------------
module Linear.Projection
  ( lookAt
  , perspective, inversePerspective
  , infinitePerspective, inverseInfinitePerspective
  , frustum, inverseFrustum
  , ortho, inverseOrtho
  ) where

import Control.Lens hiding (index)
import Linear.V3
import Linear.V4
import Linear.Matrix
import Linear.Epsilon
import Linear.Metric

-- $setup
-- >>> import Linear.Matrix
-- >>> import Linear.V2
-- >>> import Linear.V4

-- | Build a look at view matrix
lookAt
  :: (Epsilon a, Floating a)
  => V3 a -- ^ Eye
  -> V3 a -- ^ Center
  -> V3 a -- ^ Up
  -> M44 a
lookAt :: V3 a -> V3 a -> V3 a -> M44 a
lookAt V3 a
eye V3 a
center V3 a
up =
  V4 a -> V4 a -> V4 a -> V4 a -> M44 a
forall a. a -> a -> a -> a -> V4 a
V4 (a -> a -> a -> a -> V4 a
forall a. a -> a -> a -> a -> V4 a
V4 (V3 a
xaV3 a -> Getting a (V3 a) a -> a
forall s a. s -> Getting a s a -> a
^.Getting a (V3 a) a
forall (t :: * -> *) a. R1 t => Lens' (t a) a
_x)  (V3 a
xaV3 a -> Getting a (V3 a) a -> a
forall s a. s -> Getting a s a -> a
^.Getting a (V3 a) a
forall (t :: * -> *) a. R2 t => Lens' (t a) a
_y)  (V3 a
xaV3 a -> Getting a (V3 a) a -> a
forall s a. s -> Getting a s a -> a
^.Getting a (V3 a) a
forall (t :: * -> *) a. R3 t => Lens' (t a) a
_z)  a
xd)
     (a -> a -> a -> a -> V4 a
forall a. a -> a -> a -> a -> V4 a
V4 (V3 a
yaV3 a -> Getting a (V3 a) a -> a
forall s a. s -> Getting a s a -> a
^.Getting a (V3 a) a
forall (t :: * -> *) a. R1 t => Lens' (t a) a
_x)  (V3 a
yaV3 a -> Getting a (V3 a) a -> a
forall s a. s -> Getting a s a -> a
^.Getting a (V3 a) a
forall (t :: * -> *) a. R2 t => Lens' (t a) a
_y)  (V3 a
yaV3 a -> Getting a (V3 a) a -> a
forall s a. s -> Getting a s a -> a
^.Getting a (V3 a) a
forall (t :: * -> *) a. R3 t => Lens' (t a) a
_z)  a
yd)
     (a -> a -> a -> a -> V4 a
forall a. a -> a -> a -> a -> V4 a
V4 (-V3 a
zaV3 a -> Getting a (V3 a) a -> a
forall s a. s -> Getting a s a -> a
^.Getting a (V3 a) a
forall (t :: * -> *) a. R1 t => Lens' (t a) a
_x) (-V3 a
zaV3 a -> Getting a (V3 a) a -> a
forall s a. s -> Getting a s a -> a
^.Getting a (V3 a) a
forall (t :: * -> *) a. R2 t => Lens' (t a) a
_y) (-V3 a
zaV3 a -> Getting a (V3 a) a -> a
forall s a. s -> Getting a s a -> a
^.Getting a (V3 a) a
forall (t :: * -> *) a. R3 t => Lens' (t a) a
_z) a
zd)
     (a -> a -> a -> a -> V4 a
forall a. a -> a -> a -> a -> V4 a
V4 a
0         a
0         a
0          a
1)
  where za :: V3 a
za = V3 a -> V3 a
forall a (f :: * -> *).
(Floating a, Metric f, Epsilon a) =>
f a -> f a
normalize (V3 a -> V3 a) -> V3 a -> V3 a
forall a b. (a -> b) -> a -> b
$ V3 a
center V3 a -> V3 a -> V3 a
forall a. Num a => a -> a -> a
- V3 a
eye
        xa :: V3 a
xa = V3 a -> V3 a
forall a (f :: * -> *).
(Floating a, Metric f, Epsilon a) =>
f a -> f a
normalize (V3 a -> V3 a) -> V3 a -> V3 a
forall a b. (a -> b) -> a -> b
$ V3 a -> V3 a -> V3 a
forall a. Num a => V3 a -> V3 a -> V3 a
cross V3 a
za V3 a
up
        ya :: V3 a
ya = V3 a -> V3 a -> V3 a
forall a. Num a => V3 a -> V3 a -> V3 a
cross V3 a
xa V3 a
za
        xd :: a
xd = -V3 a -> V3 a -> a
forall (f :: * -> *) a. (Metric f, Num a) => f a -> f a -> a
dot V3 a
xa V3 a
eye
        yd :: a
yd = -V3 a -> V3 a -> a
forall (f :: * -> *) a. (Metric f, Num a) => f a -> f a -> a
dot V3 a
ya V3 a
eye
        zd :: a
zd = V3 a -> V3 a -> a
forall (f :: * -> *) a. (Metric f, Num a) => f a -> f a -> a
dot V3 a
za V3 a
eye

-- | Build a matrix for a symmetric perspective-view frustum
perspective
  :: Floating a
  => a -- ^ FOV (y direction, in radians)
  -> a -- ^ Aspect ratio
  -> a -- ^ Near plane
  -> a -- ^ Far plane
  -> M44 a
perspective :: a -> a -> a -> a -> M44 a
perspective a
fovy a
aspect a
near a
far =
  V4 a -> V4 a -> V4 a -> V4 a -> M44 a
forall a. a -> a -> a -> a -> V4 a
V4 (a -> a -> a -> a -> V4 a
forall a. a -> a -> a -> a -> V4 a
V4 a
x a
0 a
0    a
0)
     (a -> a -> a -> a -> V4 a
forall a. a -> a -> a -> a -> V4 a
V4 a
0 a
y a
0    a
0)
     (a -> a -> a -> a -> V4 a
forall a. a -> a -> a -> a -> V4 a
V4 a
0 a
0 a
z    a
w)
     (a -> a -> a -> a -> V4 a
forall a. a -> a -> a -> a -> V4 a
V4 a
0 a
0 (-a
1) a
0)
  where tanHalfFovy :: a
tanHalfFovy = a -> a
forall a. Floating a => a -> a
tan (a -> a) -> a -> a
forall a b. (a -> b) -> a -> b
$ a
fovy a -> a -> a
forall a. Fractional a => a -> a -> a
/ a
2
        x :: a
x = a
1 a -> a -> a
forall a. Fractional a => a -> a -> a
/ (a
aspect a -> a -> a
forall a. Num a => a -> a -> a
* a
tanHalfFovy)
        y :: a
y = a
1 a -> a -> a
forall a. Fractional a => a -> a -> a
/ a
tanHalfFovy
        fpn :: a
fpn = a
far a -> a -> a
forall a. Num a => a -> a -> a
+ a
near
        fmn :: a
fmn = a
far a -> a -> a
forall a. Num a => a -> a -> a
- a
near
        oon :: a
oon = a
0.5a -> a -> a
forall a. Fractional a => a -> a -> a
/a
near
        oof :: a
oof = a
0.5a -> a -> a
forall a. Fractional a => a -> a -> a
/a
far
        -- z = 1 / (near/fpn - far/fpn) -- would be better by .5 bits
        z :: a
z = -a
fpna -> a -> a
forall a. Fractional a => a -> a -> a
/a
fmn
        w :: a
w = a
1a -> a -> a
forall a. Fractional a => a -> a -> a
/(a
oofa -> a -> a
forall a. Num a => a -> a -> a
-a
oon) -- 13 bits error reduced to 0.17
        -- w = -(2 * far * near) / fmn

#ifdef HERBIE
{-# ANN perspective "NoHerbie" #-}
#endif

-- | Build an inverse perspective matrix
inversePerspective
  :: Floating a
  => a -- ^ FOV (y direction, in radians)
  -> a -- ^ Aspect ratio
  -> a -- ^ Near plane
  -> a -- ^ Far plane
  -> M44 a
inversePerspective :: a -> a -> a -> a -> M44 a
inversePerspective a
fovy a
aspect a
near a
far =
  V4 a -> V4 a -> V4 a -> V4 a -> M44 a
forall a. a -> a -> a -> a -> V4 a
V4 (a -> a -> a -> a -> V4 a
forall a. a -> a -> a -> a -> V4 a
V4 a
a a
0 a
0 a
0   )
     (a -> a -> a -> a -> V4 a
forall a. a -> a -> a -> a -> V4 a
V4 a
0 a
b a
0 a
0   )
     (a -> a -> a -> a -> V4 a
forall a. a -> a -> a -> a -> V4 a
V4 a
0 a
0 a
0 (-a
1))
     (a -> a -> a -> a -> V4 a
forall a. a -> a -> a -> a -> V4 a
V4 a
0 a
0 a
c a
d   )
  where tanHalfFovy :: a
tanHalfFovy = a -> a
forall a. Floating a => a -> a
tan (a -> a) -> a -> a
forall a b. (a -> b) -> a -> b
$ a
fovy a -> a -> a
forall a. Fractional a => a -> a -> a
/ a
2
        a :: a
a = a
aspect a -> a -> a
forall a. Num a => a -> a -> a
* a
tanHalfFovy
        b :: a
b = a
tanHalfFovy
        c :: a
c = a
oon a -> a -> a
forall a. Num a => a -> a -> a
- a
oof
        d :: a
d = a
oon a -> a -> a
forall a. Num a => a -> a -> a
+ a
oof
        oon :: a
oon = a
0.5a -> a -> a
forall a. Fractional a => a -> a -> a
/a
near
        oof :: a
oof = a
0.5a -> a -> a
forall a. Fractional a => a -> a -> a
/a
far


-- | Build a perspective matrix per the classic @glFrustum@ arguments.
frustum
  :: Floating a
  => a -- ^ Left
  -> a -- ^ Right
  -> a -- ^ Bottom
  -> a -- ^ Top
  -> a -- ^ Near
  -> a -- ^ Far
  -> M44 a
frustum :: a -> a -> a -> a -> a -> a -> M44 a
frustum a
l a
r a
b a
t a
n a
f =
  V4 a -> V4 a -> V4 a -> V4 a -> M44 a
forall a. a -> a -> a -> a -> V4 a
V4 (a -> a -> a -> a -> V4 a
forall a. a -> a -> a -> a -> V4 a
V4 a
x a
0 a
a    a
0)
     (a -> a -> a -> a -> V4 a
forall a. a -> a -> a -> a -> V4 a
V4 a
0 a
y a
e    a
0)
     (a -> a -> a -> a -> V4 a
forall a. a -> a -> a -> a -> V4 a
V4 a
0 a
0 a
c    a
d)
     (a -> a -> a -> a -> V4 a
forall a. a -> a -> a -> a -> V4 a
V4 a
0 a
0 (-a
1) a
0)
  where
    rml :: a
rml = a
ra -> a -> a
forall a. Num a => a -> a -> a
-a
l
    tmb :: a
tmb = a
ta -> a -> a
forall a. Num a => a -> a -> a
-a
b
    fmn :: a
fmn = a
fa -> a -> a
forall a. Num a => a -> a -> a
-a
n
    x :: a
x = a
2a -> a -> a
forall a. Num a => a -> a -> a
*a
na -> a -> a
forall a. Fractional a => a -> a -> a
/a
rml
    y :: a
y = a
2a -> a -> a
forall a. Num a => a -> a -> a
*a
na -> a -> a
forall a. Fractional a => a -> a -> a
/a
tmb
    a :: a
a = (a
ra -> a -> a
forall a. Num a => a -> a -> a
+a
l)a -> a -> a
forall a. Fractional a => a -> a -> a
/a
rml
    e :: a
e = (a
ta -> a -> a
forall a. Num a => a -> a -> a
+a
b)a -> a -> a
forall a. Fractional a => a -> a -> a
/a
tmb
    c :: a
c = a -> a
forall a. Num a => a -> a
negate (a
fa -> a -> a
forall a. Num a => a -> a -> a
+a
n)a -> a -> a
forall a. Fractional a => a -> a -> a
/a
fmn
    d :: a
d = (-a
2a -> a -> a
forall a. Num a => a -> a -> a
*a
fa -> a -> a
forall a. Num a => a -> a -> a
*a
n)a -> a -> a
forall a. Fractional a => a -> a -> a
/a
fmn

inverseFrustum
  :: Floating a
  => a -- ^ Left
  -> a -- ^ Right
  -> a -- ^ Bottom
  -> a -- ^ Top
  -> a -- ^ Near
  -> a -- ^ Far
  -> M44 a
inverseFrustum :: a -> a -> a -> a -> a -> a -> M44 a
inverseFrustum a
l a
r a
b a
t a
n a
f =
  V4 a -> V4 a -> V4 a -> V4 a -> M44 a
forall a. a -> a -> a -> a -> V4 a
V4 (a -> a -> a -> a -> V4 a
forall a. a -> a -> a -> a -> V4 a
V4 a
rx a
0 a
0 a
ax)
     (a -> a -> a -> a -> V4 a
forall a. a -> a -> a -> a -> V4 a
V4 a
0 a
ry a
0 a
by)
     (a -> a -> a -> a -> V4 a
forall a. a -> a -> a -> a -> V4 a
V4 a
0 a
0 a
0 (-a
1))
     (a -> a -> a -> a -> V4 a
forall a. a -> a -> a -> a -> V4 a
V4 a
0 a
0 a
rd a
cd)
  where
    hrn :: a
hrn  = a
0.5a -> a -> a
forall a. Fractional a => a -> a -> a
/a
n
    hrnf :: a
hrnf = a
0.5a -> a -> a
forall a. Fractional a => a -> a -> a
/(a
na -> a -> a
forall a. Num a => a -> a -> a
*a
f)
    rx :: a
rx = (a
ra -> a -> a
forall a. Num a => a -> a -> a
-a
l)a -> a -> a
forall a. Num a => a -> a -> a
*a
hrn
    ry :: a
ry = (a
ta -> a -> a
forall a. Num a => a -> a -> a
-a
b)a -> a -> a
forall a. Num a => a -> a -> a
*a
hrn
    ax :: a
ax = (a
ra -> a -> a
forall a. Num a => a -> a -> a
+a
l)a -> a -> a
forall a. Num a => a -> a -> a
*a
hrn
    by :: a
by = (a
ta -> a -> a
forall a. Num a => a -> a -> a
+a
b)a -> a -> a
forall a. Num a => a -> a -> a
*a
hrn
    cd :: a
cd = (a
fa -> a -> a
forall a. Num a => a -> a -> a
+a
n)a -> a -> a
forall a. Num a => a -> a -> a
*a
hrnf
    rd :: a
rd = (a
na -> a -> a
forall a. Num a => a -> a -> a
-a
f)a -> a -> a
forall a. Num a => a -> a -> a
*a
hrnf

-- | Build a matrix for a symmetric perspective-view frustum with a far plane at infinite
infinitePerspective
  :: Floating a
  => a -- ^ FOV (y direction, in radians)
  -> a -- ^ Aspect Ratio
  -> a -- ^ Near plane
  -> M44 a
infinitePerspective :: a -> a -> a -> M44 a
infinitePerspective a
fovy a
a a
n =
  V4 a -> V4 a -> V4 a -> V4 a -> M44 a
forall a. a -> a -> a -> a -> V4 a
V4 (a -> a -> a -> a -> V4 a
forall a. a -> a -> a -> a -> V4 a
V4 a
x a
0 a
0    a
0)
     (a -> a -> a -> a -> V4 a
forall a. a -> a -> a -> a -> V4 a
V4 a
0 a
y a
0    a
0)
     (a -> a -> a -> a -> V4 a
forall a. a -> a -> a -> a -> V4 a
V4 a
0 a
0 (-a
1) a
w)
     (a -> a -> a -> a -> V4 a
forall a. a -> a -> a -> a -> V4 a
V4 a
0 a
0 (-a
1) a
0)
  where
    t :: a
t = a
na -> a -> a
forall a. Num a => a -> a -> a
*a -> a
forall a. Floating a => a -> a
tan(a
fovya -> a -> a
forall a. Fractional a => a -> a -> a
/a
2)
    b :: a
b = -a
t
    l :: a
l = a
ba -> a -> a
forall a. Num a => a -> a -> a
*a
a
    r :: a
r = a
ta -> a -> a
forall a. Num a => a -> a -> a
*a
a
    x :: a
x = (a
2a -> a -> a
forall a. Num a => a -> a -> a
*a
n)a -> a -> a
forall a. Fractional a => a -> a -> a
/(a
ra -> a -> a
forall a. Num a => a -> a -> a
-a
l)
    y :: a
y = (a
2a -> a -> a
forall a. Num a => a -> a -> a
*a
n)a -> a -> a
forall a. Fractional a => a -> a -> a
/(a
ta -> a -> a
forall a. Num a => a -> a -> a
-a
b)
    w :: a
w = -a
2a -> a -> a
forall a. Num a => a -> a -> a
*a
n

inverseInfinitePerspective
  :: Floating a
  => a -- ^ FOV (y direction, in radians)
  -> a -- ^ Aspect Ratio
  -> a -- ^ Near plane
  -> M44 a
inverseInfinitePerspective :: a -> a -> a -> M44 a
inverseInfinitePerspective a
fovy a
a a
n =
  V4 a -> V4 a -> V4 a -> V4 a -> M44 a
forall a. a -> a -> a -> a -> V4 a
V4 (a -> a -> a -> a -> V4 a
forall a. a -> a -> a -> a -> V4 a
V4 a
rx a
0 a
0  a
0)
     (a -> a -> a -> a -> V4 a
forall a. a -> a -> a -> a -> V4 a
V4 a
0 a
ry a
0  a
0)
     (a -> a -> a -> a -> V4 a
forall a. a -> a -> a -> a -> V4 a
V4 a
0 a
0  a
0  (-a
1))
     (a -> a -> a -> a -> V4 a
forall a. a -> a -> a -> a -> V4 a
V4 a
0 a
0  a
rw (-a
rw))
  where
    t :: a
t = a
na -> a -> a
forall a. Num a => a -> a -> a
*a -> a
forall a. Floating a => a -> a
tan(a
fovya -> a -> a
forall a. Fractional a => a -> a -> a
/a
2)
    b :: a
b = -a
t
    l :: a
l = a
ba -> a -> a
forall a. Num a => a -> a -> a
*a
a
    r :: a
r = a
ta -> a -> a
forall a. Num a => a -> a -> a
*a
a
    hrn :: a
hrn = a
0.5a -> a -> a
forall a. Fractional a => a -> a -> a
/a
n
    rx :: a
rx = (a
ra -> a -> a
forall a. Num a => a -> a -> a
-a
l)a -> a -> a
forall a. Num a => a -> a -> a
*a
hrn
    ry :: a
ry = (a
ta -> a -> a
forall a. Num a => a -> a -> a
-a
b)a -> a -> a
forall a. Num a => a -> a -> a
*a
hrn
    rw :: a
rw = -a
hrn

-- | Build an orthographic perspective matrix from 6 clipping planes.
-- This matrix takes the region delimited by these planes and maps it
-- to normalized device coordinates between [-1,1]
--
-- This call is designed to mimic the parameters to the OpenGL @glOrtho@
-- call, so it has a slightly strange convention: Notably: the near and
-- far planes are negated.
--
-- Consequently:
--
-- @
-- 'ortho' l r b t n f !* 'V4' l b (-n) 1 = 'V4' (-1) (-1) (-1) 1
-- 'ortho' l r b t n f !* 'V4' r t (-f) 1 = 'V4' 1 1 1 1
-- @
--
-- Examples:
--
-- >>> ortho 1 2 3 4 5 6 !* V4 1 3 (-5) 1
-- V4 (-1.0) (-1.0) (-1.0) 1.0
--
-- >>> ortho 1 2 3 4 5 6 !* V4 2 4 (-6) 1
-- V4 1.0 1.0 1.0 1.0
ortho
  :: Fractional a
  => a -- ^ Left
  -> a -- ^ Right
  -> a -- ^ Bottom
  -> a -- ^ Top
  -> a -- ^ Near
  -> a -- ^ Far
  -> M44 a
ortho :: a -> a -> a -> a -> a -> a -> M44 a
ortho a
l a
r a
b a
t a
n a
f =
  V4 a -> V4 a -> V4 a -> V4 a -> M44 a
forall a. a -> a -> a -> a -> V4 a
V4 (a -> a -> a -> a -> V4 a
forall a. a -> a -> a -> a -> V4 a
V4 (-a
2a -> a -> a
forall a. Num a => a -> a -> a
*a
x) a
0      a
0     ((a
ra -> a -> a
forall a. Num a => a -> a -> a
+a
l)a -> a -> a
forall a. Num a => a -> a -> a
*a
x))
     (a -> a -> a -> a -> V4 a
forall a. a -> a -> a -> a -> V4 a
V4 a
0      (-a
2a -> a -> a
forall a. Num a => a -> a -> a
*a
y) a
0     ((a
ta -> a -> a
forall a. Num a => a -> a -> a
+a
b)a -> a -> a
forall a. Num a => a -> a -> a
*a
y))
     (a -> a -> a -> a -> V4 a
forall a. a -> a -> a -> a -> V4 a
V4 a
0      a
0      (a
2a -> a -> a
forall a. Num a => a -> a -> a
*a
z) ((a
fa -> a -> a
forall a. Num a => a -> a -> a
+a
n)a -> a -> a
forall a. Num a => a -> a -> a
*a
z))
     (a -> a -> a -> a -> V4 a
forall a. a -> a -> a -> a -> V4 a
V4 a
0      a
0      a
0     a
1)
  where x :: a
x = a -> a
forall a. Fractional a => a -> a
recip(a
la -> a -> a
forall a. Num a => a -> a -> a
-a
r)
        y :: a
y = a -> a
forall a. Fractional a => a -> a
recip(a
ba -> a -> a
forall a. Num a => a -> a -> a
-a
t)
        z :: a
z = a -> a
forall a. Fractional a => a -> a
recip(a
na -> a -> a
forall a. Num a => a -> a -> a
-a
f)

-- | Build an inverse orthographic perspective matrix from 6 clipping planes
inverseOrtho
  :: Fractional a
  => a -- ^ Left
  -> a -- ^ Right
  -> a -- ^ Bottom
  -> a -- ^ Top
  -> a -- ^ Near
  -> a -- ^ Far
  -> M44 a
inverseOrtho :: a -> a -> a -> a -> a -> a -> M44 a
inverseOrtho a
l a
r a
b a
t a
n a
f =
  V4 a -> V4 a -> V4 a -> V4 a -> M44 a
forall a. a -> a -> a -> a -> V4 a
V4 (a -> a -> a -> a -> V4 a
forall a. a -> a -> a -> a -> V4 a
V4 a
x a
0 a
0 a
c)
     (a -> a -> a -> a -> V4 a
forall a. a -> a -> a -> a -> V4 a
V4 a
0 a
y a
0 a
d)
     (a -> a -> a -> a -> V4 a
forall a. a -> a -> a -> a -> V4 a
V4 a
0 a
0 a
z a
e)
     (a -> a -> a -> a -> V4 a
forall a. a -> a -> a -> a -> V4 a
V4 a
0 a
0 a
0 a
1)
  where x :: a
x = a
0.5a -> a -> a
forall a. Num a => a -> a -> a
*(a
ra -> a -> a
forall a. Num a => a -> a -> a
-a
l)
        y :: a
y = a
0.5a -> a -> a
forall a. Num a => a -> a -> a
*(a
ta -> a -> a
forall a. Num a => a -> a -> a
-a
b)
        z :: a
z = a
0.5a -> a -> a
forall a. Num a => a -> a -> a
*(a
na -> a -> a
forall a. Num a => a -> a -> a
-a
f)
        c :: a
c = a
0.5a -> a -> a
forall a. Num a => a -> a -> a
*(a
la -> a -> a
forall a. Num a => a -> a -> a
+a
r)
        d :: a
d = a
0.5a -> a -> a
forall a. Num a => a -> a -> a
*(a
ba -> a -> a
forall a. Num a => a -> a -> a
+a
t)
        e :: a
e = -a
0.5a -> a -> a
forall a. Num a => a -> a -> a
*(a
na -> a -> a
forall a. Num a => a -> a -> a
+a
f)