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