Source file : dual_io.adb
package body Dual_IO is
Log_open : Boolean:= False;
Log_text : Text_IO.File_Type;
procedure Check_Log is
begin
if not Log_open then raise Log_not_open; end if;
end Check_Log;
procedure Create_Log (Name : in String) is
begin
if Log_open then raise Log_already_open; end if;
Text_IO.Create( File => Log_text,
Mode => Text_IO.Out_File,
Name => Name );
Log_open:= True;
end Create_Log;
procedure Append_Log (Name : in String) is
begin
if Log_open then raise Log_already_open; end if;
Text_IO.Open( File => Log_text,
Mode => Text_IO.Append_File,
Name => Name );
Log_open:= True;
end Append_Log;
procedure Close_Log is
begin
Check_Log;
Text_IO.Close( Log_text );
Log_open:= False;
end Close_Log;
function Is_Log_Open return Boolean is
begin
return Log_open;
end Is_Log_Open;
procedure Close_and_Append_Log is
log_name: constant String:= Text_IO.Name( Log_text );
begin
Close_Log;
Append_Log( log_name);
end Close_and_Append_Log;
procedure Flush is
begin
Text_IO.Flush;
Check_Log;
Text_IO.Flush( Log_text );
end Flush;
procedure New_Line (Spacing : in Positive_Count := 1) is
begin
Text_IO.New_Line( Spacing );
Check_Log;
Text_IO.New_Line( Log_text, Spacing );
end New_Line;
procedure Skip_Line (Spacing : in Positive_Count := 1) is
begin
Text_IO.Skip_Line( Spacing ); -- *in* Standard
Check_Log;
Text_IO.New_Line( Log_text, Spacing ); -- *out* Log
end Skip_Line;
procedure New_Page is
begin
Text_IO.New_Page;
Check_Log;
Text_IO.New_Page( Log_text );
end New_Page;
procedure Skip_Page is
begin
Text_IO.Skip_Page; -- *in* Standard
Check_Log;
Text_IO.New_Page( Log_text ); -- *out* Log
end Skip_Page;
-----------------------------
-- Characters Input-Output --
-----------------------------
procedure Get (Item : out Character) is
C : Character;
begin
Text_IO.Get( C ); -- *in* Standard
Check_Log;
Text_IO.Put( Log_text, C ); -- *out* Log
Item:= C;
end Get;
procedure Put (Item : in Character) is
begin
Text_IO.Put( Item );
Check_Log;
Text_IO.Put( Log_text, Item );
end Put;
--------------------------
-- Strings Input-Output --
--------------------------
procedure Get (Item : out String) is
S : String( Item'Range );
begin
Text_IO.Get( S ); -- *in* Standard
Check_Log;
Text_IO.Put( Log_text, S ); -- *out* Log
Item:= S;
end Get;
procedure Put (Item : in String) is
begin
Text_IO.Put( Item );
Check_Log;
Text_IO.Put( Log_text, Item );
end Put;
procedure Get_Line
(Item : out String;
Last : out Natural) is
S : String( Item'Range );
L : Natural;
begin
Text_IO.Get_Line( S, L ); -- *in* Standard
Check_Log;
Text_IO.Put_Line( Log_text, S(1..L) ); -- *out* Log
Item(Item'First..Item'First+L-1):= S(1..L);
Last:= L;
end Get_Line;
procedure Put_Line
(Item : in String) is
begin
Text_IO.Put_Line( Item );
Check_Log;
Text_IO.Put_Line( Log_text, Item );
end Put_Line;
package body Integer_IO is
package TIIO is new Text_IO.Integer_IO( Num );
procedure Get(Item : out Num;
Width : in Field := 0) is
I: Num;
begin
TIIO.Get( I, Width ); -- *in* Standard
Check_Log;
TIIO.Put( Log_text, I, Width ); -- *out* Log
Item:= I;
end Get;
procedure Put(Item : in Num;
Width : in Field := Default_Width;
Base : in Number_Base := Default_Base) is
begin
TIIO.Put( Item, Width, Base );
Check_Log;
TIIO.Put( Log_text, Item, Width, Base );
end Put;
end Integer_IO;
package body Float_IO is
package TFIO is new Text_IO.Float_IO( Num );
procedure Get(Item : out Num;
Width : in Field := 0) is
I: Num;
begin
TFIO.Get( I, Width ); -- *in* Standard
Check_Log;
TFIO.Put( Log_text, I ); -- *out* Log
Item:= I;
end Get;
procedure Put(Item : in Num;
Fore : in Field := Default_Fore;
Aft : in Field := Default_Aft;
Exp : in Field := Default_Exp) is
begin
TFIO.Put( Item, Fore, Aft, Exp );
Check_Log;
TFIO.Put( Log_text, Item, Fore, Aft, Exp );
end Put;
end Float_IO;
package body Fixed_IO is
package TXIO is new Text_IO.Fixed_IO( Num );
procedure Get(Item : out Num;
Width : in Field := 0) is
I: Num;
begin
TXIO.Get( I, Width ); -- *in* Standard
Check_Log;
TXIO.Put( Log_text, I ); -- *out* Log
Item:= I;
end Get;
procedure Put(Item : in Num;
Fore : in Field := Default_Fore;
Aft : in Field := Default_Aft;
Exp : in Field := Default_Exp) is
begin
TXIO.Put( Item, Fore, Aft, Exp );
Check_Log;
TXIO.Put( Log_text, Item, Fore, Aft, Exp );
end Put;
end Fixed_IO;
package body Decimal_IO is
package TDIO is new Text_IO.Decimal_IO( Num );
procedure Get
(Item : out Num;
Width : in Field := 0) is
I: Num;
begin
TDIO.Get( I, Width ); -- *in* Standard
Check_Log;
TDIO.Put( Log_text, I ); -- *out* Log
Item:= I;
end Get;
procedure Put
(Item : in Num;
Fore : in Field := Default_Fore;
Aft : in Field := Default_Aft;
Exp : in Field := Default_Exp) is
begin
TDIO.Put( Item, Fore, Aft, Exp );
Check_Log;
TDIO.Put( Log_text, Item, Fore, Aft, Exp );
end Put;
end Decimal_IO;
package body Modular_IO is
package TMIO is new Text_IO.Modular_IO( Num );
procedure Get
(Item : out Num;
Width : in Field := 0) is
I: Num;
begin
TMIO.Get( I, Width ); -- *in* Standard
Check_Log;
TMIO.Put( Log_text, I, Width ); -- *out* Log
Item:= I;
end Get;
procedure Put
(Item : in Num;
Width : in Field := Default_Width;
Base : in Number_Base := Default_Base) is
begin
TMIO.Put( Item, Width, Base );
Check_Log;
TMIO.Put( Log_text, Item, Width, Base );
end Put;
end Modular_IO;
package body Enumeration_IO is
package TEIO is new Text_IO.Enumeration_IO( Enum );
procedure Get(Item : out Enum) is
I: Enum;
begin
TEIO.Get( I ); -- *in* Standard
Check_Log;
TEIO.Put( Log_text, I ); -- *out* Log
Item:= I;
end Get;
procedure Put(Item : in Enum;
Width : in Field := Default_Width;
Set : in Type_Set := Default_Setting) is
begin
TEIO.Put( Item, Width, Set );
Check_Log;
TEIO.Put( Log_text, Item, Width, Set );
end Put;
end Enumeration_IO;
end Dual_IO;
Zip-Ada: Ada library for zip archive files (.zip).
Ada programming.
Some news about Zip-Ada and other related Ada projects
on Gautier's blog.