add tag out

diff --git a/swflib/OMakefile b/swflib/OMakefile
index 04b832d..a5ee0b6 100644 (file)
--- a/swflib/OMakefile
+++ b/swflib/OMakefile
@@ -20,6 +20,7 @@ FILES[] =
        revList
        abc
        bitsOut
+       tagOut
        swfBaseOut
        swfType
        swfOut
@@ -52,6 +53,7 @@ OUnitTest(revList  , revList)
 OUnitTest(cpool    , cpool revList)
 
 OUnitTest(swfOut, swfOut swfBaseOut bitsOut)
+OUnitTest(tagOut, tagOut)
 OUnitTest(swfBaseOut, swfBaseOut bitsOut)
 OUnitTest(bitsOut, bitsOut)
 

diff --git a/swflib/main.ml b/swflib/main.ml
new file mode 100644 (file)
index 0000000..c86654b
--- /dev/null
+++ b/swflib/main.ml
@@ -0,0 +1,25 @@
+open Base
+open SwfType
+open SwfOut
+
+module M = SwfOut.Make(TagOut)
+open M
+
+let swf = {
+  version     = 1;
+  frame_size  = { top=0; bottom=10000; left=0; right=20000 };
+  frame_rate  = 24.0;
+  frame_count = 1;
+  tags        = [
+    `SetBackgroundColor(0xFF,0xFF,0xFF);
+    `ShowFrame;
+    `End;
+  ]
+}
+let _ =
+  let bytes =
+    to_base swf
+    +> SwfBaseOut.to_list in
+    open_out_with "test.swf" begin fun ch ->
+      List.iter (output_byte ch) bytes
+    end

diff --git a/swflib/swfBaseOut.ml b/swflib/swfBaseOut.ml
index 8d631e1..748d4b7 100644 (file)
--- a/swflib/swfBaseOut.ml
+++ b/swflib/swfBaseOut.ml
@@ -24,7 +24,9 @@ type compose = [
 | `Fixed8  of float
 | `Float32 of float
 | `Float64 of float
-| `Rect    of int*int*int*int
+| `Rect    of int * int * int * int
+| `RGB     of int * int * int
+| `RGBA    of int * int * int * int
 ]
 
 type backpatch = [
@@ -119,6 +121,10 @@ let to_byte = function
        [`Bits [UB(5, w);
                SB(w, x_min); SB(w, x_max);
                SB(w, y_min); SB(w, y_max)]]
+  | `RGB(r,g,b) ->
+      [`Ui8 r; `Ui8 g; `Ui8 b]
+  | `RGBA(r,g,b,a) ->
+      [`Ui8 r; `Ui8 g; `Ui8 b; `Ui8 a]
 
 let backpatch xs =
   let (f,size) =

diff --git a/swflib/swfBaseOut.mli b/swflib/swfBaseOut.mli
index ffc6044..6aa679e 100644 (file)
--- a/swflib/swfBaseOut.mli
+++ b/swflib/swfBaseOut.mli
@@ -19,6 +19,8 @@ type t = [
 | `EUi32   of int32
 | `Bits    of bit list
 | `Rect    of int*int*int*int
+| `RGB     of int * int * int
+| `RGBA    of int * int * int * int
 | `Ui32Size
 ]
 

diff --git a/swflib/swfBaseOutTest.ml b/swflib/swfBaseOutTest.ml
index 2902cdb..606d069 100644 (file)
--- a/swflib/swfBaseOutTest.ml
+++ b/swflib/swfBaseOutTest.ml
@@ -112,6 +112,10 @@ let _ = begin "swfBaseOut.ml" >::: [
   "size" >:: begin fun () ->
     ok_b [`Ui32 4l] [`Ui32Size];
     ok_b [`Ui32 6l; `EUi32 0xFFl] [`Ui32Size;  `EUi32 0xFFl;];
+  end;
+  "rgb" >:: begin fun () ->
+    ok_b [`Ui8 1; `Ui8 2; `Ui8 3] [`RGB (1,2,3)];
+    ok_b [`Ui8 1; `Ui8 2; `Ui8 3; `Ui8 4] [`RGBA (1,2,3,4)]
   end
 ] end +> run_test_tt_main
 

diff --git a/swflib/swfOut.ml b/swflib/swfOut.ml
index 112354f..43d799a 100644 (file)
--- a/swflib/swfOut.ml
+++ b/swflib/swfOut.ml
@@ -3,7 +3,7 @@ open SwfType
 
 module type TagType = sig
   type t
-  val to_base : t -> SwfBaseOut.t list
+  val to_base : t -> int * SwfBaseOut.t list
 end
 
 module Make(Tag : TagType) = struct
@@ -13,13 +13,13 @@ module Make(Tag : TagType) = struct
   let of_rect {top; bottom; left; right} =
     `Rect(left,right,top,bottom)
 
-  let of_tag {tag; data} =
+  let of_tag tag =
     let make_type t size =
       `Ui16 ((t lsl 6) lor size) in
-    let data' =
-      Tag.to_base data in
+    let tag,data' =
+      Tag.to_base tag in
     let size =
-      List.length data' in
+      List.length @@ SwfBaseOut.to_list data' in
       if size < 0x3F then
        make_type tag size :: data'
       else
@@ -38,6 +38,6 @@ module Make(Tag : TagType) = struct
     `Fixed8 t.frame_rate;
     (* frame count *)
     `Ui16 t.frame_count
-  ]
+  ] @ HList.concat_map of_tag t.tags
 
 end

diff --git a/swflib/swfOut.mli b/swflib/swfOut.mli
index 9a68eef..efd3a96 100644 (file)
--- a/swflib/swfOut.mli
+++ b/swflib/swfOut.mli
@@ -1,6 +1,6 @@
 module type TagType = sig
   type t
-  val to_base : t -> SwfBaseOut.t list
+  val to_base : t -> int * SwfBaseOut.t list
 end
 
 
@@ -8,5 +8,5 @@ module Make: functor (Tag:TagType) -> sig
   val to_base : Tag.t SwfType.t -> SwfBaseOut.t list
 
     (* for debug *)
-  val of_tag : Tag.t SwfType.tag -> SwfBaseOut.t list
+  val of_tag : Tag.t -> SwfBaseOut.t list
 end

diff --git a/swflib/swfOutTest.ml b/swflib/swfOutTest.ml
index a11d583..e3e3529 100644 (file)
--- a/swflib/swfOutTest.ml
+++ b/swflib/swfOutTest.ml
@@ -3,7 +3,7 @@ open SwfType
 open OUnit
 
 module M = SwfOut.Make(struct
-                        type t = SwfBaseOut.t list
+                        type t = int * SwfBaseOut.t list
                         let to_base x = x
                       end)
 open M
@@ -39,10 +39,10 @@ let _ = begin "swfOut.ml" >::: [
       ]
   end;
   "tag" >:: begin fun () ->
-    ok ~msg:"size < 64" of_tag {tag=1; data=[`Ui8 1;`Ui8 2; `Ui8 3]}
+    ok ~msg:"size < 64" of_tag (1, [`Ui8 1;`Ui8 2; `Ui8 3])
       [ `Ui16 0b0000000001_000011; `Ui8 1; `Ui8 2; `Ui8 3 ];
     (* size >= 64*)
-    ok ~msg:"size > 64" of_tag {tag=1; data = HList.replicate 64 (`Ui8 1)} @@
+    ok ~msg:"size > 64" of_tag (1, HList.replicate 64 (`Ui8 1)) @@
       [ `Ui16 0b0000000001_111111; `Si32 64l ] @ HList.replicate 64 (`Ui8 1)
   end
 ] end +> run_test_tt_main

diff --git a/swflib/swfType.ml b/swflib/swfType.ml
index 5915828..d827e52 100644 (file)
--- a/swflib/swfType.ml
+++ b/swflib/swfType.ml
@@ -5,15 +5,10 @@ type rect = {
   bottom : int;
 }
 
-type 'a tag = {
-  tag : int;
-  data : 'a;
-}
-
 type 'a t = {
   version:    int;
   frame_size:  rect;
   frame_rate:  float;
   frame_count: int;
-  tags : 'a tag list
+  tags : 'a list
 }

diff --git a/swflib/tagOut.ml b/swflib/tagOut.ml
new file mode 100644 (file)
index 0000000..1e9e5ac
--- /dev/null
+++ b/swflib/tagOut.ml
@@ -0,0 +1,14 @@
+open Base
+
+type t = [
+  `End
+| `SetBackgroundColor of int * int * int
+| `ShowFrame
+]
+let to_base = function
+    `End ->
+      (0,[])
+  | `ShowFrame ->
+      (1,[])
+  | `SetBackgroundColor(r,g,b) ->
+      (9,[`RGB(r,g,b)])

diff --git a/swflib/tagOutTest.ml b/swflib/tagOutTest.ml
new file mode 100644 (file)
index 0000000..17cc423
--- /dev/null
+++ b/swflib/tagOutTest.ml
@@ -0,0 +1,17 @@
+open Base
+open OUnit
+open TagOut
+
+let ok x y =
+  assert_equal x @@ to_base y
+
+let _ = begin "tagOut.ml" >::: [
+  "End" >:: begin fun () ->
+    ok (0,[]) `End
+  end;
+  "SetBackgroundColor" >:: begin fun () ->
+    ok (9,[`RGB(0,1,2)]) (`SetBackgroundColor (0,1,2))
+  end
+] end +> run_test_tt_main
+
+