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 /= :: Quaternion -> Quaternion -> Bool $c/= :: Quaternion -> Quaternion -> Bool == :: Quaternion -> Quaternion -> Bool $c== :: 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 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 = 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 (f :: * -> *) a. Applicative f => a -> f a pure Quaternion :: Double -> Double -> Double -> Double -> Quaternion 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 = [Pair] -> Value Json.object [ String -> Double -> Pair forall value pair. (ToJSON value, KeyValue pair) => String -> value -> pair Json.pair String "x" (Double -> Pair) -> Double -> Pair forall a b. (a -> b) -> a -> b $ Quaternion -> Double x Quaternion a , String -> Double -> Pair forall value pair. (ToJSON value, KeyValue pair) => String -> value -> pair Json.pair String "y" (Double -> Pair) -> Double -> Pair forall a b. (a -> b) -> a -> b $ Quaternion -> Double y Quaternion a , String -> Double -> Pair forall value pair. (ToJSON value, KeyValue pair) => String -> value -> pair Json.pair String "z" (Double -> Pair) -> Double -> Pair forall a b. (a -> b) -> a -> b $ Quaternion -> Double z Quaternion a , String -> Double -> Pair forall value pair. (ToJSON value, KeyValue pair) => String -> value -> pair Json.pair String "w" (Double -> Pair) -> Double -> Pair 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 $ [(Pair, Bool)] -> Value Schema.object [ (String -> Value -> Pair forall value pair. (ToJSON value, KeyValue pair) => String -> value -> pair Json.pair String "x" (Value -> Pair) -> Value -> Pair forall a b. (a -> b) -> a -> b $ Schema -> Value Schema.ref Schema Schema.number, Bool True) , (String -> Value -> Pair forall value pair. (ToJSON value, KeyValue pair) => String -> value -> pair Json.pair String "y" (Value -> Pair) -> Value -> Pair forall a b. (a -> b) -> a -> b $ Schema -> Value Schema.ref Schema Schema.number, Bool True) , (String -> Value -> Pair forall value pair. (ToJSON value, KeyValue pair) => String -> value -> pair Json.pair String "z" (Value -> Pair) -> Value -> Pair forall a b. (a -> b) -> a -> b $ Schema -> Value Schema.ref Schema Schema.number, Bool True) , (String -> Value -> Pair forall value pair. (ToJSON value, KeyValue pair) => String -> value -> pair Json.pair String "w" (Value -> Pair) -> Value -> Pair 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 /= :: Component -> Component -> Bool $c/= :: Component -> Component -> Bool == :: Component -> Component -> Bool $c== :: 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 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 = 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 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 :: (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 (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 (f :: * -> *) a. Applicative f => a -> f a pure Component X Word 1 -> Component -> BitGet Component forall (f :: * -> *) a. Applicative f => a -> f a pure Component Y Word 2 -> Component -> BitGet Component forall (f :: * -> *) a. Applicative f => a -> f a pure Component Z Word 3 -> Component -> BitGet Component 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 (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