Best Objectech Shareware Selections/UNTITLED.iso/boss/util/misc/018/mufusion.pas

Pascal/Delphi Source File | 1993-03-04 | 33.6 KB | 1,317 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,
  {$IFDEF INT14}
  Mufint14;
  {$ELSE}
  Mufasync;
  {$ENDIF}

const
  default     = -1;
  space       = $20;
  bufsize     = 720;        {number of lines of backpage buffer.  This can be reduced
                 to increase the amount of memory available when shelled to DOS.}
  prbufsize   = 3072;       {size of the printer buffer}
  fklen       = 80;         {maximum length of function key definition}

{initialised variables}
  portnum     : integer = 1;                {communications port number}
  baudrate    : word    = 9600;             {line speed}
  fcolor      : integer = 2;                {foreground color}
  bcolor      : integer = 0;                {background color}
  pcolor      : integer = 3;                {protected color}
  defprinter  : string[40] = 'LPT1';        {default printer}
  end_now     : boolean = false;            {true if we're about to exit}
  capture_on  : boolean = false;            {true if capturing}
  printer_on  : boolean = false;            {true if printing}
  new_line    : boolean = false;            {true if a line feed is pending}
  gen_cr      : boolean = false;            {true if a carriage return may be generated}
  endprbuf    : integer = 0;                {points to end of print buffer}
  numprints   : integer = 1;                {number of copies when using esc-F-C}
  debug_off   : boolean = true;             {true if debugging is off}
  lastkb_stat : byte    = $FF;              {previous status of shift/control/alt keys}
  fk_defined  : boolean = false;            {true if the function keys have been defined}
  auto_echo   : boolean = false;            {true if characters echoed locally}
  sendbreak   : boolean = false;            {true if a break signal should be sent}
  printscrn   : boolean = false;            {true if a print screen is pending}
  prism          : boolean = false;        {true if we're trying to look like a prism}
  screenptr   : integer = 0;                {pointer to current screen within backpage buffer}

var
  screenbuf   : array[1..80,0..bufsize-1] of byte;      {backpage buffer}
  fkey        : array[1..20] of string[fklen];          {function key definitions}
  protmode    : boolean;                                {true = protected text on}
  capture     : text;                                   {file for capturing}
  printer     : text;                                   {file for printing}
  printbuf    : array[1..prbufsize] of char;            {Buffer for output to the printer.}
  start_mode  : integer;                                {Text mode when mufusion was called}
  num_lines   : integer;                                {Number of rows on terminal screen}
  thiskb_stat : byte;                                   {Status of shift/control/alt keys}
  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}



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; wait:word);

{ Write a string to the status line}

var
  oldtextattr : byte;
  x,y         : integer;

begin
  x := wherex;
  y := wherey;
  oldtextattr:=textattr;
  textattr:=$70;
  window(1,num_lines+1,80,num_lines+1);
  clreol;
  gotoxy(2,1);
  write(tstr);
  lastkb_stat:=$FF;             {ensures the status line gets restored}
  if wait>0 then
    begin
      sound(50);
      delay(wait);
      nosound;
    end;
  window(1,1,80,num_lines);
  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,num_lines+1,80,num_lines+1);
  clreol;
  gotoxy(2,1);
  write(pstr);
  lastkb_stat:=$FF;             {ensures the status line gets restored}
  gotoxy(length(pstr) + 3,1);
  {$IFDEF INT14}
  if not paused then int14_pause;
  {$ENDIF}
  readln(tstr);
  stat_read := tstr;
  window(1,1,80,num_lines);
  textattr:=oldtextattr;
  gotoxy(x,y);
end;



function open(var file_to_open : text; filename : string): boolean;

var
  attributes   : word;
  keystroke    : char;

begin
  if filename='' then open:=false else
    begin
      assign(file_to_open,filename);
      getfattr(file_to_open,attributes);
      keystroke:=' ';
      if attributes=0 then
    rewrite(file_to_open)
      else
    repeat
      stat_write('File exists, (A)ppend, (O)verlay, or (Q)uit ? ..',500);
      keystroke:=readkey;
      case keystroke of
        'A','a' : append(file_to_open);
        'O','o' : rewrite(file_to_open);
      end;
    until keystroke in ['O','o','A','a','Q','q'];
      if keystroke in ['Q','q'] then
        open:=false
      else
        begin
          if (IOresult=0) then
            open:=true
          else
            begin
              open:=false;
              stat_write('Can''t write to file '+filename+'...',1000);
            end;
        end;
    end;
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 = 8 then
    stat_write('Capture  Dial  dEbug  Feed  Hangup  Image  Lines  dOs  Print  Run  Setpr  eXit',0)
  else
    begin
      if fk_defined and (thiskb_stat<4) then
    begin
      x := wherex;
      y := wherey;
      oldtextattr:=textattr;
      window(1,num_lines+1,80,num_lines+1);
      gotoxy(1,1);
      clreol;
      textattr:=$70;
      if thiskb_stat=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);
      if prism then textattr:=4 else textattr:=1;
      if printer_on then textattr:=textattr or 8;
      if capture_on then textattr:=textattr or $80;
      write('µ3.9n');
      window(1,1,80,num_lines);
      textattr:=oldtextattr;
      gotoxy(x,y);
    end
      else
    stat_write('µfusion v3.9n by Peter Summers                           (C) Cardiology at RMH',0);
    end;
end;



procedure flushprintbuf(numcopies:integer);

{ Flush the printer buffer }

var
  i,copy : integer;
  retry  : char;

begin
  if (endprbuf=0) or not printer_on then exit;
  stat_write('Writing to the printer...',0);
  {$IFDEF INT14}
  if not paused then int14_pause;
  {$ENDIF}
  for copy:=1 to numcopies do
    for i:=1 to endprbuf do
      begin
      write(printer,printbuf[i]);
        while IOresult<>0 do
      begin
        stat_write('Can''t write to the printer, Retry (Y/N) ?',1000);
            if readkey in ['N','n'] then
              begin
            endprbuf:=0;
            printer_on:=false;
            close(printer);
                if IOresult<>0 then
                  stat_write('Error closing printer...',1000);
               exit;
              end;
            write(printer,printbuf[i]);
          end;
      end;
  endprbuf:=0;
end;



procedure print(rcvd:integer);
  begin
    if printer_on and (rcvd>=0) then
      begin
        endprbuf:=endprbuf+1;
        printbuf[endprbuf]:=chr(rcvd);
        if endprbuf=prbufsize then flushprintbuf(1);
      end;
  end;



procedure turn_printer_on;

var attributes : word;

begin
  if printer_on then exit;
  getfattr(printer,attributes);
  if attributes=0 then
    rewrite(printer)
  else
    append(printer);
  if IOresult=0 then
    printer_on:=true
  else
    stat_write('Can''t access printer...',1000);
  lastkb_stat:=$FF;             {ensures the status line gets restored}
end;



procedure turn_printer_off;

begin
  if not printer_on then exit;
  flushprintbuf(1);
  if not printer_on then exit;
  close(printer);
  if IOresult<>0 then stat_write('Error closing printer...',1000);
  printer_on:=false;
  lastkb_stat:=$FF;             {ensures the status line gets restored}
end;



procedure hangup;

{ Hang up the modem }

begin
  stat_write('Hanging up the modem...',0);
  {$IFDEF INT14}
  if not paused then int14_pause;
  {$ENDIF}
  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...',0)
  else
    stat_write('The modem has hung up...',0);
  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;
  new_line:=false;
  gen_cr:=false;
  screenptr:=(screenptr+num_lines) mod bufsize;
  for i:=1 to 80 do
    for j:=1 to num_lines 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;
  gotoxy(1,1);
  for j:=1 to num_lines do
    if screenbuf[1,(j+screenptr) mod bufsize]<>0 then
      for i:=1 to 80 do
    begin
      if not ((i=80) and (j=num_lines)) 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
    end
    else
      begin
    clreol;
    write(^M^J);
      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,last : integer;
  was_printing : boolean;

begin
  was_printing:=printer_on;
  turn_printer_on;
  for j:=1 to num_lines do
    if screenbuf[1,(j+screenptr) mod bufsize]<>0 then
      begin
    last:=80;
    while ((screenbuf[last,(j+screenptr) mod bufsize] and $7F) = $20)
      and (last>0) do last:=last-1;
        for i:=1 to last do
          print(screenbuf[i,(j+screenptr) mod bufsize] and $7F);
        print(13);
        print(10);
      end;
  if was_printing then flushprintbuf(1) else turn_printer_off;
end;



procedure feed_printer;

{ Send a formfeed to the printer }

var
  was_printing : boolean;

begin
  was_printing:=printer_on;
  turn_printer_on;
  print(12);
  if was_printing then flushprintbuf(1) else turn_printer_off;
end;



procedure dump_image_file;

{ Create a screen image file. }

var
  i,j,last     : integer;
  image        : text;

label end_of_loop;

begin
  if open(image,stat_read('Image file name ...')) then
    begin
      for j:=1 to num_lines do
    if screenbuf[1,(j+screenptr) mod bufsize]<>0 then
       begin
             last:=80;
             while ((screenbuf[last,(j+screenptr) mod bufsize] and $7F)
           = $20) and (last>0) do last:=last-1;
             for i:=1 to last+1 do
               begin
         if (i<=last) then
           write(image,chr(screenbuf[i,(j+screenptr) mod bufsize] and $7F))
         else
           write(image,^M+^J);
                 if IOresult<>0 then
           begin
                     stat_write('Can''t write to image file...',1000);
                     goto end_of_loop;
                   end;
               end;
           end;
    end_of_loop:
      close(image);
      if IOresult<>0 then
        stat_write('Error closing image file...',1000);
  end;
end;



procedure run_command(cmndline:string);

{ 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;
  if cmndline='' then
    begin
      write('Shelling to DOS, type EXIT to return...');
      {$IFDEF INT14}
      if not paused then int14_pause;
      {$ENDIF}
    end;
  setintvec($05,saveint05);
  swapvectors;
  exec(getenv('COMSPEC'),cmndline);
  swapvectors;
  textmode(oldscrnmode);
  textattr:=oldtextattr;
  clrscr;
  if debug_off then
    begin
      setintvec($05,@print_screen);
      display_screen;
      gotoxy(x,y);
    end;
  async_clear_errors;
  lastkb_stat:=$FF;             {ensures the status line gets restored}
end;



procedure backpage(offset:integer);

{ Do backpaging }

var
  x,y          : integer;
  oldtextattr  : byte;
  oldscreenptr : integer;
  keystroke    : integer;
  tempstring   : string[4];

begin
  x:=wherex;
  y:=wherey;
  oldtextattr:=textattr;
  oldscreenptr:=screenptr;
  screenptr:=(screenptr+bufsize-offset) mod bufsize;
  {$IFDEF INT14}
  if not paused then int14_pause;
  {$ENDIF}
  repeat
    str((oldscreenptr+bufsize-screenptr) mod bufsize, tempstring);
    stat_write(tempstring+' lines back, PgUp, PgDn, Home, End move, press the Space Bar to quit...',0);
    display_screen;
    keystroke:=ord(readkey);
    if keystroke=0 then
      case ord(readkey) of
    19 : run_command('/c '+stat_read('Command ...'));      {Alt-R}
    23 : dump_image_file;                                  {Alt-I}
    24 : run_command('');                                  {Alt-O}
    45 : end_now := true;                                  {Alt-X}
    73,110: if (((screenptr+bufsize-oldscreenptr) mod bufsize)>=2*num_lines)
          and (screenbuf[1,(screenptr+1) mod bufsize] <> 0) then
          screenptr:=(screenptr+bufsize-num_lines) mod bufsize;
    71:     if (((screenptr+bufsize-oldscreenptr) mod bufsize) > num_lines) and
          (screenbuf[1,(screenptr+1) mod bufsize] <> 0) then
          screenptr:=(screenptr+bufsize-1) mod bufsize;
    81,111: screenptr:=(screenptr+num_lines) mod bufsize;
    79:     screenptr:=(screenptr+1) mod bufsize;
      end;
    if printscrn then
      begin
    screen_dump;
    printscrn:=false;
      end;
  until end_now or (keystroke<>0) or
    ((screenptr+bufsize-oldscreenptr) mod bufsize<num_lines);
  screenptr:=oldscreenptr;
  display_screen;
  gotoxy(x,y);
  textattr:=oldtextattr;
end;



procedure toggle_lines;

{ Toggle in and out of 25 line mode }

var
  oldx,oldy,oldlines : byte;
  i,j : word;

begin
  oldx:=wherex;
  oldy:=wherey;
  oldlines:=num_lines;
  textmode(Font8x8 xor lastmode);
  num_lines:=hi(windmax);
  if protmode then textattr:=(bcolor shl 4) or 8 or pcolor
    else textattr:=(bcolor shl 4) or 8 or fcolor;
  if num_lines>oldlines then
    for i:=1 to 80 do
      for j:=oldlines+1 to num_lines do
    screenbuf[i,(j+screenptr) mod bufsize]:=space;
  if debug_off then
    begin
      if oldy>num_lines then
    begin
      screenptr:=screenptr+oldy-num_lines;
      oldy:=num_lines;
    end;
      display_screen;
      gotoxy(oldx,oldy);
    end;
end;



procedure toggle_debug;

{ Toggle debugging }

begin
  if debug_off then
    setintvec($05,saveint05)
  else
    setintvec($05,@print_screen);
  debug_off := not debug_off;
  if debug_off then clrscr
    else master_clear;
end;



procedure toggle_capture;

{ Toggle the capture file status }

begin
  if capture_on then
    begin
      stat_write('Closing capture file...',0);
      close(capture);
      delay(1000);
      if IOresult<>0 then
        stat_write('Error closing capture file...',1000);
      capture_on:=false;
    end
  else
    capture_on:=open(capture,stat_read('Capture file name ...'));
end;



procedure set_printer;

{ Get a new destination for printing }

var
  was_printing : boolean;

begin
  was_printing:=printer_on;
  turn_printer_off;
  printer_on:=open(printer,stat_read('Set printer to ['+defprinter+'] ...'));
  if not printer_on then assign(printer,defprinter);
  if was_printing then turn_printer_on else turn_printer_off;
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=num_lines)) 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;
  junk : char;

begin
  checkbreak:=false;

  if paramcount>0 then
    begin
      val(paramstr(1),portnum,code);
      if (code<>0) or (portnum<1) or (portnum>4) then
    begin
      writeln(^M+^J+'Microfusion MF30 terminal emulator.'+^M+^J);
      writeln('MUFUSION [port [speed [unprotected [background [protected [printer]]]]]]'+^M+^J);
      writeln('eg. MUFUSION 2                 -  use COM2.');
      writeln('    MUFUSION 1 19200           -  use COM1 at 19200 bps.');
      writeln('    MUFUSION 1 9600 6 1 7      -  use COM1 at 9600, yellow unprotected text,');
      writeln('                                  blue background, white protected text.');
      writeln('    MUFUSION 1 9600 2 0 3 COM2 -  print to COM2.'+^M+^J);
      writeln('Defaults are COM1, 9600 bps, green, black, cyan, LPT1.');
      halt(1);
    end;
    end;

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

  if paramcount>1 then val(paramstr(2),baudrate,code);

  if not(Async_Open(portnum,baudrate,'N',8,1)) then
    begin
      write('Can''t find port number ',portnum,'.');
      while keypressed do junk:=readkey;
      halt(1);
    end;

  if lo(start_mode)=mono then
    begin
      fcolor:=7;
      bcolor:=0;
      pcolor:=7;
    end
  else
    begin
      if paramcount>2 then val(paramstr(3),fcolor,code);
      fcolor:=fcolor and 7;
      if paramcount>3 then val(paramstr(4),bcolor,code);
      bcolor:=bcolor and 7;
      if paramcount>4 then val(paramstr(5),pcolor,code);
      pcolor:=pcolor and 7;
    end;

  Async_Clear_Errors;

  start_mode:=lastmode;
  textmode(lo(start_mode));
  num_lines:=hi(windmax);

  for i := 1 to 20 do fkey[i]:='';
  for j:=0 to bufsize-1 do
    screenbuf[1,j]:=0;

  master_clear;

  if paramcount>5 then defprinter:=paramstr(6);
  assign(printer,defprinter);
  turn_printer_on;
  if printer_on then turn_printer_off else
    stat_write('Printer '+defprinter+' is not available...',2000);

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

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
  char_rcvd : char;

begin
  {$IFDEF INT14}
  if paused then int14_unpause;
  {$ENDIF}

  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(char_rcvd)) then
    begin
      cgetc := ord(char_rcvd);
      if capture_on then
    begin
      write(capture,char_rcvd);
      if IOresult<>0 then
        begin
          stat_write('Can''t write to capture file...',1000);
              toggle_capture;
        end;
    end;
    end
  else
    cgetc := TIMED_OUT;
end;



procedure printonly;

var
  rcvd : integer;

label end_of_loop;

begin
  turn_printer_on;
  display_statline;
  repeat
    rcvd:=cgetc(0);
    case rcvd of
      -1,0 : {do nothing};
         3 : goto end_of_loop;
        27 : begin
               rcvd:=cgetc(5);
               case rcvd of
                 0,3,27 : print(rcvd);
                     70 : if cgetc(5)=66 then goto end_of_loop;
               else
                 print(27);
                 print(rcvd);
               end;
             end;
    else
      print(rcvd);
    end;
  until (kb_stat and 8) <> 0;         {until Alt key pressed}
end_of_loop:
  flushprintbuf(numprints);
  turn_printer_off;
end;



procedure facilities;

{ Implement the esc-F facilities }

var
  i,k : integer;

begin
  case (cgetc(5) and $7F) of
    58 : endprbuf:=0;
    59 : numprints:=cgetc(5);
    65 : turn_printer_on;
    66 : turn_printer_off;
    67 : printonly;
    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) and $7F;
         case k of
           2 : if i>1 then i:=i-1;
           3 : i:=i+1;
           4 : {do nothing};
           6 : i:=i+1;
         else
           if i<=20 then fkey[i]:=fkey[i]+chr(k);
         end;
       until k=4;
       fk_defined:=true;
       lastkb_stat:=$FF;             {ensures the status line gets restored}

     end;
  end;
end;



procedure escape;

{ Implement the escape sequences }

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

begin
  rcvd := cgetc(5) and $7F;
  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,74,89,107,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=num_lines);
            gotoxy(i,j);
          end;
      45,75,84 : if prism and printer_on and (rcvd=84) then turn_printer_off
        else
          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=num_lines));
            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) 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>num_lines then y:=wherey;
            lastposx:=wherex;
            lastposy:=wherey;
            gotoxy(x,y);
            new_line:=false;
          end;
      62    :  if wherex<80 then gotoxy(wherex+1,wherey)
             else write(^M+^J);       {cursor right}
      64    : Async_Send(^M);             {clear prism junk}
      69    : begin
            insline;                  {insert line}
            for j:=num_lines 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=num_lines) then
              begin
            screenptr:=(screenptr+1) mod bufsize;
            for i:=1 to 80 do
              screenbuf[i,(num_lines+screenptr) mod bufsize]:=space;
              end;
          end;
      77    : if wherey>1 then gotoxy(wherex,wherey-1);    {cursor up}
      78    : textattr:=textattr or $80;                   {blinking}
      79    : textattr:=textattr and $7F;                  {non-blinking}
      80    : screen_dump;
      82    : if prism then turn_printer_on
          else
            begin
              delline;                  {delete line}
              for j:=wherey to num_lines-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,(num_lines+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;
      91    : begin                       {behave like a prism}
            prism:=true;
                    lastkb_stat:=$FF;         {ensures the status line}
          end;                        {gets restored}
      98    : write(^M+^J);               {go to start of next line}
      101   : begin                       {write a character n times}
            j:=cgetc(5);
            ch:=chr(cgetc(5) and $7F);
            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=80)and(wherey=num_lines))) 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_debug;                                     {Alt-E}
          19 : run_command('/c '+stat_read('Command ...'));      {Alt-R}
          23 : if debug_off then dump_image_file;                {Alt-I}
          24 : run_command('');                                  {Alt-O}
          25 : if printer_on then turn_printer_off
                     else turn_printer_on;                           {Alt-P}
          31 : set_printer;                                      {Alt-S}
          32 : dial;                                             {Alt-D}
          33 : feed_printer;                                     {Alt-F}
          35 : hangup;
          38 : toggle_lines;
          45 : end_now := true;
          46 : toggle_capture;
          59..68 : Async_Send_String_With_Delays(fkey[ord(keystroke)-58],10,10);   {F1-10}
          71     : if debug_off then backpage(1);                {Home}
          72     : Async_Send(chr(24));                          {Up Arrow}
          73,110 : if debug_off then backpage(num_lines);        {PgUp,alt-F7}
          75,115 : Async_Send(chr(20));                          {Left Arrow}
          77,116 : Async_Send(chr(22));                          {Right Arrow}
          80     : Async_Send(chr(18));                          {Down Arrow}
          82     : Async_Send(chr(16));                          {Ins}
          83     : Async_Send(chr(14));                          {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}
          119 : Async_Send(chr(23));                             {ctrl Home}
          117 : Async_Send(chr(17));                             {ctrl End}
          132 : Async_Send(chr(25));                             {ctrl PgUp}
          118 : Async_Send(chr(19));                             {ctrl PgDn}
        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 debug_off then
        begin
                  rcvd := rcvd and $7F;
          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,(num_lines+screenptr) mod bufsize]:=space;
            end;
              if not (rcvd in [0,7,10,13,16,27]) then new_line:=false;
            end;

          case rcvd of

          32..126 : begin
                  if protmode then
                screenbuf[wherex,(wherey+screenptr) mod
                  bufsize]:=ord(rcvd)+$80
                  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=num_lines) then
                begin
                  if protmode then
                    begin
                      screenptr:=(screenptr+1) mod bufsize;
                      for k:=1 to 80 do
                    screenbuf[k,(num_lines+screenptr)
                      mod bufsize]:=space;
                    end
                  else
                    gotoxy(1,wherey);
                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;
           3      : turn_printer_off;
           7      : begin                              {bell}
                  sound(220);
                  delay(200);
                  nosound;
                end;
           8      : begin
                  if wherex>1 then                   {backspace}
                write(^H+' '+^H)
                  else if wherey>1 then
                begin
                  gotoxy(80,wherey-1);
                  write(' ');
                  gotoxy(80,wherey-1);
                end
                  else write(' ');
                  screenbuf[wherex,(wherey+screenptr)
                mod bufsize]:=space;
                end;
          10      : if wherey<num_lines then            {line feed}
                  write(^J)
                else
                  new_line:=protmode;
          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) mod 80)+1,wherey);
                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;
                  if printer_on and (rcvd in [10,12,13,32..126]) then
                    print(rcvd);
        end
          else                                             {debug on}
        begin
          case rcvd of
            32..126 : write(chr(rcvd));                  {printable}
              11,16 : write('<',rcvd,'><',cgetc(1),'>'); {address leadin}
          else
            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;

  turn_printer_off;
  if capture_on then toggle_capture;
  setintvec($05,saveint05);
  Async_Close(false);
  textbackground(0);
  textcolor(7);
  textmode(start_mode);
end.