swflib/tagIn.ml

   1 open Base
   2 open SwfBaseIn
   3
   4 let stream tag s =
   5   Stream.from begin function
   6       0 -> Some tag
   7     | _ ->
   8         try
   9           Some (Stream.next s)
  10         with _ ->
  11           None
  12   end
  13
  14 let tag n stream =
  15   match Stream.peek stream with
  16       Some m when m = n ->
  17         Stream.next stream
  18     | _ ->
  19         raise Stream.Failure
  20
  21 let option f stream =
  22   try
  23     Some (f stream)
  24   with Stream.Failure ->
  25     None
  26
  27 let rec repeat n f stream =
  28   if n = 0 then
  29     []
  30   else
  31     match stream with parser
  32         [<c = f>] ->
  33           c::repeat (n-1) f stream
  34       | [<>] ->
  35           raise (Stream.Error "invalid format")
  36
  37 let repeat_l n f stream =
  38   repeat (Int32.to_int n) f stream
  39
  40
  41 let pair f g = parser
  42     [< x = f; y = g >] ->
  43       (x,y)
  44
  45 let alist = parser
  46     [< count = ui16; xs = repeat count (pair ui16 str) >] ->
  47       xs
  48
  49 let bit_bool n s =
  50   ub n s = 1
  51
  52 let read = parser
  53     [< _ = tag 0 >]->
  54       `End
  55   | [< _ = tag 9; c = rgb >]->
  56       `SetBackgroundColor c
  57   | [< _ = tag 43; name = str; anchor = option (tag 1) >] ->
  58       `FrameLabel (name,anchor <> None)
  59   | [< _ = tag 24 >] ->
  60       `Protect
  61   | [< _ = tag 56; xs = alist >] ->
  62       `ExportAssets xs
  63   | [< _ = tag 57; url = str; xs = alist >] ->
  64       `ImportAssets (url,xs)
  65   | [< _ = tag 58; passwd = str >] ->
  66       `EnableDebugger passwd
  67   | [< _ = tag 64; _ = ui16; passwd = str >] ->
  68       `EnableDebugger2 passwd
  69   | [< _ = tag 65; max_rec = ui16; timeout = ui16 >] ->
  70       `ScriptLimits (max_rec, timeout)
  71   | [< _ = tag 66; depth = ui16; index = ui16 >] ->
  72       `SetTabIndex (depth, index)
  73   | [< _ = tag 69; (is_metadata, is_as3, use_network) = bits ~f:parser
  74            [< _ = ub 3; is_metadata = bit_bool 1; is_as3 = bit_bool 1; _ = ub 2; use_network = bit_bool 1; _ = ub 24 >] ->
  75              (is_metadata, is_as3, use_network) >] ->
  76       open TagType in
  77       `FileAttributes { is_metadata; is_as3; use_network }
  78   | [< _ = tag 71; url = str; _ = ui8; _ = ui8; xs = alist >] ->
  79       `ImportAssets2 (url,xs)
  80   | [< _ = tag 76; xs = alist >] ->
  81       `SymbolClass xs
  82   | [< _ = tag 77; s = str >] ->
  83       `Metadata s
  84   | [< _ = tag 78; id = ui16; (left,right,top,bottom) = rect >] ->
  85       open SwfType in
  86       `DefineScalingGrid (id, {left;right;top;bottom})
  87   | [< _ = tag 86;
  88        scene_count = eui32; xs = repeat_l scene_count (pair eui32 str);
  89        frame_count = eui32; ys = repeat_l frame_count (pair eui32 str); >] ->
  90       `DefineSceneAndFrameLabelData (xs, ys)
  91   | [< _ = tag 1 >] ->
  92       `ShowFrame
  93   | [<>] ->
  94       failwith "unknown tag"
  95
  96 let of_base tag s =
  97   read @@ stream tag s