1
2package body Dual_IO is
3
4   Log_open : Boolean:= False;
5
6   Log_text : 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     Text_IO.Create( File => Log_text,
17                     Mode => 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     Text_IO.Open( File => Log_text,
26                   Mode => 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     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:= 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     Text_IO.Flush;
53     Check_Log;
54     Text_IO.Flush( Log_text );
55   end Flush;
56
57   procedure New_Line (Spacing : in Positive_Count := 1) is
58   begin
59     Text_IO.New_Line( Spacing );
60     Check_Log;
61     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     Text_IO.Skip_Line( Spacing );           -- *in*  Standard
67     Check_Log;
68     Text_IO.New_Line( Log_text, Spacing );  -- *out* Log
69   end Skip_Line;
70
71   procedure New_Page is
72   begin
73     Text_IO.New_Page;
74     Check_Log;
75     Text_IO.New_Page( Log_text );
76   end New_Page;
77
78   procedure Skip_Page is
79   begin
80     Text_IO.Skip_Page;             -- *in*  Standard
81     Check_Log;
82     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     Text_IO.Get( C );            -- *in*  Standard
93     Check_Log;
94     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     Text_IO.Put( Item );
101     Check_Log;
102     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     Text_IO.Get( S );            -- *in*  Standard
113     Check_Log;
114     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     Text_IO.Put( Item );
121     Check_Log;
122     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     Text_IO.Get_Line( S, L );               -- *in*  Standard
132     Check_Log;
133     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     Text_IO.Put_Line( Item );
142     Check_Log;
143     Text_IO.Put_Line( Log_text, Item );
144   end Put_Line;
145
146   package body Integer_IO is
147
148      package TIIO is new 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 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 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 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 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 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
302end Dual_IO;
303