module Mischief.Math.Quat where

import Data.Default (Default (def))
import Linear (M33, Quaternion (Quaternion), V3 (V3), axisAngle, fromQuaternion)
import Mischief.Math.Vec (Dir3 (Dir3))
import Mischief.Math.Vec.Orphans.FieldAccessors ()

newtype Quat = Quat (Quaternion Float) deriving newtype (Int -> Quat -> ShowS
[Quat] -> ShowS
Quat -> String
(Int -> Quat -> ShowS)
-> (Quat -> String) -> ([Quat] -> ShowS) -> Show Quat
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Quat -> ShowS
showsPrec :: Int -> Quat -> ShowS
$cshow :: Quat -> String
show :: Quat -> String
$cshowList :: [Quat] -> ShowS
showList :: [Quat] -> ShowS
Show, Quat -> Quat -> Bool
(Quat -> Quat -> Bool) -> (Quat -> Quat -> Bool) -> Eq Quat
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Quat -> Quat -> Bool
== :: Quat -> Quat -> Bool
$c/= :: Quat -> Quat -> Bool
/= :: Quat -> Quat -> Bool
Eq, Eq Quat
Eq Quat =>
(Quat -> Quat -> Ordering)
-> (Quat -> Quat -> Bool)
-> (Quat -> Quat -> Bool)
-> (Quat -> Quat -> Bool)
-> (Quat -> Quat -> Bool)
-> (Quat -> Quat -> Quat)
-> (Quat -> Quat -> Quat)
-> Ord Quat
Quat -> Quat -> Bool
Quat -> Quat -> Ordering
Quat -> Quat -> Quat
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
$ccompare :: Quat -> Quat -> Ordering
compare :: Quat -> Quat -> Ordering
$c< :: Quat -> Quat -> Bool
< :: Quat -> Quat -> Bool
$c<= :: Quat -> Quat -> Bool
<= :: Quat -> Quat -> Bool
$c> :: Quat -> Quat -> Bool
> :: Quat -> Quat -> Bool
$c>= :: Quat -> Quat -> Bool
>= :: Quat -> Quat -> Bool
$cmax :: Quat -> Quat -> Quat
max :: Quat -> Quat -> Quat
$cmin :: Quat -> Quat -> Quat
min :: Quat -> Quat -> Quat
Ord, Integer -> Quat
Quat -> Quat
Quat -> Quat -> Quat
(Quat -> Quat -> Quat)
-> (Quat -> Quat -> Quat)
-> (Quat -> Quat -> Quat)
-> (Quat -> Quat)
-> (Quat -> Quat)
-> (Quat -> Quat)
-> (Integer -> Quat)
-> Num Quat
forall a.
(a -> a -> a)
-> (a -> a -> a)
-> (a -> a -> a)
-> (a -> a)
-> (a -> a)
-> (a -> a)
-> (Integer -> a)
-> Num a
$c+ :: Quat -> Quat -> Quat
+ :: Quat -> Quat -> Quat
$c- :: Quat -> Quat -> Quat
- :: Quat -> Quat -> Quat
$c* :: Quat -> Quat -> Quat
* :: Quat -> Quat -> Quat
$cnegate :: Quat -> Quat
negate :: Quat -> Quat
$cabs :: Quat -> Quat
abs :: Quat -> Quat
$csignum :: Quat -> Quat
signum :: Quat -> Quat
$cfromInteger :: Integer -> Quat
fromInteger :: Integer -> Quat
Num)

instance Default Quat where
  def :: Quat
def = Quat
identity

identity :: Quat
identity :: Quat
identity = Quaternion Float -> Quat
Quat (Quaternion Float -> Quat) -> Quaternion Float -> Quat
forall a b. (a -> b) -> a -> b
$ Float -> V3 Float -> Quaternion Float
forall a. a -> V3 a -> Quaternion a
Quaternion Float
1 (V3 Float -> Quaternion Float) -> V3 Float -> Quaternion Float
forall a b. (a -> b) -> a -> b
$ Float -> Float -> Float -> V3 Float
forall a. a -> a -> a -> V3 a
V3 Float
0 Float
0 Float
0

fromAxisAngle :: Dir3 Float -> Float -> Quat
fromAxisAngle :: Dir3 Float -> Float -> Quat
fromAxisAngle (Dir3 V3 Float
dir) Float
angle = Quaternion Float -> Quat
Quat (Quaternion Float -> Quat) -> Quaternion Float -> Quat
forall a b. (a -> b) -> a -> b
$ V3 Float -> Float -> Quaternion Float
forall a. (Epsilon a, Floating a) => V3 a -> a -> Quaternion a
axisAngle V3 Float
dir Float
angle

fromXYZW :: (Float, Float, Float, Float) -> Quat
fromXYZW :: (Float, Float, Float, Float) -> Quat
fromXYZW (Float
x, Float
y, Float
z, Float
w) = Quaternion Float -> Quat
Quat (Quaternion Float -> Quat) -> Quaternion Float -> Quat
forall a b. (a -> b) -> a -> b
$ Float -> V3 Float -> Quaternion Float
forall a. a -> V3 a -> Quaternion a
Quaternion Float
w (Float -> Float -> Float -> V3 Float
forall a. a -> a -> a -> V3 a
V3 Float
x Float
y Float
z)

fromRotationX :: Float -> Quat
fromRotationX :: Float -> Quat
fromRotationX Float
angle =
  let (Float
s, Float
c) = (Float -> Float
forall a. Floating a => a -> a
sin Float
angle, Float -> Float
forall a. Floating a => a -> a
cos Float
angle)
   in (Float, Float, Float, Float) -> Quat
fromXYZW (Float
s, Float
0, Float
0, Float
c)

fromRotationY :: Float -> Quat
fromRotationY :: Float -> Quat
fromRotationY Float
angle =
  let (Float
s, Float
c) = (Float -> Float
forall a. Floating a => a -> a
sin Float
angle, Float -> Float
forall a. Floating a => a -> a
cos Float
angle)
   in (Float, Float, Float, Float) -> Quat
fromXYZW (Float
0, Float
s, Float
0, Float
c)

fromRotationZ :: Float -> Quat
fromRotationZ :: Float -> Quat
fromRotationZ Float
angle =
  let (Float
s, Float
c) = (Float -> Float
forall a. Floating a => a -> a
sin Float
angle, Float -> Float
forall a. Floating a => a -> a
cos Float
angle)
   in (Float, Float, Float, Float) -> Quat
fromXYZW (Float
0, Float
0, Float
s, Float
c)

fromAngles :: V3 Float -> Quat
fromAngles :: V3 Float -> Quat
fromAngles V3 Float
vec3 = Float -> Quat -> Quat
rotateX V3 Float
vec3.x (Quat -> Quat) -> Quat -> Quat
forall a b. (a -> b) -> a -> b
$ Float -> Quat -> Quat
rotateY V3 Float
vec3.y (Quat -> Quat) -> Quat -> Quat
forall a b. (a -> b) -> a -> b
$ Float -> Quat -> Quat
rotateZ V3 Float
vec3.z Quat
identity

fromEuler :: Euler -> Quat
fromEuler :: Euler -> Quat
fromEuler Euler {Float
x :: Float
x :: Euler -> Float
x, Float
y :: Float
y :: Euler -> Float
y, Float
z :: Float
z :: Euler -> Float
z} = V3 Float -> Quat
fromAngles (V3 Float -> Quat) -> V3 Float -> Quat
forall a b. (a -> b) -> a -> b
$ Float -> Float -> Float -> V3 Float
forall a. a -> a -> a -> V3 a
V3 Float
x Float
y Float
z

rotateAxis :: Dir3 Float -> Float -> Quat -> Quat
rotateAxis :: Dir3 Float -> Float -> Quat -> Quat
rotateAxis Dir3 Float
dir Float
angle Quat
quat = Quat
quat Quat -> Quat -> Quat
forall a. Num a => a -> a -> a
* Dir3 Float -> Float -> Quat
fromAxisAngle Dir3 Float
dir Float
angle

rotateX :: Float -> Quat -> Quat
rotateX :: Float -> Quat -> Quat
rotateX Float
angle Quat
quat = Quat
quat Quat -> Quat -> Quat
forall a. Num a => a -> a -> a
* Float -> Quat
fromRotationX Float
angle

rotateY :: Float -> Quat -> Quat
rotateY :: Float -> Quat -> Quat
rotateY Float
angle Quat
quat = Quat
quat Quat -> Quat -> Quat
forall a. Num a => a -> a -> a
* Float -> Quat
fromRotationY Float
angle

rotateZ :: Float -> Quat -> Quat
rotateZ :: Float -> Quat -> Quat
rotateZ Float
angle Quat
quat = Quat
quat Quat -> Quat -> Quat
forall a. Num a => a -> a -> a
* Float -> Quat
fromRotationZ Float
angle

toMat3 :: Quat -> M33 Float
toMat3 :: Quat -> M33 Float
toMat3 (Quat Quaternion Float
quat) = Quaternion Float -> M33 Float
forall a. Num a => Quaternion a -> M33 a
fromQuaternion Quaternion Float
quat

toEuler :: Quat -> Euler
toEuler :: Quat -> Euler
toEuler = M33 Float -> Euler
m33ToEuler (M33 Float -> Euler) -> (Quat -> M33 Float) -> Quat -> Euler
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Quat -> M33 Float
toMat3

data Euler = Euler {Euler -> Float
x :: Float, Euler -> Float
y :: Float, Euler -> Float
z :: Float} deriving (Int -> Euler -> ShowS
[Euler] -> ShowS
Euler -> String
(Int -> Euler -> ShowS)
-> (Euler -> String) -> ([Euler] -> ShowS) -> Show Euler
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Euler -> ShowS
showsPrec :: Int -> Euler -> ShowS
$cshow :: Euler -> String
show :: Euler -> String
$cshowList :: [Euler] -> ShowS
showList :: [Euler] -> ShowS
Show, Euler -> Euler -> Bool
(Euler -> Euler -> Bool) -> (Euler -> Euler -> Bool) -> Eq Euler
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Euler -> Euler -> Bool
== :: Euler -> Euler -> Bool
$c/= :: Euler -> Euler -> Bool
/= :: Euler -> Euler -> Bool
Eq)

m33ToEuler :: M33 Float -> Euler
m33ToEuler :: M33 Float -> Euler
m33ToEuler (V3 (V3 Float
m11 Float
m12 Float
m13) (V3 Float
_ Float
_ Float
m23) (V3 Float
_ Float
_ Float
m33)) =
  Euler {x :: Float
x = Float -> Float -> Float
forall a. RealFloat a => a -> a -> a
atan2 (-Float
m23) Float
m33 Float -> Float -> Float
forall a. Num a => a -> a -> a
* Float
0.5, y :: Float
y = Float -> Float
forall a. Floating a => a -> a
asin Float
m13 Float -> Float -> Float
forall a. Num a => a -> a -> a
* Float
0.5, z :: Float
z = Float -> Float -> Float
forall a. RealFloat a => a -> a -> a
atan2 (-Float
m12) Float
m11 Float -> Float -> Float
forall a. Num a => a -> a -> a
* Float
0.5}