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,
    -- | 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 -> Word
bias :: Word,
    -- | See 'bias'.
    Vector -> Int
x :: Int,
    -- | See 'bias'.
    Vector -> Int
y :: Int,
    -- | See 'bias'.
    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
$c== :: Vector -> Vector -> Bool
== :: Vector -> Vector -> Bool
$c/= :: Vector -> Vector -> Bool
/= :: 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
$cshowsPrec :: Int -> Vector -> ShowS
showsPrec :: Int -> Vector -> ShowS
$cshow :: Vector -> String
show :: Vector -> String
$cshowList :: [Vector] -> ShowS
showList :: [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 a. a -> Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
pure 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 =
    [(Key, Value)] -> Value
Json.object
      [ String -> CompressedWord -> (Key, Value)
forall value e p.
(ToJSON value, KeyValue e p) =>
String -> value -> p
Json.pair String
"size" (CompressedWord -> (Key, Value)) -> CompressedWord -> (Key, Value)
forall a b. (a -> b) -> a -> b
$ Vector -> CompressedWord
size Vector
a,
        String -> Word -> (Key, Value)
forall value e p.
(ToJSON value, KeyValue e p) =>
String -> value -> p
Json.pair String
"bias" (Word -> (Key, Value)) -> Word -> (Key, Value)
forall a b. (a -> b) -> a -> b
$ Vector -> Word
bias Vector
a,
        String -> Int -> (Key, Value)
forall value e p.
(ToJSON value, KeyValue e p) =>
String -> value -> p
Json.pair String
"x" (Int -> (Key, Value)) -> Int -> (Key, Value)
forall a b. (a -> b) -> a -> b
$ Vector -> Int
x Vector
a,
        String -> Int -> (Key, Value)
forall value e p.
(ToJSON value, KeyValue e p) =>
String -> value -> p
Json.pair String
"y" (Int -> (Key, Value)) -> Int -> (Key, Value)
forall a b. (a -> b) -> a -> b
$ Vector -> Int
y Vector
a,
        String -> Int -> (Key, Value)
forall value e p.
(ToJSON value, KeyValue e p) =>
String -> value -> p
Json.pair String
"z" (Int -> (Key, Value)) -> Int -> (Key, Value)
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
$
    [((Key, Value), Bool)] -> Value
Schema.object
      [ (String -> Value -> (Key, Value)
forall value e p.
(ToJSON value, KeyValue e p) =>
String -> value -> p
Json.pair String
"size" (Value -> (Key, Value)) -> Value -> (Key, Value)
forall a b. (a -> b) -> a -> b
$ Schema -> Value
Schema.ref Schema
CompressedWord.schema, Bool
True),
        (String -> Value -> (Key, Value)
forall value e p.
(ToJSON value, KeyValue e p) =>
String -> value -> p
Json.pair String
"bias" (Value -> (Key, Value)) -> Value -> (Key, Value)
forall a b. (a -> b) -> a -> b
$ Schema -> Value
Schema.ref Schema
Schema.integer, Bool
True),
        (String -> Value -> (Key, Value)
forall value e p.
(ToJSON value, KeyValue e p) =>
String -> value -> p
Json.pair String
"x" (Value -> (Key, Value)) -> Value -> (Key, Value)
forall a b. (a -> b) -> a -> b
$ Schema -> Value
Schema.ref Schema
Schema.integer, Bool
True),
        (String -> Value -> (Key, Value)
forall value e p.
(ToJSON value, KeyValue e p) =>
String -> value -> p
Json.pair String
"y" (Value -> (Key, Value)) -> Value -> (Key, Value)
forall a b. (a -> b) -> a -> b
$ Schema -> Value
Schema.ref Schema
Schema.integer, Bool
True),
        (String -> Value -> (Key, Value)
forall value e p.
(ToJSON value, KeyValue e p) =>
String -> value -> p
Json.pair String
"z" (Value -> (Key, Value)) -> Value -> (Key, Value)
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 b. Integral b => Float -> b
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 a. a -> Get BitString Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure 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 a b.
(a -> b) -> Get BitString Identity a -> Get BitString Identity b
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_