OUnitTest(revList , revList)
OUnitTest(cpool , cpool revList)
-OUnitTest(swfBaseOut, swfBaseOut)
+OUnitTest(swfBaseOut, swfBaseOut bitsOut)
OUnitTest(bitsOut, bitsOut)
# phony
(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
open Base
+type bit =
+ SB of int * int
+ | UB of int * int
+
type t =
Si8 of int
| Si16 of int
| 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) ->
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
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)]
+type bit =
+ SB of int * int
+ | UB of int * int
+
type t =
Si8 of int
| Si16 of int
| 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
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
+