swflib/tagOut.ml

   1 open Base
   2 open SwfBaseOut
   3
   4 type file_attrs = {
   5   is_metadata : bool;
   6   is_as3      : bool;
   7   use_network : bool;
   8 }
   9
  10 type alist = (int * string) list
  11 type rect = {
  12   right:int;
  13   left:int;
  14   top:int;
  15   bottom:int
  16 }
  17 type t = [
  18 | `PlaceObject of int * int * SwfBaseType.matrix
  19 | `FrameLabel of string * bool
  20 | `Protect
  21 | `End
  22 | `ExportAssets of alist
  23 | `ImportAssets of string * alist
  24 | `EnableDebuger of string
  25 | `EnableDebugger2 of string
  26 | `ScriptLimits of int * int
  27 | `SetTabIndex of int * int
  28 | `FileAttributes of file_attrs
  29 | `ImportAssets2 of string * alist
  30 | `SymbolClass of alist
  31 | `Metadata of string
  32 | `DefineScalingGrid of rect
  33 | `DefineSceneAndFrameLabelData of (int * string) list * (int * string) list
  34 | `ShowFrame
  35 | `SetBackgroundColor of int * int * int
  36 | `DoABC of bool * string * int list
  37 ]
  38
  39 let alist xs =
  40   let symbol (id,name) =
  41     [`Ui16 id; `Str name] in
  42     List.concat [
  43       [`Ui16 (List.length xs)];
  44       HList.concat_map symbol xs]
  45
  46 let tag id body =
  47   (id,body)
  48
  49 let to_base : t -> int*SwfBaseOut.s list = function
  50     `PlaceObject (id,depth,matrix) ->
  51       tag 4 [
  52         `Ui16 id;
  53         `Ui16 depth;
  54         `Matrix matrix
  55       ]
  56   | `FrameLabel (name,anchor) ->
  57       if anchor then
  58         tag 43 [`Str name; `Ui8 1]
  59       else
  60         tag 43 [`Str name]
  61   | `Protect ->
  62       tag 24 []
  63   | `End ->
  64       tag 0 []
  65   | `ExportAssets xs ->
  66       tag 56 @@ alist xs
  67   | `ImportAssets (url, xs) ->
  68       tag 57 @@ (`Str url)::alist xs
  69   | `EnableDebuger passwd ->
  70       tag 58 [`Str passwd]
  71   | `EnableDebugger2 passwd ->
  72       tag 64 [`Ui16 0; `Str passwd]
  73   | `ScriptLimits (recursion, timeout) ->
  74       tag 65 [`Ui16 recursion; `Ui16 timeout]
  75   | `SetTabIndex (depth, order) ->
  76       tag 66 [`Ui16 depth; `Ui16 order]
  77   | `ShowFrame ->
  78       tag 1 []
  79   | `SetBackgroundColor(r,g,b) ->
  80       tag 9 [`RGB(r,g,b)]
  81   | `FileAttributes {is_metadata; is_as3; use_network} ->
  82       tag 69 [
  83         `Bits [
  84           UB(3 , 0);
  85           UB(1 , if is_metadata then 1 else 0);
  86           UB(1 , if is_as3 then 1 else 0);
  87           UB(2 , 0);
  88           UB(1 , if use_network then 1 else 0);
  89           UB(24, 0)
  90         ]]
  91   | `ImportAssets2 (url, xs) ->
  92       tag 71 @@ (`Str url)::`Ui8 1::`Ui8 0::alist xs
  93   | `SymbolClass xs ->
  94       tag 76 @@ alist xs
  95   | `Metadata xml ->
  96       tag 77 [`Str xml]
  97   | `DefineScalingGrid {left;right;top;bottom} ->
  98       tag 78 [`Rect (left,right,top,bottom)]
  99   | `DefineSceneAndFrameLabelData (scenes, frames) ->
 100       let bytes xs =
 101         (`EUi32 (Int32.of_int @@ List.length xs))::
 102           HList.concat_map (fun (x,y) -> [`EUi32 (Int32.of_int x); `Str y]) xs in
 103       tag 86 @@ List.concat [
 104         bytes scenes;
 105         bytes frames;
 106       ]
 107   | `DoABC (lazyInit, name, data) ->
 108       tag 82 @@ List.concat [
 109         [if lazyInit then `Ui32 1l else `Ui32 0l;
 110          `Str name];
 111         List.map (fun n -> `Ui8 n) data ]
 112