src/i386-text_console.adb

   1 pragma No_Run_Time;
   2 package body I386.Text_Console is
   3
   4    Current_Line : console_Index := 1;
   5    Current_Column : Console_Index := 1;
   6
   7    procedure Put (C : Character)
   8    is
   9       Text_Video : Text_Buffer;
  10       for Text_Video'Address use To_Address (Unsigned_32 (Video_Base_Address));
  11       L : Line_Index := Max_Line;
  12    begin
  13       if Current_Column > Max_Column then
  14          Current_Column := 1;
  15          Current_Line := Current_Line + 1;
  16       end if;
  17       if Current_Line > Max_Line then
  18          for I in 1 .. Max_Line - 1 loop
  19 --          for J in 1 .. Max_Column loop
  20 --             Text_Video (I)(J) := Text_Video (I + 1)(J);
  21 --          end loop;
  22             Text_Video (I) := Text_Video (I + 1);
  23          end loop;
  24 --           for I in 1 .. Max_Column loop
  25 --              Text_Video (Max_Line)(I).Text := Character'Pos (Ascii.NUL);
  26 --           end loop;
  27          Text_Video (Max_Line) := (others => Blank_Text_Element);
  28          Current_Line := 25;
  29       end if;
  30       Text_Video (Current_Line)(Current_Column).Text := Character'Pos (C);
  31       Current_Column := Current_Column + 1;
  32    end Put;
  33
  34    procedure Put (S : String)
  35    is
  36    begin
  37       for I in S'Range loop
  38          Put (S (I));
  39       end loop;
  40    end Put;
  41
  42    procedure Cls
  43    is
  44       Text_Video : Text_Buffer;
  45       for Text_Video'Address use To_Address (Unsigned_32 (Video_Base_Address));
  46    begin
  47 --        for I in Line_Index'Range loop
  48 --           for J in Column_Index'Range loop
  49 --              Text_Video (I)(J).Text := Character'Pos (Ascii.NUL);
  50 --           end loop;
  51 --        end loop;
  52       Text_Video := (others => (others => Blank_Text_Element));
  53       Current_Line := 1;
  54       Current_Column := 1;
  55    end Cls;
  56
  57    procedure New_Line
  58    is
  59    begin
  60       Current_Line := Current_Line + 1;
  61       Current_Column := 1;
  62    end New_Line;
  63
  64    procedure Put_Line (S : String)
  65    is
  66    begin
  67       Put (S);
  68       New_Line;
  69    end Put_Line;
  70
  71 end I386.Text_Console;