open Base
+open StdLabels
type bit =
SB of int * int
| UB of int * int
-type t =
- Si8 of int
- | Si16 of int
- | Si24 of int
- | Si32 of int32
- | Ui8 of int
- | Ui16 of int
- | Ui24 of int
- | Ui32 of int32
- | Ui64 of int64
- | Fixed of float
- | Fixed8 of float
- | Float32 of float
- | Float64 of float
- | EUi32 of int32
- | Bits of bit list
- | Rect of int*int*int*int
+type byte = [
+ `Si8 of int
+| `Si16 of int
+| `Si24 of int
+| `Si32 of int32
+| `Ui8 of int
+| `Ui16 of int
+| `Ui24 of int
+| `Ui32 of int32
+| `Ui64 of int64
+| `EUi32 of int32
+| `Bits of bit list
+]
+
+type compose = [
+ `Fixed of float
+| `Fixed8 of float
+| `Float32 of float
+| `Float64 of float
+| `Rect of int*int*int*int
+]
+
+type backpatch = [
+ `Ui32Size
+]
+
+type t = [ byte | compose | backpatch ]
let rec g_si mask shift n value =
unfold begin fun (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 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
- Si8 n | Ui8 n ->
+let to_int : byte -> int list = function
+ `Si8 n | `Ui8 n ->
si 1 n
- | Si16 n | Ui16 n ->
+ | `Si16 n | `Ui16 n ->
si 2 n
- | Si24 n | Ui24 n ->
+ | `Si24 n | `Ui24 n ->
si 3 n
- | Si32 n | Ui32 n ->
+ | `Si32 n | `Ui32 n ->
g_si
(fun n -> Int32.to_int @@ Int32.logand 0xFFl n)
(fun n -> Int32.shift_right n 8)
4 n
- | Ui64 n ->
+ | `Ui64 n ->
g_si
(fun n -> Int64.to_int @@ Int64.logand 0xffL n)
(fun n -> Int64.shift_right n 8)
8 n
- | Fixed x ->
- let int =
- floor x in
- let decimal =
- (x -. int) *. float 0x1_00_00 in
- to_int_list [Ui16 (int_of_float decimal);
- Ui16 (int_of_float int)]
- | Fixed8 x ->
- let int =
- floor x in
- let decimal =
- (x -. int) *. float 0x1_00 in
- to_int_list [Ui8 (int_of_float decimal);
- Ui8 (int_of_float int)]
- | Float32 x ->
- encode @@ Ui32 (Int32.bits_of_float x)
- | Float64 x ->
- encode @@ Ui64 (Int64.bits_of_float x)
- | EUi32 x ->
+ | `EUi32 x ->
if x = 0l then
[0]
else
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)]
+ | `Bits xs ->
+ List.fold_left ~f:bits ~init:BitsOut.empty xs
+ +> BitsOut.to_list
+
+let to_byte = function
+ `Fixed x ->
+ let int =
+ floor x in
+ let decimal =
+ (x -. int) *. float 0x1_00_00 in
+ [`Ui16 (int_of_float decimal);
+ `Ui16 (int_of_float int)]
+ | `Fixed8 x ->
+ let int =
+ floor x in
+ let decimal =
+ (x -. int) *. float 0x1_00 in
+ [`Ui8 (int_of_float decimal);
+ `Ui8 (int_of_float int)]
+ | `Float32 x ->
+ [`Ui32 (Int32.bits_of_float x)]
+ | `Float64 x ->
+ [`Ui64 (Int64.bits_of_float x)]
+ | `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
+ [`Bits [UB(5, w);
+ SB(w, x_min); SB(w, x_max);
+ SB(w, y_min); SB(w, y_max)]]
+
+let backpatch xs =
+ let (f,size) =
+ List.fold_right xs ~init:(const [],0) ~f:begin fun x (f,size) ->
+ match x with
+ #byte as b ->
+ let ints =
+ to_int b in
+ let size' =
+ size + List.length ints in
+ ((fun ctx -> ints @ f ctx), size')
+ | `Ui32Size ->
+ let size' =
+ (* same as Ui30 *)
+ size + 4 in
+ ((fun size -> to_int (`Ui32 (Int32.of_int size)) @ f size), size')
+ end in
+ f size
+
+let rec to_list (xs : t list) =
+ xs
+ +> HList.concat_map begin function
+ #byte as b -> [b]
+ | #compose as c -> to_byte c
+ | #backpatch as bp -> [bp]
+ end
+ +> backpatch
+
open SwfBaseOut
let ok_i x y =
- assert_equal ~printer:Std.dump x @@ to_int_list [ y ]
+ assert_equal ~printer:Std.dump x @@ to_list [ y ]
let ok_b x y =
- assert_equal ~printer:Std.dump (to_int_list x) (to_int_list y)
+ assert_equal ~printer:Std.dump (to_list x) (to_list y)
let _ = begin "swfBaseOut.ml" >::: [
"equality" >:: begin fun () ->
- assert_equal (Si8 0) (Si8 0)
+ assert_equal (`Si8 0) (`Si8 0)
end;
- "Si8" >:: begin fun () ->
- ok_i [0x7F] @@ Si8 0x7F;
- ok_i [0xFF] @@ Si8 (~-1);
+ "`Si8" >:: begin fun () ->
+ ok_i [0x7F] @@ `Si8 0x7F;
+ ok_i [0xFF] @@ `Si8 (~-1);
end;
- "Si16" >:: begin fun () ->
- ok_i [0x7F; 0x00] @@ Si16 0x7F;
- ok_i [0xFF; 0x7F] @@ Si16 0x7FFF;
- ok_i [0xFF; 0xFF] @@ Si16 (~-1);
+ "`Si16" >:: begin fun () ->
+ ok_i [0x7F; 0x00] @@ `Si16 0x7F;
+ ok_i [0xFF; 0x7F] @@ `Si16 0x7FFF;
+ ok_i [0xFF; 0xFF] @@ `Si16 (~-1);
end;
- "Si24" >:: begin fun () ->
- ok_i [0x7F; 0; 0] @@ Si24 0x7F;
- ok_i [0x56; 0x34; 0x12] @@ Si24 0x123456;
- ok_i [0xFF; 0xFF; 0xFF] @@ Si24 (~-1);
+ "`Si24" >:: begin fun () ->
+ ok_i [0x7F; 0; 0] @@ `Si24 0x7F;
+ ok_i [0x56; 0x34; 0x12] @@ `Si24 0x123456;
+ ok_i [0xFF; 0xFF; 0xFF] @@ `Si24 (~-1);
end;
- "Si32" >:: begin fun () ->
- ok_i [0xFF; 0xFF; 0xFF; 0x7F] @@ Si32 0x7FFFFFFFl;
- ok_i [0xFF; 0xFF; 0xFF; 0xFF] @@ Si32 (-1l);
+ "`Si32" >:: begin fun () ->
+ ok_i [0xFF; 0xFF; 0xFF; 0x7F] @@ `Si32 0x7FFFFFFFl;
+ ok_i [0xFF; 0xFF; 0xFF; 0xFF] @@ `Si32 (-1l);
end;
- "Ui8" >:: begin fun () ->
- ok_i [0x0] @@ Ui8 0x0;
- ok_i [0xFF] @@ Ui8 0xFF;
+ "`Ui8" >:: begin fun () ->
+ ok_i [0x0] @@ `Ui8 0x0;
+ ok_i [0xFF] @@ `Ui8 0xFF;
end;
- "Ui16" >:: begin fun () ->
- ok_i [0x00; 0x00] @@ Ui16 0;
- ok_i [0xFF; 0xFF] @@ Ui16 0xFFFF;
- ok_i [0x34; 0x12] @@ Ui16 0x1234;
+ "`Ui16" >:: begin fun () ->
+ ok_i [0x00; 0x00] @@ `Ui16 0;
+ ok_i [0xFF; 0xFF] @@ `Ui16 0xFFFF;
+ ok_i [0x34; 0x12] @@ `Ui16 0x1234;
end;
- "Ui24" >:: begin fun () ->
- ok_i [0;0;0] @@ Ui24 0;
- ok_i [0x56; 0x34; 0x12] @@ Ui24 0x123456;
- ok_i [0xFF; 0xFF; 0xFF] @@ Ui24 0xFFFFFF;
+ "`Ui24" >:: begin fun () ->
+ ok_i [0;0;0] @@ `Ui24 0;
+ ok_i [0x56; 0x34; 0x12] @@ `Ui24 0x123456;
+ ok_i [0xFF; 0xFF; 0xFF] @@ `Ui24 0xFFFFFF;
end;
- "Ui32" >:: begin fun () ->
- ok_i [0xFF; 0xFF; 0xFF; 0x7F] @@ Ui32 0x7FFFFFFFl;
- ok_i [0xFF; 0xFF; 0xFF; 0xFF] @@ Ui32 0xFFFFFFFFl;
+ "`Ui32" >:: begin fun () ->
+ ok_i [0xFF; 0xFF; 0xFF; 0x7F] @@ `Ui32 0x7FFFFFFFl;
+ ok_i [0xFF; 0xFF; 0xFF; 0xFF] @@ `Ui32 0xFFFFFFFFl;
end;
- "Ui64" >:: begin fun () ->
+ "`Ui64" >:: begin fun () ->
ok_i [0xFF; 0xFF; 0xFF; 0xFF; 0;0;0;0] @@
- Ui64 0xFFFFFFFFL;
+ `Ui64 0xFFFFFFFFL;
end;
"Fixed" >:: begin fun () ->
- ok_b [Ui16 0x8000; Ui16 7] [Fixed 7.5];
- ok_b [Ui16 0; Ui16 0xFFFF] [Fixed 65535.0];
+ ok_b [`Ui16 0x8000; `Ui16 7] [`Fixed 7.5];
+ ok_b [`Ui16 0; `Ui16 0xFFFF] [`Fixed 65535.0];
end;
"Fixed8" >:: begin fun () ->
- ok_b [Ui8 0x80; Ui8 7] [Fixed8 7.5];
- ok_b [Ui8 0; Ui8 0xFF] [Fixed8 255.0];
+ ok_b [`Ui8 0x80; `Ui8 7] [`Fixed8 7.5];
+ ok_b [`Ui8 0; `Ui8 0xFF] [`Fixed8 255.0];
end;
(* "Float16" >:: begin fun() ->
ok_i [0; 0x3c] @@ Float16 1.;
ok_i [0xff; 0x7b] @@ Float16 65504.;
end;*)
"Float32" >:: begin fun() ->
- ok_i [0; 0; 0x20; 0x40] @@ Float32 2.5;
+ ok_i [0; 0; 0x20; 0x40] @@ `Float32 2.5;
end;
"Float64" >:: begin fun() ->
ok_i [0x55; 0x55; 0x55; 0x55;
- 0x55; 0x55; 0xd5; 0x3f] @@ Float64 0.333333333333333315;
+ 0x55; 0x55; 0xd5; 0x3f] @@ `Float64 0.333333333333333315;
end;
"u30" >::: [
"1byte" >:: begin fun () ->
- ok_i [0] @@ EUi32 0l;
- ok_i [0x7F] @@ EUi32 0x7Fl
+ ok_i [0] @@ `EUi32 0l;
+ ok_i [0x7F] @@ `EUi32 0x7Fl
end;
"2byte" >:: begin fun () ->
- ok_i [0xFF;0x30] @@ EUi32 0x187Fl;
- ok_i [0xFF;0x01] @@ EUi32 0xFFl;
- ok_i [0xFF;0x7F] @@ EUi32 0x3FFFl
+ ok_i [0xFF;0x30] @@ `EUi32 0x187Fl;
+ ok_i [0xFF;0x01] @@ `EUi32 0xFFl;
+ ok_i [0xFF;0x7F] @@ `EUi32 0x3FFFl
end;
"3byte/15-21bit" >:: begin fun () ->
- ok_i [0xFF;0xFF;0x01] @@ EUi32 0x7FFFl;
- ok_i [0xFF;0xFF;0x7F] @@ EUi32 0x1F_FFFFl
+ ok_i [0xFF;0xFF;0x01] @@ `EUi32 0x7FFFl;
+ ok_i [0xFF;0xFF;0x7F] @@ `EUi32 0x1F_FFFFl
end;
"4 byte/22-28bit" >:: begin fun () ->
- ok_i [0xFF;0xFF;0xFF;0x01] @@ EUi32 0x003F_FFFFl;
- ok_i [0xFF;0xFF;0xFF;0x7F] @@ EUi32 0x0FFF_FFFFl
+ ok_i [0xFF;0xFF;0xFF;0x01] @@ `EUi32 0x003F_FFFFl;
+ ok_i [0xFF;0xFF;0xFF;0x7F] @@ `EUi32 0x0FFF_FFFFl
end;
"5 byte/29-35bit" >:: begin fun () ->
- ok_i [0xFF;0xFF;0xFF;0xFF;0x01] @@ EUi32 0x1FFF_FFFFl;
- ok_i [0xFF;0xFF;0xFF;0xFF;0x03] @@ EUi32 0x3FFF_FFFFl
+ ok_i [0xFF;0xFF;0xFF;0xFF;0x01] @@ `EUi32 0x1FFF_FFFFl;
+ ok_i [0xFF;0xFF;0xFF;0xFF;0x03] @@ `EUi32 0x3FFF_FFFFl
end
];
- "UB" >:: begin fun () ->
- ok_i [0b00001_000] @@ Bits [UB (5,1)];
+ "`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)];
+ "`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)]
+ 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)]
+ 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;
+ "size" >:: begin fun () ->
+ ok_b [`Ui32 4l] [`Ui32Size];
+ ok_b [`Ui32 6l; `EUi32 0xFFl] [`Ui32Size; `EUi32 0xFFl;];
end
-
] end +> run_test_tt_main
OSDN Git Service
