dummyserver_1.0.0_9a6e8708/src/black/black-text_io.adb

  1
  2
  3
  4
  5
  6
  7
  8
  9
 10
 11
 12
 13
 14
 15
 16
 17
 18
 19
 20
 21
 22
 23
 24
 25
 26
 27
 28
 29
 30
 31
 32
 33
 34
 35
 36
 37
 38
 39
 40
 41
 42
 43
 44
 45
 46
 47
 48
 49
 50
 51
 52
 53
 54
 55
 56
 57
 58
 59
 60
 61
 62
 63
 64
 65
 66
 67
 68
 69
 70
 71
 72
 73
 74
 75
 76
 77
 78
 79
 80
 81
 82
 83
 84
 85
 86
 87
 88
 89
 90
 91
 92
 93
 94
 95
 96
 97
 98
 99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
with
  Ada.Characters.Handling,
  Ada.Characters.Latin_1,
  Ada.IO_Exceptions,
  Ada.Strings,
  Ada.Strings.Fixed;

package body Black.Text_IO is
   function Get_Line
     (Stream : not null access Ada.Streams.Root_Stream_Type'Class)
     return String is
   begin
      return Ada.Strings.Unbounded.To_String (Get_Line (Stream));
   end Get_Line;

   function Get_Line
     (Stream : not null access Ada.Streams.Root_Stream_Type'Class)
     return Ada.Strings.Unbounded.Unbounded_String is
      use Ada.Characters.Latin_1, Ada.Strings.Unbounded;
      Buffer : Unbounded_String := Null_Unbounded_String;
      Next   : Character;
   begin
      loop
         Character'Read (Stream, Next);

         if Next = CR then
            Character'Read (Stream, Next);
            if Next = LF then
               return Buffer;
            else
               Append (Buffer, CR & Next);
            end if;
         else
            Append (Buffer, Next);
         end if;
      end loop;
   exception
      when Ada.IO_Exceptions.End_Error =>
         if Buffer = Null_Unbounded_String then
            raise;
         else
            return Buffer;
         end if;
   end Get_Line;

   procedure New_Line
     (Target : not null access Ada.Streams.Root_Stream_Type'Class) is
   begin
      Put (Target => Target,
           Item   => Ada.Characters.Latin_1.CR & Ada.Characters.Latin_1.LF);
   end New_Line;

   procedure Put
     (Target : not null access Ada.Streams.Root_Stream_Type'Class;
      Item   : in     String) is
      pragma Assert (Ada.Streams.Stream_Element'Size = Character'Size);
   begin
      String'Write (Target, Item);
   end Put;

   procedure Put
     (Target : not null access Ada.Streams.Root_Stream_Type'Class;
      Item   : in     Ada.Strings.Unbounded.Unbounded_String) is
   begin
      Put (Target => Target,
           Item   => Ada.Strings.Unbounded.To_String (Item));
   end Put;

   procedure Put
     (Target : not null access Ada.Streams.Root_Stream_Type'Class;
      Item   : in     Boolean) is
      use Ada.Characters.Handling;
   begin
      Put (Target => Target,
           Item   => To_Lower (Boolean'Image (Item)));
   end Put;

   procedure Put_Line
     (Target : not null access Ada.Streams.Root_Stream_Type'Class;
      Item   : in     String) is
   begin
      Put (Target => Target,
           Item   => Item &
                     Ada.Characters.Latin_1.CR & Ada.Characters.Latin_1.LF);
   end Put_Line;

   procedure Put_Line
     (Target : not null access Ada.Streams.Root_Stream_Type'Class;
      Item   : in     Ada.Strings.Unbounded.Unbounded_String) is
   begin
      Put_Line (Target => Target,
                Item   => Ada.Strings.Unbounded.To_String (Item));
   end Put_Line;

   procedure Put_Line
     (Target : not null access Ada.Streams.Root_Stream_Type'Class;
      Item   : in     Boolean) is
      use Ada.Characters.Handling;
   begin
      Put_Line (Target => Target,
                Item   => To_Lower (Boolean'Image (Item)));
   end Put_Line;

   procedure Put_Line
     (Target : not null access Ada.Streams.Root_Stream_Type'Class;
      Item   : in     Integer) is
      use Ada.Strings, Ada.Strings.Fixed;
   begin
      Put_Line (Target => Target,
                Item   => Trim (Integer'Image (Item), Both));
   end Put_Line;

   procedure Put_Line
     (Target : not null access Ada.Streams.Root_Stream_Type'Class;
      Item   : in     Duration) is
      use Ada.Strings, Ada.Strings.Fixed;
   begin
      Put_Line (Target => Target,
                Item   => Trim (Duration'Image (Item), Both));
   end Put_Line;
end Black.Text_IO;