module Rattletrap.Encode.Attribute
  ( putAttributes
  )
where

import Rattletrap.Encode.AttributeValue
import Rattletrap.Encode.CompressedWord
import Rattletrap.Type.Attribute

import qualified Data.Binary.Bits.Put as BinaryBits

putAttributes :: [Attribute] -> BinaryBits.BitPut ()
putAttributes :: [Attribute] -> BitPut ()
putAttributes [Attribute]
attributes = case [Attribute]
attributes of
  [] -> Bool -> BitPut ()
BinaryBits.putBool Bool
False
  [Attribute
attribute] -> do
    Attribute -> BitPut ()
putAttribute Attribute
attribute
    Bool -> BitPut ()
BinaryBits.putBool Bool
False
  Attribute
first : [Attribute]
rest -> do
    Attribute -> BitPut ()
putAttribute Attribute
first
    [Attribute] -> BitPut ()
putAttributes [Attribute]
rest

putAttribute :: Attribute -> BinaryBits.BitPut ()
putAttribute :: Attribute -> BitPut ()
putAttribute Attribute
attribute = do
  Bool -> BitPut ()
BinaryBits.putBool Bool
True
  CompressedWord -> BitPut ()
putCompressedWord (Attribute -> CompressedWord
attributeId Attribute
attribute)
  AttributeValue -> BitPut ()
putAttributeValue (Attribute -> AttributeValue
attributeValue Attribute
attribute)