packages feed

geomancy-0.4.0.0: test/Support/Reference/Vulkan.hs

{-# LANGUAGE ImportQualifiedPost #-}

module Support.Reference.Vulkan
  ( reverseDepthRH
  , orthoRH
  , lookAtRH
  , lookAtRH_
  ) where

import Linear (M44, V3(..))
import Linear.Epsilon (Epsilon)

import Support.Reference.Mat4 (colMajor)
import Support.Reference.Vec3 (cross, dot, normalize)

reverseDepthRH :: Floating a => a -> a -> a -> a -> M44 a
reverseDepthRH fovRads zn width height =
  colMajor
    sx  0 0  0
    0  sy 0  0
    0   0 0 zn
    0   0 1  0
  where
    sx = sy * recipAspect
      where
        recipAspect = height / width
    sy = 1 / tan (fovRads / 2)

orthoRH :: Fractional a => a -> a -> a -> a -> M44 a
orthoRH near far width height =
  colMajor
    sx 0 0 0
    0 sy 0 0
    0  0 z w
    0  0 0 1
  where
    sx = 2 / width
    sy = 2 / height
    z = 1 / (far - near)
    w = near / (near - far)

lookAtRH :: (Floating a, Epsilon a) => V3 a -> V3 a -> V3 a -> M44 a
lookAtRH eye target up =
  colMajor
    rx ry rz (-er)
    ux uy uz (-eu)
    fx fy fz (-ef)
     0  0  0    1
  where
    fwd@(V3 fx fy fz) = normalize (target - eye)
    rgt@(V3 rx ry rz) = normalize (cross fwd up)
    up'@(V3 ux uy uz) = normalize (cross fwd rgt)
    er = dot eye rgt
    eu = dot eye up'
    ef = dot eye fwd

lookAtRH_ :: (Floating a, Epsilon a) => V3 a -> V3 a -> M44 a
lookAtRH_ eye target = lookAtRH eye target (V3 0 (-1) 0)