1------------------------------------------------------------------------------
2--                                                                          --
3--                         GNAT RUN-TIME COMPONENTS                         --
4--                                                                          --
5--              A D A . T E X T _ I O . C O M P L E X _ A U X               --
6--                                                                          --
7--                                 B o d y                                  --
8--                                                                          --
9--          Copyright (C) 1992-2021, Free Software Foundation, Inc.         --
10--                                                                          --
11-- GNAT is free software;  you can  redistribute it  and/or modify it under --
12-- terms of the  GNU General Public License as published  by the Free Soft- --
13-- ware  Foundation;  either version 3,  or (at your option) any later ver- --
14-- sion.  GNAT is distributed in the hope that it will be useful, but WITH- --
15-- OUT ANY WARRANTY;  without even the  implied warranty of MERCHANTABILITY --
16-- or FITNESS FOR A PARTICULAR PURPOSE.                                     --
17--                                                                          --
18-- As a special exception under Section 7 of GPL version 3, you are granted --
19-- additional permissions described in the GCC Runtime Library Exception,   --
20-- version 3.1, as published by the Free Software Foundation.               --
21--                                                                          --
22-- You should have received a copy of the GNU General Public License and    --
23-- a copy of the GCC Runtime Library Exception along with this program;     --
24-- see the files COPYING3 and COPYING.RUNTIME respectively.  If not, see    --
25-- <http://www.gnu.org/licenses/>.                                          --
26--                                                                          --
27-- GNAT was originally developed  by the GNAT team at  New York University. --
28-- Extensive contributions were provided by Ada Core Technologies Inc.      --
29--                                                                          --
30------------------------------------------------------------------------------
31
32with Ada.Text_IO.Generic_Aux; use Ada.Text_IO.Generic_Aux;
33
34package body Ada.Text_IO.Complex_Aux is
35
36   ---------
37   -- Get --
38   ---------
39
40   procedure Get
41     (File  : File_Type;
42      ItemR : out Num;
43      ItemI : out Num;
44      Width : Field)
45   is
46      Buf   : String (1 .. Field'Last);
47      Stop  : Integer := 0;
48      Ptr   : aliased Integer;
49      Paren : Boolean := False;
50
51   begin
52      --  General note for following code, exceptions from the calls to
53      --  Get for components of the complex value are propagated.
54
55      if Width /= 0 then
56         Load_Width (File, Width, Buf, Stop);
57         Gets (Buf (1 .. Stop), ItemR, ItemI, Ptr);
58
59         for J in Ptr + 1 .. Stop loop
60            if not Is_Blank (Buf (J)) then
61               raise Data_Error;
62            end if;
63         end loop;
64
65      --  Case of width = 0
66
67      else
68         Load_Skip (File);
69         Ptr := 0;
70         Load (File, Buf, Ptr, '(', Paren);
71         Aux.Get (File, ItemR, 0);
72         Load_Skip (File);
73         Load (File, Buf, Ptr, ',');
74         Aux.Get (File, ItemI, 0);
75
76         if Paren then
77            Load_Skip (File);
78            Load (File, Buf, Ptr, ')', Paren);
79
80            if not Paren then
81               raise Data_Error;
82            end if;
83         end if;
84      end if;
85   end Get;
86
87   ----------
88   -- Gets --
89   ----------
90
91   procedure Gets
92     (From  : String;
93      ItemR : out Num;
94      ItemI : out Num;
95      Last  : out Positive)
96   is
97      Paren : Boolean;
98      Pos   : Integer;
99
100   begin
101      String_Skip (From, Pos);
102
103      if From (Pos) = '(' then
104         Pos := Pos + 1;
105         Paren := True;
106      else
107         Paren := False;
108      end if;
109
110      Aux.Gets (From (Pos .. From'Last), ItemR, Pos);
111
112      String_Skip (From (Pos + 1 .. From'Last), Pos);
113
114      if From (Pos) = ',' then
115         Pos := Pos + 1;
116      end if;
117
118      Aux.Gets (From (Pos .. From'Last), ItemI, Pos);
119
120      if Paren then
121         String_Skip (From (Pos + 1 .. From'Last), Pos);
122
123         if From (Pos) /= ')' then
124            raise Data_Error;
125         end if;
126      end if;
127
128      Last := Pos;
129   end Gets;
130
131   ---------
132   -- Put --
133   ---------
134
135   procedure Put
136     (File  : File_Type;
137      ItemR : Num;
138      ItemI : Num;
139      Fore  : Field;
140      Aft   : Field;
141      Exp   : Field)
142   is
143   begin
144      Put (File, '(');
145      Aux.Put (File, ItemR, Fore, Aft, Exp);
146      Put (File, ',');
147      Aux.Put (File, ItemI, Fore, Aft, Exp);
148      Put (File, ')');
149   end Put;
150
151   ----------
152   -- Puts --
153   ----------
154
155   procedure Puts
156     (To    : out String;
157      ItemR : Num;
158      ItemI : Num;
159      Aft   : Field;
160      Exp   : Field)
161   is
162      I_String : String (1 .. 3 * Field'Last);
163      R_String : String (1 .. 3 * Field'Last);
164
165      Iptr : Natural;
166      Rptr : Natural;
167
168   begin
169      --  Both parts are initially converted with a Fore of 0
170
171      Rptr := 0;
172      Aux.Set_Image (ItemR, R_String, Rptr, 0, Aft, Exp);
173      Iptr := 0;
174      Aux.Set_Image (ItemI, I_String, Iptr, 0, Aft, Exp);
175
176      --  Check room for both parts plus parens plus comma (RM G.1.3(34))
177
178      if Rptr + Iptr + 3 > To'Length then
179         raise Layout_Error;
180      end if;
181
182      --  If there is room, layout result according to (RM G.1.3(31-33))
183
184      To (To'First) := '(';
185      To (To'First + 1 .. To'First + Rptr) := R_String (1 .. Rptr);
186      To (To'First + Rptr + 1) := ',';
187
188      To (To'Last) := ')';
189      To (To'Last - Iptr .. To'Last - 1) := I_String (1 .. Iptr);
190
191      for J in To'First + Rptr + 2 .. To'Last - Iptr - 1 loop
192         To (J) := ' ';
193      end loop;
194
195   end Puts;
196
197end Ada.Text_IO.Complex_Aux;
198