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
  -- ^ This field is guaranteed to be small. In other words, it won't overflow.
  -- It's stored as a regular 'Word' rather than something more precise like a
  -- 'Word8' because it just gets passed to a functions that expect 'Word's.
  -- There's no reason to do a bunch of conversions.
  , Vector -> Int
x :: Int
  -- ^ See 'bias'.
  , Vector -> Int
y :: Int
  -- ^ See 'bias'.
  , Vector -> Int
z :: Int
  -- ^ See 'bias'.
  }
  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_