From 1544c90dfffe32cfedd55cf711413a6a29c3b967 Mon Sep 17 00:00:00 2001 From: mzp Date: Sat, 3 Oct 2009 18:46:49 +0900 Subject: [PATCH] implements fixed-float --- swflib/swfBaseOut.ml | 20 +++++++++++++++----- swflib/swfBaseOutTest.ml | 9 ++++----- 2 files changed, 19 insertions(+), 10 deletions(-) diff --git a/swflib/swfBaseOut.ml b/swflib/swfBaseOut.ml index 3061b35..a72a03c 100644 --- 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 --- 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 -- 2.11.0