module Rattletrap.Encode.Frame
  ( putFrames
  )
where

import Rattletrap.Encode.Float32le
import Rattletrap.Encode.Replication
import Rattletrap.Type.Frame

import qualified Data.Binary.Bits.Put as BinaryBits

putFrames :: [Frame] -> BinaryBits.BitPut ()
putFrames :: [Frame] -> BitPut ()
putFrames [Frame]
frames = case [Frame]
frames of
  [] -> () -> BitPut ()
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
  [Frame
frame] -> Frame -> BitPut ()
putFrame Frame
frame
  Frame
first : [Frame]
rest -> do
    Frame -> BitPut ()
putFrame Frame
first
    [Frame] -> BitPut ()
putFrames [Frame]
rest

putFrame :: Frame -> BinaryBits.BitPut ()
putFrame :: Frame -> BitPut ()
putFrame Frame
frame = do
  Float32le -> BitPut ()
putFloat32Bits (Frame -> Float32le
frameTime Frame
frame)
  Float32le -> BitPut ()
putFloat32Bits (Frame -> Float32le
frameDelta Frame
frame)
  [Replication] -> BitPut ()
putReplications (Frame -> [Replication]
frameReplications Frame
frame)