module Rattletrap.Encode.Str
  ( putText
  , putTextBits
  )
where

import Rattletrap.Encode.Int32le
import Rattletrap.Type.Common
import Rattletrap.Type.Int32le
import Rattletrap.Type.Str
import Rattletrap.Utility.Bytes

import qualified Data.Binary as Binary
import qualified Data.Binary.Bits.Put as BinaryBits
import qualified Data.Binary.Put as Binary
import qualified Data.ByteString as Bytes
import qualified Data.Char as Char
import qualified Data.Text as Text
import qualified Data.Text.Encoding as Text

putText :: Str -> Binary.Put
putText :: Str -> Put
putText Str
text = do
  let size :: Int32le
size = Str -> Int32le
getTextSize Str
text
  let encode :: Text -> ByteString
encode = Int32le -> Text -> ByteString
getTextEncoder Int32le
size
  Int32le -> Put
putInt32 Int32le
size
  ByteString -> Put
Binary.putByteString (Text -> ByteString
encode (Text -> Text
addNull (Str -> Text
strValue Str
text)))

putTextBits :: Str -> BinaryBits.BitPut ()
putTextBits :: Str -> BitPut ()
putTextBits Str
text = do
  let size :: Int32le
size = Str -> Int32le
getTextSize Str
text
  let encode :: Text -> ByteString
encode = Int32le -> Text -> ByteString
getTextEncoder Int32le
size
  Int32le -> BitPut ()
putInt32Bits Int32le
size
  ByteString -> BitPut ()
BinaryBits.putByteString (ByteString -> ByteString
reverseBytes (Text -> ByteString
encode (Text -> Text
addNull (Str -> Text
strValue Str
text))))

getTextSize :: Str -> Int32le
getTextSize :: Str -> Int32le
getTextSize Str
text =
  let
    value :: Text
value = Str -> Text
strValue Str
text
    scale :: Int32
scale = if (Char -> Bool) -> Text -> Bool
Text.all Char -> Bool
Char.isLatin1 Text
value then Int32
1 else -Int32
1 :: Int32
    rawSize :: Int32
rawSize = if Text -> Bool
Text.null Text
value
      then Int32
0
      else Int -> Int32
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Text -> Int
Text.length Text
value) Int32 -> Int32 -> Int32
forall a. Num a => a -> a -> a
+ Int32
1 :: Int32
    size :: Int32
size = if Text
value Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== String -> Text
Text.pack String
"\x00\x00\x00None"
      then Int32
0x05000000
      else Int32
scale Int32 -> Int32 -> Int32
forall a. Num a => a -> a -> a
* Int32
rawSize :: Int32
  in Int32 -> Int32le
Int32le Int32
size

getTextEncoder :: Int32le -> Text.Text -> Bytes.ByteString
getTextEncoder :: Int32le -> Text -> ByteString
getTextEncoder Int32le
size Text
text =
  if Int32le
size Int32le -> Int32le -> Bool
forall a. Ord a => a -> a -> Bool
< Int32 -> Int32le
Int32le Int32
0 then Text -> ByteString
Text.encodeUtf16LE Text
text else Text -> ByteString
encodeLatin1 Text
text

addNull :: Text.Text -> Text.Text
addNull :: Text -> Text
addNull Text
text = if Text -> Bool
Text.null Text
text then Text
text else Text -> Char -> Text
Text.snoc Text
text Char
'\x00'