{-# LANGUAGE BlockArguments #-}

-- | Specialized and inlined @Quaternion Float@.

module Geomancy.Quaternion
  ( Quaternion
  , quaternion
  , withQuaternion

  , axisAngle
  , rotate
  , rotatePoint
  , rotationBetween
  , lookAtUp

  , (^*)
  , (^/)
  , slerp

  , conjugate
  , norm
  , quadrance
  , dot
  , normalize
  , qNaN
  ) where

import Control.DeepSeq (NFData(rnf))
import Foreign (Storable(..), castPtr)

import Geomancy.Vec3 (Vec3, vec3, withVec3)

import qualified Geomancy.Vec3 as Vec3

data Quaternion = Quaternion
  {-# UNPACK #-} !Float
  {-# UNPACK #-} !Float
  {-# UNPACK #-} !Float
  {-# UNPACK #-} !Float
  deriving (Quaternion -> Quaternion -> Bool
(Quaternion -> Quaternion -> Bool)
-> (Quaternion -> Quaternion -> Bool) -> Eq Quaternion
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Quaternion -> Quaternion -> Bool
$c/= :: Quaternion -> Quaternion -> Bool
== :: Quaternion -> Quaternion -> Bool
$c== :: Quaternion -> Quaternion -> Bool
Eq, Eq Quaternion
Eq Quaternion
-> (Quaternion -> Quaternion -> Ordering)
-> (Quaternion -> Quaternion -> Bool)
-> (Quaternion -> Quaternion -> Bool)
-> (Quaternion -> Quaternion -> Bool)
-> (Quaternion -> Quaternion -> Bool)
-> (Quaternion -> Quaternion -> Quaternion)
-> (Quaternion -> Quaternion -> Quaternion)
-> Ord Quaternion
Quaternion -> Quaternion -> Bool
Quaternion -> Quaternion -> Ordering
Quaternion -> Quaternion -> Quaternion
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: Quaternion -> Quaternion -> Quaternion
$cmin :: Quaternion -> Quaternion -> Quaternion
max :: Quaternion -> Quaternion -> Quaternion
$cmax :: Quaternion -> Quaternion -> Quaternion
>= :: Quaternion -> Quaternion -> Bool
$c>= :: Quaternion -> Quaternion -> Bool
> :: Quaternion -> Quaternion -> Bool
$c> :: Quaternion -> Quaternion -> Bool
<= :: Quaternion -> Quaternion -> Bool
$c<= :: Quaternion -> Quaternion -> Bool
< :: Quaternion -> Quaternion -> Bool
$c< :: Quaternion -> Quaternion -> Bool
compare :: Quaternion -> Quaternion -> Ordering
$ccompare :: Quaternion -> Quaternion -> Ordering
$cp1Ord :: Eq Quaternion
Ord, Int -> Quaternion -> ShowS
[Quaternion] -> ShowS
Quaternion -> String
(Int -> Quaternion -> ShowS)
-> (Quaternion -> String)
-> ([Quaternion] -> ShowS)
-> Show Quaternion
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Quaternion] -> ShowS
$cshowList :: [Quaternion] -> ShowS
show :: Quaternion -> String
$cshow :: Quaternion -> String
showsPrec :: Int -> Quaternion -> ShowS
$cshowsPrec :: Int -> Quaternion -> ShowS
Show)

{-# INLINE quaternion #-}
quaternion :: Float -> Float -> Float -> Float -> Quaternion
quaternion :: Float -> Float -> Float -> Float -> Quaternion
quaternion = Float -> Float -> Float -> Float -> Quaternion
Quaternion

{-# INLINE withQuaternion #-}
withQuaternion
  :: Quaternion
  -> (Float -> Float -> Float -> Float -> r)
  -> r
withQuaternion :: Quaternion -> (Float -> Float -> Float -> Float -> r) -> r
withQuaternion (Quaternion Float
a Float
b Float
c Float
d) Float -> Float -> Float -> Float -> r
f = Float -> Float -> Float -> Float -> r
f Float
a Float
b Float
c Float
d

{-# INLINE (^*) #-}
(^*) :: Quaternion -> Float -> Quaternion
Quaternion Float
a Float
b Float
c Float
d ^* :: Quaternion -> Float -> Quaternion
^* Float
x =
  Float -> Float -> Float -> Float -> Quaternion
Quaternion
    (Float
a Float -> Float -> Float
forall a. Num a => a -> a -> a
* Float
x)
    (Float
b Float -> Float -> Float
forall a. Num a => a -> a -> a
* Float
x)
    (Float
c Float -> Float -> Float
forall a. Num a => a -> a -> a
* Float
x)
    (Float
d Float -> Float -> Float
forall a. Num a => a -> a -> a
* Float
x)

{-# INLINE (^/) #-}
(^/) :: Quaternion -> Float -> Quaternion
Quaternion Float
a Float
b Float
c Float
d ^/ :: Quaternion -> Float -> Quaternion
^/ Float
x =
  Float -> Float -> Float -> Float -> Quaternion
Quaternion
    (Float
a Float -> Float -> Float
forall a. Fractional a => a -> a -> a
/ Float
x)
    (Float
b Float -> Float -> Float
forall a. Fractional a => a -> a -> a
/ Float
x)
    (Float
c Float -> Float -> Float
forall a. Fractional a => a -> a -> a
/ Float
x)
    (Float
d Float -> Float -> Float
forall a. Fractional a => a -> a -> a
/ Float
x)

slerp :: Quaternion -> Quaternion -> Float -> Quaternion
slerp :: Quaternion -> Quaternion -> Float -> Quaternion
slerp Quaternion
q Quaternion
p Float
t
  | Float
1.0 Float -> Float -> Float
forall a. Num a => a -> a -> a
- Float
cosphi Float -> Float -> Bool
forall a. Ord a => a -> a -> Bool
< Float
1e-8 =
      Quaternion
q
  | Bool
otherwise =
      ( (Quaternion
q   Quaternion -> Float -> Quaternion
^* Float -> Float
forall a. Floating a => a -> a
sin ((Float
1 Float -> Float -> Float
forall a. Num a => a -> a -> a
- Float
t) Float -> Float -> Float
forall a. Num a => a -> a -> a
* Float
phi)) Quaternion -> Quaternion -> Quaternion
forall a. Num a => a -> a -> a
+
         Quaternion -> Quaternion
f Quaternion
p Quaternion -> Float -> Quaternion
^* Float -> Float
forall a. Floating a => a -> a
sin (Float
t Float -> Float -> Float
forall a. Num a => a -> a -> a
* Float
phi)
      ) Quaternion -> Float -> Quaternion
^/ Float -> Float
forall a. Floating a => a -> a
sin Float
phi
  where
    phi :: Float
phi = Float -> Float
forall a. Floating a => a -> a
acos Float
cosphi

    (Float
cosphi, Quaternion -> Quaternion
f) =
      if Float
dqp Float -> Float -> Bool
forall a. Ord a => a -> a -> Bool
< Float
0 then
        (-Float
dqp, Quaternion -> Quaternion
forall a. Num a => a -> a
negate)
      else
        (Float
dqp, Quaternion -> Quaternion
forall a. a -> a
id)

    dqp :: Float
dqp = Quaternion -> Quaternion -> Float
dot Quaternion
q Quaternion
p

{-# INLINE conjugate #-}
conjugate :: Quaternion -> Quaternion
conjugate :: Quaternion -> Quaternion
conjugate (Quaternion Float
e Float
x Float
y Float
z) = Float -> Float -> Float -> Float -> Quaternion
Quaternion Float
e (-Float
x) (-Float
y) (-Float
z)

{-# INLINE norm #-}
norm :: Quaternion -> Float
norm :: Quaternion -> Float
norm = Float -> Float
forall a. Floating a => a -> a
sqrt (Float -> Float) -> (Quaternion -> Float) -> Quaternion -> Float
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Quaternion -> Float
quadrance

{-# INLINE quadrance #-}
quadrance :: Quaternion -> Float
quadrance :: Quaternion -> Float
quadrance Quaternion
q = Quaternion -> Quaternion -> Float
dot Quaternion
q Quaternion
q

{-# INLINE dot #-}
dot :: Quaternion -> Quaternion -> Float
dot :: Quaternion -> Quaternion -> Float
dot (Quaternion Float
a Float
b Float
c Float
d) (Quaternion Float
e Float
f Float
g Float
h) =
  Float
a Float -> Float -> Float
forall a. Num a => a -> a -> a
* Float
e Float -> Float -> Float
forall a. Num a => a -> a -> a
+
  Float
b Float -> Float -> Float
forall a. Num a => a -> a -> a
* Float
f Float -> Float -> Float
forall a. Num a => a -> a -> a
+
  Float
c Float -> Float -> Float
forall a. Num a => a -> a -> a
* Float
g Float -> Float -> Float
forall a. Num a => a -> a -> a
+
  Float
d Float -> Float -> Float
forall a. Num a => a -> a -> a
* Float
h -- XXX: SIMD time!

{-# INLINE normalize #-}
normalize :: Quaternion -> Quaternion
normalize :: Quaternion -> Quaternion
normalize Quaternion
v =
  if Float -> Bool
forall a. (Ord a, Fractional a) => a -> Bool
nearZero Float
q Bool -> Bool -> Bool
|| Float -> Bool
forall a. (Ord a, Fractional a) => a -> Bool
nearZero (Float
1Float -> Float -> Float
forall a. Num a => a -> a -> a
-Float
q) then
    Quaternion
v
  else
    let
      Quaternion Float
e Float
i Float
j Float
k = Quaternion
v
    in
      Float -> Float -> Float -> Float -> Quaternion
Quaternion (Float
e Float -> Float -> Float
forall a. Fractional a => a -> a -> a
/ Float
l) (Float
i Float -> Float -> Float
forall a. Fractional a => a -> a -> a
/ Float
l) (Float
j Float -> Float -> Float
forall a. Fractional a => a -> a -> a
/ Float
l) (Float
k Float -> Float -> Float
forall a. Fractional a => a -> a -> a
/ Float
l)

  where
    q :: Float
q = Quaternion -> Quaternion -> Float
dot Quaternion
v Quaternion
v
    l :: Float
l = Float -> Float
forall a. Floating a => a -> a
sqrt Float
q

    nearZero :: a -> Bool
nearZero a
a = a -> a
forall a. Num a => a -> a
abs a
a a -> a -> Bool
forall a. Ord a => a -> a -> Bool
<= a
1e-6

instance NFData Quaternion where
  rnf :: Quaternion -> ()
rnf Quaternion{} = ()

instance Num Quaternion where
  {-# INLINE (+) #-}
  Quaternion Float
a Float
b Float
c Float
d + :: Quaternion -> Quaternion -> Quaternion
+ Quaternion Float
e Float
f Float
g Float
h =
    Float -> Float -> Float -> Float -> Quaternion
Quaternion
      (Float
a Float -> Float -> Float
forall a. Num a => a -> a -> a
+ Float
e)
      (Float
b Float -> Float -> Float
forall a. Num a => a -> a -> a
+ Float
f)
      (Float
c Float -> Float -> Float
forall a. Num a => a -> a -> a
+ Float
g)
      (Float
d Float -> Float -> Float
forall a. Num a => a -> a -> a
+ Float
h)

  {-# INLINE (-) #-}
  Quaternion Float
a Float
b Float
c Float
d - :: Quaternion -> Quaternion -> Quaternion
- Quaternion Float
e Float
f Float
g Float
h =
    Float -> Float -> Float -> Float -> Quaternion
Quaternion
      (Float
a Float -> Float -> Float
forall a. Num a => a -> a -> a
- Float
e)
      (Float
b Float -> Float -> Float
forall a. Num a => a -> a -> a
- Float
f)
      (Float
c Float -> Float -> Float
forall a. Num a => a -> a -> a
- Float
g)
      (Float
d Float -> Float -> Float
forall a. Num a => a -> a -> a
- Float
h)

  {-# INLINE (*) #-}
  Quaternion Float
a Float
b Float
c Float
d * :: Quaternion -> Quaternion -> Quaternion
* Quaternion Float
e Float
f Float
g Float
h =
    Vec3 -> (Float -> Float -> Float -> Quaternion) -> Quaternion
forall r. Vec3 -> (Float -> Float -> Float -> r) -> r
withVec3 Vec3
v \Float
y Float
z Float
w ->
      Float -> Float -> Float -> Float -> Quaternion
Quaternion Float
x Float
y Float
z Float
w
    where
      x :: Float
x = Float
a Float -> Float -> Float
forall a. Num a => a -> a -> a
* Float
e Float -> Float -> Float
forall a. Num a => a -> a -> a
- Vec3 -> Vec3 -> Float
Vec3.dot Vec3
v1 Vec3
v2
      v :: Vec3
v = Vec3 -> Vec3 -> Vec3
Vec3.cross Vec3
v1 Vec3
v2 Vec3 -> Vec3 -> Vec3
forall a. Num a => a -> a -> a
+ Vec3
v2 Vec3 -> Float -> Vec3
Vec3.^* Float
a Vec3 -> Vec3 -> Vec3
forall a. Num a => a -> a -> a
+ Vec3
v1 Vec3 -> Float -> Vec3
Vec3.^* Float
e
      v1 :: Vec3
v1 = Float -> Float -> Float -> Vec3
vec3 Float
b Float
c Float
d
      v2 :: Vec3
v2 = Float -> Float -> Float -> Vec3
vec3 Float
f Float
g Float
h

  {-# INLINE fromInteger #-}
  fromInteger :: Integer -> Quaternion
fromInteger Integer
x = Float -> Float -> Float -> Float -> Quaternion
Quaternion (Integer -> Float
forall a. Num a => Integer -> a
fromInteger Integer
x) Float
0 Float
0 Float
0

  {-# INLINE abs #-}
  abs :: Quaternion -> Quaternion
abs Quaternion
z = Float -> Float -> Float -> Float -> Quaternion
Quaternion (Quaternion -> Float
norm Quaternion
z) Float
0 Float
0 Float
0

  {-# INLINE signum #-}
  signum :: Quaternion -> Quaternion
signum q :: Quaternion
q@(Quaternion Float
e Float
i Float
j Float
k)
    | Float
m Float -> Float -> Bool
forall a. Eq a => a -> a -> Bool
== Float
0 =
        Quaternion
q
    | Bool -> Bool
not (Float -> Bool
forall a. RealFloat a => a -> Bool
isInfinite Float
m Bool -> Bool -> Bool
|| Float -> Bool
forall a. RealFloat a => a -> Bool
isNaN Float
m) =
        Float -> Float -> Float -> Float -> Quaternion
Quaternion (Float
e Float -> Float -> Float
forall a. Num a => a -> a -> a
* Float
misqrt) (Float
i Float -> Float -> Float
forall a. Num a => a -> a -> a
* Float
misqrt) (Float
j Float -> Float -> Float
forall a. Num a => a -> a -> a
* Float
misqrt) (Float
k Float -> Float -> Float
forall a. Num a => a -> a -> a
* Float
misqrt)
    | (Float -> Bool) -> [Float] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any Float -> Bool
forall a. RealFloat a => a -> Bool
isNaN [Float
e, Float
i, Float
j, Float
k] = Quaternion
qNaN
    | Bool -> Bool
not (Bool
ii Bool -> Bool -> Bool
|| Bool
ij Bool -> Bool -> Bool
|| Bool
ik) = Float -> Float -> Float -> Float -> Quaternion
Quaternion Float
1 Float
0 Float
0 Float
0
    | Bool -> Bool
not (Bool
ie Bool -> Bool -> Bool
|| Bool
ij Bool -> Bool -> Bool
|| Bool
ik) = Float -> Float -> Float -> Float -> Quaternion
Quaternion Float
0 Float
1 Float
0 Float
0
    | Bool -> Bool
not (Bool
ie Bool -> Bool -> Bool
|| Bool
ii Bool -> Bool -> Bool
|| Bool
ik) = Float -> Float -> Float -> Float -> Quaternion
Quaternion Float
0 Float
0 Float
1 Float
0
    | Bool -> Bool
not (Bool
ie Bool -> Bool -> Bool
|| Bool
ii Bool -> Bool -> Bool
|| Bool
ij) = Float -> Float -> Float -> Float -> Quaternion
Quaternion Float
0 Float
0 Float
0 Float
1
    | Bool
otherwise = Quaternion
qNaN
    where
      m :: Float
m = Quaternion -> Float
quadrance Quaternion
q
      misqrt :: Float
misqrt = Float -> Float
forall a. Fractional a => a -> a
recip (Float -> Float
forall a. Floating a => a -> a
sqrt Float
m)

      ie :: Bool
ie = Float -> Bool
forall a. RealFloat a => a -> Bool
isInfinite Float
e
      ii :: Bool
ii = Float -> Bool
forall a. RealFloat a => a -> Bool
isInfinite Float
i
      ij :: Bool
ij = Float -> Bool
forall a. RealFloat a => a -> Bool
isInfinite Float
j
      ik :: Bool
ik = Float -> Bool
forall a. RealFloat a => a -> Bool
isInfinite Float
k

{-# INLINE qNaN #-}
qNaN :: Quaternion
qNaN :: Quaternion
qNaN = Float -> Float -> Float -> Float -> Quaternion
Quaternion Float
fNaN Float
fNaN Float
fNaN Float
fNaN
  where
    fNaN :: Float
fNaN = Float
0Float -> Float -> Float
forall a. Fractional a => a -> a -> a
/Float
0

-- XXX: GPU layouts call for some padding.
instance Storable Quaternion where
  {-# INLINE sizeOf #-}
  sizeOf :: Quaternion -> Int
sizeOf Quaternion
_ = Int
16

  {-# INLINE alignment #-}
  alignment :: Quaternion -> Int
alignment Quaternion
_ = Int
16

  {-# INLINE poke #-}
  poke :: Ptr Quaternion -> Quaternion -> IO ()
poke Ptr Quaternion
ptr (Quaternion Float
a Float
b Float
c Float
d) = do
    Ptr Float -> Float -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke Ptr Float
forall b. Ptr b
ptr' Float
a
    Ptr Float -> Int -> Float -> IO ()
forall a. Storable a => Ptr a -> Int -> a -> IO ()
pokeElemOff Ptr Float
forall b. Ptr b
ptr' Int
1 Float
b
    Ptr Float -> Int -> Float -> IO ()
forall a. Storable a => Ptr a -> Int -> a -> IO ()
pokeElemOff Ptr Float
forall b. Ptr b
ptr' Int
2 Float
c
    Ptr Float -> Int -> Float -> IO ()
forall a. Storable a => Ptr a -> Int -> a -> IO ()
pokeElemOff Ptr Float
forall b. Ptr b
ptr' Int
3 Float
d
    where
      ptr' :: Ptr b
ptr' = Ptr Quaternion -> Ptr b
forall a b. Ptr a -> Ptr b
castPtr Ptr Quaternion
ptr

  {-# INLINE peek #-}
  peek :: Ptr Quaternion -> IO Quaternion
peek Ptr Quaternion
ptr = Float -> Float -> Float -> Float -> Quaternion
Quaternion
    (Float -> Float -> Float -> Float -> Quaternion)
-> IO Float -> IO (Float -> Float -> Float -> Quaternion)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Ptr Float -> IO Float
forall a. Storable a => Ptr a -> IO a
peek Ptr Float
forall b. Ptr b
ptr'
    IO (Float -> Float -> Float -> Quaternion)
-> IO Float -> IO (Float -> Float -> Quaternion)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Ptr Float -> Int -> IO Float
forall a. Storable a => Ptr a -> Int -> IO a
peekElemOff Ptr Float
forall b. Ptr b
ptr' Int
1
    IO (Float -> Float -> Quaternion)
-> IO Float -> IO (Float -> Quaternion)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Ptr Float -> Int -> IO Float
forall a. Storable a => Ptr a -> Int -> IO a
peekElemOff Ptr Float
forall b. Ptr b
ptr' Int
2
    IO (Float -> Quaternion) -> IO Float -> IO Quaternion
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Ptr Float -> Int -> IO Float
forall a. Storable a => Ptr a -> Int -> IO a
peekElemOff Ptr Float
forall b. Ptr b
ptr' Int
3
    where
      ptr' :: Ptr b
ptr' = Ptr Quaternion -> Ptr b
forall a b. Ptr a -> Ptr b
castPtr Ptr Quaternion
ptr

-- | Quaternion construction from axis and angle.
{-# INLINE axisAngle #-}
axisAngle :: Vec3 -> Float -> Quaternion
axisAngle :: Vec3 -> Float -> Quaternion
axisAngle Vec3
axis Float
rads =
  Vec3 -> (Float -> Float -> Float -> Quaternion) -> Quaternion
forall r. Vec3 -> (Float -> Float -> Float -> r) -> r
withVec3 (Vec3 -> Vec3
Vec3.normalize Vec3
axis Vec3 -> Float -> Vec3
Vec3.^* Float -> Float
forall a. Floating a => a -> a
sin Float
half) ((Float -> Float -> Float -> Quaternion) -> Quaternion)
-> (Float -> Float -> Float -> Quaternion) -> Quaternion
forall a b. (a -> b) -> a -> b
$
    Float -> Float -> Float -> Float -> Quaternion
quaternion (Float -> Float
forall a. Floating a => a -> a
cos Float
half)
  where
    half :: Float
half = Float
rads Float -> Float -> Float
forall a. Fractional a => a -> a -> a
/ Float
2

{-# INLINE rotate #-}
rotate :: Quaternion -> Vec3 -> Vec3
rotate :: Quaternion -> Vec3 -> Vec3
rotate Quaternion
q Vec3
v = Quaternion -> (Float -> Float -> Float -> Float -> Vec3) -> Vec3
forall r.
Quaternion -> (Float -> Float -> Float -> Float -> r) -> r
withQuaternion Quaternion
q' \Float
_a Float
b Float
c Float
d -> Float -> Float -> Float -> Vec3
vec3 Float
b Float
c Float
d
  where
    q' :: Quaternion
q' = Vec3 -> (Float -> Float -> Float -> Quaternion) -> Quaternion
forall r. Vec3 -> (Float -> Float -> Float -> r) -> r
withVec3 Vec3
v \Float
x Float
y Float
z ->
      Quaternion
q Quaternion -> Quaternion -> Quaternion
forall a. Num a => a -> a -> a
* Float -> Float -> Float -> Float -> Quaternion
quaternion Float
0 Float
x Float
y Float
z Quaternion -> Quaternion -> Quaternion
forall a. Num a => a -> a -> a
* Quaternion -> Quaternion
conjugate Quaternion
q

{-# INLINE rotatePoint #-}
rotatePoint :: Quaternion -> Vec3 -> Vec3 -> Vec3
rotatePoint :: Quaternion -> Vec3 -> Vec3 -> Vec3
rotatePoint Quaternion
q Vec3
origin Vec3
point =
  Vec3
origin Vec3 -> Vec3 -> Vec3
forall a. Num a => a -> a -> a
+ Quaternion -> Vec3 -> Vec3
rotate Quaternion
q (Vec3
point Vec3 -> Vec3 -> Vec3
forall a. Num a => a -> a -> a
- Vec3
origin)

{- | Rotation between vectors.

(in other words: the quaternion needed to rotate @v1@ so that it matches @v2@)
-}
rotationBetween :: Vec3 -> Vec3 -> Quaternion
rotationBetween :: Vec3 -> Vec3 -> Quaternion
rotationBetween Vec3
v1 Vec3
v2 = Vec3 -> Float -> Quaternion
axisAngle Vec3
axis Float
angle
  where
    axis :: Vec3
axis = Vec3 -> Vec3 -> Vec3
Vec3.cross Vec3
v1 Vec3
v2
    angle :: Float
angle = Float -> Float
forall a. Floating a => a -> a
acos Float
cosAngle
    cosAngle :: Float
cosAngle =
      Float -> Float -> Float
forall a. Ord a => a -> a -> a
max (-Float
1) (Float -> Float) -> (Float -> Float) -> Float -> Float
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Float -> Float -> Float
forall a. Ord a => a -> a -> a
min Float
1 (Float -> Float) -> Float -> Float
forall a b. (a -> b) -> a -> b
$
        Vec3 -> Vec3 -> Float
Vec3.dot (Vec3 -> Vec3
Vec3.normalize Vec3
v1) (Vec3 -> Vec3
Vec3.normalize Vec3
v2)

{- | Orient towards a point.

Use "rotationBetween" if you don't need to keep the object upright.
-}
lookAtUp :: Vec3 -> Vec3 -> Vec3 -> Quaternion
lookAtUp :: Vec3 -> Vec3 -> Vec3 -> Quaternion
lookAtUp Vec3
src Vec3
dst Vec3
up = Quaternion
rot2 Quaternion -> Quaternion -> Quaternion
forall a. Num a => a -> a -> a
* Quaternion
rot1
  where
    dir3 :: Vec3
dir3 = Vec3
dst Vec3 -> Vec3 -> Vec3
forall a. Num a => a -> a -> a
- Vec3
src

    -- XXX: turn "eye"
    rot1 :: Quaternion
rot1 = Vec3 -> Vec3 -> Quaternion
rotationBetween (Float -> Float -> Float -> Vec3
vec3 Float
0 Float
0 Float
1) Vec3
dir3

    rot2 :: Quaternion
rot2 = Vec3 -> Vec3 -> Quaternion
rotationBetween Vec3
newUp Vec3
fixedUp

    newUp :: Vec3
newUp = Quaternion -> Vec3 -> Vec3
rotate Quaternion
rot1 Vec3
up
    fixedUp :: Vec3
fixedUp = Vec3 -> Vec3 -> Vec3
Vec3.cross (Vec3 -> Vec3 -> Vec3
Vec3.cross Vec3
dir3 Vec3
up) Vec3
dir3