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
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
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 = forall a. String -> (Object -> Parser a) -> Value -> Parser a
Json.withObject String
"Vector" forall a b. (a -> b) -> a -> b
$ \Object
object -> do
    CompressedWord
size <- forall value. FromJSON value => Object -> String -> Parser value
Json.required Object
object String
"size"
    Word
bias <- forall value. FromJSON value => Object -> String -> Parser value
Json.required Object
object String
"bias"
    Int
x <- forall value. FromJSON value => Object -> String -> Parser value
Json.required Object
object String
"x"
    Int
y <- forall value. FromJSON value => Object -> String -> Parser value
Json.required Object
object String
"y"
    Int
z <- forall value. FromJSON value => Object -> String -> Parser value
Json.required Object
object String
"z"
    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
    [ forall value pair.
(ToJSON value, KeyValue pair) =>
String -> value -> pair
Json.pair String
"size" forall a b. (a -> b) -> a -> b
$ Vector -> CompressedWord
size Vector
a
    , forall value pair.
(ToJSON value, KeyValue pair) =>
String -> value -> pair
Json.pair String
"bias" forall a b. (a -> b) -> a -> b
$ Vector -> Word
bias Vector
a
    , forall value pair.
(ToJSON value, KeyValue pair) =>
String -> value -> pair
Json.pair String
"x" forall a b. (a -> b) -> a -> b
$ Vector -> Int
x Vector
a
    , forall value pair.
(ToJSON value, KeyValue pair) =>
String -> value -> pair
Json.pair String
"y" forall a b. (a -> b) -> a -> b
$ Vector -> Int
y Vector
a
    , forall value pair.
(ToJSON value, KeyValue pair) =>
String -> value -> pair
Json.pair String
"z" 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" forall a b. (a -> b) -> a -> b
$ [((Key, Value), Bool)] -> Value
Schema.object
  [ (forall value pair.
(ToJSON value, KeyValue pair) =>
String -> value -> pair
Json.pair String
"size" forall a b. (a -> b) -> a -> b
$ Schema -> Value
Schema.ref Schema
CompressedWord.schema, Bool
True)
  , (forall value pair.
(ToJSON value, KeyValue pair) =>
String -> value -> pair
Json.pair String
"bias" forall a b. (a -> b) -> a -> b
$ Schema -> Value
Schema.ref Schema
Schema.integer, Bool
True)
  , (forall value pair.
(ToJSON value, KeyValue pair) =>
String -> value -> pair
Json.pair String
"x" forall a b. (a -> b) -> a -> b
$ Schema -> Value
Schema.ref Schema
Schema.integer, Bool
True)
  , (forall value pair.
(ToJSON value, KeyValue pair) =>
String -> value -> pair
Json.pair String
"y" forall a b. (a -> b) -> a -> b
$ Schema -> Value
Schema.ref Schema
Schema.integer, Bool
True)
  , (forall value pair.
(ToJSON value, KeyValue pair) =>
String -> value -> pair
Json.pair String
"z" 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 =
      forall a b. (RealFrac a, Integral b) => a -> b
round (forall a. Floating a => a -> a -> a
logBase (Float
2 :: Float) (forall a b. (Integral a, Num b) => a -> b
fromIntegral (Vector -> Word
bias Vector
vector))) forall a. Num a => a -> a -> a
- Word
1 :: Word
    dx :: Word
dx = forall a b. (Integral a, Num b) => a -> b
fromIntegral (Vector -> Int
x Vector
vector forall a. Num a => a -> a -> a
+ forall a b. (Integral a, Num b) => a -> b
fromIntegral (Vector -> Word
bias Vector
vector)) :: Word
    dy :: Word
dy = forall a b. (Integral a, Num b) => a -> b
fromIntegral (Vector -> Int
y Vector
vector forall a. Num a => a -> a -> a
+ forall a b. (Integral a, Num b) => a -> b
fromIntegral (Vector -> Word
bias Vector
vector)) :: Word
    dz :: Word
dz = forall a b. (Integral a, Num b) => a -> b
fromIntegral (Vector -> Int
z Vector
vector forall a. Num a => a -> a -> a
+ forall a b. (Integral a, Num b) => a -> b
fromIntegral (Vector -> Word
bias Vector
vector)) :: Word
    limit :: Word
limit = Word
2 forall a b. (Num a, Integral b) => a -> b -> a
^ (Word
bitSize forall a. Num a => a -> a -> a
+ Word
2) :: Word
  in
    CompressedWord -> BitPut
CompressedWord.bitPut (Vector -> CompressedWord
size Vector
vector)
    forall a. Semigroup a => a -> a -> a
<> CompressedWord -> BitPut
CompressedWord.bitPut (Word -> Word -> CompressedWord
CompressedWord.CompressedWord Word
limit Word
dx)
    forall a. Semigroup a => a -> a -> a
<> CompressedWord -> BitPut
CompressedWord.bitPut (Word -> Word -> CompressedWord
CompressedWord.CompressedWord Word
limit Word
dy)
    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 = forall a. String -> BitGet a -> BitGet a
BitGet.label String
"Vector" forall a b. (a -> b) -> a -> b
$ do
  CompressedWord
size <-
    forall a. String -> BitGet a -> BitGet a
BitGet.label String
"size"
    forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word -> Get BitString Identity CompressedWord
CompressedWord.bitGet
    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 <- forall a. String -> BitGet a -> BitGet a
BitGet.label String
"x" forall a b. (a -> b) -> a -> b
$ Word -> Word -> BitGet Int
getPart Word
limit Word
bias
  Int
y <- forall a. String -> BitGet a -> BitGet a
BitGet.label String
"y" forall a b. (a -> b) -> a -> b
$ Word -> Word -> BitGet Int
getPart Word
limit Word
bias
  Int
z <- forall a. String -> BitGet a -> BitGet a
BitGet.label String
"z" forall a b. (a -> b) -> a -> b
$ Word -> Word -> BitGet Int
getPart Word
limit Word
bias
  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 = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Word -> CompressedWord -> Int
fromDelta Word
bias) (Word -> Get BitString Identity CompressedWord
CompressedWord.bitGet Word
limit)

getLimit :: CompressedWord.CompressedWord -> Word
getLimit :: CompressedWord -> Word
getLimit = (Word
2 forall a b. (Num a, Integral b) => a -> b -> a
^) forall b c a. (b -> c) -> (a -> b) -> a -> c
. (forall a. Num a => a -> a -> a
+ Word
2) forall b c a. (b -> c) -> (a -> b) -> a -> c
. CompressedWord -> Word
CompressedWord.value

getBias :: CompressedWord.CompressedWord -> Word
getBias :: CompressedWord -> Word
getBias = (Word
2 forall a b. (Num a, Integral b) => a -> b -> a
^) forall b c a. (b -> c) -> (a -> b) -> a -> c
. (forall a. Num a => a -> a -> a
+ Word
1) 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_ =
  forall a b. (Integral a, Num b) => a -> b
fromIntegral (CompressedWord -> Word
CompressedWord.value CompressedWord
x_) forall a. Num a => a -> a -> a
- forall a b. (Integral a, Num b) => a -> b
fromIntegral Word
bias_