{-# 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