add string/color/rect reader

diff --git a/base/base.ml b/base/base.ml
index e9d280d..4eb90ba 100644 (file)
--- a/base/base.ml
+++ b/base/base.ml
@@ -122,5 +122,5 @@ let open_in_with path f =
     close_in ch;
     s
 
-let undefined =
-  Obj.magic 42
+let undefined =  Obj.magic 42
+let undef     = undefined

diff --git a/swflib/swfBaseIn.ml b/swflib/swfBaseIn.ml
index 1ce77af..a5cff76 100644 (file)
--- a/swflib/swfBaseIn.ml
+++ b/swflib/swfBaseIn.ml
@@ -1,4 +1,15 @@
 open Base
+open ExtString
+
+type 'a t = int Stream.t -> 'a
+
+let rec until c stream =
+  match Stream.peek stream with
+      Some x when x != c ->
+       Stream.junk stream;
+       x::(until c stream)
+    | _ ->
+       []
 
 let byte =
   Stream.next
@@ -85,3 +96,23 @@ let rect s = bits s ~f:begin parser
     [< n = ub 5; x_min = sb n; x_max = sb n; y_min = sb n; y_max = sb n>] ->
       (x_min, x_max, y_min, y_max)
 end
+
+let str s =
+  let xs =
+    until 0 s in
+  let _ =
+    (* eat null terminator *)
+    Stream.junk s in
+    xs
+    +> List.map Char.chr
+    +> String.implode
+
+let rgb  = parser
+    [< r = ui8; g = ui8; b = ui8 >] ->
+      (r,g,b)
+
+let rgba = parser
+    [< (r,g,b) = rgb; a = ui8 >] ->
+      (r,g,b,a)
+
+let argb = rgba

diff --git a/swflib/swfBaseIn.mli b/swflib/swfBaseIn.mli
index 55d7848..5872e26 100644 (file)
--- a/swflib/swfBaseIn.mli
+++ b/swflib/swfBaseIn.mli
@@ -1,24 +1,29 @@
+type 'a t = int Stream.t -> 'a
 
-val ui8  : int Stream.t -> int
-val ui16 : int Stream.t -> int
-val ui24 : int Stream.t -> int
-val ui32 : int Stream.t -> int32
+val ui8  : int t
+val ui16 : int t
+val ui24 : int t
+val ui32 : int32 t
 
-val si8  : int Stream.t -> int
-val si16 : int Stream.t -> int
-val si24 : int Stream.t -> int
-val si32 : int Stream.t -> int32
+val si8  : int t
+val si16 : int t
+val si24 : int t
+val si32 : int32 t
 
-val eui32 : int Stream.t -> int32
+val eui32 : int32 t
 
-val bits : f:(BitsIn.bit Stream.t -> 'a) -> int Stream.t -> 'a
+val bits : f:(BitsIn.bit Stream.t -> 'a) -> 'a t
 val ub : int -> BitsIn.bit Stream.t -> int
 val sb : int -> BitsIn.bit Stream.t -> int
 
-val fixed  : int Stream.t -> float
-val fixed8 : int Stream.t -> float
+val fixed  : float t
+val fixed8 : float t
 
-val float32  : int Stream.t -> float
-val float64 : int Stream.t -> float
+val float32  : float t
+val float64  : float t
 
-val rect : int Stream.t -> int * int * int * int
+val rect : (int * int * int * int) t
+val str  : string t
+val rgb   : (int * int * int) t
+val rgba  : (int * int * int * int) t
+val argb  : (int * int * int * int) t

diff --git a/swflib/swfBaseInTest.ml b/swflib/swfBaseInTest.ml
index 4430233..9d06598 100644 (file)
--- a/swflib/swfBaseInTest.ml
+++ b/swflib/swfBaseInTest.ml
@@ -93,4 +93,14 @@ let _ = begin "swfBaseIn.ml" >::: [
       ok (127,260,15,514) rect @@ SwfBaseOut.to_list [`Bits [UB(5,11); SB(11,127); SB(11,260); SB(11,15); SB(11,514)]]
     end
   end;
+  "String" >:: begin fun () ->
+    let c = Char.code in
+      ok "foo" str [ c 'f'; c 'o'; c 'o'; 0];
+      ok ""    str [0]
+  end;
+  "color" >:: begin fun () ->
+    ok ~msg:"rgb"  (1,2,3)   rgb  [ 1; 2; 3 ];
+    ok ~msg:"rgba" (1,2,3,4) rgba [ 1; 2; 3; 4 ];
+    ok ~msg:"argb" (1,2,3,4) argb [ 1; 2; 3; 4 ]
+  end
 ] end +> run_test_tt_main