zipada_60.0.0_72ea5aa4/extras/dual_io.adb

package body Dual_IO is

   Log_open : Boolean := False;

   Log_text : Ada.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;
     Ada.Text_IO.Create (File => Log_text,
                     Mode => Ada.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;
     Ada.Text_IO.Open (File => Log_text,
                   Mode => Ada.Text_IO.Append_File,
                   Name => Name);
     Log_open := True;
   end Append_Log;

   procedure Close_Log is
   begin
     Check_Log;
     Ada.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 := Ada.Text_IO.Name (Log_text);
   begin
     Close_Log;
     Append_Log (log_name);
   end Close_and_Append_Log;

   procedure Flush is
   begin
     Ada.Text_IO.Flush;
     Check_Log;
     Ada.Text_IO.Flush (Log_text);
   end Flush;

   procedure New_Line (Spacing : in Positive_Count := 1) is
   begin
     Ada.Text_IO.New_Line (Spacing);
     Check_Log;
     Ada.Text_IO.New_Line (Log_text, Spacing);
   end New_Line;

   procedure Skip_Line (Spacing : in Positive_Count := 1) is
   begin
     Ada.Text_IO.Skip_Line (Spacing);           -- *in*  Standard
     Check_Log;
     Ada.Text_IO.New_Line (Log_text, Spacing);  -- *out* Log
   end Skip_Line;

   procedure New_Page is
   begin
     Ada.Text_IO.New_Page;
     Check_Log;
     Ada.Text_IO.New_Page (Log_text);
   end New_Page;

   procedure Skip_Page is
   begin
     Ada.Text_IO.Skip_Page;             -- *in*  Standard
     Check_Log;
     Ada.Text_IO.New_Page (Log_text);  -- *out* Log
   end Skip_Page;

   -----------------------------
   -- Characters Input-Output --
   -----------------------------

   procedure Get (Item : out Character) is
     C : Character;
   begin
     Ada.Text_IO.Get (C);            -- *in*  Standard
     Check_Log;
     Ada.Text_IO.Put (Log_text, C);  -- *out* Log
     Item := C;
   end Get;

   procedure Put (Item : in Character) is
   begin
     Ada.Text_IO.Put (Item);
     Check_Log;
     Ada.Text_IO.Put (Log_text, Item);
   end Put;

   --------------------------
   -- Strings Input-Output --
   --------------------------

   procedure Get (Item : out String) is
     S : String (Item'Range);
   begin
     Ada.Text_IO.Get (S);            -- *in*  Standard
     Check_Log;
     Ada.Text_IO.Put (Log_text, S);  -- *out* Log
     Item := S;
   end Get;

   procedure Put (Item : in String) is
   begin
     Ada.Text_IO.Put (Item);
     Check_Log;
     Ada.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
     Ada.Text_IO.Get_Line (S, L);               -- *in*  Standard
     Check_Log;
     Ada.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
     Ada.Text_IO.Put_Line (Item);
     Check_Log;
     Ada.Text_IO.Put_Line (Log_text, Item);
   end Put_Line;

   package body Integer_IO is

      package TIIO is new Ada.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 Ada.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 Ada.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 Ada.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 Ada.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 Ada.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;