content: 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
    { 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.
      bias :: Word,
      -- | See 'bias'.
      x :: Int,
      -- | See 'bias'.
      y :: Int,
      -- | See 'bias'.
      z :: Int
    }
    deriving (Eq, Show)
  
  instance Json.FromJSON Vector where
    parseJSON = Json.withObject "Vector" $ \object -> do
      size <- Json.required object "size"
      bias <- Json.required object "bias"
      x <- Json.required object "x"
      y <- Json.required object "y"
      z <- Json.required object "z"
      pure Vector {size, bias, x, y, z}
  
  instance Json.ToJSON Vector where
    toJSON a =
      Json.object
        [ Json.pair "size" $ size a,
          Json.pair "bias" $ bias a,
          Json.pair "x" $ x a,
          Json.pair "y" $ y a,
          Json.pair "z" $ z a
        ]
  
  schema :: Schema.Schema
  schema =
    Schema.named "vector" $
      Schema.object
        [ (Json.pair "size" $ Schema.ref CompressedWord.schema, True),
          (Json.pair "bias" $ Schema.ref Schema.integer, True),
          (Json.pair "x" $ Schema.ref Schema.integer, True),
          (Json.pair "y" $ Schema.ref Schema.integer, True),
          (Json.pair "z" $ Schema.ref Schema.integer, True)
        ]
  
  bitPut :: Vector -> BitPut.BitPut
  bitPut vector =
    let bitSize =
          round (logBase (2 :: Float) (fromIntegral (bias vector))) - 1 :: Word
        dx = fromIntegral (x vector + fromIntegral (bias vector)) :: Word
        dy = fromIntegral (y vector + fromIntegral (bias vector)) :: Word
        dz = fromIntegral (z vector + fromIntegral (bias vector)) :: Word
        limit = 2 ^ (bitSize + 2) :: Word
     in CompressedWord.bitPut (size vector)
          <> CompressedWord.bitPut (CompressedWord.CompressedWord limit dx)
          <> CompressedWord.bitPut (CompressedWord.CompressedWord limit dy)
          <> CompressedWord.bitPut (CompressedWord.CompressedWord limit dz)
  
  bitGet :: Version.Version -> BitGet.BitGet Vector
  bitGet version = BitGet.label "Vector" $ do
    size <-
      BitGet.label "size"
        . CompressedWord.bitGet
        $ if Version.atLeast 868 22 7 version then 21 else 19
    let limit = getLimit size
        bias = getBias size
    x <- BitGet.label "x" $ getPart limit bias
    y <- BitGet.label "y" $ getPart limit bias
    z <- BitGet.label "z" $ getPart limit bias
    pure Vector {size, bias, x, y, z}
  
  getPart :: Word -> Word -> BitGet.BitGet Int
  getPart limit bias = fmap (fromDelta bias) (CompressedWord.bitGet limit)
  
  getLimit :: CompressedWord.CompressedWord -> Word
  getLimit = (2 ^) . (+ 2) . CompressedWord.value
  
  getBias :: CompressedWord.CompressedWord -> Word
  getBias = (2 ^) . (+ 1) . CompressedWord.value
  
  fromDelta :: Word -> CompressedWord.CompressedWord -> Int
  fromDelta bias_ x_ =
    fromIntegral (CompressedWord.value x_) - fromIntegral bias_
  