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
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
`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))
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 *)
`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