home *** CD-ROM | disk | FTP | other *** search
/ Columbia Kermit / kermit.zip / c / qk3vt1.pas < prev    next >
Pascal/Delphi Source File  |  2020-01-01  |  44KB  |  931 lines
  1. Unit VT100 ;
  2. Interface
  3.   Uses
  4.     Printer,Crt,Graph,  (* Standard Turbo Pascal Units *)
  5.     KGlobals,
  6.     ModemPro,
  7.     Sysfunc,
  8.     Tek4100,
  9.     Packets,
  10.     SendRecv ;
  11.   Const
  12.     TermType = ' VT100  ' ;
  13.   Procedure Connection ;
  14.  
  15. Implementation
  16. (* ================================================================== *)
  17. (*  Global Var and Procedures for Connect Procedure.                  *)
  18. (* ================================================================== *)
  19. Const
  20.      Upward = 6 ;
  21.      Downward = 7 ;
  22.      InitVT100 : Boolean = True ;
  23.      LocalChar = $1C ;
  24.      BreakChar = $1D ;
  25.  
  26.      APLTABLE : array [0..127] of byte =
  27. {00}  ($00,$01,$02,$03,$04,$05,$06,$07,$08,$09,$0A,$0B,$0C,$0D,$0E,$0F,  {0F}
  28. {01}   $10,$11,$12,$13,$14,$15,$16,$17,$18,$19,$1A,$1B,$1C,$1D,$1E,$1F,  {1F}
  29. {02}   $20,$05,$29,$3C,$F3,$3D,$3E,$5D,$FA,$5E,$86,$F6,$2C,$2B,$2E,$2F,  {1F}
  30. {03}   $30,$31,$32,$33,$34,$35,$36,$37,$38,$39,$28,$5B,$3B,$78,$3A,$5C,  {3F}
  31. {04}   $FD,$E0,$E6,$EF,$8F,$EE,$5F,$EC,$91,$E2,$F8,$27,$95,$FE,$E7,$F9,  {4F}
  32. {05}   $2A,$3F,$FB,$8D,$7E,$19,$FC,$17,$0E,$18,$0B,$1B,$1D,$1A,$F2,$2D,  {5F}
  33. {06}   $40,$41,$42,$43,$44,$45,$46,$47,$48,$49,$4A,$4B,$4C,$4D,$4E,$4F,  {6F}
  34. {07}   $50,$51,$52,$53,$54,$55,$56,$57,$58,$59,$5A,$7B,$1C,$7D,$24,$2D); {7F}
  35.    Over1 = 'T('#$E5'T)'#$EA'GM'#$1F'HM'#$1E'OM'#$E8'O?'#$ED'O_'#$E9'OP'#$0F ;
  36.    Over2 = 'BN'#$15'GT'#$13'BJ'#$F5'NJ'#$F4'?_'#$A7'/_'#$EB'CJ'#$A6'KL'#$97 ;
  37.    Over3 = 'K.'#$21'L+'#$98 ;
  38.    Over4 = 'aFabFbcFcdFdeFefFfgFghFhiFijFjkFklFlmFmnFnoFopFpqFqrFrsFs' ;
  39.    Over5 = 'tFtuFuvFvwFwxFxyFyzFz' ;
  40.     KEYPADTABLE : array[1..13] of char = '789-456+1230.';
  41.    Htab : array [1..80] of char =     (* Default tab settings *)
  42. '00000000T0000000T0000000T0000000T0000000T0000000T0000000T0000000T0000000T0000000';
  43.      Graphicset: array [0..31] of byte =
  44. {06}  ($DB,$DB,$3F,$3F,$3F,$3F,$3F,$3F,$3F,$3F,$D9,$BF,$DA,$C0,$C5,$C4,  {6F}
  45. {07}   $C4,$C4,$C4,$5F,$C3,$B4,$C1,$C2,$B3,$F3,$F2,$7B,$7C,$7D,$7E,$7F); {7F}
  46.  
  47. Type String2 = string[2] ;
  48.  
  49. Var
  50.      achar : integer ;
  51.      EscSeq : Array [1..$88,1..2] of char ;
  52.      KeyTableName : String[14] ;
  53.      KeyTable : Text ;
  54.      ColorofText,ColorofBack : byte ;
  55.      Row,Column : integer ;
  56.      saveBackColor,saveForeColor,saveblinkf,savehighf : byte ;
  57.      saveGOG1,saveMargintop,saveMarginbot : byte ;
  58.      saverelcursor : boolean ;
  59.  
  60.     (* variables for VT100 *)
  61.   (* margintop,marginbot,       define in SYSFUNC global *)
  62.      blinkf,highf,
  63.      G0,G1,G0G1         : byte ;
  64.      ANSI,keypadnum,
  65.      relcursor,AutoWrap,
  66.      printon,screenon,
  67.      wrapit,shiftin,
  68.      Deccolm,Decscnm    : boolean ;
  69.      dwl :  array [0..24] of boolean ;
  70.  
  71. (* ------------------------------------------------------------------ *)
  72. Procedure SetColors(BackColor,ForeColor:byte) ;
  73.      Begin (* Text Color *)
  74.      ColorofBack := BackColor ;
  75.      ColorofText := ForeColor ;
  76.      TextColor(ColorofText + blinkf + highf );
  77.      TextBackground(BackColor);
  78.      End ; (* Text Color *)
  79.  
  80. (* ------------------------------------------------------------------ *)
  81. Procedure ReverseScreen ;
  82. var Back,Fore : byte ;
  83.     i : integer ;
  84.     Begin (* Reverse *)
  85.      for i := 0 to 1919 do
  86.          Begin (* flip *)
  87.          Back := RealScreen^[2*i+1] and  $70  shr 4 ;
  88.          Fore := RealScreen^[2*i+1] and  $07 ;
  89.          RealScreen^[2*i+1]:=(RealScreen^[2*i+1] and $88) or
  90.                              ( fore shl 4 ) or  Back ;
  91.          End ; (* flip *)
  92.          SetColors(ColorofText,ColorofBack);  (* flip it *)
  93.    End ; (* Reverse *)
  94.  
  95. (*------------------------------------------------------------------- *)
  96. Function hexinteger (chars :  string2): byte ;
  97.     begin (* HexInteger *)
  98.     If chars[1] in ['A'..'F'] then chars[1]:=chr(ord(chars[1])+9);
  99.     If chars[2] in ['A'..'F'] then chars[2]:=chr(ord(chars[2])+9);
  100.     hexinteger := ((ord(chars[1]) shl 4) and $F0)
  101.                  + (ord(chars[2]) and $0F) ;
  102.     end  ; (* HexInteger *)
  103.  
  104. (*------------------------------------------------------------------- *)
  105. Procedure ReadKeytable ;
  106. var I : integer ;
  107.     Newname : string[25] ;
  108.     comment : string[80] ;
  109. label retry ;
  110.  
  111.     Begin (* ReadKeytable *)
  112.     keytablename := 'KEYTABLE.DAT' ;
  113.     Assign(keytable,keytablename) ;
  114. retry :
  115.     {$I-}  Reset(keytable);  {$I+}
  116.     If IORESULT = 0 then
  117.          Begin (* Initiate key table *)
  118.          For i := 1 to $88 do
  119.               Begin (* init EscSeq table *)
  120.               Readln(KeyTable,EscSeq[i,1],EscSeq[i,2],comment) ;
  121.               If copy(comment,2,2) <> '  ' then
  122.                  EscSeq[i,1] := Chr(HexInteger(copy(comment,2,2))) ;
  123.               If copy(comment,4,2) <> '  ' then
  124.                  EscSeq[i,2] := Chr(HexInteger(copy(comment,4,2))) ;
  125.               End ; (* init EscSeq table *)
  126.          Close(keytable);
  127.          End   (* Initiate key table *)
  128.                   else
  129.          Begin (* Warning *)
  130.          ClrScr ;
  131.          Writeln('*** File ',Keytablename,' not found on drive.');
  132.          Writeln('    Please specify drive or new name of keytable file. ');
  133.          Readln(newname);
  134.          If (NewName[Length(Newname)] = '\') or
  135.             (NewName[Length(Newname)] = ':') then
  136.               keytablename := Newname + keytablename
  137.                                              else
  138.               keytablename := Newname ;
  139.          Assign(keytable,keytablename);
  140.          If length(keytablename)<3 then
  141.          Running := false
  142.                                    else Goto Retry ;
  143.          End ; (* Warning *)
  144.     End ; (* ReadKeytable *)
  145.  
  146. (* ================================================================== *)
  147. (*  Connection - Connect to the other computer and simulates          *)
  148. (*               a VT100 type terminal .                              *)
  149. (*                                                                    *)
  150. (* ================================================================== *)
  151.  
  152. Procedure Connection ;
  153.     VAR
  154.          EscapeBindex : integer ;
  155.          EscapeBuffer : array [1..20] of byte ;
  156.          achar,bchar  : byte ;
  157.          i : integer ;
  158.          overchar     : string[2] ;
  159.          overchars    : string[160] ;
  160.          EscapeFlag   : boolean ;
  161.     (* -------------------------------------------------------- *)
  162.     Procedure Escape ;
  163.          Var j,k  : byte ;
  164.  
  165.              i : integer ;
  166.          Pn : Array[1..10] of integer ;
  167.          Tempstr : string[3] ;
  168.          label  getnum,NextNum,DoCase;
  169.  
  170.          Function PNumber (var achar : byte) : integer ;
  171.           var Num  : integer ;
  172.           label getnext ;
  173.               Begin (* PNumber *)
  174.               Num := 0  ;
  175.          getnext:
  176.               While chr(achar) in ['0'..'9']  do
  177.                    Begin (* get number *)
  178.                    Num := (Num * 10) + (achar-$30) ;
  179.                    If ReadMchar(achar) then
  180.                         Begin (* save escape sequence in Escape buffer *)
  181.                         EscapeBindex := EscapeBindex + 1 ;
  182.                         Escapebuffer[EscapeBindex] := achar ;
  183.                         End ; (* save escape sequence in Escape buffer *)
  184.                    End ; (* get number *)
  185.               If achar = $08 then
  186.                   begin  (* backspace *)
  187.                   num := num div 10 ;
  188.                   If ReadMchar(achar) then ;
  189.                   goto getnext;
  190.                   end ;  (* backspace *)
  191.               PNumber := Num ;
  192.               End ; (* PNumber *)
  193.  
  194.         Procedure ClrEOScr ;
  195.         var i : integer ;
  196.         Begin (* ClrEOScr *)
  197.         for i := ((WhereY-1)*80)+(WhereX-1) to 1920 do
  198.             Begin (* clear *)
  199.             RealScreen^[2*i]:=$20 ;
  200.             RealScreen^[2*i+1]:=$07 ;
  201.             End ; (* clear *)
  202.         End ; (* ClrEOScr *)
  203.  
  204.         Procedure ClrBOScr ;
  205.         var i : integer ;
  206.         Begin (* ClrBOScr *)
  207.         for i := 0  to  ((WhereY-1)*80)+(WhereX-1) do
  208.             Begin (* clear *)
  209.             RealScreen^[2*i]:=$20 ;
  210.             RealScreen^[2*i+1]:=$07 ;
  211.             End ; (* clear *)
  212.         End ; (* ClrBOScr *)
  213.  
  214.         Procedure ClrBol ;
  215.         var i : integer ;
  216.         Begin (* ClrBol *)
  217.         for i := (WhereY-1)*80 to ((WhereY-1) * 80)+(WhereX-1) do
  218.             Begin (* clear *)
  219.             RealScreen^[2*i]:=$20 ;
  220.             RealScreen^[2*i+1]:=$07 ;
  221.             End ; (* clear *)
  222.         End ; (* ClrBOScr *)
  223.  
  224.         Procedure ClrLine ;
  225.         var i : integer ;
  226.         Begin (* Clrline *)
  227.         for i := ((WhereY-1)*80) to ((WhereY-1)*80)+79 do
  228.             Begin (* clear *)
  229.             RealScreen^[2*i]:=$20 ;
  230.             RealScreen^[2*i+1]:=$07 ;
  231.             End ; (* clear *)
  232.         End ; (* Clrline *)
  233.  
  234.         Procedure Decdwl ( dwlflag : boolean );
  235.         var i : integer ;
  236.             linenumber : byte ;
  237.         Begin (* Decdwl *)
  238.         linenumber := WhereY-1 ;
  239.         If dwlflag <> dwl[linenumber] then
  240.             Begin (* change size *)
  241.             If dwlflag then
  242.                 Begin (* make this line double size *)
  243.                 for i := 1 to 40 do
  244.                      begin (* expand *)
  245.                      RealScreen^[(linenumber*80 + 80 - 2*i)*2] :=
  246.                                 RealScreen^[(linenumber*80 + 40 - i)*2] ;
  247.                      RealScreen^[(linenumber*80 + 81 - 2*i)*2] := $20 ;
  248.                      end ; (* expand *)
  249.                 End   (* make this line double size *)
  250.                        else
  251.                 Begin (* make this line single size *)
  252.                 for i := 0 to 39 do
  253.                      begin (* compress *)
  254.                      RealScreen^[(linenumber*80+i)*2] :=
  255.                           RealScreen^[(linenumber*80+2*i)*2] ;
  256.                      end ; (* compress *)
  257.                 for i := 0 to 39 do
  258.                      begin (* blank out *)
  259.                      RealScreen^[(linenumber*80+40+i)*2] := $20 ;
  260.                      end ; (* blank out *)
  261.                 End ; (* make this line single size *)
  262.             dwl[linenumber] := dwlflag ;
  263.             End ; (* change size *)
  264.         End ; (* Decdwl *)
  265.  
  266.     Begin (* Escape Sequence *)
  267.     If ReadMchar(achar) then
  268.          Begin (* save escape sequence in Escape buffer *)
  269.          EscapeBindex := 1 ;
  270.          EscapeBuffer[EscapeBindex] := Esc ;
  271.          Escapebindex := EscapeBindex + 1 ;
  272.          Escapebuffer[EscapeBindex] := achar ;
  273.          End ; (* save escape sequence in Escape buffer *)
  274.     if screenon or (chr(achar) = '[') then
  275.     BEGIN (* screen escape sequences  *)
  276.     CASE chr(achar) of  (* First Level *)
  277.          '[':  Begin (* Left square bracket *)
  278.                If ReadMchar(achar) then
  279.                    Begin (* save escape sequence in Escape buffer *)
  280.                    Escapebindex := EscapeBindex + 1 ;
  281.                    Escapebuffer[EscapeBindex] := achar ;
  282.                    End ; (* save escape sequence in Escape buffer *)
  283.                CASE chr(achar) of   (* Second level *)
  284.                  'A': Begin CursorUp ; wrapit := false ; end ;
  285.                  'B': Begin CursorDown ; wrapit := false ; end ;
  286.                  'C': CursorRight ;
  287.                  'D': CursorLeft  ;
  288.                  'J': ClrEoScr ; (* Erase End of Display *)
  289.                  'K': ClrEol ; (* Erase End of Line *)
  290.                  '?': If ReadMchar(achar) then
  291.                         Begin (* save escape sequence in Escape buffer *)
  292.                         Escapebindex := EscapeBindex + 1 ;
  293.                         Escapebuffer[EscapeBindex] := achar ;
  294.                         goto Getnum; (* Modes  *)
  295.                         End ; (* save escape sequence in Escape buffer *)
  296.                  'f',
  297.                  'H': If Relcursor then GotoXY(1,margintop)  (* Cursor Home *)
  298.                                    else GotoXY(1,1);
  299.                  'g': Htab[WhereX] :='0';
  300.                  '}',
  301.                  'm': begin (* Normal Video - Exit all attribute modes *)
  302.                       highf := 0 ; blinkf := 0 ;
  303.                       SetColors(Black,LightGray);
  304.                       end ; (* Normal Video - Exit all attribute modes *)
  305.                  'r': begin (* Reset Margin *)
  306.                       margintop:=1 ;
  307.                       marginbot:=24 ;
  308.                       GotoXY(1,1);
  309.                       end ; (* Reset Margin *)
  310.  
  311.                  'c','h','l','n',
  312.                  'x': Begin Pn[1] := 0 ; Goto DoCase ; End ;
  313.                  ';': Begin Pn[1] := 0 ; k := 1 ; Goto nextnum ; End ;
  314.                 else  (* Pn - got a number *)
  315. Getnum:              Begin (* Esc [ Pn...Pn x   functions *)
  316.                      Pn[1] := PNumber(achar);
  317.                      k := 1 ;
  318. Nextnum:             While achar = ord(';') do
  319.                         Begin (* get Pn[k] *)
  320.                         If ReadMchar(achar) then
  321.                              Begin (* save escape sequence in Escape buffer *)
  322.                              Escapebindex := EscapeBindex + 1 ;
  323.                              Escapebuffer[EscapeBindex] := achar ;
  324.                              End ; (* save escape sequence in Escape buffer *)
  325.                         If chr(achar) = '?' then
  326.                            If ReadMchar(achar) then  (* Ignore '?'  *)
  327.                              Begin (* save escape sequence in Escape buffer *)
  328.                              Escapebindex := EscapeBindex + 1 ;
  329.                              Escapebuffer[EscapeBindex] := achar ;
  330.                              End ; (* save escape sequence in Escape buffer *)
  331.  
  332.                         k:=k+1 ;
  333.                         Pn[k] := PNumber(achar);
  334.                         End  ; (* get Pn[k] *)
  335.                      Pn[k+1] := 1 ;
  336. DoCase:              CASE chr(achar) of (* third level *)
  337.                         'A': Repeat CursorUp ; wrapit := false ;
  338.                                     Pn[1]:=Pn[1]-1; until Pn[1]<=0;
  339.                         'B': Repeat Cursordown; wrapit := false ;
  340.                                     Pn[1]:=Pn[1]-1; until Pn[1]<=0;
  341.                         'C': Repeat CursorRight;Pn[1]:=Pn[1]-1; until Pn[1]<=0;
  342.                         'D': Repeat CursorLeft; Pn[1]:=Pn[1]-1; until Pn[1]<=0;
  343.                         'f',
  344.                         'H': Begin (* Direct cursor address *)
  345.                              If Pn[1] = 0 then
  346.                                   If relcursor then Pn[1] := margintop
  347.                                                else Pn[1] := 1 ;
  348.                              If Pn[2] = 0 then Pn[2] := 1 ;
  349.                              If Pn[2] > 80 then Pn[2] := 80 ;
  350.                              wrapit := false ;
  351.                              GoToXY(Pn[2],Pn[1]);
  352.                              End ;(* Direct cursor address *)
  353.                         'c': Begin (* Device Attributes *)
  354.                              (* Send  Esc[?1;0c *)
  355.                              Sendchar(Esc); Sendchar(ord('['));
  356.                              Sendchar(ord('?')); Sendchar(ord('1'));
  357.                              Sendchar(ord(';')); Sendchar(ord('0'));
  358.                              Sendchar(ord('c'));
  359.                              End ; (* Device Attributes *)
  360.                         'g': If Pn[1]=3 then    (* clear all tabs *)
  361.                                   For j:=1 to 80 do Htab[j] := '0'
  362.                                      else (* clear tab at current position *)
  363.                                   Htab[WhereX] :='0';
  364.                         'h': (* Set Mode *)
  365.                              For j := 1 to k do
  366.                              Case Pn[j] of (* Field specs *)
  367.                              1: (* DECCKM  *) ;
  368.                              2: (* DECANM  *) ANSI := true ;  (* ANSI/VT52 *)
  369.                              3: (* DECCOLM *)  (* Col = 80 *)
  370.                                    begin Deccolm := true ; ClrScr ; end ;
  371.                              4: (* DECSCLM *) ;
  372.                              5: (* DECSCNM *)
  373.                                 If Decscnm then else
  374.                                      Begin (*  set Screen Mode *)
  375.                                      Decscnm := true ;
  376.                                      ReverseScreen ;
  377.                                      End ; (* set Screen Mode *)
  378.                              6: (* DECOM  *)
  379.                                 Begin (* Relative origin *)
  380.                                 Relcursor := true ;
  381.                                 If Relcursor then GotoXY(1,margintop)
  382.                                              else GotoXY(1,1);
  383.                                 End ; (* Relative origin *)
  384.                              7: (* DECAWM *) AutoWrap := true ;
  385.                              8: (* DECARM *) ;
  386.                              9: (* DECINLM *) ;
  387.                             20: (* Ansi LNM - linefeed mode *) ;
  388.                              End ; (* case of Field specs *)
  389.                         'l': (* Reset Mode *)
  390.                              For j := 1 to k do
  391.                              Case Pn[j] of (* Field specs *)
  392.                              1: (* DECCKM  *) ;
  393.                              2: (* DECANM  *) ANSI := false ;  (* ANSI/VT52 *)
  394.                              3: (* DECCOLM *)    (* 132 col *)
  395.                                  Begin deccolm := false ; ClrScr ; end ;
  396.                              4: (* DECSCLM *) ;
  397.                              5: (* DECSCNM *)
  398.                                 If Decscnm then
  399.                                     Begin (*  Screen Mode *)
  400.                                     Decscnm := false ;
  401.                                     ReverseScreen ;
  402.                                     End ; (* Screen Mode *)
  403.                              6: (* DECOM  *)
  404.                                 Begin (* Relative origin *)
  405.                                 Relcursor := False ;
  406.                                 If Relcursor then GotoXY(1,margintop)
  407.                                              else GotoXY(1,1);
  408.                                 End ; (* Relative origin *)
  409.                              7: (* DECAWM *) AutoWrap := false ;
  410.                              8: (* DECARM *) ;
  411.                              9: (* DECINLM *) ;
  412.                             20: (* Ansi LNM - linefeed mode *) ;
  413.                              End ; (* case of Field specs *)
  414.                         'i': Begin (* Printer Screen  on / off *)
  415.                              For j := 1 to k do
  416.                                 Case Pn[j] of (* Field specs *)
  417.                                   4: Printon := false ;
  418.                                   5: Printon := true ;
  419.                                   6: Screenon := false ;
  420.                                   7: Screenon := true ;
  421.                                 End ; (* case of Field specs *)
  422.                              EscapeBindex:=0;
  423.                              End ;  (* Printer Screen  on / off *)
  424.  
  425.                         'q': FatCursor(Pn[1]=1); (* for series/1 insert mode *)
  426.                         'n': If Pn[1] = 5 then
  427.                                   Begin (* Device Status Report *)
  428.                                   (* Send  Esc[0n *)
  429.                                   Sendchar(Esc);Sendchar(ord('['));
  430.                                   Sendchar(ord('0'));Sendchar(ord('n'));
  431.                                   End   (* Device Status Report *)
  432.                                        else
  433.                              If Pn[1] = 6 then
  434.                                   Begin (* Cursor Position Report *)
  435.                                   Sendchar(Esc);Sendchar(ord('['));
  436.                                   STR(WhereY,tempstr);     (* ROW *)
  437.                                   Sendchar(ord(tempstr[1]));
  438.                                   If length(tempstr)=2 then
  439.                                        Sendchar(ord(tempstr[2]));
  440.                                   Sendchar(ord(';'));
  441.                                   STR(WhereX,tempstr);     (* COLUMN *)
  442.                                   Sendchar(ord(tempstr[1]));
  443.                                   If length(tempstr) = 2 then
  444.                                        Sendchar(ord(tempstr[2]));
  445.                                   Sendchar(ord('R'));
  446.                                   End ; (* Cursor Position Report *)
  447.                         'x': If Pn[1]<=1 then
  448.                               Begin (* Request terminal Parameters *)
  449.                               Sendchar(Esc); Sendchar(ord('['));
  450.                               If Pn[1] = 0 then Sendchar(ord('2'))
  451.                                            else Sendchar(ord('3')); (* sol *)
  452.                               Sendchar(ord(';'));  (* parity *)
  453.                               If parity = OddP  then Sendchar(ord('4'))
  454.                                                 else
  455.                               If parity = EvenP then Sendchar(ord('5'))
  456.                                                 else Sendchar(ord('1')) ;
  457.                               Sendchar(ord(';'));
  458.                               Sendchar(ord('2'));   (* nbits *)
  459.                               Sendchar(ord(';'));
  460.                               For j := 1 to 2 do
  461.                                  Begin (* Xspeed ,Rspeed *)
  462.                                    Case baudrate of
  463.                               300 : begin Sendchar(ord('4'));
  464.                                     Sendchar(ord('8')); end ;
  465.                               600 : begin Sendchar(ord('5'));
  466.                                     Sendchar(ord('6')); end ;
  467.                              1200 : begin Sendchar(ord('6'));
  468.                                     Sendchar(ord('4')); end ;
  469.                              2400 : begin Sendchar(ord('8'));
  470.                                     Sendchar(ord('8')); end ;
  471.                              4800 : begin Sendchar(ord('1'));
  472.                                     Sendchar(ord('0'));
  473.                                     Sendchar(ord('4')); end ;
  474.                              9600 : begin Sendchar(ord('1'));
  475.                                     Sendchar(ord('1'));
  476.                                     Sendchar(ord('2')); end ;
  477.                             19200 : begin Sendchar(ord('1'));
  478.                                     Sendchar(ord('2'));
  479.                                     Sendchar(ord('0')); end ;
  480.                                    end; (* case *)
  481.                                 Sendchar(ord(';'));
  482.                                 End ;  (* Xspeed ,Rspeed *)
  483.  
  484.                              Sendchar(ord('1'));  (* clkmul *)
  485.                              Sendchar(ord(';'));
  486.                              Sendchar(ord('0'));  (* flags *)
  487.                              Sendchar(ord('x'));
  488.                              End ; (* Request terminal Parameters *)
  489.                         'm',
  490.                         '}': For j := 1 to k do
  491.                              Case Pn[j] of      (* Field specs *)
  492.                              0: begin (* Normal *)
  493.                                 blinkf := 0 ;
  494.                                 highf := 0 ;
  495.                                 If Decscnm then
  496.                                    SetColors(LightGray,Black)
  497.                                            else
  498.                                    SetColors(Black,LightGray) ;
  499.                                 end ;
  500.                              1: begin (* High Intensity *)
  501.                                 highf := 8;
  502.                                 SetColors(ColorofBack,ColorofText) ;
  503.                                 end ;
  504.                              4: SetColors(Black,LightBlue) ;   (* Underline *)
  505.  
  506.                              5: begin (* Blink *)
  507.                                 blinkf := blink ;
  508.                                 SetColors(ColorofBack,ColorofText) ;
  509.                                 end ;
  510.                              7: begin (* Reverse *)
  511.                                 If Decscnm then
  512.                                    SetColors(Black,LightGray)
  513.                                             else
  514.                                    SetColors(LightGray,Black);
  515.                                 end ;
  516.                              8: SetColors(Black,Black); (* Invisible *)
  517.                             30: SetColors(ColorofBack,Black);
  518.                             31: SetColors(ColorofBack,Red);
  519.                             32: SetColors(ColorofBack,Green);
  520.                             33: SetColors(ColorofBack,brown);
  521.                             34: SetColors(ColorofBack,Blue);
  522.                             35: SetColors(ColorofBack,Magenta);
  523.                             36: SetColors(ColorofBack,Cyan);
  524.                             37: SetColors(ColorofBack,Lightgray);
  525.  
  526.                             40: SetColors(Black,ColorofText);
  527.                             41: SetColors(Red,ColorofText);
  528.                             42: SetColors(Green,ColorofText);
  529.                             43: SetColors(Brown,ColorofText);
  530.                             44: SetColors(Blue,ColorofText);
  531.                             45: SetColors(Magenta,ColorofText);
  532.                             46: SetColors(Cyan,ColorofText);
  533.                             47: SetColors(LightGray,ColorofText);
  534.                              End ; (* case of Field specs *)
  535.                         'r':Begin  (* set margin *)
  536.                             If k<2 then Pn[2] := 24 ;
  537.                             If Pn[1]=0 then Pn[1]:=1;
  538.                             If (Pn[1]>0) and (Pn[1]<Pn[2]) and (Pn[2]<25) then
  539.                                   begin
  540.                                   margintop:=Pn[1] ;
  541.                                   marginbot:=Pn[2];
  542.                                   If Relcursor then GotoXY(1,margintop)
  543.                                                else GotoXY(1,1);
  544.                                   end;
  545.                              End ; (* Set margin *)
  546.                         'J': Case Pn[1] of
  547.                              0: ClrEOScr ; (* clear to end of screen *)
  548.                              1: ClrBOScr ; (* clear to beginning *)
  549.                              2: ClrScr ;   (* clear all of screen *)
  550.                              End ; (*  J - Pn Case *)
  551.                         'K': Case Pn[1] of
  552.                              0: ClrEol ; (* clear to end of line *)
  553.                              1: ClrBol ; (* clear to beginning *)
  554.                              2: Clrline ; (* clear line *)
  555.                              End ; (*  J - Pn  Case *)
  556.                         'L': For i := 1 to Pn[1] do InsLine ; (* Insert Line *)
  557.                         'M': For i := 1 to Pn[1] do DelLine ; (* Delete Line *)
  558.                         '@': For i := 1 to Pn[1] do (* InsertChar *)  ;
  559.                         'P': For i := 1 to Pn[1] do (* DeleteChar *)  ;
  560.                      End ; (* Case third level *)
  561.                      End ; (* Esc [ Pn...Pn x   functions *)
  562.  
  563.                End ; (* second level Case *)
  564.               End ; (* Left square bracket *)
  565.  
  566.          '7': Begin (* Save cursor position *)
  567.               Row    := WhereY;
  568.               Column := WhereX;
  569.               SaveBackColor := ColorofBack ;
  570.               SaveForeColor := ColorofText ;
  571.               Savehighf := highf ;
  572.               Saveblinkf := blinkf ;
  573.               SaveMargintop := Margintop ;
  574.               SaveMarginbot := Marginbot ;
  575.               Saverelcursor := relcursor ;
  576.               End ; (* Save cursor position *)
  577.          '8': Begin (* Restore Cursor Position *)
  578.               GotoXY(Column,Row);
  579.               ColorofBack := SaveBackcolor ;
  580.               ColorofText := SaveForecolor ;
  581.               Highf     := Savehighf ;
  582.               Blinkf    := Saveblinkf ;
  583.               Margintop := SaveMargintop ;
  584.               Marginbot := SaveMarginbot ;
  585.               relcursor := Saverelcursor ;
  586.               End ; (* Restore Cursor Position *)
  587.          'A': if not ANSI then Cursorup   ;  (* VT52 control *)
  588.          'B': if not ANSI then Cursordown ;  (* VT52 control *)
  589.          'C': if not ANSI then Cursorright;  (* VT52 control *)
  590.          'D': if not ANSI then Cursorleft    (* VT52 control *)
  591.                           else CursorDown ;  (* Index *)
  592.          'E': Begin (* Next Line *)
  593.               write(chr($0D));
  594.               if MarginBot = WhereY then
  595.                    Scroll (Upward,Margintop-1,marginbot-1)
  596.                                     else
  597.                    write(chr($0A));
  598.              End ;  (* Next Line *)
  599.          'H': If ANSI then
  600.               Begin (* Set Tab Stop *)
  601.               Htab[WhereX] := 'T' ;
  602.               End   (* Set Tab Stop *)
  603.                      else  GotoXY(1,1) ;     (* VT52 control *)
  604.          'I': if not ANSI then Cursorup ;    (* VT52 control *)
  605.          'J': if not ANSI then ClrEOScr ;    (* VT52 control *)
  606.          'K': if not ANSI then ClrEol ;      (* VT52 control *)
  607.          'M': (* Reverse Index *)
  608.               if MarginTop = WhereY then
  609.                    Scroll (Downward,Margintop-1,marginbot-1)
  610.                                     else
  611.                    CursorUp   ;
  612.          'Y': if not ANSI then               (* VT52 control *)
  613.                  Begin (* direct cursor address *)
  614.                  If ReadMchar(achar) then
  615.                         Begin (* save escape sequence in Escape buffer *)
  616.                         Escapebindex := EscapeBindex + 1 ;
  617.                         Escapebuffer[EscapeBindex] := achar ;
  618.                         End ; (* save escape sequence in Escape buffer *)
  619.                  row  :=  achar  - $1F ;
  620.                  If ReadMchar(achar) then
  621.                         Begin (* save escape sequence in Escape buffer *)
  622.                         Escapebindex := EscapeBindex + 1 ;
  623.                         Escapebuffer[EscapeBindex] := achar ;
  624.                         End ; (* save escape sequence in Escape buffer *)
  625.                  column  :=  achar  - $1F ;
  626.                  GotoXY(row,column);
  627.                  End ; (* direct cursor address *)
  628.          'Z': if ANSI then
  629.                    Begin (* Device Attributes *)
  630.                    (* Send  Esc[?1;0c *)
  631.                    Sendchar(Esc); Sendchar(ord('['));
  632.                    Sendchar(ord('?')); Sendchar(ord('1'));
  633.                    Sendchar(ord(';')); Sendchar(ord('0'));
  634.                    Sendchar(ord('c'));
  635.                    End  (* Device Attributes *)
  636.                       else (* VT52 control *)
  637.                 Begin Sendchar(Esc);Sendchar(ord('/'));Sendchar(ord('Z'));end;
  638.          'c': Begin (* Reset *)
  639.               highf := 0 ; blinkf := 0 ;
  640.               SetColors(Black,LightGray);
  641.               Relcursor := False ;
  642.               Margintop := 0 ; Marginbot := 23 ;
  643.               End ; (* Reset *)
  644.          '#': Begin (* Esc # sequence *)
  645.               If ReadMchar(achar) then
  646.                    Begin (* save escape sequence in Escape buffer *)
  647.                    Escapebindex := EscapeBindex + 1 ;
  648.                    Escapebuffer[EscapeBindex] := achar ;
  649.                    End ; (* save escape sequence in Escape buffer *)
  650.               Case  chr(achar) of
  651.                  '3' : Decdwl (true);
  652.                  '4' : Decdwl (true);
  653.                  '5' : Decdwl (false);
  654.                  '6' : Decdwl (true );
  655.                  '8' : Begin (* Self Test *)
  656.                        For i := 0 to 1919 do
  657.                            begin (* fill with E *)
  658.                            RealScreen^[i*2] := $45 ;
  659.                            RealScreen^[i*2+1] := $07 ;
  660.                            end ; (* fill with E *)
  661.                        Margintop := 1 ;
  662.                        Marginbot := 24 ;
  663.                        GotoXY(1,1) ;
  664.                        End ; (* Self Test *)
  665.                 End ; (* case *)
  666.               End ;  (* Esc # sequence *)
  667.          '=': keypadnum:=false ;
  668.          '>': keypadnum:=true  ;
  669.          '<': if not ANSI then ANSI := True  ;    (* VT52 control *)
  670.          '(': If ReadMchar(achar) then
  671.                    Begin (* save escape sequence in Escape buffer *)
  672.                    Escapebindex := EscapeBindex + 1 ;
  673.                    Escapebuffer[EscapeBindex] := achar ;
  674.                    G0 := achar ;   (* G0 *)
  675.                    End ; (* save escape sequence in Escape buffer *)
  676.          ')': If ReadMchar(achar) then
  677.                    Begin (* save escape sequence in Escape buffer *)
  678.                    Escapebindex := EscapeBindex + 1 ;
  679.                    Escapebuffer[EscapeBindex] := achar ;
  680.                    G1 := achar ;   (* G1 *)
  681.                    End ; (* save escape sequence in Escape buffer *)
  682.               (* valid G0 and G1 are  A B 0 1 and 2 *)
  683.          '%': If ReadMchar(achar) then
  684.                    Begin (* check for Mode *)
  685.                    Escapebindex := EscapeBindex + 1 ;
  686.                    Escapebuffer[EscapeBindex] := achar ;
  687.                    If achar = ord('!') then
  688.                      If ReadMchar(achar) then
  689.                         Begin (* check for Tek4100 mode *)
  690.                         Escapebindex := EscapeBindex + 1 ;
  691.                         Escapebuffer[EscapeBindex] := achar ;
  692.                         If achar = ord('0') then
  693.                             (* ************************** *)
  694.                                     TEKTRONICS(0) ;
  695.                             (* ************************** *)
  696.                         End ;  (* check for Tek4100 mode *)
  697.                    End ; (* check for Mode *)
  698.          End ; (* First Level Case  *)
  699.     END ; (* screen escape sequences  *)
  700.     If printon then
  701.         if EscapeBindex > 1 then
  702.            Begin (* print esc sequence *)
  703.            for i := 1 to EscapeBindex do
  704.                write(Lst,Chr(EscapeBuffer[i]));
  705.            EscapeBindex := 0 ;
  706.            End ; (* print esc sequence *)
  707.     End ; (* Escape Sequence *)
  708.     (* -------------------------------------------------------- *)
  709.          Procedure RemoteCommand  ;
  710.          Var
  711.               i : integer ;
  712.               Filename : String ;
  713.          Begin (* RemoteCommand procedure *)
  714.          GotSOH := true ;
  715.          LocalScreen ;
  716.          If RecvPacket then
  717.               Begin (* Got a Packet *)
  718.               If  InPacketType = Ord('S') then        (* Send Packet *)
  719.                    Begin (* Receive *)
  720.                    writeln('Got a Send    request ');
  721.                    Filename :=  '' ;
  722.                    RecvFile(filename);
  723.                    End   (* Receive *)
  724.                                           else
  725.               If  InPacketType = Ord('R') then        (* Receive Packet *)
  726.                    Begin (* Receive *)
  727.                    writeln('Got a receive request ');
  728.                    for i := 1 to InCount-3 do
  729.                        filename[i] := chr(RecvData[i]);
  730.                    Filename[0] :=  chr(InCount-3) ;
  731.                    waitxon := XonXoff ;
  732.                    SendFile(filename);
  733.                    End   (* Receive *)
  734.                                           else
  735.               If  InPacketType = Ord('G') then        (* General Packet *)
  736.                    Begin (* Receive *)
  737.                    writeln('Got a General request ');
  738.                    SendPacketType('Y');
  739.                    End   (* Receive *)
  740.                                           else
  741.  
  742.                    Begin (* Unknow packet Type *)
  743.                    OutCount := 15 ;
  744.                    Outseq := 0 ;
  745.                    OutPacketType := Ord('E');
  746.         (*           SendData := 'Unknow Command';  *)
  747.                    End;   (* Unknown packet Type *)
  748.               End ; (* Got a Packet *)
  749.               RemoteScreen ;
  750.          End ; (* RemoteCommand Procedure *)
  751.  
  752. (* ------------------------------------------------------------------ *)
  753.  
  754.     Begin (* Connection *)
  755.     DialModem ;
  756.     Overchars := Over1+Over2+Over3+Over4+Over5 ;
  757.     RemoteScreen ;      (* Save local screen, restore remote screen *)
  758.     If InitVT100 then
  759.          Begin  (* Initialize VT100 settings *)
  760.          InitVT100 := false ;
  761.          ColorofText := Lightgray ; SaveForeColor := ColorofText ;
  762.          ColorofBack := black ;     SaveBackColor := ColorofBack ;
  763.          margintop := 1 ;           SaveMargintop := Margintop ;
  764.          marginbot := 24 ;          SaveMarginbot := Marginbot ;
  765.          blinkf := 0 ;              Saveblinkf    := blinkf ;
  766.          highf := 0 ;               Savehighf     := highf ;
  767.          Relcursor := false ;       Saverelcursor := relcursor ;
  768.          ANSI := true ;
  769.          Keypadnum := false ;
  770.          screenon := true ;
  771.          printon := false ;
  772.          Shiftin := false ;
  773.          G0 := ord('A') ;
  774.          G1 := ord('B') ;
  775.          Deccolm := false ;
  776.          Decscnm := false ;
  777.          for i := 0 to 24 do dwl[i] := false ;
  778.          newgraph := true ;
  779.          End ;   (* Initialize VT100 settings *)
  780.  
  781.     While KeyChar(achar,bchar) do ;    (* Empty keyboard buffer *)
  782.     While connected do
  783.          Begin (* connected *)
  784.          If RecvChar(achar) then
  785.               Begin (* got a modem char *)
  786.               if screenon then
  787.                if achar < $20 then
  788.                    Begin (* Control Character *)
  789.                    if achar = StartChar then  RemoteCommand
  790.                                         else
  791.                    Case achar of
  792.                    {EOT} $04 : connected := false ;
  793.                    {ESC} $1B : Escape ;
  794.                    {SO } $0E : shiftin := false ;
  795.                    {SI } $0F : shiftin := true ;
  796.                    {BS } $08 : If AplFlag then
  797.                         Begin (* Overstrick character *)
  798.                         overchar[0] := chr(2) ;
  799.                         If ReadMchar(achar) then overchar[2]:=chr(achar);
  800.                         i:=Pos(overchar,overchars);
  801.                         If i > 0 then  achar := ord(overchars[i+2])
  802.                                  else
  803.                               begin (* reverse order *)
  804.                               overchar[2] := overchar[1] ;
  805.                               overchar[1] := chr(achar);
  806.                               i:=Pos(overchar,overchars);
  807.                               If i>0 then achar := ord(overchars[i+2])
  808.                                      else achar := AplTable[ord(overchar[2])];
  809.                               end ; (* reverse order *)
  810.                         write(chr(BS),chr(achar));
  811.                         End  (* Overstrick character *)
  812.                                            else
  813.                         write(chr(achar));
  814.  
  815.                    {VT } $0B ,
  816.                    {FF } $0C ,
  817.                    {LF } $0A : if MarginBot = WhereY then
  818.                                    Scroll (Upward,Margintop-1,marginbot-1)
  819.                                                             else
  820.                                    write(chr(achar)) ;
  821.                    {BEL} $07,
  822.                    {CR } $0D : write(chr(achar)) ;
  823.                    {TAB} $09 :
  824.                         Begin (* tab character *)
  825.                         i:=WhereX ;
  826.                         If i<80 then
  827.                            Repeat  i:=i+1 ; CursorRight ;
  828.                            Until (Htab[i]='T') or (i>=80) ;
  829.                         End ; (* tab character *)
  830.                    {FS}  $1C ,
  831.                    {GS}  $1D ,
  832.                    {RS}  $1E ,
  833.                    {US}  $1F :  Tektronics (achar) ;
  834.  
  835.                     End ; (* Case of control char *)
  836.                    End   (* Control Character *)
  837.                              else
  838.                    If achar <> DEL then
  839.                              if AplFlag then begin (* APL char *)
  840.                                              write(chr(APLTABLE[achar]));
  841.                                              overchar[1] := chr(achar) ;
  842.                                              end
  843.                                         else  (* write normal char *)
  844.                         Begin (* Normal char *)
  845.                         If shiftin then G0G1 := G0 else G0G1 := G1 ;
  846.                         Case chr(G0G1) of
  847.                             'A' :  (* UK ascii set *)
  848.                                   If achar = $23 then achar := $9C ;
  849.                             'B' : ; (* normal ascii set *)
  850.                             '0' : If chr(achar) in ['a'..'z'] then
  851.                                     achar := Graphicset[achar-$60] ;
  852.                             '1' : ; (* Special set - not implemented *)
  853.                             '2' : ; (* Special set - not implemented *)
  854.                          end ; (* Case G0G1 *)
  855.                         If WhereX <> 80 then
  856.                              begin
  857.                              write(chr(achar));
  858.                              if dwl[WhereY-1] then write(' ');
  859.                              wrapit:=false;
  860.                              end
  861.                                         else
  862.                              if wrapit then
  863.                                   begin  (* Next line  *)
  864.                                   If MarginBot=WhereY then
  865.                                        begin (* Scroll up *)
  866.                                        Scroll (Upward,Margintop-1,marginbot-1);
  867.                                        GotoXY(1,WhereY);
  868.                                        end    (* Scroll up *)
  869.                                                        else
  870.                                        GotoXY(1,WhereY+1);
  871.                                   write(chr(achar));
  872.                                   wrapit := false ;
  873.                                   end   (* Next line *)
  874.                                          else
  875.                                   begin (* put char on col 80 *)
  876.                                   i := ((WhereY-1)*80 + 79)*2;
  877.                                   RealScreen^[i] := achar ;
  878.                                   RealScreen^[i+1]:=blinkf+(ColorofBack shl 4)
  879.                                                      +highf+ColorofText;
  880.                                   if Autowrap and Deccolm then wrapit := true ;
  881.                                   end ; (* put char on col 80 *)
  882.                         End ; (* Normal char *)
  883.               If printon then
  884.                   If achar = ESC then Escape
  885.                                  else if EscapeBindex = 0
  886.                                          then EscapeBindex := 1
  887.                                          else write(LST,chr(achar));
  888.               End ; (* got a modem char *)
  889.  
  890.          if KeyChar(achar,bchar) then
  891.               Begin (* key input *)
  892.               if bchar = $70 then achar := LocalChar else  (* Alt F9  *)
  893.               if bchar = $71 then achar := BreakChar else  (* Alt F10 *)
  894.               if (bchar >=$47) and (bchar<=$53) then
  895.                    If keypadnum then  achar := ord(KEYPADTABLE[bchar-70])
  896.                                 else  achar := 0 ;
  897.               If achar=0  then
  898.                    Begin (* Send escape sequence *)
  899.                    If EscSeq[Bchar,1]<>' ' then SendChar(Esc);
  900.                    If EscSeq[Bchar,1]<>' ' then
  901.                              SendChar(Ord(EscSeq[bchar,1])) ;
  902.                    If EscSeq[bchar,2]<>' ' then
  903.                              SendChar(Ord(EscSeq[bchar,2])) ;
  904.                    End  (* Send Escape Sequence *)
  905.                          else
  906.                    Begin (* Normal Key *)
  907.                    If EscapeFlag then
  908.                         if achar = $7B then AplFlag := true  else
  909.                         if achar = $7D then AplFlag := false ;
  910.                    Escapeflag := achar = ESC ;
  911.                    if achar = LocalChar then connected := false else
  912.                       if achar = BreakChar then
  913.                          Begin (* Break *)
  914.                          SendBreak;
  915.                          If CharsInBuffer > 100 then EmptyBuffer ;
  916.                          End  (* Break *)
  917.                                            else Sendchar(achar);
  918.                    if LocalEcho and connected then
  919.                              if AplFlag then write(chr(APLTABLE[achar]))
  920.                                         else write(chr(achar));
  921.                    End ; (* Normal Key *)
  922.  
  923.              End; (* key input *)
  924.          End; (* connected *)
  925.     LocalScreen ;  (* save remote screen , restore local screen *)
  926.     End ; (* Connection *)
  927. Begin (* Connect Unit *)
  928. ReadKeytable ;
  929. AplFlag := false ;
  930. End.  (* Connect Unit *)
  931.