{-# LANGUAGE TemplateHaskell #-}

module Rattletrap.Type.Quaternion
  ( Quaternion(..)
  , Component(..)
  , toQuaternion
  , compressPart
  , decompressPart
  , maxComponent
  , maxCompressedValue
  )
where

import Rattletrap.Type.Common
import Rattletrap.Type.CompressedWord

import qualified Data.List as List
import qualified Data.Maybe as Maybe

data Quaternion = Quaternion
  { Quaternion -> Double
quaternionX :: Double
  , Quaternion -> Double
quaternionY :: Double
  , Quaternion -> Double
quaternionZ :: Double
  , Quaternion -> Double
quaternionW :: Double
  } 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)

$(deriveJson ''Quaternion)

data Component
  = ComponentX
  | ComponentY
  | ComponentZ
  | ComponentW
  deriving (Component -> Component -> Bool
(Component -> Component -> Bool)
-> (Component -> Component -> Bool) -> Eq Component
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Component -> Component -> Bool
$c/= :: Component -> Component -> Bool
== :: Component -> Component -> Bool
$c== :: Component -> Component -> Bool
Eq, Eq Component
Eq Component
-> (Component -> Component -> Ordering)
-> (Component -> Component -> Bool)
-> (Component -> Component -> Bool)
-> (Component -> Component -> Bool)
-> (Component -> Component -> Bool)
-> (Component -> Component -> Component)
-> (Component -> Component -> Component)
-> Ord Component
Component -> Component -> Bool
Component -> Component -> Ordering
Component -> Component -> Component
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 :: Component -> Component -> Component
$cmin :: Component -> Component -> Component
max :: Component -> Component -> Component
$cmax :: Component -> Component -> Component
>= :: Component -> Component -> Bool
$c>= :: Component -> Component -> Bool
> :: Component -> Component -> Bool
$c> :: Component -> Component -> Bool
<= :: Component -> Component -> Bool
$c<= :: Component -> Component -> Bool
< :: Component -> Component -> Bool
$c< :: Component -> Component -> Bool
compare :: Component -> Component -> Ordering
$ccompare :: Component -> Component -> Ordering
$cp1Ord :: Eq Component
Ord, Int -> Component -> ShowS
[Component] -> ShowS
Component -> String
(Int -> Component -> ShowS)
-> (Component -> String)
-> ([Component] -> ShowS)
-> Show Component
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Component] -> ShowS
$cshowList :: [Component] -> ShowS
show :: Component -> String
$cshow :: Component -> String
showsPrec :: Int -> Component -> ShowS
$cshowsPrec :: Int -> Component -> ShowS
Show)

toQuaternion :: Component -> Double -> Double -> Double -> Quaternion
toQuaternion :: Component -> Double -> Double -> Double -> Quaternion
toQuaternion Component
component Double
a Double
b Double
c =
  let d :: Double
d = Double -> Double -> Double -> Double
toPart Double
a Double
b Double
c
  in
    case Component
component of
      Component
ComponentX -> Double -> Double -> Double -> Double -> Quaternion
Quaternion Double
d Double
a Double
b Double
c
      Component
ComponentY -> Double -> Double -> Double -> Double -> Quaternion
Quaternion Double
a Double
d Double
b Double
c
      Component
ComponentZ -> Double -> Double -> Double -> Double -> Quaternion
Quaternion Double
a Double
b Double
d Double
c
      Component
ComponentW -> Double -> Double -> Double -> Double -> Quaternion
Quaternion Double
a Double
b Double
c Double
d

toPart :: Double -> Double -> Double -> Double
toPart :: Double -> Double -> Double -> Double
toPart Double
a Double
b Double
c = Double -> Double
forall a. Floating a => a -> a
sqrt (Double
1 Double -> Double -> Double
forall a. Num a => a -> a -> a
- (Double
a Double -> Double -> Double
forall a. Num a => a -> a -> a
* Double
a) Double -> Double -> Double
forall a. Num a => a -> a -> a
- (Double
b Double -> Double -> Double
forall a. Num a => a -> a -> a
* Double
b) Double -> Double -> Double
forall a. Num a => a -> a -> a
- (Double
c Double -> Double -> Double
forall a. Num a => a -> a -> a
* Double
c))

compressPart :: Double -> CompressedWord
compressPart :: Double -> CompressedWord
compressPart =
  Word -> Word -> CompressedWord
CompressedWord Word
maxCompressedValue
    (Word -> CompressedWord)
-> (Double -> Word) -> Double -> CompressedWord
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Double -> Word
forall a b. (RealFrac a, Integral b) => a -> b
round
    (Double -> Word) -> (Double -> Double) -> Double -> Word
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Double -> Double -> Double
forall a. Num a => a -> a -> a
* Word -> Double
wordToDouble Word
maxCompressedValue)
    (Double -> Double) -> (Double -> Double) -> Double -> Double
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Double -> Double -> Double
forall a. Num a => a -> a -> a
+ Double
0.5)
    (Double -> Double) -> (Double -> Double) -> Double -> Double
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ Double
2.0)
    (Double -> Double) -> (Double -> Double) -> Double -> Double
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ Double
maxValue)

decompressPart :: CompressedWord -> Double
decompressPart :: CompressedWord -> Double
decompressPart CompressedWord
x =
  (Double -> Double -> Double
forall a. Num a => a -> a -> a
* Double
maxValue)
    (Double -> Double) -> (Word -> Double) -> Word -> Double
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Double -> Double -> Double
forall a. Num a => a -> a -> a
* Double
2.0)
    (Double -> Double) -> (Word -> Double) -> Word -> Double
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Double -> Double -> Double
forall a. Num a => a -> a -> a
subtract Double
0.5
    (Double -> Double) -> (Word -> Double) -> Word -> Double
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ Word -> Double
wordToDouble (CompressedWord -> Word
compressedWordLimit CompressedWord
x))
    (Double -> Double) -> (Word -> Double) -> Word -> Double
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word -> Double
wordToDouble
    (Word -> Double) -> Word -> Double
forall a b. (a -> b) -> a -> b
$ CompressedWord -> Word
compressedWordValue CompressedWord
x

maxComponent :: Quaternion -> Component
maxComponent :: Quaternion -> Component
maxComponent Quaternion
quaternion =
  let
    x :: Double
x = Quaternion -> Double
quaternionX Quaternion
quaternion
    y :: Double
y = Quaternion -> Double
quaternionY Quaternion
quaternion
    z :: Double
z = Quaternion -> Double
quaternionZ Quaternion
quaternion
    w :: Double
w = Quaternion -> Double
quaternionW Quaternion
quaternion
    parts :: [(Double, Component)]
parts =
      [(Double
x, Component
ComponentX), (Double
y, Component
ComponentY), (Double
z, Component
ComponentZ), (Double
w, Component
ComponentW)]
    biggestPart :: (Double, Component)
biggestPart = [(Double, Component)] -> (Double, Component)
forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
maximum [(Double, Component)]
parts
    roundTrip :: Double -> Double
roundTrip = CompressedWord -> Double
decompressPart (CompressedWord -> Double)
-> (Double -> CompressedWord) -> Double -> Double
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Double -> CompressedWord
compressPart
    computedPart :: (Double, Component)
computedPart = (Double, Component)
-> Maybe (Double, Component) -> (Double, Component)
forall a. a -> Maybe a -> a
Maybe.fromMaybe
      (Double, Component)
biggestPart
      (((Double, Component) -> Bool)
-> [(Double, Component)] -> Maybe (Double, Component)
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Maybe a
List.find (\(Double
value, Component
_) -> Double
value Double -> Double -> Bool
forall a. Eq a => a -> a -> Bool
/= Double -> Double
roundTrip Double
value) [(Double, Component)]
parts)
  in (Double, Component) -> Component
forall a b. (a, b) -> b
snd
    (if ((Double, Component)
biggestPart (Double, Component) -> (Double, Component) -> Bool
forall a. Eq a => a -> a -> Bool
== (Double, Component)
computedPart)
        Bool -> Bool -> Bool
|| (Double -> Double
forall a. Num a => a -> a
abs ((Double, Component) -> Double
forall a b. (a, b) -> a
fst (Double, Component)
biggestPart Double -> Double -> Double
forall a. Num a => a -> a -> a
- (Double, Component) -> Double
forall a b. (a, b) -> a
fst (Double, Component)
computedPart) Double -> Double -> Bool
forall a. Ord a => a -> a -> Bool
> Double
0.00001)
      then (Double, Component)
biggestPart
      else (Double, Component)
computedPart
    )

numBits :: Word
numBits :: Word
numBits = Word
18

wordToDouble :: Word -> Double
wordToDouble :: Word -> Double
wordToDouble = Word -> Double
forall a b. (Integral a, Num b) => a -> b
fromIntegral

maxCompressedValue :: Word
maxCompressedValue :: Word
maxCompressedValue = (Word
2 Word -> Word -> Word
forall a b. (Num a, Integral b) => a -> b -> a
^ Word
numBits) Word -> Word -> Word
forall a. Num a => a -> a -> a
- Word
1

maxValue :: Double
maxValue :: Double
maxValue = Double
1.0 Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ Double -> Double
forall a. Floating a => a -> a
sqrt Double
2.0