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