Implement SwfIn

I implement Swf reading module. But there is imcompatibility between SwfIn and TagIn. This should be fixed.

diff --git a/swflib/swfIn.ml b/swflib/swfIn.ml
index 7adf199..cc51229 100644 (file)
--- a/swflib/swfIn.ml
+++ b/swflib/swfIn.ml
@@ -1,14 +1,64 @@
 open Base
+open SwfType
+open SwfBaseIn
 
 module type TagType = sig
   type t
-  val of_base : int -> int Stream.t -> int
+  val of_base : int -> int Stream.t -> t
 end
 
 
 module Make(Tag:TagType) = struct
-  let of_base _ = undef
-  let to_tag _ = undef
-end
+  let char n s =
+    let n' =
+      Char.code n in
+    match Stream.peek s with
+       Some m when n' = m ->
+         Stream.junk s;
+         ()
+      | None | Some _ ->
+         raise Stream.Failure
+
+  let rec many parse stream =
+    match stream with parser
+       [< e = parse; s>] -> e::many parse s
+      | [<>] -> []
+
+  let rec repeat n f stream =
+    if n <= 0 then
+      []
+    else
+      match stream with parser
+         [<c = f>] ->
+           c::repeat (n-1) f stream
+       | [<>] ->
+           raise (Stream.Error "invalid format")
 
+  let tag_and_size s =
+    let tag_and_size =
+      ui16 s in
+    let tag =
+      tag_and_size lsr 6 in
+    let size =
+      tag_and_size land 0x3f in
+      if size < 0x3F then begin
+       (tag,size)
+      end else
+       (tag, Int32.to_int @@ si32 s)
 
+  let to_tag = parser
+      [< (tag,size) = tag_and_size; body = repeat size ui8 >] ->
+       Tag.of_base tag @@ Stream.of_list body
+
+  let of_base = parser
+      [< _ = char 'F'; _ = char 'W'; _ = char 'S';
+        version = ui8; _ = ui32; (left,right,top,bottom) = rect;
+        frame_rate = fixed8; frame_count = ui16; tags = many to_tag >] ->
+       {
+         version;
+         frame_size  = { top; bottom; left; right };
+         frame_rate;
+         frame_count;
+         tags
+       }
+end

diff --git a/swflib/swfIn.mli b/swflib/swfIn.mli
index 4aed25b..0b09cf8 100644 (file)
--- a/swflib/swfIn.mli
+++ b/swflib/swfIn.mli
@@ -1,6 +1,6 @@
 module type TagType = sig
   type t
-  val of_base : int -> int Stream.t -> int
+  val of_base : int -> int Stream.t -> t
 end
 
 

diff --git a/swflib/swfInTest.ml b/swflib/swfInTest.ml
index d4bdfee..ad76719 100644 (file)
--- a/swflib/swfInTest.ml
+++ b/swflib/swfInTest.ml
@@ -3,9 +3,19 @@ open SwfType
 open SwfIn
 open OUnit
 
+let rec entire s =
+  try
+    let x =
+      Stream.next s in
+    let xs =
+      entire s in
+      x::xs
+  with Stream.Failure ->
+    []
+
 module M = SwfIn.Make(struct
-                       type t = int
-                       let of_base _ = 42
+                       type t = int * int list
+                       let of_base t s = (t,entire s)
                      end)
 open M
 
@@ -13,7 +23,7 @@ let char c =
   `Ui8 (Char.code c)
 
 let ok ?msg x f y =
-  assert_equal ?msg x (f y)
+  assert_equal ~printer:Std.dump ?msg x (f @@ Stream.of_list @@ SwfBaseOut.to_list y)
 
 let ok_b ?msg f x y =
   assert_equal ?msg (SwfBaseOut.to_list y) (SwfBaseOut.to_list (f x))
@@ -27,8 +37,7 @@ let _ = begin "swfIn.ml" >::: [
       frame_count = 42;
       tags        = []
     } in
-    let bytes =
-      Stream.of_list @@ SwfBaseOut.to_list [
+      ok swf M.of_base [
        (* signature *)
        char 'F'; char 'W'; char 'S';
        (* version *)
@@ -41,14 +50,13 @@ let _ = begin "swfIn.ml" >::: [
        `Fixed8 24.0;
        (* frame count *)
        `Ui16 42;
-      ] in
-      ok swf M.of_base bytes
+      ]
   end;
   "tag" >:: begin fun () ->
-    ok_b ~msg:"size < 64" of_tag (1, [`Ui8 1;`Ui8 2; `Ui8 3])
+    ok ~msg:"size < 64" (1, [1; 2; 3]) M.to_tag
       [ `Ui16 0b0000000001_000011; `Ui8 1; `Ui8 2; `Ui8 3 ];
     (* size >= 64*)
-    ok_b ~msg:"size > 64" of_tag (1, HList.replicate 64 (`Ui8 1)) @@
+    ok ~msg:"size > 64" (1,HList.replicate 64 1) M.to_tag @@
       [ `Ui16 0b0000000001_111111; `Si32 64l ] @ HList.replicate 64 (`Ui8 1)
   end
 ] end +> run_test_tt_main