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
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175 | --------------------------------------------------------------------------------
-- Copyright (C) 2020 by Heisenbug Ltd. (gh+si_units@heisenbug.eu)
--
-- This work is free. You can redistribute it and/or modify it under the
-- terms of the Do What The Fuck You Want To Public License, Version 2,
-- as published by Sam Hocevar. See the LICENSE file for more details.
--------------------------------------------------------------------------------
pragma License (Unrestricted);
with Ada.IO_Exceptions;
with SI_Units.Float_IO;
package body SI_Units.Metric is
function Prefix (S : in Prefixes) return String is
(case S is
when yocto => "y",
when zepto => "z",
when atto => "a",
when femto => "f",
when pico => "p",
when nano => "n",
when micro => Micro_Sign,
when milli => "m",
when None => "",
when kilo => "k",
when Mega => "M",
when Giga => "G",
when Tera => "T",
when Peta => "P",
when Exa => "E",
when Zetta => "Z",
when Yotta => "Y") with
Inline => True;
function General_Image (Value : in Float_IO.General_Float;
Aft : in Ada.Text_IO.Field;
Unit : in String) return String;
-- The actual implementation of each of the Image subprograms.
--
-- Finds the best match for a value such that the value to be displayed will
-- be in the interval (0.0 .. 1000.0] with an appropriate prefix for the
-- unit name, i.e. a call to
--
-- General_Image (123_456_789.0, 3, "Hz");
--
-- will return the string
--
-- 123.457 MHz
function General_Image (Value : in Float_IO.General_Float;
Aft : in Ada.Text_IO.Field;
Unit : in String) return String
is
use type Float_IO.General_Float;
Temp : Float_IO.General_Float := abs Value;
-- Ignore sign for temporary value.
Scale : Prefixes := None;
begin
-- No prefix if no unit is given or value is exactly zero.
if Unit /= No_Unit and then Temp /= 0.0 then
-- We ignored the sign of the input value, so we only have to cope
-- with positive values here.
if Temp < 1.0 then
Handle_Small_Prefixes :
declare
-- Set threshold, if the value is less than that it will be
-- rounded down. Please note, that an Aft of 0 will be handled
-- like an Aft of 1 (as we always emit at least one digit after
-- the decimal point.
Threshold : constant Float_IO.General_Float
:= 1.0 - (0.1 ** (Ada.Text_IO.Field'Max (1, Aft))) / 2.0;
begin
Find_Best_Small_Prefix :
while Temp <= Threshold loop
exit Find_Best_Small_Prefix when Scale = Prefixes'First;
-- Value is too small to be optimally represented.
-- Down to next prefix.
Scale := Prefixes'Pred (Scale);
Temp := Temp * Magnitude;
end loop Find_Best_Small_Prefix;
-- Value is (still) too small to be properly represented, treat
-- as zero.
if Temp < 1.0 - Threshold then
Temp := 0.0;
Scale := None;
end if;
end Handle_Small_Prefixes;
else
Handle_Large_Prefixes :
declare
Threshold : constant Float_IO.General_Float :=
Magnitude - ((0.1 ** Aft) / 2.0);
-- If the value is greater than that it will be rounded up.
begin
Find_Best_Large_Prefix :
while Temp >= Threshold loop
exit Find_Best_Large_Prefix when Scale = Prefixes'Last;
-- Value is too large to be optimally represented.
-- Up to next prefix.
Scale := Prefixes'Succ (Scale);
Temp := Temp / Magnitude;
end loop Find_Best_Large_Prefix;
end Handle_Large_Prefixes;
end if;
end if;
-- Restore sign before converting into string.
if Value < 0.0 then
Temp := -Temp;
end if;
Convert_To_Postfixed_String :
declare
Result : String (1 .. 5 + Ada.Text_IO.Field'Max (1, Aft));
-- "-999.[...]";
begin
Try_Numeric_To_String_Conversion :
begin
Float_IO.General_Float_IO.Put (To => Result,
Item => Temp,
Aft => Aft,
Exp => 0);
exception
when Ada.IO_Exceptions.Layout_Error =>
-- Value was larger than 999 Yunits and didn't fit into the
-- string.
-- Reset Scale and return "<inf>"inity instead.
Scale := None;
Result (1 .. 4) := (if Temp < 0.0
then Minus_Sign
else Plus_Sign) & "inf";
Result (5 .. Result'Last) := (others => ' ');
end Try_Numeric_To_String_Conversion;
return Trim (Result &
(if Unit = No_Unit
then ""
else No_Break_Space & Prefix (Scale) & Unit));
end Convert_To_Postfixed_String;
end General_Image;
function Fixed_Image
(Value : in Item;
Aft : in Ada.Text_IO.Field := Default_Aft) return String is
(General_Image (Value => Float_IO.General_Float (Value),
Aft => Aft,
Unit => Unit));
function Float_Image
(Value : in Item;
Aft : in Ada.Text_IO.Field := Default_Aft) return String is
(General_Image (Value => Float_IO.General_Float (Value),
Aft => Aft,
Unit => Unit));
function Integer_Image
(Value : in Item;
Aft : in Ada.Text_IO.Field := Default_Aft) return String is
(General_Image (Value => Float_IO.General_Float (Value),
Aft => Aft,
Unit => Unit));
function Mod_Image
(Value : in Item;
Aft : in Ada.Text_IO.Field := Default_Aft) return String is
(General_Image (Value => Float_IO.General_Float (Value),
Aft => Aft,
Unit => Unit));
end SI_Units.Metric;
|