The World of Computer Software/World_Of_Computer_Software-02-385-Vol-1of3.iso/r/rusn-09.zip/RUSN-IO.PAS

Pascal/Delphi Source File | 1992-11-03 | 4KB | 311 lines

{

rusn-io.pas - nonconsole input/output routines}

procedure noncwritec(c: char);

var
  regs: registers;

begin
  regs.dx := port;
  regs.ah := 1;
  regs.al := ord(c);
  intr($14,regs);
end;

function noncreadc: char;

var
  regs: registers;

begin
  regs.dx := port;
  regs.ah := 2;
  intr($14,regs);
  noncreadc := chr(regs.al);
end;

function noncinready: boolean;

var
  regs: registers;

begin
  regs.dx := port;
  regs.ah := 3;
  intr($14,regs);
  noncinready := odd(regs.ah);
end;

procedure xwrites(s: string);

var
  i: integer;

begin
  if console then
    write(s)
  else
    begin
      for i := 1 to length(s) do
        noncwritec(s[i]);
    end;
end;

procedure xwritei(i: integer);

var
  s: string;

begin
  if console then
    write(i)
  else
    begin
      str(i,s);
      xwrites(s);
    end;
end;

procedure xwriteiw(i,w: integer);

var
  s: string;

begin
  if console then
    write(i:w)
  else
    begin
      str(i:w,s);
      xwrites(s);
    end;
end;

procedure xwritess(s1,s2: string);

begin
  xwrites(s1);
  xwrites(s2);
end;

procedure xwritesss(s1,s2,s3: string);

begin
  xwrites(s1);
  xwrites(s2);
  xwrites(s3);
end;

procedure xwritessss(s1,s2,s3,s4: string);

begin
  xwrites(s1);
  xwrites(s2);
  xwrites(s3);
  xwrites(s4);
end;

procedure xwritesis(s1: string; i2: integer; s3: string);

begin
  xwrites(s1);
  xwritei(i2);
  xwrites(s3);
end;

procedure xwritessis(s1,s2: string; i3: integer; s4: string);

begin
  xwritess(s1,s2);
  xwritei(i3);
  xwrites(s4);
end;

procedure xwriteln;

begin
  if console then
    writeln
  else
    xwritess(chr(13),chr(10));
end;

procedure xwritelns(s: string);

begin
  xwrites(s);
  xwriteln;
end;

procedure xwritelnss(s1,s2: string);

begin
  xwrites(s1);
  xwrites(s2);
  xwriteln;
end;

procedure xwritelnsss(s1,s2,s3: string);

begin
  xwrites(s1);
  xwrites(s2);
  xwrites(s3);
  xwriteln;
end;

procedure xwritelnssss(s1,s2,s3,s4: string);

begin
  xwrites(s1);
  xwrites(s2);
  xwrites(s3);
  xwrites(s4);
  xwriteln;
end;

procedure xwritelnsssisis(s1,s2,s3: string; i4: integer; s5: string;
 i6: integer; s7: string);

begin
  xwritesss(s1,s2,s3);
  xwritei(i4);
  xwrites(s5);
  xwritei(i6);
  xwritelns(s7);
end;

procedure xgotoxy(x,y: integer);

begin
  if console then
    gotoxy(x,y)
  else
    begin
      xwritess(#27,'[');
      xwritei(y);
      xwrites(';');
      xwritei(x);
      xwrites('f');
    end;
end;

procedure writexy(x,y: integer; s: string);

begin
  xgotoxy(x,y);
  xwrites(s);
end;

procedure xclreol;

begin
  if console then
    clreol
  else
    xwritess(#27,'[0K');
end;

procedure xclreolxy(x,y: integer);

begin
  xgotoxy(x,y);
  xclreol;
end;

procedure xclrscr;

begin
  if console then
    clrscr
  else
    begin
      xwritess(#27,'[2J');
      xgotoxy(1,1);
    end;
end;

function xkeypressed: boolean;

begin
  if console then
    xkeypressed := keypressed
  else
    xkeypressed := noncinready;
end;

function xreadkey: char;

begin
  if console then
    xreadkey := readkey
  else
    begin
      while not xkeypressed do
        ;
      xreadkey := noncreadc;
    end;
end;

procedure xreadlns(var s: string);

var
  result: string;
  len: integer;
  c: char;

begin
  if console then
    readln(s)
  else
    begin
      len := 0;
      result := '';
      repeat
        c := xreadkey;
        if (c=#127) or (c=#8) then
          begin
            if length(result)>0 then
              begin
                xwritesss(#8,' ',#8);
                dec(len);
                if len=0 then
                  result := ''
                else
                  result := copy(result,1,len);
              end;
          end
        else if (c=#13) then
          begin
            xwriteln;
          end
        else if (ord(c)>=32) and (ord(c)<128) and (len<250) then
          begin
            inc(len);
            result := result+c;
            noncwritec(c);
          end
      until c=#13;
      s := result;
    end;
end;

procedure xhighvideo;

begin
  if console then
    highvideo
  else
    xwritess(#27,'[7m');
end;

procedure xlowvideo;

begin
  if console then
    lowvideo
  else
    xwritess(#27,'[m');
end;