module Rattletrap.Encode.ProductAttribute
  ( putProductAttributes
  )
where

import Rattletrap.Encode.Common
import Rattletrap.Encode.CompressedWord
import Rattletrap.Encode.Word32le
import Rattletrap.Encode.Word8le
import Rattletrap.Encode.Str
import Rattletrap.Type.ProductAttribute
import Rattletrap.Type.Word8le

import qualified Data.Binary.Bits.Put as BinaryBits

putProductAttributes :: [ProductAttribute] -> BinaryBits.BitPut ()
putProductAttributes :: [ProductAttribute] -> BitPut ()
putProductAttributes [ProductAttribute]
attributes = do
  Word8le -> BitPut ()
putWord8Bits (Word8 -> Word8le
Word8le (Int -> Word8
forall a b. (Integral a, Num b) => a -> b
fromIntegral ([ProductAttribute] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [ProductAttribute]
attributes)))
  (ProductAttribute -> BitPut ()) -> [ProductAttribute] -> BitPut ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ ProductAttribute -> BitPut ()
putProductAttribute [ProductAttribute]
attributes

putProductAttribute :: ProductAttribute -> BinaryBits.BitPut ()
putProductAttribute :: ProductAttribute -> BitPut ()
putProductAttribute ProductAttribute
attribute = do
  Bool -> BitPut ()
BinaryBits.putBool (ProductAttribute -> Bool
productAttributeUnknown ProductAttribute
attribute)
  Word32le -> BitPut ()
putWord32Bits (ProductAttribute -> Word32le
productAttributeObjectId ProductAttribute
attribute)
  case ProductAttribute -> ProductAttributeValue
productAttributeValue ProductAttribute
attribute of
    ProductAttributeValuePaintedOld CompressedWord
x -> CompressedWord -> BitPut ()
putCompressedWord CompressedWord
x
    ProductAttributeValuePaintedNew Word32
x -> Int -> Word32 -> BitPut ()
forall a. Bits a => Int -> a -> BitPut ()
putBitsLE Int
31 Word32
x
    ProductAttributeValueTeamEditionOld CompressedWord
x -> CompressedWord -> BitPut ()
putCompressedWord CompressedWord
x
    ProductAttributeValueTeamEditionNew Word32
x -> Int -> Word32 -> BitPut ()
forall a. Bits a => Int -> a -> BitPut ()
putBitsLE Int
31 Word32
x
    ProductAttributeValueSpecialEdition Word32
x -> Int -> Word32 -> BitPut ()
forall a. Bits a => Int -> a -> BitPut ()
putBitsLE Int
31 Word32
x
    ProductAttributeValueUserColorOld Maybe Word32
x -> case Maybe Word32
x of
      Maybe Word32
Nothing -> Bool -> BitPut ()
BinaryBits.putBool Bool
False
      Just Word32
y -> do
        Bool -> BitPut ()
BinaryBits.putBool Bool
True
        Int -> Word32 -> BitPut ()
forall a. Bits a => Int -> a -> BitPut ()
putBitsLE Int
31 Word32
y
    ProductAttributeValueUserColorNew Word32le
x -> Word32le -> BitPut ()
putWord32Bits Word32le
x
    ProductAttributeValueTitleId Str
x -> Str -> BitPut ()
putTextBits Str
x