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 (Quaternion -> Quaternion -> Bool) -> (Quaternion -> Quaternion -> Bool) -> Eq Quaternion forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a $c== :: Quaternion -> Quaternion -> Bool == :: Quaternion -> Quaternion -> Bool $c/= :: Quaternion -> Quaternion -> Bool /= :: Quaternion -> Quaternion -> Bool Eq, 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 $cshowsPrec :: Int -> Quaternion -> ShowS showsPrec :: Int -> Quaternion -> ShowS $cshow :: Quaternion -> String show :: Quaternion -> String $cshowList :: [Quaternion] -> ShowS showList :: [Quaternion] -> ShowS Show) instance Json.FromJSON Quaternion where parseJSON :: Value -> Parser Quaternion parseJSON = String -> (Object -> Parser Quaternion) -> Value -> Parser Quaternion forall a. String -> (Object -> Parser a) -> Value -> Parser a Json.withObject String "Quaternion" ((Object -> Parser Quaternion) -> Value -> Parser Quaternion) -> (Object -> Parser Quaternion) -> Value -> Parser Quaternion forall a b. (a -> b) -> a -> b $ \Object object -> do Double x <- Object -> String -> Parser Double forall value. FromJSON value => Object -> String -> Parser value Json.required Object object String "x" Double y <- Object -> String -> Parser Double forall value. FromJSON value => Object -> String -> Parser value Json.required Object object String "y" Double z <- Object -> String -> Parser Double forall value. FromJSON value => Object -> String -> Parser value Json.required Object object String "z" Double w <- Object -> String -> Parser Double forall value. FromJSON value => Object -> String -> Parser value Json.required Object object String "w" Quaternion -> Parser Quaternion forall a. a -> Parser a 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 [ String -> Double -> (Key, Value) forall value e p. (ToJSON value, KeyValue e p) => String -> value -> p Json.pair String "x" (Double -> (Key, Value)) -> Double -> (Key, Value) forall a b. (a -> b) -> a -> b $ Quaternion -> Double x Quaternion a, String -> Double -> (Key, Value) forall value e p. (ToJSON value, KeyValue e p) => String -> value -> p Json.pair String "y" (Double -> (Key, Value)) -> Double -> (Key, Value) forall a b. (a -> b) -> a -> b $ Quaternion -> Double y Quaternion a, String -> Double -> (Key, Value) forall value e p. (ToJSON value, KeyValue e p) => String -> value -> p Json.pair String "z" (Double -> (Key, Value)) -> Double -> (Key, Value) forall a b. (a -> b) -> a -> b $ Quaternion -> Double z Quaternion a, String -> Double -> (Key, Value) forall value e p. (ToJSON value, KeyValue e p) => String -> value -> p Json.pair String "w" (Double -> (Key, Value)) -> Double -> (Key, Value) 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" (Value -> Schema) -> Value -> Schema forall a b. (a -> b) -> a -> b $ [((Key, Value), Bool)] -> Value Schema.object [ (String -> Value -> (Key, Value) forall value e p. (ToJSON value, KeyValue e p) => String -> value -> p Json.pair String "x" (Value -> (Key, Value)) -> Value -> (Key, Value) forall a b. (a -> b) -> a -> b $ Schema -> Value Schema.ref Schema Schema.number, Bool True), (String -> Value -> (Key, Value) forall value e p. (ToJSON value, KeyValue e p) => String -> value -> p Json.pair String "y" (Value -> (Key, Value)) -> Value -> (Key, Value) forall a b. (a -> b) -> a -> b $ Schema -> Value Schema.ref Schema Schema.number, Bool True), (String -> Value -> (Key, Value) forall value e p. (ToJSON value, KeyValue e p) => String -> value -> p Json.pair String "z" (Value -> (Key, Value)) -> Value -> (Key, Value) forall a b. (a -> b) -> a -> b $ Schema -> Value Schema.ref Schema Schema.number, Bool True), (String -> Value -> (Key, Value) forall value e p. (ToJSON value, KeyValue e p) => String -> value -> p Json.pair String "w" (Value -> (Key, Value)) -> Value -> (Key, Value) 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 (Component -> Component -> Bool) -> (Component -> Component -> Bool) -> Eq Component forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a $c== :: Component -> Component -> Bool == :: Component -> Component -> Bool $c/= :: Component -> Component -> Bool /= :: Component -> Component -> Bool Eq, 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 $cshowsPrec :: Int -> Component -> ShowS showsPrec :: Int -> Component -> ShowS $cshow :: Component -> String show :: Component -> String $cshowList :: [Component] -> ShowS showList :: [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 = 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.CompressedWord compressPart :: Double -> CompressedWord compressPart = Word -> Word -> CompressedWord CompressedWord.CompressedWord Word maxCompressedValue (Word -> CompressedWord) -> (Double -> Word) -> Double -> CompressedWord forall b c a. (b -> c) -> (a -> b) -> a -> c . Double -> Word forall b. Integral b => Double -> b 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.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 CompressedWord.limit 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 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 = ((Double, Component) -> Double) -> [(Double, Component)] -> (Double, Component) forall (t :: * -> *) b a. (Foldable t, Ord b) => (a -> b) -> t a -> a maximumOn (Double, Component) -> Double forall a b. (a, b) -> a fst [(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 ) 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 = (a -> a -> Ordering) -> t a -> a forall (t :: * -> *) a. Foldable t => (a -> a -> Ordering) -> t a -> a List.maximumBy ((a -> b) -> a -> a -> Ordering 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 = 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 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 BitPut -> BitPut -> BitPut 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 BitPut -> BitPut -> BitPut forall a. Semigroup a => a -> a -> a <> Double -> BitPut putPart Double b BitPut -> BitPut -> BitPut forall a. Semigroup a => a -> a -> a <> Double -> BitPut putPart Double c putPart :: Double -> BitPut.BitPut putPart :: Double -> BitPut putPart = CompressedWord -> BitPut CompressedWord.bitPut (CompressedWord -> BitPut) -> (Double -> CompressedWord) -> Double -> 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 Quaternion -> BitGet Quaternion forall a. a -> Get BitString Identity a forall (f :: * -> *) a. Applicative f => a -> f a pure (Quaternion -> BitGet Quaternion) -> Quaternion -> BitGet Quaternion 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 -> Component -> BitGet Component forall a. a -> Get BitString Identity a forall (f :: * -> *) a. Applicative f => a -> f a pure Component X Word 1 -> Component -> BitGet Component forall a. a -> Get BitString Identity a forall (f :: * -> *) a. Applicative f => a -> f a pure Component Y Word 2 -> Component -> BitGet Component forall a. a -> Get BitString Identity a forall (f :: * -> *) a. Applicative f => a -> f a pure Component Z Word 3 -> Component -> BitGet Component forall a. a -> Get BitString Identity a forall (f :: * -> *) a. Applicative f => a -> f a pure Component W Word y_ -> InvalidComponent -> BitGet Component forall e a. Exception e => e -> BitGet a BitGet.throw (InvalidComponent -> BitGet Component) -> InvalidComponent -> BitGet Component forall a b. (a -> b) -> a -> b $ Word -> InvalidComponent InvalidComponent.InvalidComponent Word y_ decodePart :: BitGet.BitGet Double decodePart :: BitGet Double decodePart = (CompressedWord -> Double) -> BitGet CompressedWord -> BitGet Double forall a b. (a -> b) -> Get BitString Identity a -> Get BitString Identity b forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b fmap CompressedWord -> Double decompressPart (BitGet CompressedWord -> BitGet Double) -> BitGet CompressedWord -> BitGet Double forall a b. (a -> b) -> a -> b $ Word -> BitGet CompressedWord CompressedWord.bitGet Word maxCompressedValue