{ I/O unit for Z280 system ver 92-12-05 }

UNIT system;

INTERFACE

  type
    read_fn = procedure(): char;
    write_fn = procedure(ch: char);

  var
    decimal : boolean;

  PROCEDURE cls;
  PROCEDURE put(GENERIC);
  PROCEDURE putln(GENERIC);
  PROCEDURE gets(var s: string);
  PROCEDURE getchar(): char;
  PROCEDURE set_echo(on: boolean);
  PROCEDURE echo_on(): boolean;
  PROCEDURE init_system(rd: read_fn; wr: write_fn);

IMPLEMENTATION

 uses strings;

 var
   echo    : boolean;
   rxf     : read_fn;
   txf     : write_fn;

 const
   rsdat  = 50;
   rscmd  = 51;


  PROCEDURE cls;
  BEGIN
    txf(#12);
  END;


  PROCEDURE puts(s: string);
   var
     i,size : int;
  BEGIN
    i := 1;
    size := length(s); 
    while i <= size loop
      txf(s[i]);
      inc(i);
    end;
  END;


  PROCEDURE putd(n: int);
   var
    res : array[10] of char; 
  BEGIN
    if decimal then
       str(n,10,5,false,res);
    else
       str(n,16,4,false,res);
    end;
    puts(res);
  END;


  PROCEDURE do_put(value,typeCode: int);
  BEGIN
     case typeCode of
       1 : txf(char(value));
       2 : putd(value);
       3 : if boolean(value) then
              puts("true");
           else
              puts("false");
           end;
       5 : puts(string(value));
     end;
  END;


  PROCEDURE put(GENERIC);
   var
     i : int;
  BEGIN
    for i := 1 while i <= length(GENERIC) do inc(i) loop
        do_put(GENERIC[i].value,GENERIC[i].typeCode);
    end;
  END put;


  PROCEDURE putln(GENERIC);
   var
     i : int;
  BEGIN
    for i := 1 while i <= length(GENERIC) do inc(i) loop
        do_put(GENERIC[i].value,GENERIC[i].typeCode);
    end;
    txf(#13);
    if echo then txf(#10); end;
  END putln;


  PROCEDURE gets(var s: string);
   var
     i  : int;
     ch : char;
  BEGIN
    i := 1;
    ch := #0;
    while (ch <> #13) and (i <= 80) loop
      ch := rxf();
      if echo then
         txf(ch);
      end;
      if ch >= ' ' then
         s[i] := ch;
         i := i + 1; 
      else
        if (ch = #8) and (i > 1) then
           if echo then
              txf(' ');
              txf(#8);
           end;
           i := i - 1;
        end; 
      end;
    end;
    if echo then
       txf(#13); 
       txf(#10); 
    end;
    length(s) := i-1;
  END gets;


  PROCEDURE getchar(): char;
  BEGIN
    return rxf();
  END;


  PROCEDURE set_echo(on: boolean);
  BEGIN
    echo := on;
  END;


  PROCEDURE echo_on(): boolean;
  BEGIN
    return echo;
  END;


  PROCEDURE init_system(rd: read_fn; wr: write_fn);
  BEGIN
    rxf := rd;
    txf := wr;
    echo := true;
    decimal := true;
  END;


BEGIN
END system;