Source file : dual_io.adb
1
2 package body Dual_IO is
3
4 Log_open : Boolean := False;
5
6 Log_text : Ada.Text_IO.File_Type;
7
8 procedure Check_Log is
9 begin
10 if not Log_open then raise Log_not_open; end if;
11 end Check_Log;
12
13 procedure Create_Log (Name : in String) is
14 begin
15 if Log_open then raise Log_already_open; end if;
16 Ada.Text_IO.Create (File => Log_text,
17 Mode => Ada.Text_IO.Out_File,
18 Name => Name);
19 Log_open := True;
20 end Create_Log;
21
22 procedure Append_Log (Name : in String) is
23 begin
24 if Log_open then raise Log_already_open; end if;
25 Ada.Text_IO.Open (File => Log_text,
26 Mode => Ada.Text_IO.Append_File,
27 Name => Name);
28 Log_open := True;
29 end Append_Log;
30
31 procedure Close_Log is
32 begin
33 Check_Log;
34 Ada.Text_IO.Close (Log_text);
35 Log_open := False;
36 end Close_Log;
37
38 function Is_Log_Open return Boolean is
39 begin
40 return Log_open;
41 end Is_Log_Open;
42
43 procedure Close_and_Append_Log is
44 log_name : constant String := Ada.Text_IO.Name (Log_text);
45 begin
46 Close_Log;
47 Append_Log (log_name);
48 end Close_and_Append_Log;
49
50 procedure Flush is
51 begin
52 Ada.Text_IO.Flush;
53 Check_Log;
54 Ada.Text_IO.Flush (Log_text);
55 end Flush;
56
57 procedure New_Line (Spacing : in Positive_Count := 1) is
58 begin
59 Ada.Text_IO.New_Line (Spacing);
60 Check_Log;
61 Ada.Text_IO.New_Line (Log_text, Spacing);
62 end New_Line;
63
64 procedure Skip_Line (Spacing : in Positive_Count := 1) is
65 begin
66 Ada.Text_IO.Skip_Line (Spacing); -- *in* Standard
67 Check_Log;
68 Ada.Text_IO.New_Line (Log_text, Spacing); -- *out* Log
69 end Skip_Line;
70
71 procedure New_Page is
72 begin
73 Ada.Text_IO.New_Page;
74 Check_Log;
75 Ada.Text_IO.New_Page (Log_text);
76 end New_Page;
77
78 procedure Skip_Page is
79 begin
80 Ada.Text_IO.Skip_Page; -- *in* Standard
81 Check_Log;
82 Ada.Text_IO.New_Page (Log_text); -- *out* Log
83 end Skip_Page;
84
85 -----------------------------
86 -- Characters Input-Output --
87 -----------------------------
88
89 procedure Get (Item : out Character) is
90 C : Character;
91 begin
92 Ada.Text_IO.Get (C); -- *in* Standard
93 Check_Log;
94 Ada.Text_IO.Put (Log_text, C); -- *out* Log
95 Item := C;
96 end Get;
97
98 procedure Put (Item : in Character) is
99 begin
100 Ada.Text_IO.Put (Item);
101 Check_Log;
102 Ada.Text_IO.Put (Log_text, Item);
103 end Put;
104
105 --------------------------
106 -- Strings Input-Output --
107 --------------------------
108
109 procedure Get (Item : out String) is
110 S : String (Item'Range);
111 begin
112 Ada.Text_IO.Get (S); -- *in* Standard
113 Check_Log;
114 Ada.Text_IO.Put (Log_text, S); -- *out* Log
115 Item := S;
116 end Get;
117
118 procedure Put (Item : in String) is
119 begin
120 Ada.Text_IO.Put (Item);
121 Check_Log;
122 Ada.Text_IO.Put (Log_text, Item);
123 end Put;
124
125 procedure Get_Line
126 (Item : out String;
127 Last : out Natural) is
128 S : String (Item'Range);
129 L : Natural;
130 begin
131 Ada.Text_IO.Get_Line (S, L); -- *in* Standard
132 Check_Log;
133 Ada.Text_IO.Put_Line (Log_text, S (1 .. L)); -- *out* Log
134 Item (Item'First .. Item'First + L - 1) := S (1 .. L);
135 Last := L;
136 end Get_Line;
137
138 procedure Put_Line
139 (Item : in String) is
140 begin
141 Ada.Text_IO.Put_Line (Item);
142 Check_Log;
143 Ada.Text_IO.Put_Line (Log_text, Item);
144 end Put_Line;
145
146 package body Integer_IO is
147
148 package TIIO is new Ada.Text_IO.Integer_IO (Num);
149
150 procedure Get (Item : out Num;
151 Width : in Field := 0) is
152 I : Num;
153 begin
154 TIIO.Get (I, Width); -- *in* Standard
155 Check_Log;
156 TIIO.Put (Log_text, I, Width); -- *out* Log
157 Item := I;
158 end Get;
159
160 procedure Put (Item : in Num;
161 Width : in Field := Default_Width;
162 Base : in Number_Base := Default_Base) is
163 begin
164 TIIO.Put (Item, Width, Base);
165 Check_Log;
166 TIIO.Put (Log_text, Item, Width, Base);
167 end Put;
168
169 end Integer_IO;
170
171 package body Float_IO is
172
173 package TFIO is new Ada.Text_IO.Float_IO (Num);
174
175 procedure Get (Item : out Num;
176 Width : in Field := 0) is
177 I : Num;
178 begin
179 TFIO.Get (I, Width); -- *in* Standard
180 Check_Log;
181 TFIO.Put (Log_text, I); -- *out* Log
182 Item := I;
183 end Get;
184
185 procedure Put (Item : in Num;
186 Fore : in Field := Default_Fore;
187 Aft : in Field := Default_Aft;
188 Exp : in Field := Default_Exp) is
189 begin
190 TFIO.Put (Item, Fore, Aft, Exp);
191 Check_Log;
192 TFIO.Put (Log_text, Item, Fore, Aft, Exp);
193 end Put;
194
195 end Float_IO;
196
197 package body Fixed_IO is
198
199 package TXIO is new Ada.Text_IO.Fixed_IO (Num);
200
201 procedure Get (Item : out Num;
202 Width : in Field := 0) is
203 I : Num;
204 begin
205 TXIO.Get (I, Width); -- *in* Standard
206 Check_Log;
207 TXIO.Put (Log_text, I); -- *out* Log
208 Item := I;
209 end Get;
210
211 procedure Put (Item : in Num;
212 Fore : in Field := Default_Fore;
213 Aft : in Field := Default_Aft;
214 Exp : in Field := Default_Exp) is
215 begin
216 TXIO.Put (Item, Fore, Aft, Exp);
217 Check_Log;
218 TXIO.Put (Log_text, Item, Fore, Aft, Exp);
219 end Put;
220
221 end Fixed_IO;
222
223 package body Decimal_IO is
224
225 package TDIO is new Ada.Text_IO.Decimal_IO (Num);
226
227 procedure Get
228 (Item : out Num;
229 Width : in Field := 0) is
230 I : Num;
231 begin
232 TDIO.Get (I, Width); -- *in* Standard
233 Check_Log;
234 TDIO.Put (Log_text, I); -- *out* Log
235 Item := I;
236 end Get;
237
238 procedure Put
239 (Item : in Num;
240 Fore : in Field := Default_Fore;
241 Aft : in Field := Default_Aft;
242 Exp : in Field := Default_Exp) is
243 begin
244 TDIO.Put (Item, Fore, Aft, Exp);
245 Check_Log;
246 TDIO.Put (Log_text, Item, Fore, Aft, Exp);
247 end Put;
248
249 end Decimal_IO;
250
251 package body Modular_IO is
252
253 package TMIO is new Ada.Text_IO.Modular_IO (Num);
254
255 procedure Get
256 (Item : out Num;
257 Width : in Field := 0) is
258 I : Num;
259 begin
260 TMIO.Get (I, Width); -- *in* Standard
261 Check_Log;
262 TMIO.Put (Log_text, I, Width); -- *out* Log
263 Item := I;
264 end Get;
265
266 procedure Put
267 (Item : in Num;
268 Width : in Field := Default_Width;
269 Base : in Number_Base := Default_Base) is
270 begin
271 TMIO.Put (Item, Width, Base);
272 Check_Log;
273 TMIO.Put (Log_text, Item, Width, Base);
274 end Put;
275
276 end Modular_IO;
277
278 package body Enumeration_IO is
279
280 package TEIO is new Ada.Text_IO.Enumeration_IO (Enum);
281
282 procedure Get (Item : out Enum) is
283 I : Enum;
284 begin
285 TEIO.Get (I); -- *in* Standard
286 Check_Log;
287 TEIO.Put (Log_text, I); -- *out* Log
288 Item := I;
289 end Get;
290
291 procedure Put (Item : in Enum;
292 Width : in Field := Default_Width;
293 Set : in Type_Set := Default_Setting) is
294 begin
295 TEIO.Put (Item, Width, Set);
296 Check_Log;
297 TEIO.Put (Log_text, Item, Width, Set);
298 end Put;
299
300 end Enumeration_IO;
301
302 end Dual_IO;
Web view of Ada source code generated by GNATHTML, project: ALI_Parse version 1.0.
Zip-Ada: Ada library for zip archive files (.zip).
Ada programming.
Some news about Zip-Ada and other Ada projects
on Gautier's blog.
