{-# LANGUAGE BlockArguments #-}

module Geomancy.Vulkan.View
  ( orthoFitScreen
  , lookAt
  ) where

import Geomancy.Mat4 (Mat4, rowMajor)
import Geomancy.Vec3 (Vec3, withVec3)
import Geomancy.Transform (Transform(..))

import qualified Geomancy.Vec3 as Vec3

lookAt :: Vec3 -> Vec3 -> Vec3 -> Transform
lookAt :: Vec3 -> Vec3 -> Vec3 -> Transform
lookAt Vec3
eye Vec3
center Vec3
up =
  forall r. Vec3 -> (Float -> Float -> Float -> r) -> r
withVec3 Vec3
xa \Float
xaX Float
xaY Float
xaZ ->
  forall r. Vec3 -> (Float -> Float -> Float -> r) -> r
withVec3 Vec3
ya \Float
yaX Float
yaY Float
yaZ ->
  forall r. Vec3 -> (Float -> Float -> Float -> r) -> r
withVec3 Vec3
za \Float
zaX Float
zaY Float
zaZ ->
  forall a.
Coercible Mat4 a =>
Float
-> Float
-> Float
-> Float
-> Float
-> Float
-> Float
-> Float
-> Float
-> Float
-> Float
-> Float
-> Float
-> Float
-> Float
-> Float
-> a
rowMajor
    Float
xaX Float
yaX (-Float
zaX) Float
0
    Float
xaY Float
yaY (-Float
zaY) Float
0
    Float
xaZ Float
yaZ (-Float
zaZ) Float
0
    Float
xd  Float
yd    Float
zd   Float
1
  where
    xa :: Vec3
xa = Vec3 -> Vec3
Vec3.normalize forall a b. (a -> b) -> a -> b
$ Vec3 -> Vec3 -> Vec3
Vec3.cross Vec3
za Vec3
up
    ya :: Vec3
ya = Vec3 -> Vec3 -> Vec3
Vec3.cross Vec3
xa Vec3
za
    za :: Vec3
za = Vec3 -> Vec3
Vec3.normalize forall a b. (a -> b) -> a -> b
$ Vec3
center forall a. Num a => a -> a -> a
- Vec3
eye

    xd :: Float
xd = - Vec3 -> Vec3 -> Float
Vec3.dot Vec3
xa Vec3
eye
    yd :: Float
yd = - Vec3 -> Vec3 -> Float
Vec3.dot Vec3
ya Vec3
eye
    zd :: Float
zd =   Vec3 -> Vec3 -> Float
Vec3.dot Vec3
za Vec3
eye

orthoFitScreen :: Float -> Float -> Float -> Float -> Mat4
orthoFitScreen :: Float -> Float -> Float -> Float -> Mat4
orthoFitScreen Float
screenWidth Float
screenHeight Float
targetWidth Float
targetHeight =
  forall a.
Coercible Mat4 a =>
Float
-> Float
-> Float
-> Float
-> Float
-> Float
-> Float
-> Float
-> Float
-> Float
-> Float
-> Float
-> Float
-> Float
-> Float
-> Float
-> a
rowMajor
    Float
s Float
0 Float
0 Float
0
    Float
0 Float
s Float
0 Float
0
    Float
0 Float
0 Float
1 Float
0
    Float
0 Float
0 Float
0 Float
1
  where
    s :: Float
s = forall a. Ord a => a -> a -> a
min (Float
screenWidth forall a. Fractional a => a -> a -> a
/ Float
targetWidth) (Float
screenHeight forall a. Fractional a => a -> a -> a
/ Float
targetHeight)