{-# LANGUAGE BlockArguments #-}

module Geomancy.Vulkan.View
  ( lookAtRH
  , lookAtRH_
  ) where

import Geomancy.Mat4 (colMajor)
import Geomancy.Transform (Transform(..))
import Geomancy.Vec3 (Vec3, cross, dot, normalize, vec3, withVec3)

{- | Construct a right-handed world-to-view transformation.

This will rotate and translate the world around a static camera.
This would produce an identity when looking from @vec3 0 0 0@ to @vec3 0 0 1@ using (-Y up).

The fallback "up" should be used when you're looking close to your UP in either direction.
-}
lookAtRH
  :: Vec3 -- ^ Eye position
  -> Vec3 -- ^ Target
  -> Vec3 -- ^ Up direction
  -> Transform
lookAtRH :: Vec3 -> Vec3 -> Vec3 -> Transform
lookAtRH Vec3
eye Vec3
target Vec3
up =
  Vec3 -> (Float -> Float -> Float -> Transform) -> Transform
forall r. Vec3 -> (Float -> Float -> Float -> r) -> r
withVec3 Vec3
rgt \Float
rx Float
ry Float
rz ->
  Vec3 -> (Float -> Float -> Float -> Transform) -> Transform
forall r. Vec3 -> (Float -> Float -> Float -> r) -> r
withVec3 Vec3
up' \Float
ux Float
uy Float
uz ->
  Vec3 -> (Float -> Float -> Float -> Transform) -> Transform
forall r. Vec3 -> (Float -> Float -> Float -> r) -> r
withVec3 Vec3
fwd \Float
fx Float
fy Float
fz ->
  Float
-> Float
-> Float
-> Float
-> Float
-> Float
-> Float
-> Float
-> Float
-> Float
-> Float
-> Float
-> Float
-> Float
-> Float
-> Float
-> Transform
forall a.
Coercible Mat4 a =>
Float
-> Float
-> Float
-> Float
-> Float
-> Float
-> Float
-> Float
-> Float
-> Float
-> Float
-> Float
-> Float
-> Float
-> Float
-> Float
-> a
colMajor
    Float
rx Float
ry Float
rz (-Float
er)
    Float
ux Float
uy Float
uz (-Float
eu)
    Float
fx Float
fy Float
fz (-Float
ef)
     Float
0  Float
0  Float
0    Float
1
  where
    fwd :: Vec3
fwd = Vec3 -> Vec3
normalize (Vec3
target Vec3 -> Vec3 -> Vec3
forall a. Num a => a -> a -> a
- Vec3
eye)
    rgt :: Vec3
rgt = Vec3 -> Vec3
normalize (Vec3 -> Vec3 -> Vec3
cross Vec3
fwd Vec3
up)
    up' :: Vec3
up' = Vec3 -> Vec3
normalize (Vec3 -> Vec3 -> Vec3
cross Vec3
fwd Vec3
rgt)
    er :: Float
er = Vec3 -> Vec3 -> Float
dot Vec3
eye Vec3
rgt
    eu :: Float
eu = Vec3 -> Vec3 -> Float
dot Vec3
eye Vec3
up'
    ef :: Float
ef = Vec3 -> Vec3 -> Float
dot Vec3
eye Vec3
fwd

{- | A shortcut for using the -Y as the up axis.

Looking forward from the origin does nothing.
-}
{-# INLINE lookAtRH_ #-}
lookAtRH_ :: Vec3 -> Vec3 -> Transform
lookAtRH_ :: Vec3 -> Vec3 -> Transform
lookAtRH_ Vec3
eye Vec3
target = Vec3 -> Vec3 -> Vec3 -> Transform
lookAtRH Vec3
eye Vec3
target Vec3
yNeg
  where
    yNeg :: Vec3
yNeg = Float -> Float -> Float -> Vec3
vec3 Float
0 (-Float
1) Float
0