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 | --------------------------------------------------------------- {{{1 ----------
--: Copyright © 2003 … 2023 Martin Krischik «krischik@users.sourceforge.net»
-------------------------------------------------------------------------------
--: This library is free software; you can redistribute it and/or modify it
--: under the terms of the GNU Library General Public License as published by
--: the Free Software Foundation; either version 2 of the License, or (at your
--: option) any later version.
--:
--: This library is distributed in the hope that it will be useful, but
--: WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
--: or FITNESS FOR A PARTICULAR PURPOSE. See the GNU Library General Public
--: License for more details.
--:
--: You should have received a copy of the GNU Library General Public License
--: along with this library; if not, write to the Free Software Foundation,
--: Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
--------------------------------------------------------------- }}}1 ----------
pragma License (Modified_Gpl);
pragma Ada_2022;
with Ada.Strings.Wide_Fixed;
with Ada.Wide_Text_IO;
package body AdaCL.Wide_Strings.Hex is
function Generic_Image (Value : in Unsigned_Type) return Wide_String is
use Ada.Strings.Wide_Fixed;
package IO is new Ada.Wide_Text_IO.Modular_IO (Num => Unsigned_Type);
Lead : constant := 3;
Tail : constant := 1;
Text : Wide_String (1 .. Lead + Width + Tail);
Retval : Wide_String (1 .. Width);
begin
IO.Put
(To => Text,
Item => Value,
Base => 16);
declare
Start : constant Natural := Index (Source => Text, Pattern => "#");
Padding : constant Natural := Start - Lead;
begin
Retval := (Padding * '0') & Text (Start + 1 .. Lead + Width);
end;
return Retval;
end Generic_Image;
function Generic_Value (Image : in Wide_String) return Unsigned_Type is
package IO is new Ada.Wide_Text_IO.Modular_IO (Num => Unsigned_Type);
Last : Positive;
Retval : Unsigned_Type;
begin
IO.Get
(From => "16#" & Image & "#",
Item => Retval,
Last => Last);
return Retval;
end Generic_Value;
----------------------------------------------------------------------------
function Image (Value : in Interfaces.Unsigned_8) return Wide_String is
function Delegate is new Generic_Image (Unsigned_Type => Interfaces.Unsigned_8, Width => 2);
begin
return Delegate (Value);
end Image;
function Image (Value : in Interfaces.Unsigned_16) return Wide_String is
function Delegate is new Generic_Image (Unsigned_Type => Interfaces.Unsigned_16, Width => 4);
begin
return Delegate (Value);
end Image;
function Image (Value : in Interfaces.Unsigned_32) return Wide_String is
function Delegate is new Generic_Image (Unsigned_Type => Interfaces.Unsigned_32, Width => 8);
begin
return Delegate (Value);
end Image;
function Image (Value : in Interfaces.Unsigned_64) return Wide_String is
function Delegate is new Generic_Image (Unsigned_Type => Interfaces.Unsigned_64, Width => 16);
begin
return Delegate (Value);
end Image;
----------------------------------------------------------------------------
function Value (Image : in Wide_String) return Interfaces.Unsigned_8 is
function Delegate is new Generic_Value (Unsigned_Type => Interfaces.Unsigned_8);
begin
return Delegate (Image);
end Value;
function Value (Image : in Wide_String) return Interfaces.Unsigned_16 is
function Delegate is new Generic_Value (Unsigned_Type => Interfaces.Unsigned_16);
begin
return Delegate (Image);
end Value;
function Value (Image : in Wide_String) return Interfaces.Unsigned_32 is
function Delegate is new Generic_Value (Unsigned_Type => Interfaces.Unsigned_32);
begin
return Delegate (Image);
end Value;
function Value (Image : in Wide_String) return Interfaces.Unsigned_64 is
function Delegate is new Generic_Value (Unsigned_Type => Interfaces.Unsigned_64);
begin
return Delegate (Image);
end Value;
end AdaCL.Wide_Strings.Hex;
---------------------------------------------------------------- {{{ ----------
--: vim: set textwidth=0 nowrap tabstop=8 shiftwidth=3 softtabstop=3 expandtab :
--: vim: set filetype=ada fileencoding=utf-8 fileformat=unix foldmethod=expr :
--: vim: set spell spelllang=en_gb
|