implements fixed-float

diff --git a/swflib/swfBaseOut.ml b/swflib/swfBaseOut.ml
index 3061b35..a72a03c 100644 (file)
--- a/swflib/swfBaseOut.ml
+++ b/swflib/swfBaseOut.ml
@@ -41,9 +41,19 @@ let rec encode = function
        (fun n -> Int64.to_int @@ Int64.logand 0xffL n)
        (fun n -> Int64.shift_right n 8)
        8 n
-  | Fixed _ | Fixed8 _ ->
-      []
-
-
-let to_int_list xs =
+  | 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)]
+and to_int_list xs =
   HList.concat_map encode xs

diff --git a/swflib/swfBaseOutTest.ml b/swflib/swfBaseOutTest.ml
index 04373c4..75b518b 100644 (file)
--- a/swflib/swfBaseOutTest.ml
+++ b/swflib/swfBaseOutTest.ml
@@ -6,7 +6,7 @@ let ok_i x y =
   assert_equal x @@ to_int_list [ y ]
 
 let ok_b x y =
-  assert_equal (to_int_list x) (to_int_list y)
+  assert_equal ~printer:Std.dump (to_int_list x) (to_int_list y)
 
 let _ = begin "swfBaseOut.ml" >::: [
   "equality" >:: begin fun () ->
@@ -53,12 +53,11 @@ let _ = begin "swfBaseOut.ml" >::: [
       Ui64 0xFFFFFFFFL;
   end;
   "Fixed" >:: begin fun () ->
-    ok_b [Ui16 8; Ui16 7] [Fixed 7.5];
+    ok_b [Ui16 0x8000; Ui16 7] [Fixed 7.5];
     ok_b [Ui16 0; Ui16 0xFFFF] [Fixed 65535.0];
-    ok_b [Ui16 0xFFFF; Ui16 0xFFFF] [Fixed 65535.65535]
   end;
   "Fixed8" >:: begin fun () ->
-    ok_b [Ui16 0xFF; Ui16 0xFF] [Fixed 256.256];
-    ok_b [Ui8 42; Ui8 1] [Fixed 42.1]
+    ok_b [Ui8 0x80; Ui8 7] [Fixed8 7.5];
+    ok_b [Ui8 0; Ui8 0xFF] [Fixed8 255.0];
   end
 ]end +> run_test_tt_main