wl_lib_0.1.3_1c94dc7c/src/wl-generic_real_images.adb

 1
 2
 3
 4
 5
 6
 7
 8
 9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
with Ada.Strings.Fixed;

package body WL.Generic_Real_Images is

   subtype Non_Negative_Real is Real range 0.0 .. Real'Last;

   function Significant_Digits_Image (Value : Non_Negative_Real;
                                      Sig   : Positive)
                                      return String;

   -----------------------
   -- Approximate_Image --
   -----------------------

   function Approximate_Image (Value : Real) return String is
      Factors    : constant array (1 .. 3) of Real :=
                     (1.0E9, 1.0E6, 1.0E3);
      Extensions : constant String := "GMK";
   begin
      if Value < 0.0 then
         return "-" & Approximate_Image (-Value);
      else
         for I in Factors'Range loop
            if Value > Factors (I) then
               return Significant_Digits_Image (Value / Factors (I), 3) &
               (1 => Extensions (I));
            end if;
         end loop;
         return Significant_Digits_Image (Value, 3);
      end if;
   end Approximate_Image;

   ------------------------------
   -- Significant_Digits_Image --
   ------------------------------

   function Significant_Digits_Image (Value : Non_Negative_Real;
                                      Sig   : Positive)
                                      return String
   is
      Result    : String (1 .. Sig);
      Point     : Natural := 0;
      Acc       : Real := Value;
      Boundary  : constant Real := 10.0 ** Sig;
   begin
      if Value < 1.0 / Boundary then
         return "0.00";
      end if;

      if Value >= Boundary then
         if Value >= 1.0e6 then
            return Ada.Strings.Fixed.Trim
              (Non_Negative_Real'Image (Value),
               Ada.Strings.Left);
         else
            return Ada.Strings.Fixed.Trim (Integer'Image (Integer (Value)),
                                           Ada.Strings.Left);
         end if;
      else
         while abs Acc * 10.0 < Boundary loop
            Acc := Acc * 10.0;
            Point := Point + 1;
         end loop;

         Result :=
           Ada.Strings.Fixed.Trim (Integer'Image (Integer (Acc - 0.5)),
                                   Ada.Strings.Left);
         if Point < Sig then
            if Point = 0 then
               return Result;
            else
               return Result (1 .. Result'Last - Point) & "." &
                 Result (Result'Last - Point + 1 .. Result'Last);
            end if;
         else
            declare
               Zeroes : constant String (1 .. Point - Sig) :=
                          (others => '0');
            begin
               return "0." & Zeroes & Result;
            end;
         end if;
      end if;
   end Significant_Digits_Image;

end WL.Generic_Real_Images;