adacl_5.15.1_e7c1515b/src/adacl-wide_wide_strings-hex.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
--------------------------------------------------------------- {{{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_Wide_Fixed;
with Ada.Wide_Wide_Text_IO;

---
--  @summary
--  Strings with hex numbers.
--
--  @description
--  Operation on hex string which don't contain the 16# and #
--
package body AdaCL.Wide_Wide_Strings.Hex is
   ---
   --  Given an modulus type returns an hex character string without the base marker.
   --
   --: @param Unsigned_Type Modulo type to convert to a hex string.
   --: @param Width         Width of the hex string formated to. Wide_Wide_String is filled with leading 0
   --: @param Value         Value to convert to hex
   --: @return              Fixed width character string repesenting the value
   function Generic_Image (Value : in Unsigned_Type) return Wide_Wide_String is
      use Ada.Strings.Wide_Wide_Fixed;

      package IO is new Ada.Wide_Wide_Text_IO.Modular_IO (Num => Unsigned_Type);

      Lead   : constant := 3;
      Tail   : constant := 1;
      Text   : Wide_Wide_String (1 .. Lead + Width + Tail);
      Retval : Wide_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;

   ---
   --  Given a string to hex digits return the value as an unsigned type
   --
   --: @param Unsigned_Type Modulo type to convert to a hex string.
   --: @param Value         Value to convert to hex
   --: @return              Fixed width character string repesenting the value
   function Generic_Value (Image : in Wide_Wide_String) return Unsigned_Type is
      package IO is new Ada.Wide_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;

   ----------------------------------------------------------------------------

   ---
   --  Given an Unsigned_8 returns an hex 2 character hex string without the base marker
   --
   --: @param Value  Value to convert to hex
   --: @return           Fixewd 4 character string repesenting the value
   function Image (Value : in Interfaces.Unsigned_8) return Wide_Wide_String is
      function Delegate is new Generic_Image (Unsigned_Type => Interfaces.Unsigned_8, Width => 2);
   begin
      return Delegate (Value);
   end Image;

   ---
   --  Given an Unsigned_16 returns an hex 4 character hex string without the base marker
   --
   --: @param Value  Value to convert to hex
   --: @return           Fixed 4 character string repesenting the value
   function Image (Value : in Interfaces.Unsigned_16) return Wide_Wide_String is
      function Delegate is new Generic_Image (Unsigned_Type => Interfaces.Unsigned_16, Width => 4);
   begin
      return Delegate (Value);
   end Image;

   ---
   --  Given an Unsigned_32 returns an hex 2 character hex string without the base marker
   --
   --: @param Value  Value to convert to hex
   --: @return           Fixewd 8 character string repesenting the value
   function Image (Value : in Interfaces.Unsigned_32) return Wide_Wide_String is
      function Delegate is new Generic_Image (Unsigned_Type => Interfaces.Unsigned_32, Width => 8);
   begin
      return Delegate (Value);
   end Image;

   ---
   --  Given an Unsigned_64 returns an hex 2 character hex string without the base marker
   --
   --: @param Value  Value to convert to hex
   --: @return           Fixewd 16 character string repesenting the value
   function Image (Value : in Interfaces.Unsigned_64) return Wide_Wide_String is
      function Delegate is new Generic_Image (Unsigned_Type => Interfaces.Unsigned_64, Width => 16);
   begin
      return Delegate (Value);
   end Image;

   ----------------------------------------------------------------------------

   ---
   --  Given hex string, return its Value as a Unsigned_8.
   --
   --: @param Wide_Wide_String  Hex Wide_Wide_String without 16#...#.
   --: @return        pased Unsigned_64 value
   function Value (Image : in Wide_Wide_String) return Interfaces.Unsigned_8 is
      function Delegate is new Generic_Value (Unsigned_Type => Interfaces.Unsigned_8);
   begin
      return Delegate (Image);
   end Value;

   ---
   --  Given hex string, return its Value as a Unsigned_64.
   --
   --: @param Wide_Wide_String  Hex Wide_Wide_String without 16#...#.
   --: @return        pased Unsigned_16 value
   function Value (Image : in Wide_Wide_String) return Interfaces.Unsigned_16 is
      function Delegate is new Generic_Value (Unsigned_Type => Interfaces.Unsigned_16);
   begin
      return Delegate (Image);
   end Value;

   ---
   --  Given hex string, return its Value as a Unsigned_64.
   --
   --: @param Wide_Wide_String  Hex Wide_Wide_String without 16#...#.
   --: @return        pased Unsigned_32 value
   function Value (Image : in Wide_Wide_String) return Interfaces.Unsigned_32 is
      function Delegate is new Generic_Value (Unsigned_Type => Interfaces.Unsigned_32);
   begin
      return Delegate (Image);
   end Value;

   ---
   --  Given hex string, return its Value as a Unsigned_64.
   --
   --: @param Wide_Wide_String  Hex Wide_Wide_String without 16#...#.
   --: @return        pased Unsigned_64 value
   function Value (Image : in Wide_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_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