swflib/swfOut.ml

   1 open Base
   2 open SwfType
   3
   4 module type TagType = sig
   5   type t
   6   val to_base : t -> int * SwfBaseOut.t list
   7 end
   8
   9 module Make(Tag : TagType) = struct
  10   let char c =
  11     `Ui8 (Char.code c)
  12
  13   let of_rect {top; bottom; left; right} =
  14     `Rect(left,right,top,bottom)
  15
  16   let of_tag tag =
  17     let make_type t size =
  18       `Ui16 ((t lsl 6) lor size) in
  19     let tag,data' =
  20       Tag.to_base tag in
  21     let size =
  22       List.length @@ SwfBaseOut.to_list data' in
  23       if size < 0x3F then
  24         make_type tag size :: data'
  25       else
  26         make_type tag 0x3F :: `Si32 (Int32.of_int size) :: data'
  27
  28   let to_base t = [
  29     (* signature *)
  30     char 'F'; char 'W'; char 'S';
  31     (* version *)
  32     `Ui8 t.version;
  33     (* file length *)
  34     `Ui32Size;
  35     (* frame size *)
  36     of_rect t.frame_size;
  37     (* frame rate *)
  38     `Fixed8 t.frame_rate;
  39     (* frame count *)
  40     `Ui16 t.frame_count
  41   ] @ HList.concat_map of_tag t.tags
  42
  43 end