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