-- |
-- Functions for working with 3-dimensional homogeneous coordinates.
-- This includes 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
--
-- Adapted from [Linear.Projection](https://hackage.haskell.org/package/linear-1.21.8/docs/Linear-Projection.html)
module Nonlinear.Projective.Hom3 where

import Nonlinear.Internal (Lens')
import Nonlinear.Matrix
import Nonlinear.Quaternion
import Nonlinear.V3
import Nonlinear.V4
import Nonlinear.Vector

-- | Convert from a 4x3 matrix to a 4x4 matrix, extending it with the @[ 0 0 0 1 ]@ column vector
m43_to_m44 :: Num a => M43 a -> M44 a
m43_to_m44 :: M43 a -> M44 a
m43_to_m44
  ( V4
      (V3 a
a a
b a
c)
      (V3 a
d a
e a
f)
      (V3 a
g a
h a
i)
      (V3 a
j a
k a
l)
    ) =
    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
b a
c a
0)
      (a -> a -> a -> a -> V4 a
forall a. a -> a -> a -> a -> V4 a
V4 a
d a
e a
f a
0)
      (a -> a -> a -> a -> V4 a
forall a. a -> a -> a -> a -> V4 a
V4 a
g a
h a
i a
0)
      (a -> a -> a -> a -> V4 a
forall a. a -> a -> a -> a -> V4 a
V4 a
j a
k a
l a
1)

-- | Convert a 3-dimensional affine vector into a 4-dimensional homogeneous vector,
-- i.e. sets the @w@ coordinate to 0.
vector :: Num a => V3 a -> V4 a
vector :: V3 a -> V4 a
vector (V3 a
a a
b a
c) = a -> a -> a -> a -> V4 a
forall a. a -> a -> a -> a -> V4 a
V4 a
a a
b a
c a
0
{-# INLINE vector #-}

-- | Convert a 3-dimensional affine point into a 4-dimensional homogeneous vector,
-- i.e. sets the @w@ coordinate to 1.
point :: Num a => V3 a -> V4 a
point :: V3 a -> V4 a
point (V3 a
a a
b a
c) = a -> a -> a -> a -> V4 a
forall a. a -> a -> a -> a -> V4 a
V4 a
a a
b a
c a
1
{-# INLINE point #-}

-- | Convert 4-dimensional projective coordinates to a 3-dimensional
-- point. This operation may be denoted, @euclidean [x:y:z:w] = (x\/w,
-- y\/w, z\/w)@ where the projective, homogeneous, coordinate
-- @[x:y:z:w]@ is one of many associated with a single point @(x\/w,
-- y\/w, z\/w)@.
normalizePoint :: Fractional a => V4 a -> V3 a
normalizePoint :: V4 a -> V3 a
normalizePoint (V4 a
a a
b a
c a
w) = (a
1 a -> a -> a
forall a. Fractional a => a -> a -> a
/ a
w) a -> V3 a -> V3 a
forall (f :: * -> *) a. (Vec f, Num a) => a -> f a -> f a
*^ a -> a -> a -> V3 a
forall a. a -> a -> a -> V3 a
V3 a
a a
b a
c
{-# INLINE normalizePoint #-}

-- | Convert a 3x3 matrix to a 4x4 matrix extending it with 0's in the new row and column.
m33_to_m44 :: Num a => M33 a -> M44 a
m33_to_m44 :: M33 a -> M44 a
m33_to_m44 (V3 V3 a
r1 V3 a
r2 V3 a
r3) = V4 a -> V4 a -> V4 a -> V4 a -> M44 a
forall a. a -> a -> a -> a -> V4 a
V4 (V3 a -> V4 a
forall a. Num a => V3 a -> V4 a
vector V3 a
r1) (V3 a -> V4 a
forall a. Num a => V3 a -> V4 a
vector V3 a
r2) (V3 a -> V4 a
forall a. Num a => V3 a -> V4 a
vector V3 a
r3) (V3 a -> V4 a
forall a. Num a => V3 a -> V4 a
point V3 a
0)

-- | Extract the translation vector (first three entries of the last
--  column) from a 3x4 or 4x4 matrix.
translation :: (Vec t, R3 t, R4 v) => Lens' (t (v a)) (V3 a)
translation :: Lens' (t (v a)) (V3 a)
translation = Lens' (v a) a -> Lens' (t (v a)) (t a)
forall (v :: * -> *) a b. Vec v => Lens' a b -> Lens' (v a) (v b)
column Lens' (v a) a
forall (t :: * -> *) a. R4 t => Lens' (t a) a
_w ((t a -> m (t a)) -> t (v a) -> m (t (v a)))
-> ((V3 a -> m (V3 a)) -> t a -> m (t a))
-> (V3 a -> m (V3 a))
-> t (v a)
-> m (t (v a))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (V3 a -> m (V3 a)) -> t a -> m (t a)
forall (t :: * -> *) a. R3 t => Lens' (t a) (V3 a)
_xyz

-- | Build a transformation matrix from a rotation matrix and a
-- translation vector.
mkTransformationMat :: Num a => M33 a -> V3 a -> M44 a
mkTransformationMat :: M33 a -> V3 a -> M44 a
mkTransformationMat (V3 V3 a
r1 V3 a
r2 V3 a
r3) (V3 a
tx a
ty a
tz) =
  V4 a -> V4 a -> V4 a -> V4 a -> M44 a
forall a. a -> a -> a -> a -> V4 a
V4 (V3 a -> a -> V4 a
forall a. V3 a -> a -> V4 a
snoc3 V3 a
r1 a
tx) (V3 a -> a -> V4 a
forall a. V3 a -> a -> V4 a
snoc3 V3 a
r2 a
ty) (V3 a -> a -> V4 a
forall a. V3 a -> a -> V4 a
snoc3 V3 a
r3 a
tz) (a -> a -> a -> a -> V4 a
forall a. a -> a -> a -> a -> V4 a
V4 a
0 a
0 a
0 a
1)
  where
    snoc3 :: V3 a -> a -> V4 a
snoc3 (V3 a
x a
y a
z) = a -> a -> a -> a -> V4 a
forall a. a -> a -> a -> a -> V4 a
V4 a
x a
y a
z
{-# INLINE mkTransformationMat #-}

-- | Build a transformation matrix from a rotation expressed as a
--  'Quaternion' and a translation vector.
mkTransformation :: Num a => Quaternion a -> V3 a -> M44 a
mkTransformation :: Quaternion a -> V3 a -> M44 a
mkTransformation = M33 a -> V3 a -> M44 a
forall a. Num a => M33 a -> V3 a -> M44 a
mkTransformationMat (M33 a -> V3 a -> M44 a)
-> (Quaternion a -> M33 a) -> Quaternion a -> V3 a -> M44 a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Quaternion a -> M33 a
forall a. Num a => Quaternion a -> M33 a
fromQuaternion
{-# INLINE mkTransformation #-}

{-# SPECIALIZE lookAt :: V3 Float -> V3 Float -> V3 Float -> M44 Float #-}
{-# SPECIALIZE lookAt :: V3 Double -> V3 Double -> V3 Double -> M44 Double #-}

-- | Build a look at view matrix
lookAt ::
  (Floating a) =>
  -- | Eye
  V3 a ->
  -- | Center
  V3 a ->
  -- | Up
  V3 a ->
  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
    (V3 a -> a -> V4 a
forall a. V3 a -> a -> V4 a
snoc3 V3 a
xa a
xd)
    (V3 a -> a -> V4 a
forall a. V3 a -> a -> V4 a
snoc3 V3 a
ya a
yd)
    (V3 a -> a -> V4 a
forall a. V3 a -> a -> V4 a
snoc3 (-V3 a
za) 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
    snoc3 :: V3 a -> a -> V4 a
snoc3 (V3 a
a a
b a
c) = a -> a -> a -> a -> V4 a
forall a. a -> a -> a -> a -> V4 a
V4 a
a a
b a
c
    za :: V3 a
za = V3 a -> V3 a
forall (f :: * -> *) a. (Vec f, Floating 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 (f :: * -> *) a. (Vec f, Floating 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. (Vec 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. (Vec 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. (Vec f, Num a) => f a -> f a -> a
dot V3 a
za V3 a
eye

{-# SPECIALIZE perspective :: Float -> Float -> Float -> Float -> M44 Float #-}
{-# SPECIALIZE perspective :: Double -> Double -> Double -> Double -> M44 Double #-}

-- | Build a matrix for a symmetric perspective-view frustum
perspective ::
  Floating a =>
  -- | FOV (y direction, in radians)
  a ->
  -- | Aspect ratio
  a ->
  -- | Near plane
  a ->
  -- | Far plane
  a ->
  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.5 a -> a -> a
forall a. Fractional a => a -> a -> a
/ a
near
    oof :: a
oof = a
0.5 a -> 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
fpn a -> a -> a
forall a. Fractional a => a -> a -> a
/ a
fmn
    w :: a
w = a
1 a -> a -> a
forall a. Fractional a => a -> a -> a
/ (a
oof a -> a -> a
forall a. Num a => a -> a -> a
- a
oon) -- 13 bits error reduced to 0.17
    -- w = -(2 * far * near) / fmn

{-# SPECIALIZE inversePerspective :: Float -> Float -> Float -> Float -> M44 Float #-}
{-# SPECIALIZE inversePerspective :: Double -> Double -> Double -> Double -> M44 Double #-}

-- | Build an inverse perspective matrix
inversePerspective ::
  Floating a =>
  -- | FOV (y direction, in radians)
  a ->
  -- | Aspect ratio
  a ->
  -- | Near plane
  a ->
  -- | Far plane
  a ->
  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.5 a -> a -> a
forall a. Fractional a => a -> a -> a
/ a
near
    oof :: a
oof = a
0.5 a -> a -> a
forall a. Fractional a => a -> a -> a
/ a
far

{-# SPECIALIZE frustum :: Float -> Float -> Float -> Float -> Float -> Float -> M44 Float #-}
{-# SPECIALIZE frustum :: Double -> Double -> Double -> Double -> Double -> Double -> M44 Double #-}

-- | Build a perspective matrix per the classic @glFrustum@ arguments.
frustum ::
  Floating a =>
  -- | Left
  a ->
  -- | Right
  a ->
  -- | Bottom
  a ->
  -- | Top
  a ->
  -- | Near
  a ->
  -- | Far
  a ->
  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
r a -> a -> a
forall a. Num a => a -> a -> a
- a
l
    tmb :: a
tmb = a
t a -> a -> a
forall a. Num a => a -> a -> a
- a
b
    fmn :: a
fmn = a
f a -> a -> a
forall a. Num a => a -> a -> a
- a
n
    x :: a
x = a
2 a -> a -> a
forall a. Num a => a -> a -> a
* a
n a -> a -> a
forall a. Fractional a => a -> a -> a
/ a
rml
    y :: a
y = a
2 a -> a -> a
forall a. Num a => a -> a -> a
* a
n a -> a -> a
forall a. Fractional a => a -> a -> a
/ a
tmb
    a :: a
a = (a
r a -> 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
t a -> 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
f a -> 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
2 a -> a -> a
forall a. Num a => a -> a -> a
* a
f a -> a -> a
forall a. Num a => a -> a -> a
* a
n) a -> a -> a
forall a. Fractional a => a -> a -> a
/ a
fmn

{-# SPECIALIZE inverseFrustum :: Float -> Float -> Float -> Float -> Float -> Float -> M44 Float #-}
{-# SPECIALIZE inverseFrustum :: Double -> Double -> Double -> Double -> Double -> Double -> M44 Double #-}
inverseFrustum ::
  Floating a =>
  -- | Left
  a ->
  -- | Right
  a ->
  -- | Bottom
  a ->
  -- | Top
  a ->
  -- | Near
  a ->
  -- | Far
  a ->
  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.5 a -> a -> a
forall a. Fractional a => a -> a -> a
/ a
n
    hrnf :: a
hrnf = a
0.5 a -> a -> a
forall a. Fractional a => a -> a -> a
/ (a
n a -> a -> a
forall a. Num a => a -> a -> a
* a
f)
    rx :: a
rx = (a
r a -> 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
t a -> 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
r a -> 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
t a -> 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
f a -> 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
n a -> a -> a
forall a. Num a => a -> a -> a
- a
f) a -> a -> a
forall a. Num a => a -> a -> a
* a
hrnf

{-# SPECIALIZE infinitePerspective :: Float -> Float -> Float -> M44 Float #-}
{-# SPECIALIZE infinitePerspective :: Double -> Double -> Double -> M44 Double #-}

-- | Build a matrix for a symmetric perspective-view frustum with a far plane at infinite
infinitePerspective ::
  Floating a =>
  -- | FOV (y direction, in radians)
  a ->
  -- | Aspect Ratio
  a ->
  -- | Near plane
  a ->
  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
n a -> a -> a
forall a. Num a => a -> a -> a
* a -> a
forall a. Floating a => a -> a
tan (a
fovy a -> a -> a
forall a. Fractional a => a -> a -> a
/ a
2)
    b :: a
b = -a
t
    l :: a
l = a
b a -> a -> a
forall a. Num a => a -> a -> a
* a
a
    r :: a
r = a
t a -> a -> a
forall a. Num a => a -> a -> a
* a
a
    x :: a
x = (a
2 a -> a -> a
forall a. Num a => a -> a -> a
* a
n) a -> a -> a
forall a. Fractional a => a -> a -> a
/ (a
r a -> a -> a
forall a. Num a => a -> a -> a
- a
l)
    y :: a
y = (a
2 a -> a -> a
forall a. Num a => a -> a -> a
* a
n) a -> a -> a
forall a. Fractional a => a -> a -> a
/ (a
t a -> a -> a
forall a. Num a => a -> a -> a
- a
b)
    w :: a
w = -a
2 a -> a -> a
forall a. Num a => a -> a -> a
* a
n

{-# SPECIALIZE inverseInfinitePerspective :: Float -> Float -> Float -> M44 Float #-}
{-# SPECIALIZE inverseInfinitePerspective :: Double -> Double -> Double -> M44 Double #-}
inverseInfinitePerspective ::
  Floating a =>
  -- | FOV (y direction, in radians)
  a ->
  -- | Aspect Ratio
  a ->
  -- | Near plane
  a ->
  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
n a -> a -> a
forall a. Num a => a -> a -> a
* a -> a
forall a. Floating a => a -> a
tan (a
fovy a -> a -> a
forall a. Fractional a => a -> a -> a
/ a
2)
    b :: a
b = -a
t
    l :: a
l = a
b a -> a -> a
forall a. Num a => a -> a -> a
* a
a
    r :: a
r = a
t a -> a -> a
forall a. Num a => a -> a -> a
* a
a
    hrn :: a
hrn = a
0.5 a -> a -> a
forall a. Fractional a => a -> a -> a
/ a
n
    rx :: a
rx = (a
r a -> 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
t a -> 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

{-# SPECIALIZE ortho :: Float -> Float -> Float -> Float -> Float -> Float -> M44 Float #-}
{-# SPECIALIZE ortho :: Double -> Double -> Double -> Double -> Double -> Double -> M44 Double #-}

-- | 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 =>
  -- | Left
  a ->
  -- | Right
  a ->
  -- | Bottom
  a ->
  -- | Top
  a ->
  -- | Near
  a ->
  -- | Far
  a ->
  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
2 a -> a -> a
forall a. Num a => a -> a -> a
* a
x) a
0 a
0 ((a
r a -> 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
2 a -> a -> a
forall a. Num a => a -> a -> a
* a
y) a
0 ((a
t a -> 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
2 a -> a -> a
forall a. Num a => a -> a -> a
* a
z) ((a
f a -> 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
l a -> a -> a
forall a. Num a => a -> a -> a
- a
r)
    y :: a
y = a -> a
forall a. Fractional a => a -> a
recip (a
b a -> a -> a
forall a. Num a => a -> a -> a
- a
t)
    z :: a
z = a -> a
forall a. Fractional a => a -> a
recip (a
n a -> a -> a
forall a. Num a => a -> a -> a
- a
f)

{-# SPECIALIZE inverseOrtho :: Float -> Float -> Float -> Float -> Float -> Float -> M44 Float #-}
{-# SPECIALIZE inverseOrtho :: Double -> Double -> Double -> Double -> Double -> Double -> M44 Double #-}

-- | Build an inverse orthographic perspective matrix from 6 clipping planes
inverseOrtho ::
  Fractional a =>
  -- | Left
  a ->
  -- | Right
  a ->
  -- | Bottom
  a ->
  -- | Top
  a ->
  -- | Near
  a ->
  -- | Far
  a ->
  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.5 a -> a -> a
forall a. Num a => a -> a -> a
* (a
r a -> a -> a
forall a. Num a => a -> a -> a
- a
l)
    y :: a
y = a
0.5 a -> a -> a
forall a. Num a => a -> a -> a
* (a
t a -> a -> a
forall a. Num a => a -> a -> a
- a
b)
    z :: a
z = a
0.5 a -> a -> a
forall a. Num a => a -> a -> a
* (a
n a -> a -> a
forall a. Num a => a -> a -> a
- a
f)
    c :: a
c = a
0.5 a -> a -> a
forall a. Num a => a -> a -> a
* (a
l a -> a -> a
forall a. Num a => a -> a -> a
+ a
r)
    d :: a
d = a
0.5 a -> a -> a
forall a. Num a => a -> a -> a
* (a
b a -> a -> a
forall a. Num a => a -> a -> a
+ a
t)
    e :: a
e = -a
0.5 a -> a -> a
forall a. Num a => a -> a -> a
* (a
n a -> a -> a
forall a. Num a => a -> a -> a
+ a
f)