{-# LANGUAGE BlockArguments #-}
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
{-# 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
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
{-# 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)
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)
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
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