Programmer 7500/MAX_PROGRAMMERS.iso/INFO/MODEM/MUFUS32R.ZIP/MUFUSION.PAS

Pascal/Delphi Source File | 1991-10-31 | 31.4 KB | 1,079 lines

{$B-}    {Boolean complete evaluation off}
{$S-}    {Stack checking off}
{$I-}    {I/O checking off}
{$R-}    {Range checking off}
{$M 4096,8192,8192}

program mufusion;

{  This terminal package by was written by Peter Summers, using code
   released to the public domain program by Jim Nutt.  It now emulates a
   Microfusion MF30 terminal.  The program (including source) may be
   distributed freely, but copyright is retained by the Cardiology
   Department at Royal Melbourne Hospital.    }

Uses
  Dos,
  Crt,
  MufAsync;

const
  default     = -1;
  defportnum  = 1;
  defbaudrate = 9600;
  deffcolor   = 2;          {default foreround color}
  defbcolor   = 0;          {default background color}
  defpcolor   = 3;          {default protected text color}
  space       = $20;
  bufsize     = 744;        {number of lines of backpage buffer (=30+current).  This can be reduced
                             to increase the amount of memory available when shelled to DOS.}

var
  fcolor      : integer;
  bcolor      : integer;
  pcolor      : integer;
  screenbuf   : array[1..80,0..bufsize-1] of byte;      {backpage buffer}
  screenptr   : integer;                                {pointer to current screen within backpage buffer}
  end_now     : boolean;
  protmode    : boolean;                                {true = protected text on}
  fkey        : array[1..20] of string[80];             {function key definitions}
  new_line    : boolean;                                {true if a line feed is pending}
  gen_cr      : boolean;                                {true if a carriage return may be generated}
  portnum     : integer;                                {communications port number}
  baudrate    : word;
  capture     : text;
  capture_on  : boolean;
  printer     : text;
  printer_on  : boolean;
  printbuf    : string[128];                            {Buffer for output to the printer.  Don't make this string >128 long,
                                                         or the close command at the end of the program will have to time out
                                                         if the printer is unavailable.  I don't understand this.}
  emulation   : boolean;                                {True if emulation is on, false in debugging mode}
  start_mode  : integer;                                {Text mode when mufusion was called}
  stat_line   : integer;                                {Position of the status line}
  thiskb_stat : byte;                                   {Status of shift/control/alt keys}
  lastkb_stat : byte;                                   {Previous status of shift/control/alt keys}
  fk_defined  : boolean;                                {True if the function keys have been defined}
  auto_echo   : boolean;                                {True if characters echoed locally}
  lastposx    : integer;                                {Used for restoring cursor position (with on of the ecs F functions)}
  lastposy    : integer;
  saveint05   : pointer;                                {The original print screen vector}
  reg         : registers;                              {Used for called to interrupt routines}
  sendbreak   : boolean;                                {True if a break signal should be sent}
  printscrn   : boolean;                                {True if a print screen is pending}



function kb_stat: byte;

{ Returns the shift/control/alt function key status of the keyboard}

begin
  reg.AH := $02;
  intr($16, Reg);
  kb_stat := reg.AL;
end;



procedure stat_write(tstr : string);

{ Write a string to the status line}

var
  oldtextattr : byte;
  x,y         : integer;

begin
  x := wherex;
  y := wherey;
  oldtextattr:=textattr;
  textattr:=$70;
  window(1,stat_line,80,stat_line);
  clreol;
  gotoxy(3,1);
  write(tstr);
  window(1,1,80,stat_line-1);
  textattr:=oldtextattr;
  gotoxy(x,y);
end;



function stat_read(pstr : string) : string;

{ Prompt for an input string on the status line}

var
  oldtextattr : byte;
  tstr        : string[80];
  x,y         : integer;

begin

  x := wherex;
  y := wherey;
  oldtextattr:=textattr;
  textattr:=$70;
  window(1,stat_line,80,stat_line);
  clreol;
  gotoxy(3,1);
  write(pstr);
  gotoxy(length(pstr) + 3,1);
  readln(tstr);
  stat_read := tstr;
  window(1,1,80,stat_line-1);
  textattr:=oldtextattr;
  gotoxy(x,y);
end;



procedure display_statline;

{ Display the current status line, dependant on keyboard shift/alt key
  status and definition of function keys }

var
  oldtextattr : byte;
  startkey    : integer;
  i,j,x,y     : integer;

begin
  if (thiskb_stat and $08)<>0 then
    stat_write('(C)apture   (D)ial   (E)mulation   (H)angup   d(O)s   (P)rinter   e(X)it')
  else
    begin
      if fk_defined then
        begin
          x := wherex;
          y := wherey;
          oldtextattr:=textattr;
          window(1,stat_line,80,stat_line);
          gotoxy(1,1);
          clreol;
          textattr:=$70;
          if (thiskb_stat and $03)=0 then
            startkey:=1
          else
            startkey:=11;
          for i:= 0 to 9 do
            begin
              gotoxy(7*i+2*(i div 4)+1,1);
              for j:= 1 to 6 do
                if (j <= length(fkey[startkey+i]))
                  and (ord(fkey[startkey+i,j]) in [32..126])
                    then write(fkey[startkey+i,j]) else write(' ');
            end;
          gotoxy(75,1);
          textattr:=$01;
          write('µ3.2r');
          window(1,1,80,stat_line-1);
          textattr:=oldtextattr;
          gotoxy(x,y);
        end
      else
        stat_write('µfusion v3.2r by Peter Summers                         (C) Cardiology at RMH');
    end;
end;



procedure flushprintbuf;

{ Flush the printer buffer }

begin
  stat_write('Writing to the printer...');
  write(printer,printbuf);
  if IOresult<>0 then
    begin
      stat_write('Can''t write to the printer, turning printing off...');
      printer_on:=false;
      sound(50);
      delay(1000);
      nosound;
    end;
  printbuf:='';
  display_statline;
end;



function cgetc(TimeLimit : integer) : integer;

{ Get a character from the COM port, and send it to the printer and capture
  file as required, or return -1 if no character was found }

const
  TIMED_OUT = -1;
var
  rcvd : char;

begin
  if TimeLimit>0 then
    begin
      TimeLimit := 1000*TimeLimit;
      repeat
        delay(1);
        TimeLimit:=TimeLimit-1;
      until Async_Buffer_Check or (TimeLimit=0);
    end;

  if (Async_Receive(rcvd)) then
    begin
      cgetc := ord(rcvd) and $7F;
      if capture_on then
        begin
          write(capture,rcvd);
          if IOresult<>0 then
            begin
              stat_write('Can''t write to capture file...');
              sound(50);
              delay(1000);
              nosound;
              close(capture);
              capture_on:=false;
              display_statline;
            end;
        end;
      if printer_on then
        begin
          printbuf:=printbuf+rcvd;
          if length(printbuf)=128 then flushprintbuf;
        end;
    end
  else
    cgetc := TIMED_OUT;
end;



procedure hangup;

{ Hang up the modem }

begin
  stat_write('Hanging up the modem...');
  Async_Close(true);
  delay(1100);
  if not(Async_Open(portnum,baudrate,'N',8,1)) then halt(1);
  if Async_Carrier_Detect then
    begin
      Async_Send_String_With_Delays('+++',10,10);
      delay(1100);
      Async_Send_String_With_Delays(^M+'ATH'+^M,10,10);
    end;
  if Async_Carrier_Detect then
    stat_write('The modem won''t hang up...')
  else
    stat_write('The modem has hung up...');
  delay(1000);
 end;



procedure dial;

{ Dial with a Hayes compatible modem }

var
  number : string[40];

begin
  number := stat_read('Number to dial? ');
  if number<>'' then
    begin
      if Async_Carrier_Detect then hangup;
      Async_Send_String_With_Delays(^M + 'ATD' + number + ^M,10,10);
    end;
end;



procedure master_clear;

{ Clear the current screen }

var
  i,j : integer;

begin
  textattr:=(bcolor shl 4) or 8 or pcolor;
  clrscr;
  protmode:=true;
  screenptr:=(screenptr+24) mod bufsize;
  for i:=1 to 80 do
    for j:=1 to 24 do
      screenbuf[i,(j+screenptr) mod bufsize]:=space;
end;



procedure display_screen;

{ Display the section of the backpage buffer pointed to by screenptr }

var
  i,j,k       : integer;
  oldtextattr : byte;

begin
  oldtextattr:=textattr;
  clrscr;
  for j:=1 to 24 do
    if screenbuf[1,(j+screenptr) mod bufsize]=0 then write(^M^J) else
      for i:=1 to 80 do
        if not ((i=80) and (j=24)) then
          begin
            k:=screenbuf[i,(j+screenptr) mod bufsize];
            if (k and $80)=0 then
              textattr:=(bcolor shl 4) or 8 or fcolor
            else
              textattr:=(bcolor shl 4) or 8 or pcolor;
            write(chr(k and $7F));
          end;
  textattr:=oldtextattr;
end;



procedure control_break(flags,cs,ip,ax,bx,cx,dx,si,di,ds,es,bp:word);

{ Interrupt routine to catch the control-break key }

interrupt;

begin
  sendbreak:=true;
end;



procedure print_screen(flags,cs,ip,ax,bx,cx,dx,si,di,ds,es,bp:word);

{ Interrupt routine to catch the print-screen key }

interrupt;

begin
  printscrn:=true;
end;



procedure screen_dump;

{ Print the section of the backpage buffer pointed to by screenptr (normally
  the current screen) to the nominated print device }

var
  i,j,k : integer;

begin
  stat_write('Writing to the printer...');
  for j:=1 to 24 do
    if screenbuf[1,(j+screenptr) mod bufsize]<>0 then
      for i:=1 to 81 do
        begin
          if (i<81) then
            write(printer,chr(screenbuf[i,(j+screenptr) mod bufsize] and $7F))
          else
            write(printer,^M+^J);
          if IOresult<>0 then
            begin
              stat_write('Can''t write to the printer, turning printing off...');
              sound(50);
              delay(1000);
              nosound;
              display_statline;
              exit;
            end;
        end;
  display_statline;
end;



procedure backpage;

{ Do backpaging }

var
  x,y          : integer;
  oldtextattr  : byte;
  oldscreenptr : integer;
  keystroke    : integer;

begin
  x:=wherex;
  y:=wherey;
  oldtextattr:=textattr;
  oldscreenptr:=screenptr;
  screenptr:=(screenptr+bufsize-24) mod bufsize;
  repeat
    stat_write('PgUp goes backwards, PgDn goes forward, press the Space Bar to quit...');
    display_screen;
    keystroke:=ord(readkey);
    if keystroke=0 then
      begin
        if ord(readkey) in [73,110] then
          begin
            if ((screenptr+bufsize-oldscreenptr) mod bufsize) > 24 then
              screenptr:=(screenptr+bufsize-24) mod bufsize;
          end
        else
          screenptr:=(screenptr+24) mod bufsize;
      end;
    if printscrn then
      begin
        screen_dump;
        printscrn:=false;
      end;
  until (keystroke<>0) or (screenptr=oldscreenptr);
  screenptr:=oldscreenptr;
  display_screen;
  display_statline;
  gotoxy(x,y);
  textattr:=oldtextattr;
end;



procedure toggle_emulation;

{ Toggle emulution/debugging }

begin
  if start_mode<>mono then
    begin
      if emulation then
        begin
          textmode(Font8x8+CO80);
          setintvec($05,saveint05);
        end
      else
        begin
          textmode(CO80);
          setintvec($05,@print_screen);
        end;
      stat_line:=hi(windmax)+1;
    end;
  emulation := not emulation;
  master_clear;
end;



procedure toggle_capture;

{ Toggle the capture file status }

var
  attributes   : word;
  keystroke    : char;
  capture_file : string[80];

begin
  if capture_on then
    begin
      stat_write('Closing capture file...');
      close(capture);
      delay(1000);
      capture_on:=false;
      display_statline;
    end
  else
    begin
      capture_file:=stat_read('Capture file name ... ');
      if capture_file<>'' then
        begin
          assign(capture,capture_file);
          getfattr(capture,attributes);
          if attributes=0 then
            rewrite(capture)
          else
            repeat
              sound(50);
              delay(1000);
              nosound;
              stat_write('File exists, (A)ppend, (O)verlay, or (Q)uit ? ..');
              keystroke:=readkey;
              case keystroke of
                'A','a' : append(capture);
                'O','o' : rewrite(capture);
                'Q','q' : exit;
              end;
            until keystroke in ['Q','q','O','o','A','a'];
          if IOresult=0 then
            capture_on:=true
          else
            begin
              stat_write('Can''t open '+capture_file+'...');
              sound(50);
              delay(1000);
              nosound;
            end;
        end;
    end;
end;



procedure shell_to_dos;

{ Shell to DOS }

var
  x,y         : integer;
  oldscrnmode : word;
  oldtextattr : byte;

begin
  x:=wherex;
  y:=wherey;
  oldtextattr:=textattr;
  oldscrnmode:=lastmode;
  textmode(start_mode);
  textattr:=$07;
  write('Shelling to DOS, type EXIT to return...');
  setintvec($05,saveint05);
  swapvectors;
  exec(getenv('COMSPEC'),'');
  swapvectors;
  textmode(oldscrnmode);
  textattr:=oldtextattr;
  display_statline;
  if emulation then
    begin
      setintvec($05,@print_screen);
      display_screen;
      gotoxy(x,y);
    end;
end;



procedure findunprot;

{ Find the next unprotected section of the screen }

var
  i,j  : integer;

begin
  i := wherex;
  j := wherey;
  repeat
    i:=i+1;
    if i=81 then
      begin
        i:=1;
        j:=j+1;
      end;
  until ((i=80) and (j=24)) or
    ((screenbuf[i,(j+screenptr) mod bufsize] and $80)=0);
  gotoxy(i,j);
end;



procedure setup;

{ Initialise the program }

var
  code : integer;
  i,j  : integer;

begin
  checkbreak:=false;
  start_mode:=lastmode;
  stat_line:=hi(windmax)+1;
  code:=0;
  if paramcount>0 then
    val(paramstr(1),portnum,code)
  else
    portnum:=defportnum;
  portnum:=((portnum-1) and 3)+1;
  if paramcount>1 then
    val(paramstr(2),baudrate,code)
  else
    baudrate:=defbaudrate;
  if start_mode=mono then
    begin
      fcolor:=7;
      bcolor:=0;
      pcolor:=7;
    end
  else
    begin
      textmode(co80);
      if paramcount>2 then
        val(paramstr(3),fcolor,code)
      else
        fcolor:=deffcolor;
      fcolor:=fcolor and 7;
      if paramcount>3 then
        val(paramstr(4),bcolor,code)
      else
        bcolor:=defbcolor;
      bcolor:=bcolor and 7;
      if paramcount>4 then
        val(paramstr(5),pcolor,code)
      else
        pcolor:=defpcolor;
      pcolor:=pcolor and 7;
    end;
  if paramcount>5 then
    assign(printer,paramstr(6))
  else
    assign(printer,'LPT1');
  rewrite(printer);
  end_now := false;
  for i := 1 to 20 do fkey[i]:='';
  new_line:=false;
  gen_cr:=false;
  capture_on:=false;
  printer_on:=false;
  printbuf:='';
  emulation:=true;
  lastkb_stat:=$FF;
  fk_defined:=false;
  auto_echo:=false;
  sendbreak:=false;
  printscrn:=false;

  Async_Init(default,default,default,default,default);
  Async_Setup_Port(portnum,default,default,default);

  if not(Async_Open(portnum,baudrate,'N',8,1)) then
    begin
      write('Can''t find port number ',portnum,'.');
      halt(1);
    end;

  Async_Clear_Errors;

  screenptr:=0;
  for j:=0 to bufsize-1 do
    screenbuf[1,j]:=0;

  master_clear;

  getintvec($05,saveint05);
  setintvec($05,@print_screen);
  setintvec($1B,@control_break);

end;



procedure facilities;

{ Implement the esc-F facilities }

var
  i,k : integer;

begin
  case cgetc(5) of
    65 : printer_on:=true;
    66 : begin
           printer_on:=false;
           flushprintbuf;
         end;
    67 : begin
           printer_on:=true;
           repeat until ((cgetc(5)=27)and(cgetc(5)=70)and(cgetc(5)=66))
             or (keypressed and (readkey=chr(3)));
           printer_on:=false;
           flushprintbuf;
         end;
    69 : auto_echo:=true;
    70 : auto_echo:=false;
    77 : begin
           gotoxy(lastposx,lastposy);
           lastposx:=wherex;
           lastposy:=wherey;
         end;
    87 : begin
           for i:=1 to 20 do fkey[i]:='';
           i:=1;
           repeat
             k:=cgetc(5);
             case k of
               2 : if i>1 then i:=i-1;
               3 : i:=i+1;
               4 : ;
               6 : i:=i+1;
             else
               if i<=20 then fkey[i]:=fkey[i]+chr(k);
             end;
           until k=4;
           fk_defined:=true;
           display_statline;
         end;
  end;
end;



procedure escape;

{ Implement the escape sequences }

var
  rcvd : integer;
  ch   : char;
  x,y  : integer;
  i,j  : integer;

begin
  rcvd := cgetc(5);
  if rcvd > 0
    then
      begin
        case rcvd of
          32    : write(^H+' '+^H);           {back space destructive}
          33    : begin
                    sound(50);
                    repeat until keypressed;
                    nosound;
                  end;
          38    : begin
                    protmode:=FALSE;          {protected mode OFF}
                    textattr:=textattr and $F8 or fcolor
                  end;
          39    : begin
                    protmode:=TRUE;           {protected mode ON}
                    textattr:=textattr and $F8 or pcolor
                  end;
          40    : textattr:=textattr or 8;    {high intensity}
          41    : textattr:=textattr and $F7; {low intensity}
          42    : gotoxy(1,wherey+1);         {new line}
          43    : master_clear;               {master clear}
          44,89,111
                : begin                       {clear to end of page}
                    i := wherex;
                    j := wherey;
                    x := wherex;
                    y := wherey;
                    repeat
                      if ((screenbuf[x,(y+screenptr) mod bufsize] and $80)=0)
                        or (protmode and (rcvd<>111)) then
                          begin
                            screenbuf[x,(y+screenptr) mod bufsize]:=space;
                            gotoxy(x,y);
                            write(' ');
                          end;
                      x:=x+1;
                      if x=81 then
                        begin
                          x:=1;
                          y:=y+1;
                        end;
                    until (x=80) and (y=24);
                    gotoxy(i,j);
                  end;
          45,84 : begin                       {clear to end of line}
                    i := wherex;
                    j := wherey;
                    x := wherex;
                    y := wherey;
                    repeat
                      if ((screenbuf[x,(y+screenptr) mod bufsize] and $80)=0)
                        or protmode then
                        begin
                          screenbuf[x,(y+screenptr) mod bufsize]:=space;
                          gotoxy(x,y);
                          write(' ');
                        end;
                      x:=x+1;
                    until (x=81) or ((x=80) and (y=24));
                    gotoxy(i,j);
                  end;
          49    : if protmode then            {non-reverse text}
                    textattr:=(textattr and $88) or pcolor or (bcolor shl 4)
                  else
                    textattr:=(textattr and $88) or fcolor or (bcolor shl 4);
          50    : if protmode then            {reverse text}
                    textattr:=(textattr and $88) or bcolor or (pcolor shl 4)
                  else
                    textattr:=(textattr and $88) or bcolor or (fcolor shl 4);
          53    : begin                       {bell}
                    sound(220);
                    delay(200);
                    nosound;
                  end;
          60    : if (wherex>1) and
                    ((screenbuf[wherex-1,(wherey+screenptr) mod bufsize] and $80)=0)
                      then gotoxy(wherex-1,wherey);  {cursor left}
          61    : begin                       {goto y,x}
                    y:=cgetc(5)-31;
                    x:=cgetc(5)-31;
                    if x>80 then x:=wherex;
                    if y>24 then y:=wherey;
                    lastposx:=wherex;
                    lastposy:=wherey;
                    gotoxy(x,y);
                  end;
          62    :  if wherex<80 then
                     begin
                       if ((screenbuf[wherex+1,(wherey+screenptr) mod bufsize]
                         and $80)<>0) then
                           findunprot
                         else
                           gotoxy(wherex+1,wherey);    {cursor right}
                     end;
          64    : Async_Send(^M);             {clear prism junk}
          69    : begin
                    insline;                  {insert line}
                    for j:=24 downto wherey+1 do
                      for i:= 1 to 80 do
                        screenbuf[i,(j+screenptr) mod bufsize]:=
                          screenbuf[i,(j-1+screenptr) mod bufsize];
                    for i:= 1 to 80 do
                      screenbuf[i,(wherey+screenptr) mod bufsize]:=space;
                  end;
          70    : facilities;                 {extended facilities}
          76    : begin
                    write(^J);                  {cursor down}
                    if (wherey=24) then
                      begin
                        screenptr:=(screenptr+1) mod bufsize;
                        for i:=1 to 80 do
                          screenbuf[i,(24+screenptr) mod bufsize]:=space;
                      end;
                  end;
          77    : if wherey>1 then gotoxy(wherex,wherey-1);    {cursor up}
          78    : begin                       {blinking}
                    textattr:=textattr or $80;
                  end;
          79    : begin;                      {non-blinking}
                    textattr:=textattr and $7F;
                  end;
          80    : screen_dump;
          82    : begin
                    delline;                  {delete line}
                    for j:=wherey to 23 do
                      for i:= 1 to 80 do
                        screenbuf[i,(j+screenptr) mod bufsize]:=
                          screenbuf[i,(j-1+screenptr) mod bufsize];
                    for i:= 1 to 80 do
                      screenbuf[i,(24+screenptr) mod bufsize]:=space;
                  end;
          90    : begin
                    gotoxy(1,1);              {cursor home}
                    if ((screenbuf[wherex,(wherey+screenptr) mod bufsize]
                      and $80)<>0) and not protmode then
                      findunprot;
                  end;
          101   : begin                       {write a character n times}
                    j:=cgetc(5);
                    ch:=chr(cgetc(5));
                    for i:=1 to j do
                      Async_Stuff(ch);
                  end;
          112   : begin                       {clear field}
                    x := wherex;
                    y := wherey;
                    while not (((screenbuf[wherex,(wherey+screenptr) mod bufsize]
                      and $80)<>0) or (wherex=1) or
                        ((wherex=80)and(wherey=24))) do
                        begin
                          screenbuf[wherex,(wherey+screenptr) mod bufsize]
                            :=space;
                          write(' ');
                        end;
                    gotoxy(x,y);
                  end;
        end;
      end;
end;



var
  keystroke : char;
  rcvd      : integer;
  k         : integer;

begin {mufusion}
  setup;
  repeat
    if keypressed then
      begin
        keystroke:=readkey;
        if (keystroke = chr(0)) and keypressed then
          begin
            keystroke:=readkey;
            case ord(keystroke) of
              18 : toggle_emulation;                                 {Alt-E}
              24 : shell_to_dos;                                     {Alt-O}
              25 : begin                                             {Alt-P}
                     if printer_on then flushprintbuf;
                     printer_on := not printer_on;
                   end;
              32 : dial;                                             {Alt-D}
              35 : hangup;
              45 : end_now := true;
              46 : toggle_capture;
              59..68 : Async_Send_String_With_Delays(fkey[ord(keystroke)-58],10,10);   {F1-10}
              73,110 : if emulation then backpage;                   {PgUp,alt-F7}
              83 : Async_Send(chr(127));                             {Del}
              84..93 : Async_Send_String_With_Delays(fkey[ord(keystroke)-73],10,10);   {shift F1-10}
              104 : Async_Send(chr(27));                             {alt-F1}
              105 : Async_Send(chr(28));                             {alt-F2}
              106 : Async_Send(chr(30));                             {alt-F3}
              107 : Async_Send(chr(29));                             {alt-F4}
              108,109 : Async_Send(chr(0));                          {alt-F5,alt-F6}
              112 : master_clear;                                    {alt-F9}
            end;
          end
        else
          begin
            gen_cr:=true;
            Async_Send(keystroke);
            if auto_echo then Async_Stuff(keystroke);
          end;
      end;

    if not end_now
      then
        begin

          if sendbreak then
            begin
              Async_Send_Break;
              sendbreak:=false;
            end;

          if printscrn then
            begin
              screen_dump;
              printscrn:=false;
            end;

          rcvd := cgetc(0);

          if rcvd > 0 then
            begin
              if emulation then
                begin
                  if new_line then
                    begin
                      if (rcvd in [10,32..126]) then
                        begin
                          write(^J);
                          screenptr:=(screenptr+1) mod bufsize;
                          for k:=1 to 80 do
                            screenbuf[k,(24+screenptr) mod bufsize]:=space;
                        end;
                      if not (rcvd in [7,10,13]) then new_line:=false;
                    end;

                  case rcvd of

                  32..126 : begin
                              if protmode then
                                begin
                                  screenbuf[wherex,(wherey+screenptr) mod
                                    bufsize]:=ord(rcvd)+$80;
                                end
                              else
                                begin
                                  if ((screenbuf[wherex,(wherey+screenptr)
                                    mod bufsize]and $80)<>0) then findunprot;
                                  screenbuf[wherex,(wherey+screenptr) mod
                                    bufsize]:=ord(rcvd);
                                end;
                              if (wherex=80) and (wherey=24) then
                                begin
                                  screenptr:=(screenptr+1) mod bufsize;
                                  for k:=1 to 80 do
                                    screenbuf[k,(24+screenptr)
                                      mod bufsize]:=space;
                                end;
                              write(chr(rcvd));
                              if gen_cr and (not protmode) and
                                ((screenbuf[wherex,(wherey+screenptr)
                                mod bufsize] and $80)<>0) then
                                  Async_Send(chr(13));
                            end;
                   7      : begin                {bell}
                              sound(220);
                              delay(200);
                              nosound;
                            end;
                   8      : write(^H+' '+^H);    {back space destructive}
                  10      : if wherey<24 then    {line feed}
                              write(^J)
                            else
                              new_line:=true;
                  11      : begin                {vertical address lead-in}
                              k:=cgetc(5);
                              lastposx:=wherex;
                              lastposy:=wherey;
                              if k>0 then gotoxy(wherex,(k mod 32)+1);
                            end;
                  12,26   : master_clear;        {master clear}
                  13      : gotoxy(1,wherey);    {carriage return}
                  16      : begin                {horiz. address lead-in}
                              k:=cgetc(5);
                              lastposx:=wherex;
                              lastposy:=wherey;
                              gotoxy(k mod 16 + 10*(k div 16) +1,wherey);
                            end;
                  18      : printer_on:=true;    {printer on}
                  20      : begin                {printer off}
                              printer_on:=false;
                              flushprintbuf;
                            end;
                  27      : escape;              {escape}

                  end;
                  if (not protmode) and (rcvd<>13) and ((screenbuf[wherex,
                    (wherey+screenptr) mod bufsize] and $80)<>0)
                      then findunprot;
                  gen_cr:=false;
                end
              else                                             {no emulation}
                begin
                  while rcvd=13 do
                    begin                                      {drop the}
                      write(^M^J);                             {line feed}
                      rcvd:=cgetc(1);                          {after a}
                      if rcvd=10 then rcvd:=cgetc(1);          {carriage}
                    end;                                       {return}
                  case rcvd of
                    32..126 : write(chr(rcvd));                {printable}
                    11,16 : write('<',rcvd,'><',cgetc(5),'>'); {address leadin}
                    12 : write('<12>'+^M^J);                   {clear screen}
                    8  : if keystroke<>^H then write('<8>')
                           else write(^H+' '+^H);              {backspace}
                  else
                    if rcvd>0 then write('<',rcvd,'>');        {unprintable}
                  end;
                end;
              end;
        end;

    thiskb_stat:=(kb_stat and $0F);
    if thiskb_stat<>lastkb_stat then display_statline;
    lastkb_stat:=thiskb_stat;

  until end_now;

  flushprintbuf;
  close(printer);
  if capture_on then close(capture);
  setintvec($05,saveint05);
  Async_Close(false);
  textbackground(0);
  textcolor(7);
  window(1,1,80,25);
  textmode(start_mode);
  clrscr;
end.