OSDN Git Service

add rect
authormzp <mzpppp@gmail.com>
Sun, 4 Oct 2009 07:38:49 +0000 (16:38 +0900)
committermzp <mzpppp@gmail.com>
Sun, 4 Oct 2009 07:38:49 +0000 (16:38 +0900)
swflib/OMakefile
swflib/bitsOut.ml
swflib/swfBaseOut.ml
swflib/swfBaseOut.mli
swflib/swfBaseOutTest.ml

index 896578e..397b4e8 100644 (file)
@@ -46,7 +46,7 @@ OUnitTest(methodOut, methodOut cpool bytesOut label revList)
 OUnitTest(revList  , revList)
 OUnitTest(cpool    , cpool revList)
 
-OUnitTest(swfBaseOut, swfBaseOut)
+OUnitTest(swfBaseOut, swfBaseOut bitsOut)
 OUnitTest(bitsOut, bitsOut)
 
 # phony
index 0695b98..95008be 100644 (file)
@@ -28,7 +28,8 @@ let max_int n =
   (1 lsl n) - 1
 
 let rec put t ~width ~bits =
-  if bits > max_int width then raise (Invalid_argument "BitsStream.put");
+  if bits land max_int width <> bits then
+    raise (Invalid_argument "BitsStream.put");
   let remain =
     cByte - t.pos in
     if remain >= width then
index a907fa5..ea38fbc 100644 (file)
@@ -1,5 +1,9 @@
 open Base
 
+type bit =
+    SB of int * int
+  | UB of int * int
+
 type t =
     Si8  of int
   | Si16 of int
@@ -15,6 +19,8 @@ type t =
   | Float32 of float
   | Float64 of float
   | EUi32   of int32
+  | Bits    of bit list
+  | Rect of int*int*int*int
 
 let rec g_si mask shift n value =
   unfold begin fun (n,value) ->
@@ -27,6 +33,19 @@ let rec g_si mask shift n value =
 let si n value =
   g_si ((land) 0xff) (fun x -> x lsr 8) n value
 
+let mask n =
+  (1 lsl n) - 1
+
+let bits s =
+  function
+      UB(width,bits) ->
+       BitsOut.put s ~width ~bits
+    | SB(width,bits) ->
+       if bits < - mask (width - 1) - 1 ||  mask (width - 1) < bits then
+         raise (Invalid_argument "SB");
+       BitsOut.put s ~width ~bits:(bits land mask width)
+
+
 let rec to_int_list xs =
   HList.concat_map encode xs
 and encode = function
@@ -80,4 +99,14 @@ and encode = function
              Int32.to_int @@ Int32.logor 0x80l @@ Int32.logand x 0x7Fl in
              Some (current,next)
        end x
-
+| Bits xs ->
+    List.fold_left bits BitsOut.empty xs
+    +> BitsOut.to_list
+| Rect (x_min,x_max,y_min,y_max) ->
+    let bits =
+      float @@ 1 + HList.maximum [x_min; x_max; y_min; y_max] in
+    let w =
+      int_of_float @@ 1. +. ceil (log bits /. log 2.) in
+      encode @@ Bits [UB(5, w);
+                     SB(w, x_min); SB(w, x_max);
+                     SB(w, y_min); SB(w, y_max)]
index 37492aa..1d0ea38 100644 (file)
@@ -1,3 +1,7 @@
+type bit =
+    SB of int * int
+  | UB of int * int
+
 type t =
     Si8  of int
   | Si16 of int
@@ -13,6 +17,8 @@ type t =
   | Float32 of float
   | Float64 of float
   | EUi32 of int32
+  | Bits    of bit list
+  | Rect of int*int*int*int
 
 
 val to_int_list : t list -> int list
index 988155f..110e778 100644 (file)
@@ -95,4 +95,21 @@ let _ = begin "swfBaseOut.ml" >::: [
       ok_i [0xFF;0xFF;0xFF;0xFF;0x03] @@ EUi32 0x3FFF_FFFFl
     end
   ];
+  "UB" >:: begin fun () ->
+    ok_i [0b00001_000] @@ Bits [UB (5,1)];
+  end;
+  "SB" >:: begin fun () ->
+    ok_i [0b00001_000] @@ Bits [SB (5,1)];
+    ok_i [0b11111_000] @@ Bits [SB (5,-1)];
+  end;
+  "Bits" >:: begin fun () ->
+    ok_i [0b00001_000; 0b1000_0000] @@ Bits [UB (5,1); UB (4,1)]
+  end;
+  "rect" >:: begin fun () ->
+    ok_b [Bits[UB(5,2);SB(2,0);SB(2,0);SB(2,1);SB(2,1)]] @@ [Rect (0,0,1,1)];
+    ok_b [Bits[UB(5,11);SB(11,127);SB(11,260);SB(11,15);SB(11,514)]] @@
+      [Rect (127,260,15,514)]
+  end
+
 ] end +> run_test_tt_main
+