-
Notifications
You must be signed in to change notification settings - Fork 6
/
pragmarc-images.adb
181 lines (152 loc) · 6.55 KB
/
pragmarc-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
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
176
177
178
179
180
181
-- PragmAda Reusable Component (PragmARC)
-- Copyright (C) 2023 by PragmAda Software Engineering. All rights reserved.
-- Released under the terms of the BSD 3-Clause license; see https://opensource.org/licenses
-- **************************************************************************
--
-- History:
-- 2023 Apr 15 J. Carter V2.3--Correct Float_Image
-- 2021 May 01 J. Carter V2.2--Adhere to coding standard
-- 2021 Feb 01 J. Carter V2.1--Make Float_Image work if Ada.Text_IO.Field'Last is very large
-- 2020 Nov 01 J. Carter V2.0--Initial Ada-12 version
----------------------------------------------------------------------------
-- 2019 Aug 15 J. Carter V1.3--Added Base to Float_Image
-- 2018 Aug 01 J. Carter V1.2--Cleanup compiler warnings
-- 2006 Mar 01 J. Carter V1.1--Added Float_Image
-- 2004 Apr 01 J. Carter V1.0--Initial version
--
with Ada.Strings.Fixed;
with Ada.Strings.Unbounded;
with PragmARC.Conversions.Unbounded_Strings;
with PragmARC.Unbounded_Numbers.Integers;
package body PragmARC.Images is
use Ada.Strings.Fixed;
use Ada.Text_IO;
function Adjust (Image : in String; Width : in Field; Negative : in Boolean; Zero_Filled : in Boolean) return String;
-- Apply Width, Negative, & Zero_Filled to Image
function Adjust (Image : in String; Width : in Field; Negative : in Boolean; Zero_Filled : in Boolean) return String is
Blank : constant Character := ' ';
Zero : constant Character := '0';
Minus : constant Character := '-';
begin -- Adjust
if Zero_Filled then
if Negative then
return Minus & (1 .. Width - Image'Length - 1 => Zero) & Image;
else
return (1 .. Width - Image'Length => Zero) & Image;
end if;
else
if Negative then
return (1 .. Width - Image'Length - 1 => Blank) & Minus & Image;
else
return (1 .. Width - Image'Length => Blank) & Image;
end if;
end if;
end Adjust;
function Signed_Image (Value : in Number; Width : in Field := 0; Zero_Filled : in Boolean := False; Base : in Number_Base := 10)
return String is
package Number_IO is new Integer_IO (Number);
use Number_IO;
Image : String (1 .. 100);
Start : Positive;
Stop : Positive;
Negative : constant Boolean := Value < 0;
begin -- Signed_Image
Put (To => Image, Item => Value, Base => Base);
case Base is
when 10 =>
Start := Index_Non_Blank (Image);
Stop := Image'Last;
if Negative then
Start := Start + 1;
end if;
when 2 .. 9 | 11 .. 16 =>
Start := 1 + Index (Image, "#");
Stop := Image'Last - 1;
end case;
return Adjust (Image (Start .. Stop), Width, Negative, Zero_Filled);
end Signed_Image;
function Modular_Image (Value : in Number; Width : in Field := 0; Zero_Filled : in Boolean := False; Base : in Number_Base := 10)
return String is
package Number_IO is new Modular_IO (Number);
use Number_IO;
Image : String (1 .. 100);
Start : Positive;
Stop : Positive;
begin -- Modular_Image
Put (To => Image, Item => Value, Base => Base);
case Base is
when 10 =>
Start := Index_Non_Blank (Image);
Stop := Image'Last;
when 2 .. 9 | 11 .. 16 =>
Start := 1 + Index (Image, "#");
Stop := Image'Last - 1;
end case;
return Adjust (Image (Start .. Stop), Width, False, Zero_Filled);
end Modular_Image;
function Float_Image (Value : in Number;
Fore : in Field := 2;
Aft : in Field := Number'Digits - 1;
Exp : in Field := 3;
Zero_Filled : in Boolean := False;
Base : in Number_Base := 10)
return String is
package Number_IO is new Float_IO (Number);
use Ada.Strings.Unbounded;
use Conversions.Unbounded_Strings;
function Base_10_Image return String;
-- Returns the image of Value in base 10
function Non_10_Image return String;
-- Returns the image of Value for Base /= 10
function Base_10_Image return String is
Image : String (1 .. 3 * 255 + 3);
Start : Natural;
Width : Field := Fore + Aft + 1;
begin -- Base_10_Image
Number_IO.Put (To => Image, Item => abs Value, Aft => Aft, Exp => Exp);
Start := Index_Non_Blank (Image);
if Exp > 0 then
Width := Width + Exp + 1;
end if;
return Adjust (Image (Start .. Image'Last), Width, Value < 0.0, Zero_Filled);
end Base_10_Image;
function Non_10_Image return String is
function Hex_Digit (Value : in Natural) return Character is
(if Value < 10 then Character'Val (Character'Pos ('0') + Value)
else Character'Val (Character'Pos ('A') + Value - 10) );
Work : Number := abs Value;
Image : String (1 .. 12 * 255 + 3);
Start : Natural;
Dot : Natural;
Col : Number := 1.0 / Number (Base);
Digit : Natural;
use Unbounded_Numbers;
begin -- Non_10_Image
Number_IO.Put (To => Image, Item => Work, Aft => 40, Exp => 0);
Start := Index_Non_Blank (Image);
Dot := Index (Image, ".");
Integer_Part : declare
Full_Image : Unbounded_String :=
+Integers.Image (Integers.Value (Image (Start .. Dot - 1) ), Base => Integers.Base_Number (Base) ) & '.';
begin -- Integer_Part
Work := Work - Number'Value (Image (Start .. Dot) & '0');
Extract_Fraction : for K in 1 .. 1_000 Loop
exit Extract_Fraction when Work <= 0.0;
Digit := Integer (Number'Truncation (Work / Col) );
Append (Source => Full_Image, New_Item => Hex_Digit (Digit) );
Work := Work - Number (Digit) * Col;
Col := Col / Number (Base);
end loop Extract_Fraction;
if Element (Full_Image, Length (Full_Image) ) = '.' then
Append (Source => Full_Image, New_Item => '0');
end if;
return Adjust (+Full_Image, Integer'Max (Length (Full_Image), Fore + Aft + 1), Value < 0.0, Zero_Filled);
end Integer_Part;
end Non_10_Image;
begin -- Float_Image
if Base = 10 then
return Base_10_Image;
end if;
return Non_10_Image;
end Float_Image;
end PragmARC.Images;