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 = String -> BitGet Vector -> BitGet Vector
forall a. String -> BitGet a -> BitGet a
BitGet.label String
"Vector" (BitGet Vector -> BitGet Vector) -> BitGet Vector -> BitGet Vector
forall a b. (a -> b) -> a -> b
$ do
  CompressedWord
size <-
    String -> BitGet CompressedWord -> BitGet CompressedWord
forall a. String -> BitGet a -> BitGet a
BitGet.label String
"size"
    (BitGet CompressedWord -> BitGet CompressedWord)
-> (Word -> BitGet CompressedWord) -> Word -> BitGet CompressedWord
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word -> BitGet CompressedWord
CompressedWord.bitGet
    (Word -> BitGet CompressedWord) -> Word -> BitGet CompressedWord
forall a b. (a -> b) -> a -> b
$ if Int -> Int -> Int -> Version -> Bool
Version.atLeast Int
868 Int
22 Int
7 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
  Int
x <- String -> BitGet Int -> BitGet Int
forall a. String -> BitGet a -> BitGet a
BitGet.label String
"x" (BitGet Int -> BitGet Int) -> BitGet Int -> BitGet Int
forall a b. (a -> b) -> a -> b
$ Word -> Word -> BitGet Int
getPart Word
limit Word
bias
  Int
y <- String -> BitGet Int -> BitGet Int
forall a. String -> BitGet a -> BitGet a
BitGet.label String
"y" (BitGet Int -> BitGet Int) -> BitGet Int -> BitGet Int
forall a b. (a -> b) -> a -> b
$ Word -> Word -> BitGet Int
getPart Word
limit Word
bias
  Int
z <- String -> BitGet Int -> BitGet Int
forall a. String -> BitGet a -> BitGet a
BitGet.label String
"z" (BitGet Int -> BitGet Int) -> BitGet Int -> BitGet Int
forall a b. (a -> b) -> a -> b
$ Word -> Word -> BitGet Int
getPart Word
limit Word
bias
  Vector -> BitGet 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 }

getPart :: Word -> Word -> BitGet.BitGet Int
getPart :: Word -> Word -> BitGet Int
getPart Word
limit Word
bias = (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)

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_