module Rattletrap.Type.Quaternion where

import qualified Data.List as List
import qualified Data.Maybe as Maybe
import qualified Data.Ord as Ord
import qualified Rattletrap.BitGet as BitGet
import qualified Rattletrap.BitPut as BitPut
import qualified Rattletrap.Exception.InvalidComponent as InvalidComponent
import qualified Rattletrap.Schema as Schema
import qualified Rattletrap.Type.CompressedWord as CompressedWord
import qualified Rattletrap.Utility.Json as Json

data Quaternion = Quaternion
  { Quaternion -> Double
x :: Double,
    Quaternion -> Double
y :: Double,
    Quaternion -> Double
z :: Double,
    Quaternion -> Double
w :: Double
  }
  deriving (Quaternion -> Quaternion -> Bool
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, Int -> Quaternion -> ShowS
[Quaternion] -> ShowS
Quaternion -> String
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)

instance Json.FromJSON Quaternion where
  parseJSON :: Value -> Parser Quaternion
parseJSON = forall a. String -> (Object -> Parser a) -> Value -> Parser a
Json.withObject String
"Quaternion" forall a b. (a -> b) -> a -> b
$ \Object
object -> do
    Double
x <- forall value. FromJSON value => Object -> String -> Parser value
Json.required Object
object String
"x"
    Double
y <- forall value. FromJSON value => Object -> String -> Parser value
Json.required Object
object String
"y"
    Double
z <- forall value. FromJSON value => Object -> String -> Parser value
Json.required Object
object String
"z"
    Double
w <- forall value. FromJSON value => Object -> String -> Parser value
Json.required Object
object String
"w"
    forall (f :: * -> *) a. Applicative f => a -> f a
pure Quaternion {Double
x :: Double
x :: Double
x, Double
y :: Double
y :: Double
y, Double
z :: Double
z :: Double
z, Double
w :: Double
w :: Double
w}

instance Json.ToJSON Quaternion where
  toJSON :: Quaternion -> Value
toJSON Quaternion
a =
    [(Key, Value)] -> Value
Json.object
      [ forall value pair.
(ToJSON value, KeyValue pair) =>
String -> value -> pair
Json.pair String
"x" forall a b. (a -> b) -> a -> b
$ Quaternion -> Double
x Quaternion
a,
        forall value pair.
(ToJSON value, KeyValue pair) =>
String -> value -> pair
Json.pair String
"y" forall a b. (a -> b) -> a -> b
$ Quaternion -> Double
y Quaternion
a,
        forall value pair.
(ToJSON value, KeyValue pair) =>
String -> value -> pair
Json.pair String
"z" forall a b. (a -> b) -> a -> b
$ Quaternion -> Double
z Quaternion
a,
        forall value pair.
(ToJSON value, KeyValue pair) =>
String -> value -> pair
Json.pair String
"w" forall a b. (a -> b) -> a -> b
$ Quaternion -> Double
w Quaternion
a
      ]

schema :: Schema.Schema
schema :: Schema
schema =
  String -> Value -> Schema
Schema.named String
"quaternion" forall a b. (a -> b) -> a -> b
$
    [((Key, Value), Bool)] -> Value
Schema.object
      [ (forall value pair.
(ToJSON value, KeyValue pair) =>
String -> value -> pair
Json.pair String
"x" forall a b. (a -> b) -> a -> b
$ Schema -> Value
Schema.ref Schema
Schema.number, Bool
True),
        (forall value pair.
(ToJSON value, KeyValue pair) =>
String -> value -> pair
Json.pair String
"y" forall a b. (a -> b) -> a -> b
$ Schema -> Value
Schema.ref Schema
Schema.number, Bool
True),
        (forall value pair.
(ToJSON value, KeyValue pair) =>
String -> value -> pair
Json.pair String
"z" forall a b. (a -> b) -> a -> b
$ Schema -> Value
Schema.ref Schema
Schema.number, Bool
True),
        (forall value pair.
(ToJSON value, KeyValue pair) =>
String -> value -> pair
Json.pair String
"w" forall a b. (a -> b) -> a -> b
$ Schema -> Value
Schema.ref Schema
Schema.number, Bool
True)
      ]

data Component
  = X
  | Y
  | Z
  | W
  deriving (Component -> Component -> Bool
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, Int -> Component -> ShowS
[Component] -> ShowS
Component -> String
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
X -> Double -> Double -> Double -> Double -> Quaternion
Quaternion Double
d Double
a Double
b Double
c
        Component
Y -> Double -> Double -> Double -> Double -> Quaternion
Quaternion Double
a Double
d Double
b Double
c
        Component
Z -> Double -> Double -> Double -> Double -> Quaternion
Quaternion Double
a Double
b Double
d Double
c
        Component
W -> 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 = forall a. Floating a => a -> a
sqrt (Double
1 forall a. Num a => a -> a -> a
- (Double
a forall a. Num a => a -> a -> a
* Double
a) forall a. Num a => a -> a -> a
- (Double
b forall a. Num a => a -> a -> a
* Double
b) forall a. Num a => a -> a -> a
- (Double
c forall a. Num a => a -> a -> a
* Double
c))

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

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

maxComponent :: Quaternion -> Component
maxComponent :: Quaternion -> Component
maxComponent Quaternion
quaternion =
  let x_ :: Double
x_ = Quaternion -> Double
x Quaternion
quaternion
      y_ :: Double
y_ = Quaternion -> Double
y Quaternion
quaternion
      z_ :: Double
z_ = Quaternion -> Double
z Quaternion
quaternion
      w_ :: Double
w_ = Quaternion -> Double
w Quaternion
quaternion
      parts :: [(Double, Component)]
parts = [(Double
x_, Component
X), (Double
y_, Component
Y), (Double
z_, Component
Z), (Double
w_, Component
W)]
      biggestPart :: (Double, Component)
biggestPart = forall (t :: * -> *) b a.
(Foldable t, Ord b) =>
(a -> b) -> t a -> a
maximumOn forall a b. (a, b) -> a
fst [(Double, Component)]
parts
      roundTrip :: Double -> Double
roundTrip = CompressedWord -> Double
decompressPart forall b c a. (b -> c) -> (a -> b) -> a -> c
. Double -> CompressedWord
compressPart
      computedPart :: (Double, Component)
computedPart =
        forall a. a -> Maybe a -> a
Maybe.fromMaybe
          (Double, Component)
biggestPart
          (forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Maybe a
List.find (\(Double
value, Component
_) -> Double
value forall a. Eq a => a -> a -> Bool
/= Double -> Double
roundTrip Double
value) [(Double, Component)]
parts)
   in forall a b. (a, b) -> b
snd
        ( if ((Double, Component)
biggestPart forall a. Eq a => a -> a -> Bool
== (Double, Component)
computedPart)
            Bool -> Bool -> Bool
|| (forall a. Num a => a -> a
abs (forall a b. (a, b) -> a
fst (Double, Component)
biggestPart forall a. Num a => a -> a -> a
- forall a b. (a, b) -> a
fst (Double, Component)
computedPart) forall a. Ord a => a -> a -> Bool
> Double
0.00001)
            then (Double, Component)
biggestPart
            else (Double, Component)
computedPart
        )

maximumOn :: (Foldable t, Ord b) => (a -> b) -> t a -> a
maximumOn :: forall (t :: * -> *) b a.
(Foldable t, Ord b) =>
(a -> b) -> t a -> a
maximumOn a -> b
f = forall (t :: * -> *) a.
Foldable t =>
(a -> a -> Ordering) -> t a -> a
List.maximumBy (forall a b. Ord a => (b -> a) -> b -> b -> Ordering
Ord.comparing a -> b
f)

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

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

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

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

bitPut :: Quaternion -> BitPut.BitPut
bitPut :: Quaternion -> BitPut
bitPut Quaternion
q =
  let c :: Component
c = Quaternion -> Component
maxComponent Quaternion
q
   in Component -> BitPut
putComponent Component
c forall a. Semigroup a => a -> a -> a
<> case Component
c of
        Component
X -> Double -> Double -> Double -> BitPut
putParts (Quaternion -> Double
y Quaternion
q) (Quaternion -> Double
z Quaternion
q) (Quaternion -> Double
w Quaternion
q)
        Component
Y -> Double -> Double -> Double -> BitPut
putParts (Quaternion -> Double
x Quaternion
q) (Quaternion -> Double
z Quaternion
q) (Quaternion -> Double
w Quaternion
q)
        Component
Z -> Double -> Double -> Double -> BitPut
putParts (Quaternion -> Double
x Quaternion
q) (Quaternion -> Double
y Quaternion
q) (Quaternion -> Double
w Quaternion
q)
        Component
W -> Double -> Double -> Double -> BitPut
putParts (Quaternion -> Double
x Quaternion
q) (Quaternion -> Double
y Quaternion
q) (Quaternion -> Double
z Quaternion
q)

putComponent :: Component -> BitPut.BitPut
putComponent :: Component -> BitPut
putComponent Component
component =
  CompressedWord -> BitPut
CompressedWord.bitPut
    ( Word -> Word -> CompressedWord
CompressedWord.CompressedWord
        Word
3
        ( case Component
component of
            Component
X -> Word
0
            Component
Y -> Word
1
            Component
Z -> Word
2
            Component
W -> Word
3
        )
    )

putParts :: Double -> Double -> Double -> BitPut.BitPut
putParts :: Double -> Double -> Double -> BitPut
putParts Double
a Double
b Double
c = Double -> BitPut
putPart Double
a forall a. Semigroup a => a -> a -> a
<> Double -> BitPut
putPart Double
b forall a. Semigroup a => a -> a -> a
<> Double -> BitPut
putPart Double
c

putPart :: Double -> BitPut.BitPut
putPart :: Double -> BitPut
putPart = CompressedWord -> BitPut
CompressedWord.bitPut forall b c a. (b -> c) -> (a -> b) -> a -> c
. Double -> CompressedWord
compressPart

bitGet :: BitGet.BitGet Quaternion
bitGet :: BitGet Quaternion
bitGet = do
  Component
component <- BitGet Component
decodeComponent
  Double
a <- BitGet Double
decodePart
  Double
b <- BitGet Double
decodePart
  Double
c <- BitGet Double
decodePart
  forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ Component -> Double -> Double -> Double -> Quaternion
toQuaternion Component
component Double
a Double
b Double
c

decodeComponent :: BitGet.BitGet Component
decodeComponent :: BitGet Component
decodeComponent = do
  CompressedWord
x_ <- Word -> BitGet CompressedWord
CompressedWord.bitGet Word
3
  case CompressedWord -> Word
CompressedWord.value CompressedWord
x_ of
    Word
0 -> forall (f :: * -> *) a. Applicative f => a -> f a
pure Component
X
    Word
1 -> forall (f :: * -> *) a. Applicative f => a -> f a
pure Component
Y
    Word
2 -> forall (f :: * -> *) a. Applicative f => a -> f a
pure Component
Z
    Word
3 -> forall (f :: * -> *) a. Applicative f => a -> f a
pure Component
W
    Word
y_ -> forall e a. Exception e => e -> BitGet a
BitGet.throw forall a b. (a -> b) -> a -> b
$ Word -> InvalidComponent
InvalidComponent.InvalidComponent Word
y_

decodePart :: BitGet.BitGet Double
decodePart :: BitGet Double
decodePart = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap CompressedWord -> Double
decompressPart forall a b. (a -> b) -> a -> b
$ Word -> BitGet CompressedWord
CompressedWord.bitGet Word
maxCompressedValue