------------------------------------------------------------------
--
--  NAME: BUFFERED_IO - BODY
--  DISCREPANCY REPORTS:
------------------------------------------------------------------
-- FILE : BUFIO_B.ADA
-- LEVEL : ALL LEVELS

with TEXT_IO;
package body BUFFERED_IO is

procedure SET_BUF (MY_BUF       : in out OUTPUT_BUFFER_TYPE_PTR;
                   CONNECT      : in STRING) is
begin
   
   -- Allocate new output buffer and open corresponding device for output
   MY_BUF := new OUTPUT_BUFFER_TYPE;
   TEXT_IO.OPEN (MY_BUF.FILE, TEXT_IO.OUT_FILE, CONNECT);

end SET_BUF;

procedure CLOSE (MY_BUF    : in out OUTPUT_BUFFER_TYPE_PTR) is
begin
   TEXT_IO.CLOSE (MY_BUF.FILE);
end CLOSE;    

procedure FLUSH (MY_BUF : in out OUTPUT_BUFFER_TYPE_PTR) is
begin
   if MY_BUF.SIZE > 0 then
      TEXT_IO.PUT_LINE (MY_BUF.FILE, MY_BUF.TEXT(1 .. MY_BUF.SIZE));
      MY_BUF.SIZE := 0;
   end if;
end FLUSH;

procedure PARTIAL_FLUSH (MY_BUF : in out OUTPUT_BUFFER_TYPE_PTR) is
begin            
-- This can be used after a BUFIO.PUT and before a TEXT_IO.GET_LINE.
-- Used to clear the buffer but not necessarily send the buffer out.
-- Following a PARTIAL_FLUSH with a TEXT_IO.GET_LINE will send the buffer out;
--       the cursor will remain on the same line.
   if MY_BUF.SIZE > 0 then
      TEXT_IO.PUT (MY_BUF.FILE, MY_BUF.TEXT(1 .. MY_BUF.SIZE));
      MY_BUF.SIZE := 0;
   end if;
end PARTIAL_FLUSH;

procedure PUT (MY_BUF : in out OUTPUT_BUFFER_TYPE_PTR; A_CHAR : in CHARACTER) is
begin
   if MY_BUF.SIZE >= MY_BUF.TEXT'LAST then
      FLUSH(MY_BUF);
   end if;
   MY_BUF.SIZE := MY_BUF.SIZE + 1;
   MY_BUF.TEXT (MY_BUF.SIZE) := A_CHAR;
end PUT;

procedure PUT (MY_BUF  : in out OUTPUT_BUFFER_TYPE_PTR; A_STRING : in STRING) is
   I   : NATURAL := A_STRING'FIRST - 1;
   LEN : NATURAL;
begin
   while A_STRING'LAST - I > MY_BUF.TEXT'LAST - MY_BUF.SIZE loop
      LEN := MY_BUF.TEXT'LAST - MY_BUF.SIZE ;
      if LEN > 0 then
         MY_BUF.TEXT(MY_BUF.SIZE + 1 .. MY_BUF.TEXT'LAST) :=
                A_STRING(I + 1 .. I + LEN);
      end if;
      I := I + LEN;
      MY_BUF.SIZE := MY_BUF.TEXT'LAST;
      FLUSH(MY_BUF);
   end loop;
   LEN := A_STRING'LAST - I;
   MY_BUF.TEXT(MY_BUF.SIZE + 1 .. MY_BUF.SIZE + LEN) :=
       A_STRING(I + 1 .. I + LEN);
   MY_BUF.SIZE := MY_BUF.SIZE + LEN;
end PUT;

end BUFFERED_IO;