Programmer 7500/MAX_PROGRAMMERS.iso/PASCAL/TM40.ZIP/TM1.INC

Text File | 1985-07-20 | 30.8 KB | 1,027 lines

(****************************************************************************)
(*                              SEND STRING                                 *)
(****************************************************************************)
   procedure
      store_sout_buffer( ch : char );   FORWARD;

   procedure
      send_str( s : strtype );
   var
      i           : integer;
   begin
      delay( sync_time * 4 );
      for i:=1 to length( s ) do
         store_sout_buffer( s[i] );
   end;

(****************************************************************************)
(*                         EN-QUE SERIAL PORT INPUT &                       *)
(*                         DE-QUE SERIAL PORT OUTPUT                        *)
(*                             INTERRUPT DRIVEN                             *)
(****************************************************************************)
   procedure
      async_intr_handler;
   begin
      inline ($FB/$50/$53/$51/$52/$57/$56/$06/$1E);
      inline ($2E/$A1/datasegment/$8E/$D8);
      int_ident := port[int_ident_reg];
      repeat
         if int_ident = 4 then begin
            sin_buffer_ptr^[sin_store_ptr] := port[base_com_addr];
            if ascii_mode then begin
               if sin_buffer_ptr^[sin_store_ptr]=XOFF then
                  port[int_enable_reg] := 1;
               if sin_buffer_ptr^[sin_store_ptr]=XON  then
                  port[int_enable_reg] := 3;
            end;
            if sin_store_ptr = sin_buf_size then
               sin_store_ptr := 1
            else
               sin_store_ptr := succ(sin_store_ptr);
            sin_buf_fill_cnt := succ(sin_buf_fill_cnt);
         end
         else begin
            if sout_store_ptr = sout_read_ptr then begin
               port[int_enable_reg] := 1;
               sout_int_off := true;
            end
            else begin
               port[base_com_addr] := sout_buffer_ptr^[sout_read_ptr];
               if sout_read_ptr = sout_buf_size then
                  sout_read_ptr := 1
               else
                  sout_read_ptr := succ(sout_read_ptr);
            end;
         end;
         int_ident := port[int_ident_reg];
      until int_ident = 1;
      port[$20] := $20;
      inline ($1F/$07/$5E/$5F/$5A/$59/$5B/$58/$5D/$5D/$CF);
   end;

(****************************************************************************)
(*                           SETUP SERIAL PORT                              *)
(****************************************************************************)
   procedure
      setserial(baudrate,stopbits,databits,parity : integer);
   var
      parameter : integer;
      parn      : byte;
   begin
      case baudrate of
         300  : begin
                   baudrate:=2;
                   sync_time := wait_increment div 4;
                end;
         1200 : begin
                   baudrate:=4;
                   sync_time := wait_increment div 11;
                end;
         2400 : begin
                   baudrate:=5;
                   sync_time := wait_increment div 22;
                end;
         4800 : begin
                   baudrate:=6;
                   sync_time := (wait_increment div 44)+1;
                end;
         9600 : begin
                   baudrate:=7;
                   sync_time := (wait_increment div 88)+1;
                end;
      else
         baudrate:=4;
         sync_time := wait_increment div 11;
      end;
      if stopbits=2 then
         stopbits:=1
      else
         stopbits:=0;                     { Default to 1 stop bit }
      parn := parity;
      if databits=7 then
         databits:=2
      else begin
         databits:=3;                     { Default to 8 data bits }
         parn:=0;
      end;
      parameter:=(baudrate shl 5)+(stopbits shl 2)+databits;
      case parn of
         1 : parameter:=parameter+24;
         2 : parameter:=parameter+8;
      end;
      regs.DX := pred(com_port);
      regs.AX := parameter;
      regs.FLAGS := 0;
      intr($14,regs);
      port[modem_control_reg] := $0B;
      port[$21] := port[$21] and turn_IRQ_on;
      port[int_enable_reg] := 1;
      sout_int_off := true;
   end;

(****************************************************************************)
(*                         INITIALIZE THE COM PORT                          *)
(****************************************************************************)
   procedure
      init_com_port;
   begin
      base_com_addr := com_addr[ com_port ];
      if base_com_addr = $3F8 then   { Setup vectors and port addresses. }
         begin
            turn_IRQ_on := $EF;
            turn_IRQ_off := $10;
            IRQ_vector_ofs := $0030;
            IRQ_vector_seg := $0032;
         end
      else
         begin
            turn_IRQ_on := $F7;
            turn_IRQ_off := $08;
            IRQ_vector_ofs := $002C;
            IRQ_vector_seg := $002E;
         end;
      sin_store_ptr := 1;
      sin_read_ptr := 1;
      sin_buf_fill_cnt := 0;
      sin_xoff := false;
      sout_store_ptr := 1;
      sout_read_ptr := 1;
      hold_vector_ofs := memw[$0000:IRQ_vector_ofs];
      hold_vector_seg := memw[$0000:IRQ_vector_seg];
      memw[$0000:IRQ_vector_ofs] := ofs(async_intr_handler);
      memw[$0000:IRQ_vector_seg] := CSeg;
      int_enable_reg := base_com_addr + 1;
      int_ident_reg := base_com_addr + 2;
      line_control_reg := base_com_addr + 3;
      modem_control_reg := base_com_addr + 4;
      line_status_reg := base_com_addr + 5;
      modem_status_reg := base_com_addr + 6;
      setserial(baud,stopbits,databits,par);
   end;

(****************************************************************************)
(*                       FLUSH SERIAL INPUT BUFFER                          *)
(****************************************************************************)
   procedure
      flush_sin_buff;
   begin
      sin_read_ptr := sin_store_ptr;
      sin_buf_fill_cnt := 0;
   end;

(****************************************************************************)
(*                       EN-QUE SERIAL PORT OUTPUT                          *)
(****************************************************************************)
   procedure
      store_sout_buffer;
   var
      new_sout_store_ptr   : integer;
      cnt                  : integer;
   begin
      if sout_store_ptr = sout_buf_size then
         new_sout_store_ptr := 1
      else
         new_sout_store_ptr := succ(sout_store_ptr);
      cnt := 0;
      while new_sout_store_ptr = sout_read_ptr do begin  { Wait for room }
         cnt := succ(cnt);                               { in the queue. }
         if cnt > 40 then begin
            sout_store_ptr := sout_read_ptr;
            continue_transfer := false;
            sout_int_off := true;
            exit;
         end;
         delay( wait_increment );
      end;
      sout_buffer_ptr^[sout_store_ptr] := ord(ch);
      sout_store_ptr := new_sout_store_ptr;
      if sout_int_off then begin
         sout_int_off := false;
         port[int_enable_reg] := 3;
      end;
   end;

(****************************************************************************)
(*                        DE-QUE SERIAL PORT INPUT                          *)
(****************************************************************************)
   function
      read_sin_buffer : char;
   begin
      read_sin_buffer := chr(sin_buffer_ptr^[sin_read_ptr]);
      if sin_read_ptr = sin_buf_size then
         sin_read_ptr := 1
      else
         sin_read_ptr := succ(sin_read_ptr);
      sin_buf_fill_cnt := pred(sin_buf_fill_cnt);
      if sin_xoff then begin
         if sin_buf_fill_cnt < sin_buf_drain_lim then begin
            sin_xoff := false;
            store_sout_buffer( chr(xon) );
         end;
         exit;
      end;
      if sin_buf_fill_cnt > sin_buf_fill_lim then begin
         sin_xoff := true;
         store_sout_buffer( chr(xoff) );
      end;
   end;

(****************************************************************************)
(*                         DISPLAY PROMPTS LINE                             *)
(****************************************************************************)
   procedure
      clear_pos( i,j : integer );
   begin
      escape_win;
      textcolor( BGcolor );
      textbackground( FGcolor );
      gotoxy(i,j);
      write(' ');
      textcolor( FGcolor );
      textbackground( BGcolor );
      reset_win;
   end;

   procedure
      display_prompts;
   begin
      escape_win;
      textcolor( BGcolor );
      textbackground( FGcolor );
      gotoxy(1,25);
      clreol;
      write('   Alt: T=Terminate, R=Receive, X=Transmit, C=Capture, H=Help, S=Chg Params.   ');
      textcolor( FGcolor );
      textbackground( BGcolor );
      reset_win;
   end;

(****************************************************************************)
(*                         SAVE CAPTURE BUFFERS                             *)
(****************************************************************************)
   procedure
      save_capture_buffers;
   var
      r        : real;
   begin
      writeln;
      write(' Enter Filename for Capture Buffer Save: ');
      readln(filename);
      if length(filename)=0 then exit;
      assign(recv_file,filename);
      rewrite(recv_file);
      capture_curr := capture_first;
      repeat
         if capture_curr^.capture_store_ptr <= capture_buf_size then
            capture_curr^.capture_buffer[capture_curr^.capture_store_ptr] := ^Z
         else
            capture_curr^.capture_store_ptr := capture_buf_size;
         if capture_curr^.capture_store_ptr > 1 then begin
            r := (capture_curr^.capture_store_ptr / 128.0) + 0.999;
            blockwrite(recv_file,capture_curr^.capture_buffer,trunc(r));
         end;
         capture_curr := capture_curr^.capture_next;
      until capture_curr = nil;
      close(recv_file);
   end;

(****************************************************************************)
(*                      ENTER / LEAVE  CAPTURE MODE                         *)
(****************************************************************************)
   procedure
      toggle_capture_mode;
   begin
      if capture_flag then begin
         capture_flag := false;
         mkwin(11,8,67,14,'Exit Capture Mode');
         writeln;
         write(' Do you wish to save capture buffer? ');
         readln(yes_no);
         yes_no := upcase(yes_no[1]);
         if yes_no = 'Y' then
            save_capture_buffers;
         capture_curr := capture_first;
         repeat
            capture_first := capture_curr;
            capture_curr := capture_curr^.capture_next;
            dispose(capture_first);
         until capture_curr = nil;
         rmwin;
         clear_pos(1,25);
      end
      else begin
         capture_flag := true;
         capture_warning := false;
         escape_win;
         gotoxy(1,25);
         write('*');
         reset_win;
         new(capture_first);
         capture_curr := capture_first;
         capture_curr^.capture_store_ptr := 1;
         capture_curr^.capture_next := nil;
      end;
   end;

(****************************************************************************)
(*                          CAPTURE A CHARACTER                             *)
(****************************************************************************)
   procedure
      capture( c : char );
   begin
      capture_curr^.capture_buffer[capture_curr^.capture_store_ptr] := c;
      capture_curr^.capture_store_ptr := capture_curr^.capture_store_ptr + 1;
      if capture_curr^.capture_store_ptr > capture_buf_size then begin
         if memory < 5 then
            toggle_capture_mode
         else begin
            new(capture_curr^.capture_next);
            capture_curr := capture_curr^.capture_next;
            capture_curr^.capture_store_ptr := 1;
            capture_curr^.capture_next := nil;
            if (not capture_warning and (memory < 7)) then begin
               capture_warning := true;
               escape_win;
               gotoxy(1,25);
               write('W');
               reset_win;
            end;
         end;
      end;
   end;

(****************************************************************************)
(*                           SET SHADE OF COLOR                             *)
(****************************************************************************)
   procedure
      set_intensity;
   begin
      for shade_no := 0 to 7 do
         FG_shade[ shade_no ] := shade_no + intensity_state + blink_state;
      FG := FG mod 8 + intensity_state + blink_state;
   end;

(****************************************************************************)
(*                             PROCESS ESCAPE                               *)
(****************************************************************************)
   procedure
      scrwrite( var c : char );  FORWARD;

   procedure
      escape_wrt;
   var
      i   : integer;
   begin
      escape_mode := false;
      for i:=1 to length( escape_str ) do
         scrwrite( escape_str[i] );
   end;

   procedure
      set_graphics;
   var
      i     : integer;
   begin
      for i:=1 to escape_number do begin
         case escape_register[i] of
            0 : begin
                   intensity_state := 0;
                   blink_state := 0;
                   set_intensity;
                   FG := lightgray;
                   BG := black;
                end;
            1 : begin
                   intensity_state := 8;
                   set_intensity;
                end;
            4 : FG := blue;
            5 : begin
                   blink_state := blink;
                   set_intensity;
                end;
            7 : begin
                   FG := BGcolor;
                   BG := FGcolor;
                end;
            8 : FG := BG;
           30 : FG := FG_shade[ black     ];
           31 : FG := FG_shade[ red       ];
           32 : FG := FG_shade[ green     ];
           33 : FG := FG_shade[ brown     ];
           34 : FG := FG_shade[ blue      ];
           35 : FG := FG_shade[ magenta   ];
           36 : FG := FG_shade[ cyan      ];
           37 : FG := FG_shade[ lightgray ];
           40 : BG := black;
           41 : BG := red;
           42 : BG := green;
           43 : BG := brown;
           44 : BG := blue;
           45 : BG := magenta;
           46 : BG := cyan;
           47 : BG := lightgray;
         end;
      end;
      textcolor( FG );
      textbackground( BG );
   end;

   procedure
      addr_cursor;
   begin
      if scroll_region         then window(1,1,80,24);
      if escape_number=1       then escape_register[2]:=1;
      if escape_register[1]=0  then escape_register[1]:=1;
      if escape_register[2]=0  then escape_register[2]:=1;
      if escape_register[1]=25 then escape_register[1]:=24;
      gotoxy(escape_register[2],escape_register[1]);
      if scroll_region         then window(1,scroll_top,80,scroll_bot);
   end;

   procedure
      cursor_up;
   begin
      if escape_register[1]=0 then escape_register[1]:=1;
      my := wherey - escape_register[1];
      gotoxy(wherex,my);
   end;

   procedure
      cursor_down;
   begin
      if escape_register[1]=0 then escape_register[1]:=1;
      my := wherey + escape_register[1];
      if my > scroll_last then my:=scroll_last;
      gotoxy(wherex,my);
   end;

   procedure
      cursor_right;
   begin
      if escape_register[1]=0 then escape_register[1]:=1;
      mx := wherex + escape_register[1];
      gotoxy(mx,wherey);
   end;

   procedure
      index_cursor;
   begin
      mx := wherex;
      my := wherey;
      if my=scroll_last then begin
         textbackground( BGcolor );
         writeln;
         textbackground( BG );
      end
      else
         my := succ( my );
      gotoxy(mx,my);
   end;

   procedure
      cursor_left;
   begin
      if escape_type = ' ' then begin
         index_cursor;
         exit;
      end;
      if escape_register[1]=0 then escape_register[1]:=1;
      mx := wherex - escape_register[1];
      gotoxy(mx,wherey);
   end;

   procedure
      insert_line;
   var
      i  : byte;
   begin
      if escape_register[1]=0 then escape_register[1]:=1;
      for i:=1 to escape_register[1] do begin
         textbackground( BGcolor );
         insline;
         textbackground( BG );
      end;
   end;

   procedure
      rev_index_cursor;
   begin
      my := wherey;
      if wherey=1 then begin
         textbackground( BGcolor );
         insline;
         textbackground( BG );
      end
      else
         my := pred( my );
      gotoxy(wherex,my);
   end;

   procedure
      delete_line;
   var
      i  : byte;
   begin
      if escape_type = ' ' then begin
         rev_index_cursor;
         exit;
      end;
      if escape_register[1]=0 then escape_register[1]:=1;
      for i:=1 to escape_register[1] do delline;
   end;

   procedure
      delete_char;
   var
      i,j   : byte;
   begin
      my := wherey;
      if escape_register[1]=0 then escape_register[1]:=1;
      if crt_mode = 7 then begin
         for i:=wherex to 80 do begin
            j := i + escape_register[1];
            if j<81 then
               mono_scr[my][i] := mono_scr[my][j]
            else
               mono_scr[my][i].disp_char := ' ';
         end;
      end
      else begin
         for i:=wherex to 80 do begin
            j := i + escape_register[1];
            if j<81 then
               color_scr[my][i] := color_scr[my][j]
            else
               color_scr[my][i].disp_char := ' ';
         end;
      end;
   end;

   procedure
      clear_scr;
   var
      i  : byte;
   begin
      if emulation_mode[1]='T' then
         textbackground( BGcolor );
      mx := wherex;
      my := wherey;
      case escape_register[1] of
         0 : begin
                clreol;
                for i:=succ(my) to 24 do begin
                   gotoxy(1,i);
                   clreol;
                end;
                gotoxy(mx,my);
             end;
         1 : begin
                for i:=1 to pred(my) do begin
                   gotoxy(1,i);
                   clreol;
                end;
                gotoxy(1,my);
                for i:=1 to mx do write( ' ' );
                gotoxy(mx,my);
             end;
         2 : clrscr;
      end;
      textbackground( BG );
   end;

   procedure
      clear_line;
   var
      i  : byte;
   begin
      if emulation_mode[1]='T' then
         textbackground( BGcolor );
      mx := wherex;
      my := wherey;
      case escape_register[1] of
         0 : clreol;
         1 : begin
                gotoxy(1,my);
                for i:=1 to mx do write( ' ' );
             end;
         2 : begin
                gotoxy(1,my);
                clreol;
             end;
      end;
      gotoxy(mx,my);
      textbackground( BG );
   end;

   procedure
      print_screen;
   var
      i,j    : byte;
   begin
      if crt_mode = 7 then begin
         for j:=1 to 24 do begin
            for i:=1 to 80 do write(lst,mono_scr[j][i].disp_char);
            write(lst,CRLF);
         end;
      end
      else begin
         for j:=1 to 24 do begin
            for i:=1 to 80 do write(lst,color_scr[j][i].disp_char);
            write(lst,CRLF)
         end;
      end;
      write(lst,FF);
   end;

   procedure
      printer_control;
   begin
      if escape_str = '?5' then  printer_on := true;
      if escape_str = '?4' then  printer_on := false;
      if escape_str = '5'  then  begin
         printer_control_off := false;
         printer_on := true;
      end;
      if escape_str = '4'  then  begin
         printer_control_off := true;
         printer_on := false;
      end;
      if escape_register[1]=0 then print_screen;
   end;

   procedure
      save_cursor;
   begin
      with cursor_hold do begin
         x_coor := wherex;
         y_coor := wherey;
         bscan  := curr_bscan;
         sscan  := curr_sscan;
         ForeG  := FG;
         BackG  := BG;
      end;
   end;

   procedure
      restore_cursor;
   begin
      with cursor_hold do begin
         FG := ForeG;
         BG := BackG;
         textcolor( FG );
         textbackground( BG );
         gotoxy( x_coor, y_coor );
         shape_cursor( bscan, sscan );
      end;
   end;

   procedure
      clear_tab_stop;
   var
      i   : integer;
   begin
      if escape_register[1]=0 then begin
         if wherex<80 then tab_stop[ wherex ] := 0
      end
      else begin
         for i:=1 to 79 do tab_stop[i] := 0;
      end;
   end;

   procedure
      cursor_report;
   var
      s  : string10;
      s1 : string10;
      s2 : string10;
   begin
      str(wherey,s1);
      str(wherex,s2);
      s := ESC + '[' + s1 + ';' + s2 + 'R';
      send_str( s );
   end;

   procedure
      xmodem_file_xmit;          FORWARD;
   procedure
      esc_xmit;
   begin
      assign(size_file,filename);
      {$I-}
      reset(size_file);
      {$I+}
      ok := (ioresult = 0);
      if ok then begin
         mkwin(15,4,62,13,'Automatic Transmit');
         writeln(' Transmitting File: ',filename);
         xmodem_file_xmit;
         rmwin;
      end
      else
         store_sout_buffer( CAN );
      escape_mode := false;
   end;

   procedure
      xmodem_file_recv;          FORWARD;
   procedure
      esc_recv;
   begin
      mkwin(15,4,62,12,'Automatic Receive');
      writeln(' Receiving File: ',filename);
      setserial(baud,stopbits,8,0);
      batch_mode := false;
      xmodem_file_recv;
      setserial(baud,stopbits,databits,par);
      rmwin;
      escape_mode := false;
   end;

   procedure
      process_escape( c : char );
   label
      BBS_STYLE,MORE_ESCAPE;
   var
      ch   : char;
   begin
      if emulation_mode[1]='F' then goto BBS_STYLE;
      if escape_type = '{' then begin
         if c = '}' then filename := escape_str;
         if escape_sub_type = '}' then begin
            case c of
               '0' : escape_mode:=false;
               '1' : esc_recv;
               '2' : escape_mode:=false;
               '3' : esc_xmit;
               '4' : escape_mode:=false;
            end;
         end;
         escape_str := escape_str + c;
         escape_sub_type := c;
         exit;
      end;
      case c of
         '[','(','{'
                 : begin
                      escape_type := c;
                      exit;
                   end;
         '0'     : begin
                      if escape_type <> '(' then goto MORE_ESCAPE;
                      line_drawing_chars := true;
                   end;
         'm'     : set_graphics;
         'f'     : addr_cursor;
         'H'     : begin
                      if escape_type = '[' then
                         addr_cursor
                      else
                         tab_stop[ wherex ] := 1;
                   end;
         'J'     : clear_scr;
         'K'     : clear_line;
         '7'     : begin
                      if escape_type <> ' ' then goto MORE_ESCAPE;
                      save_cursor;
                   end;
         'A'     : cursor_up;
         'B'     : begin
                      if escape_type = '(' then
                         line_drawing_chars := false
                      else
                         cursor_down;
                   end;
         'C'     : cursor_right;
         'D'     : cursor_left;
         'L'     : insert_line;
         'M'     : delete_line;
         'I'     : rev_index_cursor;
         'P'     : delete_char;
         'h'     : begin
                      if escape_register[1]=4 then begin
                         shape_cursor(1,7);
                         insert_mode := true;
                      end;
                      if escape_register[1]=1 then keypad_mode := true;
                   end;
         'l'     : begin
                      if escape_register[1]=4 then begin
                         shape_cursor(6,7);
                         insert_mode := false;
                      end;
                      if escape_register[1]=1 then keypad_mode := false;
                   end;
         'E'     : begin
                      escape_str := CRLF;
                      escape_wrt;
                   end;
         'i'     : printer_control;
         '8'     : begin
                      if escape_type <> ' ' then goto MORE_ESCAPE;
                      restore_cursor;
                   end;
         '='     : keypad_mode := true;
         '>'     : keypad_mode := false;
         'g'     : clear_tab_stop;
         'n'     : cursor_report;
         'Z'     : send_str( ^['[?6c' );
         'c'     : begin
                      if escape_register[1]=0 then
                         send_str( ^['[?6c' );
                   end;
         'r'     : begin
                      scroll_top := escape_register[1];
                      scroll_bot := escape_register[2];
                      window(1,scroll_top,80,scroll_bot);
                      scroll_last := scroll_bot - scroll_top + 1;
                      if ( scroll_top = 1 ) and ( scroll_bot = 24 ) then
                         scroll_region := false
                      else
                         scroll_region := true;
                   end;
         'R'     : ;
         '<'     : ;
      else
         goto MORE_ESCAPE;
      end;
      escape_mode := false;
      exit;
   BBS_STYLE:
      case c of
         '[',' ',LF
                 : exit;
         'm'     : set_graphics;
         'f','H' : addr_cursor;
         'J'     : clear_scr;
         'K','k' : clear_line;
         ^N      : play( escape_str + ' ' );
         CR      : begin
                      play( escape_str + ' ' );
                      escape_str := '';
                      escape_type := ' ';
                      escape_sub_type := ' ';
                      escape_number := 1;
                      escape_register[1] := 0;
                      exit;
                   end;
      else
         goto MORE_ESCAPE;
      end;
      escape_mode := false;
      exit;
   MORE_ESCAPE:
      ch := upcase( c );
      escape_str := escape_str + ch;
      if ch in [ 'A'..'G','L'..'P','T','S','#','+','-','>','<','.','?' ] then
         exit;
      if ch in [ '0'..'9' ] then begin
         escape_register[escape_number] := (escape_register[escape_number] * 10) + ord( ch ) - ord( '0' );
         exit;
      end;
      if ch in [ ';', ',' ] then begin
         escape_number := succ(escape_number);
         escape_register[escape_number] := 0;
         exit;
      end;
      escape_wrt;
      set_graphics;
   end;

(****************************************************************************)
(*                             SCREEN HANDLER                               *)
(****************************************************************************)
   procedure
      insert_mode_wrt( ch : char );
   var
      i        : byte;
      c1,c2    : screen_char;
   begin
      my := wherey;
      mx := wherex;
      if crt_mode = 7 then begin
         c1 := mono_scr[my][mx];
         write( ch );
         for i:=mx+1 to 80 do begin
            c2 := mono_scr[my][i];
            mono_scr[my][i] := c1;
            c1 := c2;
         end;
      end
      else begin
         c1 := color_scr[my][mx];
         write( ch );
         for i:=mx+1 to 80 do begin
            c2 := color_scr[my][i];
            color_scr[my][i] := c1;
            c1 := c2;
         end;
      end;
      gotoxy(mx+1,my);
   end;

   procedure
      lp_write( c : char);
   begin
      regs.AX := ord( c );
      regs.DX := 0;
      intr( $17,regs );
   end;

   procedure
      wrt( c : char );
   begin
      if printer_control_off then write( c );
      if printer_on then lp_write( c );
      if capture_flag then capture( c );
   end;

   procedure
      monitor_recv( ch : char );
   begin
      if ch < ' ' then begin
         wrt( '^' );
         wrt( chr( ord( ch ) + 64 ) );
      end
      else
         wrt( ch );
   end;

   procedure
      scrwrite;
   var
      i  : byte;
   begin
      if monitor_mode then begin
         monitor_recv( c );
         exit;
      end;
      if escape_mode then begin
         process_escape( c );
         exit;
      end;
      if c > #31 then begin
         auto_wrap := false;
         if c = DEL then exit;
         if line_drawing_chars then begin
            if c > #95 then
               c := char( alt_character[ ord( c ) ] );
         end;
         if insert_mode then begin
            insert_mode_wrt( c );
            exit;
         end;
         if wherex = 80 then auto_wrap := true;
         wrt( c );
         exit;
      end;
      case c of
         NUL   : auto_wrap := false;
         ESC   : begin
                    auto_wrap := false;
                    escape_str := '';
                    escape_type := ' ';
                    escape_sub_type := ' ';
                    escape_number := 1;
                    escape_register[1] := 0;
                    escape_mode := true;
                 end;
         FF    : begin
                    auto_wrap := false;
                    if printer_control_off then clrscr;
                    if printer_on then lp_write( c );
                    if capture_flag then capture( c );
                 end;
         VT,LF : begin
                    if auto_wrap then
                       auto_wrap := false
                    else
                       wrt( LF );
                 end;
         CR    : begin
                    wrt( CR );
                    if auto_LF[1]='T' then begin
                       if auto_wrap then
                          auto_wrap := false
                       else
                          wrt( LF );
                    end;
                 end;
         HT    : begin
                    auto_wrap := false;
                    i := wherex;
                    if i <> 80 then begin
                       repeat
                          i := succ( i );
                          if printer_on then lp_write( ' ' );
                          if capture_flag then capture( ' ' );
                       until tab_stop[ i ] = 1;
                       gotoxy(i,wherey);
                    end;
                 end;
      else
         auto_wrap := false;
         wrt( c );
      end;
   end;