module Rattletrap.Encode.RemoteId
  ( putRemoteId
  )
where

import Rattletrap.Encode.Common
import Rattletrap.Encode.Str
import Rattletrap.Encode.Word64le
import Rattletrap.Type.RemoteId
import Rattletrap.Type.Word64le
import Rattletrap.Utility.Bytes

import qualified Data.Binary.Bits.Put as BinaryBits
import qualified Data.ByteString as Bytes

putRemoteId :: RemoteId -> BinaryBits.BitPut ()
putRemoteId :: RemoteId -> BitPut ()
putRemoteId RemoteId
remoteId = case RemoteId
remoteId of
  RemoteIdPlayStation Text
name [Word8]
bytes -> do
    let rawName :: ByteString
rawName = ByteString -> ByteString
reverseBytes (Int -> ByteString -> ByteString
forall a. Integral a => a -> ByteString -> ByteString
padBytes (Int
16 :: Int) (Text -> ByteString
encodeLatin1 Text
name))
    ByteString -> BitPut ()
BinaryBits.putByteString ByteString
rawName
    ByteString -> BitPut ()
BinaryBits.putByteString ([Word8] -> ByteString
Bytes.pack [Word8]
bytes)
  RemoteIdPsyNet Either Word64le (Word64le, Word64le, Word64le, Word64le)
e -> case Either Word64le (Word64le, Word64le, Word64le, Word64le)
e of
    Left Word64le
l -> Word64le -> BitPut ()
putWord64Bits Word64le
l
    Right (Word64le
a, Word64le
b, Word64le
c, Word64le
d) -> Word64le -> Word64le -> Word64le -> Word64le -> BitPut ()
putWord256 Word64le
a Word64le
b Word64le
c Word64le
d
  RemoteIdSplitscreen Word32
word24 -> Int -> Word32 -> BitPut ()
forall a. Bits a => Int -> a -> BitPut ()
putBitsLE Int
24 Word32
word24
  RemoteIdSteam Word64le
word64 -> Word64le -> BitPut ()
putWord64Bits Word64le
word64
  RemoteIdSwitch Word64le
a Word64le
b Word64le
c Word64le
d -> Word64le -> Word64le -> Word64le -> Word64le -> BitPut ()
putWord256 Word64le
a Word64le
b Word64le
c Word64le
d
  RemoteIdXbox Word64le
word64 -> Word64le -> BitPut ()
putWord64Bits Word64le
word64
  RemoteIdEpic Str
str -> Str -> BitPut ()
putTextBits Str
str

putWord256
  :: Word64le -> Word64le -> Word64le -> Word64le -> BinaryBits.BitPut ()
putWord256 :: Word64le -> Word64le -> Word64le -> Word64le -> BitPut ()
putWord256 Word64le
a Word64le
b Word64le
c Word64le
d = do
  Word64le -> BitPut ()
putWord64Bits Word64le
a
  Word64le -> BitPut ()
putWord64Bits Word64le
b
  Word64le -> BitPut ()
putWord64Bits Word64le
c
  Word64le -> BitPut ()
putWord64Bits Word64le
d