module Rattletrap.Type.Vector where
import qualified Rattletrap.BitGet as BitGet
import qualified Rattletrap.BitPut as BitPut
import qualified Rattletrap.Schema as Schema
import qualified Rattletrap.Type.CompressedWord as CompressedWord
import qualified Rattletrap.Type.Version as Version
import qualified Rattletrap.Utility.Json as Json
data Vector = Vector
{ Vector -> CompressedWord
size :: CompressedWord.CompressedWord
, Vector -> Word
bias :: Word
, Vector -> Int
x :: Int
, Vector -> Int
y :: Int
, Vector -> Int
z :: Int
}
deriving (Vector -> Vector -> Bool
(Vector -> Vector -> Bool)
-> (Vector -> Vector -> Bool) -> Eq Vector
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Vector -> Vector -> Bool
$c/= :: Vector -> Vector -> Bool
== :: Vector -> Vector -> Bool
$c== :: Vector -> Vector -> Bool
Eq, Int -> Vector -> ShowS
[Vector] -> ShowS
Vector -> String
(Int -> Vector -> ShowS)
-> (Vector -> String) -> ([Vector] -> ShowS) -> Show Vector
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Vector] -> ShowS
$cshowList :: [Vector] -> ShowS
show :: Vector -> String
$cshow :: Vector -> String
showsPrec :: Int -> Vector -> ShowS
$cshowsPrec :: Int -> Vector -> ShowS
Show)
instance Json.FromJSON Vector where
parseJSON :: Value -> Parser Vector
parseJSON = String -> (Object -> Parser Vector) -> Value -> Parser Vector
forall a. String -> (Object -> Parser a) -> Value -> Parser a
Json.withObject String
"Vector" ((Object -> Parser Vector) -> Value -> Parser Vector)
-> (Object -> Parser Vector) -> Value -> Parser Vector
forall a b. (a -> b) -> a -> b
$ \Object
object -> do
CompressedWord
size <- Object -> String -> Parser CompressedWord
forall value. FromJSON value => Object -> String -> Parser value
Json.required Object
object String
"size"
Word
bias <- Object -> String -> Parser Word
forall value. FromJSON value => Object -> String -> Parser value
Json.required Object
object String
"bias"
Int
x <- Object -> String -> Parser Int
forall value. FromJSON value => Object -> String -> Parser value
Json.required Object
object String
"x"
Int
y <- Object -> String -> Parser Int
forall value. FromJSON value => Object -> String -> Parser value
Json.required Object
object String
"y"
Int
z <- Object -> String -> Parser Int
forall value. FromJSON value => Object -> String -> Parser value
Json.required Object
object String
"z"
Vector -> Parser Vector
forall (f :: * -> *) a. Applicative f => a -> f a
pure Vector :: CompressedWord -> Word -> Int -> Int -> Int -> Vector
Vector { CompressedWord
size :: CompressedWord
size :: CompressedWord
size, Word
bias :: Word
bias :: Word
bias, Int
x :: Int
x :: Int
x, Int
y :: Int
y :: Int
y, Int
z :: Int
z :: Int
z }
instance Json.ToJSON Vector where
toJSON :: Vector -> Value
toJSON Vector
a = [Pair] -> Value
Json.object
[ String -> CompressedWord -> Pair
forall value pair.
(ToJSON value, KeyValue pair) =>
String -> value -> pair
Json.pair String
"size" (CompressedWord -> Pair) -> CompressedWord -> Pair
forall a b. (a -> b) -> a -> b
$ Vector -> CompressedWord
size Vector
a
, String -> Word -> Pair
forall value pair.
(ToJSON value, KeyValue pair) =>
String -> value -> pair
Json.pair String
"bias" (Word -> Pair) -> Word -> Pair
forall a b. (a -> b) -> a -> b
$ Vector -> Word
bias Vector
a
, String -> Int -> Pair
forall value pair.
(ToJSON value, KeyValue pair) =>
String -> value -> pair
Json.pair String
"x" (Int -> Pair) -> Int -> Pair
forall a b. (a -> b) -> a -> b
$ Vector -> Int
x Vector
a
, String -> Int -> Pair
forall value pair.
(ToJSON value, KeyValue pair) =>
String -> value -> pair
Json.pair String
"y" (Int -> Pair) -> Int -> Pair
forall a b. (a -> b) -> a -> b
$ Vector -> Int
y Vector
a
, String -> Int -> Pair
forall value pair.
(ToJSON value, KeyValue pair) =>
String -> value -> pair
Json.pair String
"z" (Int -> Pair) -> Int -> Pair
forall a b. (a -> b) -> a -> b
$ Vector -> Int
z Vector
a
]
schema :: Schema.Schema
schema :: Schema
schema = String -> Value -> Schema
Schema.named String
"vector" (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
"size" (Value -> Pair) -> Value -> Pair
forall a b. (a -> b) -> a -> b
$ Schema -> Value
Schema.ref Schema
CompressedWord.schema, Bool
True)
, (String -> Value -> Pair
forall value pair.
(ToJSON value, KeyValue pair) =>
String -> value -> pair
Json.pair String
"bias" (Value -> Pair) -> Value -> Pair
forall a b. (a -> b) -> a -> b
$ Schema -> Value
Schema.ref Schema
Schema.integer, Bool
True)
, (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.integer, 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.integer, 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.integer, Bool
True)
]
bitPut :: Vector -> BitPut.BitPut
bitPut :: Vector -> BitPut
bitPut Vector
vector =
let
bitSize :: Word
bitSize =
Float -> Word
forall a b. (RealFrac a, Integral b) => a -> b
round (Float -> Float -> Float
forall a. Floating a => a -> a -> a
logBase (Float
2 :: Float) (Word -> Float
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Vector -> Word
bias Vector
vector))) Word -> Word -> Word
forall a. Num a => a -> a -> a
- Word
1 :: Word
dx :: Word
dx = Int -> Word
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Vector -> Int
x Vector
vector Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Word -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Vector -> Word
bias Vector
vector)) :: Word
dy :: Word
dy = Int -> Word
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Vector -> Int
y Vector
vector Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Word -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Vector -> Word
bias Vector
vector)) :: Word
dz :: Word
dz = Int -> Word
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Vector -> Int
z Vector
vector Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Word -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Vector -> Word
bias Vector
vector)) :: Word
limit :: Word
limit = Word
2 Word -> Word -> Word
forall a b. (Num a, Integral b) => a -> b -> a
^ (Word
bitSize Word -> Word -> Word
forall a. Num a => a -> a -> a
+ Word
2) :: Word
in
CompressedWord -> BitPut
CompressedWord.bitPut (Vector -> CompressedWord
size Vector
vector)
BitPut -> BitPut -> BitPut
forall a. Semigroup a => a -> a -> a
<> CompressedWord -> BitPut
CompressedWord.bitPut (Word -> Word -> CompressedWord
CompressedWord.CompressedWord Word
limit Word
dx)
BitPut -> BitPut -> BitPut
forall a. Semigroup a => a -> a -> a
<> CompressedWord -> BitPut
CompressedWord.bitPut (Word -> Word -> CompressedWord
CompressedWord.CompressedWord Word
limit Word
dy)
BitPut -> BitPut -> BitPut
forall a. Semigroup a => a -> a -> a
<> CompressedWord -> BitPut
CompressedWord.bitPut (Word -> Word -> CompressedWord
CompressedWord.CompressedWord Word
limit Word
dz)
bitGet :: Version.Version -> BitGet.BitGet Vector
bitGet :: Version -> BitGet Vector
bitGet Version
version = do
CompressedWord
size_ <- Word -> BitGet CompressedWord
CompressedWord.bitGet (if Version -> Bool
has21Bits Version
version then Word
21 else Word
19)
let
limit :: Word
limit = CompressedWord -> Word
getLimit CompressedWord
size_
bias_ :: Word
bias_ = CompressedWord -> Word
getBias CompressedWord
size_
CompressedWord -> Word -> Int -> Int -> Int -> Vector
Vector CompressedWord
size_ Word
bias_
(Int -> Int -> Int -> Vector)
-> BitGet Int -> BitGet (Int -> Int -> Vector)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (CompressedWord -> Int) -> BitGet CompressedWord -> BitGet Int
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Word -> CompressedWord -> Int
fromDelta Word
bias_) (Word -> BitGet CompressedWord
CompressedWord.bitGet Word
limit)
BitGet (Int -> Int -> Vector)
-> BitGet Int -> BitGet (Int -> Vector)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (CompressedWord -> Int) -> BitGet CompressedWord -> BitGet Int
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Word -> CompressedWord -> Int
fromDelta Word
bias_) (Word -> BitGet CompressedWord
CompressedWord.bitGet Word
limit)
BitGet (Int -> Vector) -> BitGet Int -> BitGet Vector
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (CompressedWord -> Int) -> BitGet CompressedWord -> BitGet Int
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Word -> CompressedWord -> Int
fromDelta Word
bias_) (Word -> BitGet CompressedWord
CompressedWord.bitGet Word
limit)
has21Bits :: Version.Version -> Bool
has21Bits :: Version -> Bool
has21Bits Version
v =
Version -> Int
Version.major Version
v Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
868 Bool -> Bool -> Bool
&& Version -> Int
Version.minor Version
v Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
22 Bool -> Bool -> Bool
&& Version -> Int
Version.patch Version
v Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
7
getLimit :: CompressedWord.CompressedWord -> Word
getLimit :: CompressedWord -> Word
getLimit = (Word
2 Word -> Word -> Word
forall a b. (Num a, Integral b) => a -> b -> a
^) (Word -> Word)
-> (CompressedWord -> Word) -> CompressedWord -> Word
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Word -> Word -> Word
forall a. Num a => a -> a -> a
+ Word
2) (Word -> Word)
-> (CompressedWord -> Word) -> CompressedWord -> Word
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CompressedWord -> Word
CompressedWord.value
getBias :: CompressedWord.CompressedWord -> Word
getBias :: CompressedWord -> Word
getBias = (Word
2 Word -> Word -> Word
forall a b. (Num a, Integral b) => a -> b -> a
^) (Word -> Word)
-> (CompressedWord -> Word) -> CompressedWord -> Word
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Word -> Word -> Word
forall a. Num a => a -> a -> a
+ Word
1) (Word -> Word)
-> (CompressedWord -> Word) -> CompressedWord -> Word
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CompressedWord -> Word
CompressedWord.value
fromDelta :: Word -> CompressedWord.CompressedWord -> Int
fromDelta :: Word -> CompressedWord -> Int
fromDelta Word
bias_ CompressedWord
x_ =
Word -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (CompressedWord -> Word
CompressedWord.value CompressedWord
x_) Int -> Int -> Int
forall a. Num a => a -> a -> a
- Word -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word
bias_