-- | A 'Camera' represents a coordinate frame into which 3D points may
-- be transformed. For rendering purposes, it is often helpful to
-- combine a transformation matrix computed from a 'Camera' by
-- 'camMatrix' -- that transforms points into the camera's coordinate
-- frame -- with a perspective projection matrix, as created by
-- 'projectionMatrix'.
module Graphics.GLUtil.Camera3D
  (-- * Camera movement
   Camera(..), panRad, pan, tiltRad, tilt, rollRad, roll, dolly,
   panGlobalRad, panGlobal, tiltGlobalRad, tiltGlobal, rollGlobalRad,
   rollGlobal,
   -- * Camera initialization
   rosCamera, fpsCamera,
   -- * Matrices
   projectionMatrix, orthoMatrix, camMatrix,
   -- * Miscellaneous
   deg2rad) where
import           Linear            (Conjugate (conjugate), Epsilon, V3 (..),
                                    V4 (..))
import           Linear.Matrix     (M44, mkTransformation)
import           Linear.Quaternion (Quaternion, axisAngle, rotate)

-- | A 'Camera' may be translated and rotated to provide a coordinate
-- frame into which 3D points may be transformed.
data Camera a = Camera { Camera a -> V3 a
forward     :: V3 a
                       , Camera a -> V3 a
upward      :: V3 a
                       , Camera a -> V3 a
rightward   :: V3 a
                       , Camera a -> Quaternion a
orientation :: Quaternion a
                       , Camera a -> V3 a
location    :: V3 a }

-- | Pan a camera view (turn side-to-side) by an angle given in
-- radians. Panning is about the camera's up-axis (e.g. the positive
-- Y axis for 'fpsCamera').
panRad :: (Epsilon a, RealFloat a) => a -> Camera a -> Camera a
panRad :: a -> Camera a -> Camera a
panRad theta :: a
theta c :: Camera a
c = Camera a
c { orientation :: Quaternion a
orientation = Camera a -> Quaternion a
forall a. Camera a -> Quaternion a
orientation Camera a
c Quaternion a -> Quaternion a -> Quaternion a
forall a. Num a => a -> a -> a
* Quaternion a
r }
  where r :: Quaternion a
r = V3 a -> a -> Quaternion a
forall a. (Epsilon a, Floating a) => V3 a -> a -> Quaternion a
axisAngle (Camera a -> V3 a
forall a. Camera a -> V3 a
upward Camera a
c) a
theta

-- | Pan a camera view (turn side-to-side) by an angle given in
-- degrees. Panning is about the camera's up-axis (e.g. the positive
-- Y axis for 'fpsCamera').
pan :: (Epsilon a, RealFloat a) => a -> Camera a -> Camera a
pan :: a -> Camera a -> Camera a
pan = a -> Camera a -> Camera a
forall a. (Epsilon a, RealFloat a) => a -> Camera a -> Camera a
panRad (a -> Camera a -> Camera a)
-> (a -> a) -> a -> Camera a -> Camera a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> a
forall a. RealFloat a => a -> a
deg2rad

-- | Pan a camera view (turn side-to-side) by an angle given in
-- radians. Panning is about the world's up-axis as captured by the
-- initial camera state (e.g. the positive Y axis for 'fpsCamera').
panGlobalRad :: (Epsilon a, RealFloat a) => a -> Camera a -> Camera a
panGlobalRad :: a -> Camera a -> Camera a
panGlobalRad theta :: a
theta c :: Camera a
c = Camera a
c { orientation :: Quaternion a
orientation = Quaternion a
r Quaternion a -> Quaternion a -> Quaternion a
forall a. Num a => a -> a -> a
* Camera a -> Quaternion a
forall a. Camera a -> Quaternion a
orientation Camera a
c }
  where r :: Quaternion a
r = V3 a -> a -> Quaternion a
forall a. (Epsilon a, Floating a) => V3 a -> a -> Quaternion a
axisAngle (Camera a -> V3 a
forall a. Camera a -> V3 a
upward Camera a
c) a
theta

-- | Pan a camera view (turn side-to-side) by an angle given in
-- degrees. Panning is about the world's up-axis as captured by the
-- initial camera state (e.g. the positive Y axis for 'fpsCamera').
panGlobal :: (Epsilon a, RealFloat a) => a -> Camera a -> Camera a
panGlobal :: a -> Camera a -> Camera a
panGlobal = a -> Camera a -> Camera a
forall a. (Epsilon a, RealFloat a) => a -> Camera a -> Camera a
panGlobalRad (a -> Camera a -> Camera a)
-> (a -> a) -> a -> Camera a -> Camera a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> a
forall a. RealFloat a => a -> a
deg2rad

-- | Tilt a camera view (up-and-down) by an angle given in
-- radians. Tilting is about the camera's horizontal axis (e.g. the
-- positive X axis for 'fpsCamera').
tiltRad :: (Epsilon a, RealFloat a) => a -> Camera a -> Camera a
tiltRad :: a -> Camera a -> Camera a
tiltRad theta :: a
theta c :: Camera a
c = Camera a
c { orientation :: Quaternion a
orientation = Camera a -> Quaternion a
forall a. Camera a -> Quaternion a
orientation Camera a
c Quaternion a -> Quaternion a -> Quaternion a
forall a. Num a => a -> a -> a
* Quaternion a
r }
  where r :: Quaternion a
r = V3 a -> a -> Quaternion a
forall a. (Epsilon a, Floating a) => V3 a -> a -> Quaternion a
axisAngle (Camera a -> V3 a
forall a. Camera a -> V3 a
rightward Camera a
c) a
theta

-- | Tilt a camera view (up-and-down) by an angle given in degrees.
-- Tilting is about the camera's horizontal axis (e.g. the positive X
-- axis for 'fpsCamera').
tilt :: (Epsilon a, RealFloat a) => a -> Camera a -> Camera a
tilt :: a -> Camera a -> Camera a
tilt = a -> Camera a -> Camera a
forall a. (Epsilon a, RealFloat a) => a -> Camera a -> Camera a
tiltRad (a -> Camera a -> Camera a)
-> (a -> a) -> a -> Camera a -> Camera a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> a
forall a. RealFloat a => a -> a
deg2rad

-- | Tilt a camera view (up-and-down) by an angle given in
-- radians. Tilting is about the world's horizontal axis as captured by
-- the initial camera state (e.g. the positive X axis for 'fpsCamera').
tiltGlobalRad :: (Epsilon a, RealFloat a) => a -> Camera a -> Camera a
tiltGlobalRad :: a -> Camera a -> Camera a
tiltGlobalRad theta :: a
theta c :: Camera a
c = Camera a
c { orientation :: Quaternion a
orientation = Quaternion a
r Quaternion a -> Quaternion a -> Quaternion a
forall a. Num a => a -> a -> a
* Camera a -> Quaternion a
forall a. Camera a -> Quaternion a
orientation Camera a
c }
  where r :: Quaternion a
r = V3 a -> a -> Quaternion a
forall a. (Epsilon a, Floating a) => V3 a -> a -> Quaternion a
axisAngle (Camera a -> V3 a
forall a. Camera a -> V3 a
rightward Camera a
c) a
theta

-- | Tilt a camera view (up-and-down) by an angle given in degrees.
-- Tilting is about the world's horizontal axis as captured by the
-- initial camera state (e.g. the positive X axis for 'fpsCamera').
tiltGlobal :: (Epsilon a, RealFloat a) => a -> Camera a -> Camera a
tiltGlobal :: a -> Camera a -> Camera a
tiltGlobal = a -> Camera a -> Camera a
forall a. (Epsilon a, RealFloat a) => a -> Camera a -> Camera a
tiltGlobalRad (a -> Camera a -> Camera a)
-> (a -> a) -> a -> Camera a -> Camera a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> a
forall a. RealFloat a => a -> a
deg2rad

-- | Roll a camera view about its view direction by an angle given in
-- radians. Rolling is about the camera's forward axis (e.g. the
-- negative Z axis for 'fpsCamera').
rollRad :: (Epsilon a, RealFloat a) => a -> Camera a -> Camera a
rollRad :: a -> Camera a -> Camera a
rollRad theta :: a
theta c :: Camera a
c = Camera a
c { orientation :: Quaternion a
orientation = Camera a -> Quaternion a
forall a. Camera a -> Quaternion a
orientation Camera a
c Quaternion a -> Quaternion a -> Quaternion a
forall a. Num a => a -> a -> a
* Quaternion a
r }
  where r :: Quaternion a
r = V3 a -> a -> Quaternion a
forall a. (Epsilon a, Floating a) => V3 a -> a -> Quaternion a
axisAngle (Camera a -> V3 a
forall a. Camera a -> V3 a
forward Camera a
c) a
theta

-- | Roll a camera view about its view direction by an angle given in
-- degrees. Rolling is about the camera's forward axis (e.g. the
-- negative Z axis for 'fpsCamera').
roll :: (Epsilon a, RealFloat a) => a -> Camera a -> Camera a
roll :: a -> Camera a -> Camera a
roll = a -> Camera a -> Camera a
forall a. (Epsilon a, RealFloat a) => a -> Camera a -> Camera a
rollRad (a -> Camera a -> Camera a)
-> (a -> a) -> a -> Camera a -> Camera a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> a
forall a. RealFloat a => a -> a
deg2rad

-- | Roll a camera view about its view direction by an angle given in
-- radians. Rolling is about the world's forward axis as captured by
-- the initial camera state (e.g. the negative Z axis for 'fpsCamera').
rollGlobalRad :: (Epsilon a, RealFloat a) => a -> Camera a -> Camera a
rollGlobalRad :: a -> Camera a -> Camera a
rollGlobalRad theta :: a
theta c :: Camera a
c = Camera a
c { orientation :: Quaternion a
orientation = Quaternion a
r Quaternion a -> Quaternion a -> Quaternion a
forall a. Num a => a -> a -> a
* Camera a -> Quaternion a
forall a. Camera a -> Quaternion a
orientation Camera a
c }
  where r :: Quaternion a
r = V3 a -> a -> Quaternion a
forall a. (Epsilon a, Floating a) => V3 a -> a -> Quaternion a
axisAngle (Camera a -> V3 a
forall a. Camera a -> V3 a
forward Camera a
c) a
theta

-- | Roll a camera view about its view direction by an angle given in
-- degrees. Rolling is about the world's forward axis as captured by the
-- initial camera state (e.g. the negative Z axis for 'fpsCamera').
rollGlobal :: (Epsilon a, RealFloat a) => a -> Camera a -> Camera a
rollGlobal :: a -> Camera a -> Camera a
rollGlobal = a -> Camera a -> Camera a
forall a. (Epsilon a, RealFloat a) => a -> Camera a -> Camera a
rollGlobalRad (a -> Camera a -> Camera a)
-> (a -> a) -> a -> Camera a -> Camera a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> a
forall a. RealFloat a => a -> a
deg2rad

-- | Translate a camera's position by the given vector.
dolly :: (Conjugate a, Epsilon a, RealFloat a) => V3 a -> Camera a -> Camera a
dolly :: V3 a -> Camera a -> Camera a
dolly t :: V3 a
t c :: Camera a
c = Camera a
c { location :: V3 a
location = Camera a -> V3 a
forall a. Camera a -> V3 a
location Camera a
c V3 a -> V3 a -> V3 a
forall a. Num a => a -> a -> a
+ V3 a
t' }
  where t' :: V3 a
t' = Camera a -> Quaternion a
forall a. Camera a -> Quaternion a
orientation Camera a
c Quaternion a -> V3 a -> V3 a
forall a.
(Conjugate a, RealFloat a) =>
Quaternion a -> V3 a -> V3 a
`rotate` V3 a
t

-- | Convert degrees to radians.
deg2rad :: RealFloat a => a -> a
deg2rad :: a -> a
deg2rad x :: a
x = a
x a -> a -> a
forall a. Num a => a -> a -> a
* a
forall a. Floating a => a
pi a -> a -> a
forall a. Fractional a => a -> a -> a
/ 180

-- | A camera at the origin with its up-axis coincident with the
-- positive Z axis. This is the convention used by the ROS robotics
-- platform.
rosCamera :: (Epsilon a, RealFloat a) => Camera a
rosCamera :: Camera a
rosCamera = V3 a -> V3 a -> V3 a -> Quaternion a -> V3 a -> Camera a
forall a. V3 a -> V3 a -> V3 a -> Quaternion a -> V3 a -> Camera a
Camera (a -> a -> a -> V3 a
forall a. a -> a -> a -> V3 a
V3 1 0 0) (a -> a -> a -> V3 a
forall a. a -> a -> a -> V3 a
V3 0 0 1) (a -> a -> a -> V3 a
forall a. a -> a -> a -> V3 a
V3 0 1 0) 1 0

-- | A camera at the origin with its up-axis coincident with the
-- positive Y axis. This is the convention used by "first-person
-- shooter" (fps) video games.
fpsCamera :: (Epsilon a, RealFloat a) => Camera a
fpsCamera :: Camera a
fpsCamera = V3 a -> V3 a -> V3 a -> Quaternion a -> V3 a -> Camera a
forall a. V3 a -> V3 a -> V3 a -> Quaternion a -> V3 a -> Camera a
Camera (a -> a -> a -> V3 a
forall a. a -> a -> a -> V3 a
V3 0 0 (-1)) (a -> a -> a -> V3 a
forall a. a -> a -> a -> V3 a
V3 0 1 0) (a -> a -> a -> V3 a
forall a. a -> a -> a -> V3 a
V3 1 0 0) 1 0

-- | @projectionMatrix fov aspect near far@ produces a perspective
-- projection matrix with the specified vertical field of view (FOV),
-- given in radians, aspect ratio, and near and far clipping planes.
projectionMatrix :: (Conjugate a, Epsilon a, RealFloat a)
                 => a -> a -> a -> a -> M44 a
projectionMatrix :: a -> a -> a -> a -> M44 a
projectionMatrix fovy :: a
fovy aspect :: a
aspect near :: a
near far :: 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
focal a -> a -> a
forall a. Fractional a => a -> a -> a
/ a
aspect) 0 0 0)
     (a -> a -> a -> a -> V4 a
forall a. a -> a -> a -> a -> V4 a
V4 0 a
focal 0 0)
     (a -> a -> a -> a -> V4 a
forall a. a -> a -> a -> a -> V4 a
V4 0 0 ((a
fara -> a -> a
forall a. Num a => a -> a -> a
+a
near) a -> a -> a
forall a. Fractional a => a -> a -> a
/ (a
near a -> a -> a
forall a. Num a => a -> a -> a
- a
far)) ((2a -> a -> a
forall a. Num a => a -> a -> a
*a
fara -> a -> a
forall a. Num a => a -> a -> a
*a
near) a -> a -> a
forall a. Fractional a => a -> a -> a
/ (a
near a -> a -> a
forall a. Num a => a -> a -> a
- a
far)))
     (a -> a -> a -> a -> V4 a
forall a. a -> a -> a -> a -> V4 a
V4 0 0 (-1) 0)
  where focal :: a
focal = 1 a -> a -> a
forall a. Fractional a => a -> a -> a
/ a -> a
forall a. Floating a => a -> a
tan (a
fovy a -> a -> a
forall a. Num a => a -> a -> a
* 0.5)

-- | @orthoMatrix left right top bottom near far@ produces a parallel
-- projection matrix with the specified left, right, top, bottom, near and
-- far clipping planes.
orthoMatrix :: (Num a, Fractional a) => a -> a -> a -> a -> a -> a -> M44 a
orthoMatrix :: a -> a -> a -> a -> a -> a -> M44 a
orthoMatrix left :: a
left right :: a
right top :: a
top bottom :: a
bottom near :: a
near far :: 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 (2a -> a -> a
forall a. Fractional a => a -> a -> a
/(a
righta -> a -> a
forall a. Num a => a -> a -> a
-a
left)) 0 0 (-(a
righta -> a -> a
forall a. Num a => a -> a -> a
+a
left)a -> a -> a
forall a. Fractional a => a -> a -> a
/(a
righta -> a -> a
forall a. Num a => a -> a -> a
-a
left)) )
       (a -> a -> a -> a -> V4 a
forall a. a -> a -> a -> a -> V4 a
V4 0 (2a -> a -> a
forall a. Fractional a => a -> a -> a
/(a
topa -> a -> a
forall a. Num a => a -> a -> a
-a
bottom)) 0 (-(a
topa -> a -> a
forall a. Num a => a -> a -> a
+a
bottom)a -> a -> a
forall a. Fractional a => a -> a -> a
/(a
topa -> a -> a
forall a. Num a => a -> a -> a
-a
bottom)) )
       (a -> a -> a -> a -> V4 a
forall a. a -> a -> a -> a -> V4 a
V4 0 0 (-2a -> a -> a
forall a. Fractional a => a -> a -> a
/(a
fara -> a -> a
forall a. Num a => a -> a -> a
-a
near)) (-(a
fara -> a -> a
forall a. Num a => a -> a -> a
+a
near)a -> a -> a
forall a. Fractional a => a -> a -> a
/(a
fara -> a -> a
forall a. Num a => a -> a -> a
-a
near)) )
       (a -> a -> a -> a -> V4 a
forall a. a -> a -> a -> a -> V4 a
V4 0 0 0 1)

-- | Produce a transformation matrix from a 'Camera'. This matrix
-- transforms homogenous points into the camera's coordinate frame.
camMatrix :: (Conjugate a, Epsilon a, RealFloat a) => Camera a -> M44 a
camMatrix :: Camera a -> M44 a
camMatrix c :: Camera a
c = Quaternion a -> V3 a -> M44 a
forall a. Num a => Quaternion a -> V3 a -> M44 a
mkTransformation Quaternion a
q (Quaternion a -> V3 a -> V3 a
forall a.
(Conjugate a, RealFloat a) =>
Quaternion a -> V3 a -> V3 a
rotate Quaternion a
q (V3 a -> V3 a) -> (Camera a -> V3 a) -> Camera a -> V3 a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. V3 a -> V3 a
forall a. Num a => a -> a
negate (V3 a -> V3 a) -> (Camera a -> V3 a) -> Camera a -> V3 a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Camera a -> V3 a
forall a. Camera a -> V3 a
location (Camera a -> V3 a) -> Camera a -> V3 a
forall a b. (a -> b) -> a -> b
$ Camera a
c)
  where q :: Quaternion a
q = Quaternion a -> Quaternion a
forall a. Conjugate a => a -> a
conjugate (Quaternion a -> Quaternion a) -> Quaternion a -> Quaternion a
forall a b. (a -> b) -> a -> b
$ Camera a -> Quaternion a
forall a. Camera a -> Quaternion a
orientation Camera a
c

{-
-- | A lens for the fourth column of a matrix.
translation' :: (R3 t, R4 v, Functor f)
            => (V3 a -> f (V3 a)) -> t (v a) -> f (t (v a))
translation' f m = fmap (\(V3 x y z) -> m & _x._w .~ x & _y._w .~ y & _z._w .~ z)
                        (f (fmap (^. _w) (m ^. _xyz)))
-}