Unit Tek4100 ;
(* ------------------------------------------------------------------ *)
(* Tektronics 4100  Graphics emulation unit                           *)
(* ------------------------------------------------------------------ *)
Interface
  Uses Crt,Graph,Printer,    (* Standard Turbo Pascal Units *)
       Fonts,Drivers,        (* Optional Turbo Pascal generated Units *)
       KGlobals,Sysfunc,
       Modempro,Packets;
  Const
    Gversion = ' a' ;
    enq = $05 ;    EQ = #$05 ;
    bel = $07 ;    BL = #$07 ;
    ff_ = $0C ;    FF = #$0C ;
    cr_ = $0D ;    CR = #$0D ;
    etb = $17 ;    EB = #$17 ;
    can = $18 ;    CN = #$18 ;
    sub = $1A ;    SB = #$1A ;
    esc = $1B ;    EC = #$1B ;
    fs_ = $1C ;    FS = #$1C ;
    gs_ = $1D ;    GS = #$1D ;
    rs_ = $1E ;    RS = #$1E ;
    us_ = $1F ;    US = #$1F ;
  Var
    NewGraph : Boolean ;
    Graphics : string [25] ;
    Afile    : file of byte ;
    filename : string[25] ;
    achar    : char ;

    Procedure Tektronics (lastbyte : byte) ;

Implementation
(* ------------------------------------------------------------------ *)
Type
     screen  = array [0..$7FFF] of byte ;

var  (* Tek 4100 variables *)
     tek4010                  : boolean ;
     abyte,bbyte              : byte ;
     result,
     Ysize                    : Integer ;
     BeginPanel               : boolean ;
     BeginPanelX,BeginPanelY,
     LastX,LastY,NewX,NewY,
     XDim,YDim,
     CursorX,CursorY,
     SGPosX,SGPosY,
     X1,X2,Y1,Y2,
     WindowX,WindowY          : integer ;
     Xscale,Yscale            : Real ;
     HiY, LoY, HiX, LoX,
     ExtraY, ExtraX           : byte ;
     NeedLoY,DrawVector       : Boolean ;

     GTslant,GTbackindex,
     GTdashindex,GTFont,
     height,
     GTwidth,GTheight,GTspacing,
     PickId,LineIndex,MarkerNumber,
     GTpath,FillPattern,GTprecision,
     Unknown1,Unknown2,Unknown3,
     Mantissa,Exponent,
     TextIndex,LineStyle,
     FixLevel,ErrorLevel,
     GTB_FontNumber,
     SegmentNum,OpenSegment,
     PixSurface,ALUmode,BitsPerPixel,
     DevFunCode,DistanceFilter,TimeFilter,
     ViewNumber,DAlines       : integer ;
     GTrotation               : real ;
     SurfaceNumber,
     ColorCoord1,ColorCoord2,ColorCoord3,
     ColorMode,ColorOverMode,GrayMode,
     ColorMixI,I :integer ;
     ColorMix                 : Array [1..64] of integer ;
     GINColor                 : shortint ;
     GTB_FontChar             : byte ;
     BoundfillPat,
     GINenable ,
     GAmode,DAenable,
     DAvisibility             : boolean ;
     PI                       : integer ;
     alphastr                 : string  ;
     alphacnt                 : integer ;
     GraphDriver,GraphMode    : integer ;
     palette                  : PaletteType ;
     PolyGon                  : array  [1..127] of PointType ;
     GraphScreen,SaveScreen   : ^screen ;
     SaveScreenP              : pointer ;
(* ------------------------------------------------------------------ *)
Procedure CrossHair ( X,Y : integer );
const    CrossX    = 24;
         CrossY    = 10;
var      x1,y1,x2,y2  :  integer;
    begin (* Cross Hair *)
    x1 := X - CrossX;  if x1 < 0 then x1 := 0;
    x2 := X + CrossX;  if x2 >= XDim then x2 := XDim - 1;
    y1 := Y - CrossY;  if y1 < 0 then y1 := 0;
    y2 := Y + CrossY;  if y2 >= Ydim then y2 := YDim - 1;
    for x1 := x1 to x2 do PutPixel(x1,(YDim-Y),GetPixel(x1,(YDim-Y)) xor $0F);
    for y1 := y1 to y2 do PutPixel(X,(YDim-y1),GetPixel(X,(YDim-y1)) xor $0F);
    end ; (* CrossHair *)

Procedure Mark( X,Y,Marktype : integer );
         Begin (* Mark  *)
         Case Marktype of
   0:  Begin { Dot }
       line(X,Y,X,Y);
       End ; { Dot }

   1:  Begin { Small Cross }
       Line(X,Y-2,X,Y+2);
       Line(X-2,Y,X+2,Y);
       End ; { Small Cross }

   2:  Begin { Cross }
       Line(X,Y-3,X,Y+3);
       Line(X-3,Y,X+3,Y);
       End ; { Cross }

   3:  Begin { Star  }
       Line(X-2,Y-2,X+2,Y+2);
       Line(X-2,Y+2,X+2,Y-2);
       Line(X,Y-3,X,Y+3);
       End ; { Star  }

   4:  Begin { Zero }
       Line(X-1,Y-4,X+1,Y-4);
       Line(X-2,Y-3,X-2,Y+3);
       Line(X+2,Y-3,X+2,Y+3);
       Line(X-1,Y+4,X+1,Y+4);
       End ; { Zero  }

   5:  Begin { X }
       Line(X-2,Y-3,X+2,Y+3);
       Line(X-2,Y+3,X+2,Y-3);
       End ; { X }

   6:  Begin { Square }
       Line(X-2,Y-2,X+2,Y-2);
       Line(X-2,Y+2,X-2,Y-2);
       Line(X+2,Y-2,X+2,Y+2);
       Line(X-2,Y+2,X+2,Y+2);
       End ; { Square  }

   7 : Begin { Diamond }
       Line(X-2,Y,X,Y-2);
       Line(X-2,Y,X,Y+2);
       Line(X,Y-2,X+2,Y);
       Line(X,Y+2,X+2,Y);
       End ; { Diamond  }

   8 : Begin { Square and Dot }
       Line(X-2,Y-2,X+2,Y-2);
       Line(X-2,Y+2,X-2,Y-2);
       Line(X+2,Y-2,X+2,Y+2);
       Line(X-2,Y+2,X+2,Y+2);
       Line(X,Y,X,Y);
       End ; { Square and Dot }

   9 : Begin { Diamond and Dot }
       Line(X-2,Y,X,Y-2);
       Line(X-2,Y,X,Y+2);
       Line(X,Y-2,X+2,Y);
       Line(X,Y+2,X+2,Y);
       Line(X,Y,X,Y);
       End ; { Diamond and Dot }

   10: Begin { Square and cross }
       Line(X-2,Y-2,X+2,Y-2);
       Line(X-2,Y+2,X-2,Y-2);
       Line(X+2,Y-2,X+2,Y+2);
       Line(X-2,Y+2,X+2,Y+2);
       Line(X-1,Y-1,X-1,Y-1);
       Line(X-1,Y+1,X-1,Y+1);
       Line(X+1,Y-1,X+1,Y-1);
       Line(X+1,Y+1,X+1,Y+1);
       End ; { Square and cross }
          End ; (* case marktype *)
         End ; (* Mark  *)

 (* ----------------------------------------------------------------- *)

(* ****************************************************************** *)
Procedure Tektronics (lastbyte : byte) ;
 Const
    BitCheck = $60 ;
    LoYBit   = $60 ;
    LoXBit   = $40 ;
    HiBit    = $20 ;
    Bit6     = $20 ;
    FiveBits = $1F ;
    pattern : array [0..3] of word  = ($FFF0,$333F,$7FE6,$F0F0);
 Var
    TekState, Done,
    TEK4014LineStyle : boolean ;
    abyte            : byte ;
    achar            : char ;
    Temp,ix          : Integer ;
 Label VectorMode,VectorContinue,exit ;

    (* --------------------------------------------------------------- *)
    Procedure GetCoord(var X,Y : integer);
    label exit ;
    BEGIN (* Get X,Y Coordinates *)
    NeedLoY := false ;
    IF (abyte and BitCheck) = HiBit THEN
         Begin (* HiY *)
         HiY := abyte and FiveBits ;
         If ReadMchar(abyte) then else goto exit;
         End ;  (* HiY *)
   IF (abyte and BitCheck) = LoYBit   THEN
         BEGIN  (* LoYBit *)
         LoY := abyte and FiveBits;
         IF  (abyte and $10) = 0 then
              begin (* Assume Extra bits *)
              ExtraX := abyte and $03 ;
              ExtraY := (abyte and $0C) shr 2 ;
              NeedLoY := true ;
              end  (* Assume Extra bits *)
                                  else
              LoY := abyte and FiveBits;
         If ReadMchar(abyte) then else goto exit;
         END ;   (* LoYBit or Extra Bit *)
   IF ((abyte and BitCheck) = LoYBit)   THEN
         BEGIN  (* LoYBit *)
         LoY := abyte and FiveBits;
         NeedLoY := false ;
         If ReadMchar(abyte) then else goto exit ;
         End    (* LoYBit *)
                                      ELSE
         If NeedLoY  then
              Begin  {Extra bit was really LoY bits }
              NeedLoY := false ;
              ExtraX := 0 ;
              ExtraY := 0 ;
              End ;
      IF (abyte and BitCheck) = HiBit THEN
         Begin (* HiX *)
         HiX := abyte and FiveBits ;
         If ReadMchar(abyte) then else goto exit;
         End ; (* HiX *)
    IF (abyte and BitCheck) = LoXBit THEN
         BEGIN  (* LoXBit *)
         LoX := abyte and FiveBits;
         X := ((HiX shl 5 + LoX) shl 2 ) + ExtraX ;
         Y := ((HiY shl 5 + LoY) shl 2 ) + ExtraY ;
         END ; (* LoXBit *)
exit :
      END ; (* Get X,Y Coordinates *)
(* ------------------------------------------------------------------ *)
Function GetInteger : integer ;
var Hi1,Hi2,Low : byte ;
label exit ;
     Begin (* GetInteger *)
     Hi1 := 0 ; Hi2 := 0 ; Low := 0 ;
     If ReadMchar(abyte) then else goto exit;
     If (abyte and $40) <> 0 then
        begin (* Hi byte *)
        Hi1 := (abyte and $3F);
        If ReadMchar(abyte) then else goto exit;
        if (abyte and $40) <> 0 then
            begin (* Hi2 byte *)
            Hi2 := Hi1 ;
            Hi1 := abyte and $3F ;
            If ReadMchar(abyte) then else goto exit ;
            end ; (* Hi2 byte *)
        end ; (* Hi byte *)
        Low := abyte and $0F ;
        if (abyte and $10) <> 0 then
            GetInteger := Hi2 shl 10 + Hi1 shl 4 + Low
                                 else
            GetInteger := 0 - (Hi2 shl 10 + Hi1 shl 4 + Low) ;
exit :
     End ; (* GetInteger *)
(* -------------------------------------------------------------------- *)
    Function HLScolor(Hue,Lightness,Saturation : integer): integer;
     (* This function returns a color value (0-15) for a given  *)
     (*   Hue,Lightness,and Saturation                          *)
     Const
      HueTable : array [0..12] of integer =(Blue,magenta,red,brown,green,cyan,
           LightBlue,lightmagenta,lightred,yellow,lightgreen,lightCyan,blue);
        Begin (* HLS color *)
    (* Check Lightness 100 for white , 0 for Black *)
    if Lightness = 100 then HLSColor := white
                       else
      if Lightness =  0  then HLSColor := black
                         else
        if Saturation =  0 then  (* no color - GRAY *)
               if Lightness >= 50 then HLSColor := LightGray
                                  else HLSColor := DarkGray
                           else
        If Lightness < 50 then
            HLSColor := HueTable[(Hue+30) div 60 ]
                          else
            HLSColor := HueTable[((Hue+30) div 60)+6];
    End ; (* HLS color *)
(* ------------------------------------------------------------------------ *)
    Function PaletteIndex ( Color : shortint) : shortint ;
    (* This function returns the PaletteIndex for a given color.          *)
    (* If the color is not found in the Palette, the index is set to one. *)
    Var Pal : PaletteType ;
        i : shortint ;
    Label exit ;
    Begin (* PaletteIndex *)
    GetPalette(Pal);
    For i := 0 to Pal.Size-1 do
       If Pal.Colors[i] = Color then goto exit ;
    i := 1 ;
Exit :
    PaletteIndex := i ;
    End ; (* PaletteIndex *)
(* ------------------------------------------------------------------------ *)
    Procedure GIN ;
    var Done      : boolean ;
        XGin,YGin : integer ;
        SaveColor : shortint ;
    Begin  (* GIN - Graphics INput *)
    Done := false;
      repeat
         begin (* move cursor *)
         SaveColor := GetColor ;
         SetColor(PaletteIndex(GINcolor));
         CrossHair(CursorX, CursorY);  {draw it}
         REPEAT UNTIL KeyChar(abyte,bbyte);
         CrossHair(CursorX, CursorY);  {erase it}
           if abyte = 0 then
              begin {special key}
              case bbyte of
              $48: begin {up arrow}
                   CursorY := CursorY + 1 ;
                   if CursorY >= YDim then  CursorY := (YDim - 1) ;
                   end;  {up arrow}
              $4B: begin {left arrow}
                   CursorX := CursorX - 1 ;
                   if CursorX < 0 then CursorX := 0;
                   end ; {left arrow}
              $4D: begin {right arrow}
                   CursorX := CursorX + 1 ;
                   if CursorX >= XDim then CursorX := (XDim - 1) ;
                   end; {right arrow}
              $50: begin {down arrow}
                   CursorY := CursorY - 1 ;
                   if CursorY < 0 then CursorY := 0;
                   end; {down arrow}
              $4F: begin {END}
                   Done := true;
                   SendChar($0D);
                   end; {END}
                        else
                            {not recognized}
               end (* of case *);
               end { special key }
                              else
         begin (* send cursor location *)
         SendChar(abyte);
         if tek4010 then
              begin (* TEK4010 GIN *)
              XGin := Round(CursorX / XScale) shr 2 ;
              SendChar((XGin shr 5) or Bit6 ) ;      (* Hi X *)
              SendChar((XGin and FiveBits) or Bit6); (* Lo X *)
              YGin := Round(CursorY / YScale) shr 2 ;
              SendChar((YGin shr 5) or Bit6 ) ;      (* Hi Y *)
              SendChar((YGin and FiveBits) or Bit6); (* Lo Y *)
              SendChar($0D);
              Done := True;
              end  (* TEK4010 GIN *)
                    else
              begin (* TEK4100 GIN *)
              YGin := Round((CursorY / YScale) * (4096 / windowY));
              XGin := Round((CursorX / XScale) * (4096 / windowX));
              SendChar(((YGin shr 7) and FiveBits) or Bit6); (* Hi Y *)
              SendChar(((YGin and $03) shl 2) or
                       (XGin and $03) or $60 );             (* Extra bits *)
              SendChar(((YGin shr 2) and FiveBits) or $60 ); (* Lo Y *)
              SendChar(((XGin shr 7) and FiveBits) or Bit6); (* Hi X *)
              SendChar(((XGin shr 2) and FiveBits) or $40 ); (* Lo X *)
              SendChar($0D);
              Done := True;
              end  (* TEK4100 GIN *)
         end; (* send cursor location *)
      end until Done;  (* move cursor *)
      SetColor(SaveColor);
    End ; (* GIN - Graphics INput *)

         Function PNumber (var abyte : byte) : integer ;
          var Num  : integer ;
              Begin (* PNumber *)
              Num := 0  ;
              While chr(abyte) in ['0'..'9']  do
                   Begin (* get number *)
                   Num := (Num * 10) + (abyte-$30) ;
                   If ReadMchar(abyte) then ;
                   End ; (* get number *)
              PNumber := Num ;
              End ; (* PNumber *)

(* ==================== Graphic Escape State ======================= *)
Procedure TekEscapeSeq ;
var  Pn      : array [1..10] of Integer ;
     i,j,k   : integer ;
     tempstr : string[3] ;
label getnum,NextNum,DoCase,exit ;

    Begin (* Graphic Escape State *)
     (*    savescreen^ := GraphScreen^ ; *)
     (*   GetImage(0,0,Xdim,Ydim,SaveScreenP^);  *)
    If ReadMchar(abyte) then else goto exit;
           case chr(abyte) of
    FF :     (* PAGE *)
              begin
              newgraph := true ;
         (*     repeat until keypressed ;
              achar := readkey ;        *)
              end ;
    SB :     (* Enable 4010 GIN *)
             GIN ;
    CR :     outtext(' UNKNOWN ') ; (* unknown *)
    '[':  Begin (* Left square bracket *)
          SetTextStyle(SmallFont,0,4) ;
             If ReadMchar(abyte) then
               CASE chr(abyte) of   (* Second level *)
                 'A': CursorUp ;
                 'B': CursorDown ;
                 'C': CursorRight ;
                 'D': CursorLeft  ;
                 'J': ; (* Erase End of Display *)
                 'K': ; (* Erase End of Line *)
                 '?': If ReadMchar(abyte) then
                        goto Getnum; (* Modes  *)
                 'f',
                 'H': Moveto(1,1);  (* Cursor Home *)
                 'g': ; (* Cleartab *)
                 '}',
                 'm': begin (* Normal Video - Exit all attribute modes *)
                      SetColor(LightGray);
                      end ; (* Normal Video - Exit all attribute modes *)
                 'r': begin (* Reset Margin *)
                      Moveto(1,1);
                      end ; (* Reset Margin *)

                 'c','h','l','n',
                 'x': Begin Pn[1] := 0 ; Goto DoCase ; End ;
                 ';': Begin Pn[1] := 0 ; k := 1 ; Goto nextnum ; End ;
                else  (* Pn - got a number *)
Getnum:              Begin (* Esc [ Pn...Pn x   functions *)
                     Pn[1] := PNumber(abyte);
                     k := 1 ;
Nextnum:             While abyte = ord(';') do
                        Begin (* get Pn[k] *)
                        If ReadMchar(abyte) then
                        If chr(abyte) = '?' then
                           If ReadMchar(abyte) then ; (* Ignore '?'  *)
                        k:=k+1 ;
                        Pn[k] := PNumber(abyte);
                        End  ; (* get Pn[k] *)
                     Pn[k+1] := 1 ;
DoCase:              CASE chr(abyte) of (* third level *)
                        'A': MoveTo(GetX,GetY-Pn[1]) ;  { Cursor Up   }
                        'B': MoveTo(GetX,GetY+Pn[1]) ;  { Cursor Down }
                        'C': MoveTo(GetX+Pn[1],GetY) ;  { Cursor Right}
                        'D': MoveTo(GetX-Pn[1],GetY) ;  { Cursor Left }
                        'f',
                        'H': Begin (* Direct cursor address *)
                             If Pn[2] = 0 then Pn[2] := 1 ;
                             If Pn[2] > 80 then Pn[2] := 80 ;
                             Moveto(Pn[2]*(XDim div 80),Pn[1]*(Ydim div 24));
                             End ;(* Direct cursor address *)
                        'c': Begin (* Device Attributes *)
                             (* Send  Esc[?1;0c *)
                             Sendchar(Esc); Sendchar(ord('['));
                             Sendchar(ord('?')); Sendchar(ord('1'));
                             Sendchar(ord(';')); Sendchar(ord('0'));
                             Sendchar(ord('c'));
                             End ; (* Device Attributes *)
                        'g': (* clear tabs *) ;
                        'h': (* Set Mode *) ;
                        'l': (* Reset Mode *) ;
                        'i': Begin (* Printer Screen  on / off *)
                             End ;  (* Printer Screen  on / off *)

                        'q': FatCursor(Pn[1]=1); (* for series/1 insert mode *)
                        'n': If Pn[1] = 5 then
                                  Begin (* Device Status Report *)
                                  (* Send  Esc[0n *)
                                  Sendchar(Esc);Sendchar(ord('['));
                                  Sendchar(ord('0'));Sendchar(ord('n'));
                                  End   (* Device Status Report *)
                                       else
                             If Pn[1] = 6 then
                                  Begin (* Cursor Position Report *)
                                  Sendchar(Esc);Sendchar(ord('['));
                                  STR(WhereY,tempstr);     (* ROW *)
                                  Sendchar(ord(tempstr[1]));
                                  If length(tempstr)=2 then
                                       Sendchar(ord(tempstr[2]));
                                  Sendchar(ord(';'));
                                  STR(WhereX,tempstr);     (* COLUMN *)
                                  Sendchar(ord(tempstr[1]));
                                  If length(tempstr) = 2 then
                                       Sendchar(ord(tempstr[2]));
                                  Sendchar(ord('R'));
                                  End ; (* Cursor Position Report *)
                        'x': If Pn[1]<=1 then
                              Begin (* Request terminal Parameters *)
                              Sendchar(Esc); Sendchar(ord('['));
                              If Pn[1] = 0 then Sendchar(ord('2'))
                                           else Sendchar(ord('3')); (* sol *)
                              Sendchar(ord(';'));  (* parity *)
                              If parity = OddP  then Sendchar(ord('4'))
                                                else
                              If parity = EvenP then Sendchar(ord('5'))
                                                else Sendchar(ord('1')) ;
                              Sendchar(ord(';'));
                              Sendchar(ord('2'));   (* nbits *)
                              Sendchar(ord(';'));
                              For j := 1 to 2 do
                                 Begin (* Xspeed ,Rspeed *)
                                   Case baudrate of
                              300 : begin Sendchar(ord('4'));
                                    Sendchar(ord('8')); end ;
                              600 : begin Sendchar(ord('5'));
                                    Sendchar(ord('6')); end ;
                             1200 : begin Sendchar(ord('6'));
                                    Sendchar(ord('4')); end ;
                             2400 : begin Sendchar(ord('8'));
                                    Sendchar(ord('8')); end ;
                             4800 : begin Sendchar(ord('1'));
                                    Sendchar(ord('0'));
                                    Sendchar(ord('4')); end ;
                             9600 : begin Sendchar(ord('1'));
                                    Sendchar(ord('1'));
                                    Sendchar(ord('2')); end ;
                            19200 : begin Sendchar(ord('1'));
                                    Sendchar(ord('2'));
                                    Sendchar(ord('0')); end ;
                                   end; (* case *)
                                Sendchar(ord(';'));
                                End ;  (* Xspeed ,Rspeed *)

                             Sendchar(ord('1'));  (* clkmul *)
                             Sendchar(ord(';'));
                             Sendchar(ord('0'));  (* flags *)
                             Sendchar(ord('x'));
                             End ; (* Request terminal Parameters *)
                        'm',
                        '}': For j := 1 to k do
                             Case Pn[j] of      (* Field specs *)
                             0: begin (* Normal *)
                                SetColor(LightGray) ;
                                end ;
                             1: begin (* High Intensity *)
                                SetColor(White) ;
                                end ;
                             4: SetColor(LightBlue) ;   (* Underline *)

                             5: begin (* Blink *)
                                end ;
                             7: begin (* Reverse *)
                                end ;
                             8: Begin (* Invisible *)
                                 SetColor(Black);
                                 SetBkColor(Black);
                                 end ;
                            30: SetColor(Black);
                            31: SetColor(Red);
                            32: SetColor(Green);
                            33: SetColor(brown);
                            34: SetColor(Blue);
                            35: SetColor(Magenta);
                            36: SetColor(Cyan);
                            37: SetColor(Lightgray);

                            40: SetBkColor(Black);
                            41: SetBkColor(Red);
                            42: SetBkColor(Green);
                            43: SetBkColor(Brown);
                            44: SetBkColor(Blue);
                            45: SetBkColor(Magenta);
                            46: SetBkColor(Cyan);
                            47: SetBkColor(LightGray);
                             End ; (* case of Field specs *)
                        'r': Begin  (* set margin *)
                             End ; (* Set margin *)
                        'J': Case Pn[1] of
                             0:  ; (* clear to end of screen *)
                             1:  ; (* clear to beginning *)
                             2:  ;   (* clear all of screen *)
                             End ; (*  J - Pn Case *)
                        'K': Case Pn[1] of
                             0:  ; (* clear to end of line *)
                             1:  ; (* clear to beginning *)
                             2:  ; (* clear line *)
                             End ; (*  J - Pn  Case *)
                        'L': For i := 1 to Pn[1] do (* Insert Line *) ;
                        'M': For i := 1 to Pn[1] do (* Delete Line *) ;
                        '@': For i := 1 to Pn[1] do (* InsertChar *)  ;
                        'P': For i := 1 to Pn[1] do (* DeleteChar *)  ;
                     End ; (* Case third level *)
                     End ; (* Esc [ Pn...Pn x   functions *)

               End ; (* second level Case *)
              End ; (* Left square bracket *)

    '%':     Begin (* Select Code *)
              If ReadMchar(abyte) then else goto exit ;
              if abyte = ord('!') then
                 begin (* get code *)
                 If ReadMchar(abyte) then else goto exit;
                 case chr(abyte) of
              '0' : Begin
                    TekState := True ;     { TEK  }
                    Ysize := 4096 ;
                    Yscale := YDim / Ysize ;
                    End ;
              '1' ,                        { ANSI }
              '2' ,                        { EDIT }
              '3' : TekState := false ;    { VT52 }
                  end ; (* case *)
                 end ; (* get code *)
             End ; (* Select Code *)
    '#':      (* Report syntax Mode *) ;

    '8',
    '9',
    ':',
    ';':      (* Set 4014 Alpha text size *) ;

    CN :      (* Enter Bypass Mode *) ;
    EB :      (* 4010 Hardcopy *) ;
    EQ :      (* Report 4010 Status *) ;

    'I' :     Begin (* I cases *)
              If ReadMchar(abyte) then else goto exit ;
              Case chr(abyte) of
              'A' : { set pick Aperture } ;
              'C' : { set GIN Cursor } ;
              'D' : { Disable GIN }
                    GINenable := False ;
              'E' : Begin { Enable GIN }
                    write(chr(bel));
                    GINenable := True ;
                    GIN ;
                    End ; { Enable GIN }
              'F' : Begin { Set GIN stroke Filtering }
                    DevFunCode := GetInteger ;
                    DistanceFilter := GetInteger ;
                    TimeFilter := GetInteger ;
                    End ; { Set GIN stroke Filtering }
              'G' : { Set GIN Gridding } ;
              'I' : { Set GIN Inking } ;
              'L' : { Set report max Line length } ;
              'M' : { set report EOM frequency } ;
              'P' : { report GIN point } ;
              'Q' : { report Terminal settings } ;
              'R' : { set GIN rubberbanding } ;
              'S' : { set report signature characters } ;
              'V' : { set GIN area } ;
              'W' : { set GIN Window } ;
              'X' : { set GIN display start Point } ;
              end ; (* I sub cases *)
              End ; (* I cases *)

    'J' :     Begin (* J cases *)
              If ReadMchar(abyte) then else goto exit ;
              Case chr(abyte) of
              'C' : { Copy } ;
              'Q' : { report device status } ;
              end ; (* J subcases *)
              End ; (* J cases *)

    'K' :     Begin (* K cases *)
              If ReadMchar(abyte) then else goto exit ;
              Case chr(abyte) of
              'A' : Begin { enable dialog area }
                    DAenable := (GetInteger = 1) ;
                    End ; { enable dialog area }
              'B' : { set tab stops } ;
              'C' : { cancel } ;
              'D' : { define macro } ;
              'E' : { set echo } ;
              'F' : { lfcr } ;
              'H' : { hardcopy } ;
              'I' : { ignore deletes } ;
              'L' : { lock keyboard } ;
              'N' : Begin { renew view }
                    ViewNumber := GetInteger ;
                    ClearDevice ;
                    End ; { renew view }
              'O' : { define nonvolatile macro } ;
              'Q' : { report errors } ;
              'R' : { crlf } ;
              'S' : { set snoopy mode } ;
              'T' : Begin { set error threshold }
                    ErrorLevel := GetInteger ; (* valid values 0-4 *)
                    End ; { set error threshold }

              'U' : { save nonvolatile parameters } ;
              'V' : { reset } ;
              'W' : { enable keyboard expansion } ;
              'X' : { expand macro } ;
              'Y' : { set key execte character } ;
              'Z' : { set edit characters } ;
              end ; (* K subcases *)
              End ; (* K cases *)

    'L' :     Begin (* L cases *)
              If ReadMchar(abyte) then else goto exit ;
              Case chr(abyte) of
              'B' : { set dialog area buffer size } ;
              'E' :  Begin { End Panel }
                     Line ( Round(LastX * Xscale),Round(LastY * Yscale),
                           Round(BeginPanelX  * Xscale),
                           Round(BeginPanelY  * Yscale) );
                    FillPoly(Pi,PolyGon) ;
                    BeginPanel := False ;
                    End ; { End panel }
              'F' : Begin { Move }
                    If ReadMchar(abyte) then else goto exit;
                    GetCoord(X1,Y1);
                    LastX := X1 * (4096 div windowx) ;
                    LastY := Ysize - (Y1 * (4096 div windowY)) ;
                    End ; { Move }
              'G' : Begin { draw }
                    If ReadMchar(abyte) then else goto exit;
                    GetCoord(X1,Y1);
                    NewX := X1 * (4096 div windowx) ;
                    NewY := Ysize - (Y1 * (4096 div windowy )) ;
                    Line ( Round(LastX * Xscale),Round(LastY * Yscale),
                           Round(NewX  * Xscale),Round(NewY  * Yscale) ) ;
                    LastX := NewX;
                    LastY := NewY;
                    End ; { draw }
              'H' : { draw marker } ;
              'I' : { set dialog area index } ;
              'L' : Begin { set dialog area lines }
                    DAlines := GetInteger ;
                    End ; { set dialog area lines }
              'M' : { set dialog area write mode } ;
              'P' : Begin { begin panel boundary }
                    BeginPanel := True ;
                    If ReadMchar(abyte) then else goto exit;
                    GetCoord(X1,Y1);    { first point }
                    BeginPanelX := X1 * (4096 div windowx) ;
                    BeginPanelY := Ysize - (Y1 * (4096 div windowY)) ;
                    LastX := BeginPanelX ;
                    LastY := BeginPanelY ;
                    Boundfillpat := GetInteger = 0  { use fill pattern }
                                         ; { else Use current line style }
                    PI := 1 ;
                    PolyGon[pi].X := Round(BeginPanelX * xscale );
                    PolyGon[pi].Y := Round(BeginPanelY * yscale );
                    End ; { begin panel boundary }
              'T' : Begin { graphic text }
                    AlphaCnt := GetInteger ;
                    if alphacnt > 255 then alphacnt := 255;
                    For I := 1 to AlphaCnt do
                        Begin
                        If ReadMchar(abyte) then else goto exit;
                        AlphaStr[I] := chr(abyte);
                        End;
                    AlphaStr[0] := Chr(AlphaCnt) ;
                    OutTextXY(Trunc(LastX*Xscale),
                              Trunc(LastY*Yscale)-textheight('X'),AlphaStr);
                    AlphaStr := ' ';
                    DrawVector := false ;
                    End ; { graphic text }
              'V' : Begin { set dialog area visibility }
                    If ReadMchar(abyte) then else goto exit;
                    DAvisibility :=  abyte = ord('1') ;
                    End ; { set dialog area visibility }
              'Z' : { clear dialog scroll } ;
              end ; (* L subcases *)
              End ; (* L cases *)

    'M' :     Begin (* M cases *)
              If ReadMchar(abyte) then else goto exit ;
              Case chr(abyte) of
              'A' : Begin { set graphtext slant }
                    GTslant := GetInteger ;
                    End ; { set graphtext slant }
              'B' : Begin { set background indices }
                    GTbackindex := GetInteger ;
                    GTdashindex := GetInteger ;
                    End ; { set background indices }
              'C' : Begin { set graph text size }
                    GTwidth := GetInteger ;
                    GTheight := GetInteger ;
                    GTspacing := GetInteger ;
                  SetUserCharSize((GTwidth+GTspacing)*(4096 div windowX),
                      Round(22400/xdim),GTheight*Round(Ysize/windowY),
                       Round(20000/ydim));
                    SetTextStyle(SmallFont,0,UserCharSize) ;
                    End ; { set graph text size }
              'F' : Begin { set graph text font }
                    GTFont := GetInteger ;
                    End ; { set graph text font }
              'G' : Begin { set graphics area writing mode }
                    GAmode := (GetInteger = 1 ) ;
                    End ; { set graphics area writing mode }
              'I' : Begin { set pick id }
                    PickId := GetInteger ; (* value 0 to 32767 *)
                    End ; { set pick id }
              'L' : Begin { set line index }
                    LineIndex := GetInteger ; (* value 0 to 15 *)
                    if LineIndex > 15 then LineIndex := 15 ;
                    SetColor(LineIndex);
                    End ; { set line index }
              'M' : Begin { set line marker type }
                    MarkerNumber := GetInteger ; (* value 0 to 10 *)
                    End ; { set line marker type }
              'N' : Begin { set character path }
                    GTpath := GetInteger ; (* value 0 to 4 *)
                    End ; { set character path }
              'P' : Begin { select fill pattern }
                    Fillpattern := GetInteger ;  (* value -15 to 174 *)
                    If Fillpattern < 0 then
                        SetFillStyle(1,-Fillpattern)
                                       else
                        SetFillStyle(Fillpattern,1);
                    End ; { select fill pattern }
              'Q' : Begin { set graph text precision }
                    GTprecision := GetInteger ; (* value 1 or 2 *)
                    End ; { set graph text precision }
              'R' : Begin { set graph text rotation }
                    Mantissa := GetInteger ; (* value -32767 to 32767 *)
                    Exponent := GetInteger ;
                 (*   GTRotation := (Mantissa * (2 ** Exponent); *)
                    End ; { set graph text rotation }
              'S' : Begin { UNKNOWN }
                    Unknown1 := GetInteger ;
                    Unknown2 := GetInteger ;
                    Unknown3 := GetInteger ;
                    End ;{ UNKNOWN }
              'T' : Begin { set text index }
                    TextIndex := GetInteger ; (* value 0 to 15 *)
                    If TextIndex > 15 then TextIndex := 15 ;
                    SetColor(TextIndex);
                    End ; { set text index }
              'V' : Begin  { set line style }
                    LineStyle := GetInteger ; (* value 0 to 7 *)
                    If LineStyle > 3 then
                    SetLineStyle(4,pattern[linestyle and $03],normWidth)
                                     else
                    SetLineStyle(LineStyle,
                                 pattern[linestyle and $03],normWidth);
                    End ;  { set line style }
               end ; (* M subcases *)
              End ; (* M cases *)

    'N' :     Begin (* N cases *)
              If ReadMchar(abyte) then else goto exit ;
              Case chr(abyte) of
              'B' : { set stop bits } ;
              'C' : { set eom characters } ;
              'D' : { set transmit delay } ;
              'E' : { set eof string } ;
              'F' : { set flagging mode } ;
              'G' : Unknown1 := GetInteger ;  { UNKNOWN }
              'K' : { set break time } ;
              'L' : { set transmit limit } ;
              'M' : { prompt mode } ;
              'P' : { set parity } ;
              'Q' : { set queue size } ;
              'R' : { set baud rates } ;
              'S' : { set prompt string } ;
              'T' : { set eol string } ;
              'U' : { set bypass cancel character } ;
               end ; (* N subcases *)
              End ; (* N cases *)

    'P' :     Begin (* P cases *)
              If ReadMchar(abyte) then else goto exit ;
              Case chr(abyte) of
              'A' : { port assign } ;
              'B' : { set port stop bits } ;
              'E' : { set port eof string } ;
              'F' : { set port flagging mode } ;
              'I' : { map index to pen } ;
              'L' : { plot } ;
              'M' : { set port eol string } ;
              'P' : { set port parity } ;
              'Q' : { report port status } ;
              'R' : { set port baud rate } ;
              end ; (* P subcases *)
              End ; (* P cases *)

    'Q' :     Begin (* Q cases *)
              If ReadMchar(abyte) then else goto exit ;
              Case chr(abyte) of
              'A' : { set copy size } ;
              'D' : { select hardcopy interface } ;
              'L' : { set dialog hardcopy attributes } ;
               end ; (* Q subcases *)
              End ; (* Q cases *)

    'R' :     Begin (* R cases *)
              If ReadMchar(abyte) then else goto exit ;
              Case chr(abyte) of
              'A' : { set view attribute } ;
              'C' : { select view } ;
              'D' : { set surface definitions } ;
              'E' : { set border visibility } ;
              'F' : Begin { set fixup level }
                    FixLevel := GetInteger ;
                    End ; { set fixup level }
              'H' : { set pixel beam position } ;
              'I' : { set surface visibility } ;
              'J' : { lock viewing keys } ;
              'K' : Begin { delete view }
                    ViewNumber := GetInteger ;
                    End ; { delete view }
              'L' : { runlength write } ;
              'N' : { set surface priority } ;
              'P' : { raster write } ;
              'Q' : { set view display cluster } ;
              'R' : { rectangle fill } ;
              'S' : { set pixel viewport } ;
              'U' : Begin { begin pixel operation }
                    PixSurface := GetInteger ;
                    ALUmode := GetInteger ;
                    BitsPerPixel := GetInteger ;
                    End ; { begin pixel operation }
              'V' : Begin { set view port }
                    If ReadMchar(abyte) then else goto exit;
                    GetCoord(X1,Y1);
                    If ReadMchar(abyte) then else goto exit;
                    GetCoord(X2,Y2) ;
                    End ; { set view port }
              'W' : Begin { set window }
                    If ReadMchar(abyte) then else goto exit;
                    GetCoord(X1,Y1);
                    If ReadMchar(abyte) then else goto exit;
                    GetCoord(X2,Y2) ;
                    WindowX := X2-X1;
                    WindowY := Y2-Y1;
                    End ; { set window }
              'X' : { pixel copy } ;
               end ; (* R subcases *)
              End ; (* R cases *)

    'S' :     Begin (* S cases *)
              If ReadMchar(abyte) then else goto exit ;
              Case chr(abyte) of
              'A' : { set segment class } ;
              'B' : { begin lower segment }
                     SegmentNum := SegmentNum - 1 ;
              'C' : { end segment } ;
              'D' : { set segment detectablity } ;
              'E' : Begin { begin new segment }
                    SegmentNum := GetInteger ;
                    End ; { begin new segment }
              'H' : { set segment highlighting } ;
              'I' : { set segment image transform } ;
              'K' : Begin { delete segment }
                    SegmentNum := GetInteger ;
                    End ; { delete segment }
              'L' : { set current matching class } ;
              'M' : { set segment writing mode } ;
              'N' : { begin higher segment }
                    SegmentNum := SegmentNum + 1 ;
              'O' : Begin { begin segment }
                    OpenSegment := GetInteger ;
                    End ; { begin segment }
              'P' : { set pivot point } ;
              'Q' : { report segment status } ;
              'R' : { rename segment } ;
              'S' : { set segment display priority } ;
              'T' : Begin { begin graphtext character }
                    If ReadMchar(abyte) then else goto exit;
                    GTB_FontNumber := GetInteger ;
                    If ReadMchar(abyte) then else goto exit;
                    GTB_FontChar := abyte ;
                    End ; { begin graphtext character }
              'U' : { end graphtext character } ;
              'V' : { set segment visibilty } ;
              'X' : Begin { set segment position }
                    SegmentNum := GetInteger ;
                    If ReadMchar(abyte) then else goto exit;
                    GetCoord(SGPosX,SGPosY);
                    End ; { set segment position }
               end ; (* S subcases *)
              End ; (* S cases *)

    'T' :     Begin (* T cases *)
              If ReadMchar(abyte) then else goto exit ;
              Case chr(abyte) of
              'B' : Begin { set background color }
                    ColorCoord1 := GetInteger ;
                    ColorCoord2 := GetInteger ;
                    ColorCoord3 := GetInteger ;
                    SetBKcolor(PaletteIndex(HLSColor(ColorCoord1,
                                        ColorCoord2,ColorCoord3))) ;
                    End ; { set background color }
              'C' : Begin { set GIN cursor color }
                    ColorCoord1 := GetInteger ;
                    ColorCoord2 := GetInteger ;
                    ColorCoord3 := GetInteger ;
                    GINcolor := PaletteIndex(HLSColor(ColorCoord1,
                                        ColorCoord2,ColorCoord3)) ;
                    End ; { set GIN cursor color }
              'D' : { set alpha cursor indices } ;
              'F' : { set dialog area color map } ;
              'G' : Begin { set surface color  map }
                    (* surfacenumber(-1to4) , numberofintegers (4),
                       colorindex(0-15),Hue,Lightness,Saturation *)
                    SurfaceNumber := GetInteger ;
                    ColorMixI := GetInteger ;
                    For I := 1 to ColorMixI do
                      ColorMix[I] := GetInteger ;
                    I := 1 ;
                    While I  < ColorMixI  do
                        Begin (* Set Color for Colorindex *)
                        (* ColorMix[I]   = ColorIndex *)
                        (* ColorMix[I+1] = Hue        *)
                        (* ColorMix[I+2] = Lightness  *)
                        (* ColorMix[I+3] = Saturation *)
                        SetPalette(ColorMix[I],
                         HLSColor(ColorMix[I+1],ColorMix[I+2],ColorMix[I+3]));
                        I := I + 4 ;
                        End ; (* Set Color for Colorindex *)
                    End ; { set surface color  map }
              'M' : Begin { set color mode }
                    ColorMode := GetInteger ;
                    ColorOverMode := GetInteger ;
                    GrayMode := GetInteger ;
                    End ; { set color mode }
              end ; (* T subcases *)
              End ; (* T cases *)
    '`','a','b','c','d','e','f','g','h','i','j','k','l','m','n','o' :
              Begin (* Set 4014 Line Style *)
              LineStyle := abyte - $60 ; (* value 0 to 15 *)
              If LineStyle>7 then LineStyle := LineStyle - 8 ;
                    If LineStyle > 3 then
              SetLineStyle(4,pattern[linestyle and $03],normWidth)
                               else
              SetLineStyle(LineStyle,pattern[linestyle and $03],normWidth);
              TEK4014Linestyle := true ;
              End ; (* Set 4014 Line Style *)
       else
   exit :
             End ; (* case abyte *)
         End ; (* Graphic Escape State *)
(* ================================================================= *)

Begin (* Tektronics Procedure *)
 (* delay(9000);   add delay to bypass 449 bug *)
TekState := true ;
if lastbyte = 0 then
    begin (* TEK4100 color *)
    TEK4010 := false ;
    Ysize := 4095 ;
   Case GraphDriver of
     CGA : Graphmode := CGAC0 ;
    MCGA : Graphmode := MCGAC0 ;
     EGA : Graphmode := EGAHi ;
   EGA64 : Graphmode := EGA64Hi ;
  EGAMono: Graphmode := EGAMonoHi ;
HercMono : Graphmode := HercMonoHi ;
  ATT400 : Graphmode := ATT400C0 ;
     VGA : Graphmode := VGALo ;
  PC3270 : Graphmode := PC3270Hi ;
    End ; (* case *)
    end   (* TEK4100 color *)
                else
    begin (* TEK4010 mono *)
    abyte := lastbyte ;
    Tek4010 := true ;
    Ysize := 780 * 4 ;
   Case GraphDriver of
     CGA : Graphmode := CGAHi ;
    MCGA : Graphmode := MCGAHi ;
     EGA : Graphmode := EGAHi ;
   EGA64 : Graphmode := EGA64Hi ;
  EGAMono: Graphmode := EGAMonoHi ;
HercMono : Graphmode := HercMonoHi ;
  ATT400 : Graphmode := ATT400Hi ;
     VGA : Graphmode := VGAHi ;
  PC3270 : Graphmode := PC3270Hi ;
    End ; (* case *)
    end ; (* TEK4010 mono *)
InitGraph(GraphDriver,GraphMode,' ') ;
result := graphresult ;
 if result <> 0 then
     begin
     writeln(' INIT graph failed ',result);
     goto exit ;
     end ;
    XDim := GetMaxX ;
    YDim := GetMaxY ;
    WindowX := 4095 ;
    WindowY := 4095 ;
    XScale := XDim / 4095 ;
    YScale := YDim / Ysize ;
 (*   getmem(SaveScreenP,ImageSize(0,0,Xdim,YDim) ) ; *)
 With palette do
   Begin (* palette *)
   Size := 16 ;
   Colors[0] := Black ;
   Colors[1] := White ;
   Colors[2] := Red ;
   Colors[3] := Green ;
   Colors[4] := Blue ;
   Colors[5] := Cyan ;
   Colors[6] := Magenta ;
   Colors[7] := Yellow ;
   Colors[8] := Brown ;
   Colors[9] := LightGreen ;
   Colors[10] := LightCyan ;
   Colors[11] := LightBlue ;
   Colors[12] := LightMagenta ;
   Colors[13] := LightRed ;
   Colors[14] := DarkGray ;
   Colors[15] := LightGray ;
   End ;
   if tek4010 then (* mono chrome *)
              else SetAllPalette(palette) ;

SetTextStyle(SmallFont,0,4) ;
If Newgraph then
    begin (* init new graph *)
    Newgraph := false ;
    WindowX := 4095 ;
    WindowY := 4095 ;
    XScale := XDim / 4095 ;
    YScale := YDim / Ysize ;
    CursorX := Xdim div 2 ;
    CursorY := Ydim div 2 ;
    end  (* init new graph *)
            else
   GraphScreen^ := Savescreen^ ;
(*    PutImage(0,0,SaveScreenP^,Normalput) ; *)
HiY := 0; LoY := 0; ExtraY := 0 ;
HiX := 0; LoX := 0; ExtraX := 0 ;
LastX := 0; LastY := 0;
NeedLoY := FALSE ;
DrawVector := FALSE ;
BeginPanel := FALSE ;
AlphaCnt := 0 ;
AlphaStr := '' ;
While TekState Do
    Begin (* Tek4100 Emulation *)
    If lastbyte = 0 then
      If ReadMchar(abyte) then
                          else goto exit
                    else lastbyte := 0 ;
Vectormode :
    If abyte = GS_ then
         Begin (* Vector Mode *)
         DrawVector := False ;
VectorContinue :
         If ReadMchar(abyte) then else goto exit ;
         While not (abyte in [esc,gs_,rs_,us_,fs_,sub,bel,can]) do
              Begin (* New coordinates *)
              GetCoord(X1,Y1);
              NewX := X1 * (4096 div windowx) ;
              NewY := Ysize -  (Y1 * (4096 div windowY)) ;
      (*       if Round(NewX * Xscale) > XDim then NewX := 1 ;
               if Round(Newy * Yscale) > YDim then NewY := 1 ; *)
              IF DrawVector or BeginPanel THEN
               Line ( Round(LastX * Xscale),Round(LastY * Yscale),
                      Round(NewX  * Xscale),Round(NewY  * Yscale) )
                                          ELSE
                   DrawVector := TRUE;
              LastX := NewX;
              LastY := NewY;
              If BeginPanel then
                  Begin { Record Poly Points }
                  Pi := Pi + 1 ;
                  PolyGon[pi].x := Round(LastX * Xscale) ;
                  PolyGon[pi].y := Round(LastY * Yscale) ;
                  End ; { Record Poly Points }
              If ReadMchar(abyte) then else goto exit;
              If abyte = gs_ then
                   Begin
                   DrawVector := false ;
                   If ReadMchar(abyte) then else goto exit ;
                   End ;
              End ; (* New Coordinates *)
         End ; (* Vector Mode *)

    If abyte = ESC then
         Begin (* esc sequence *)
         TEK4014LineStyle := false ; (* reset tek4014 flag *)
         TekEscapeSeq ;
         If TEK4014LineStyle then goto VectorContinue ;
         End  (* esc sequence *)
                   else
      If abyte = FS_ then
         Begin (* Marker Mode *)
         If ReadMchar(abyte) then else goto exit;
         GetCoord(X1,Y1) ;
         LastX := X1 * (4096 div windowx) ;
         LastY :=  Ysize -  (Y1 * (4096 div windowY)) ;
         (* make a mark *)
         Mark(Trunc(LastX*Xscale),Trunc(LastY*Yscale),MarkerNumber);
         End  (* Marker Mode *)
                     else
      If abyte = US_ then
         BEGIN {alphamode}
         If ReadMchar(abyte) then else goto exit ;
         While not (abyte in [esc,gs_,rs_,us_,fs_,ff_,sub,bel,can]) and
           (AlphaCnt < 255) do
              BEGIN  (* get alpha string *)
              AlphaStr := alphaStr + chr(abyte);
              AlphaCnt := AlphaCnt + 1;
              If ReadMchar(abyte) then else goto exit;
              END ;  (* get alpha string *)
         if AlphaCnt > 0 then
               OutTextXY(Trunc(LastX*Xscale),
                         Trunc(LastY*Yscale)-textheight('X'),AlphaStr);
         DrawVector := false ;
         AlphaCnt := 0 ;
         AlphaStr := '' ;
         Goto VectorMode ;
         END  {alphamode}
                     else
      If abyte = BEL then
         BEGIN { bell }
         writeln(chr(abyte));
         Repeat  until keypressed ;
         achar := readkey ;
         TekState := false ;
         END   { bell }
                     else
      If abyte = FF_ then
         BEGIN { Form Feed - New Screen }
         ClearDevice ;
         sound(2000); delay(1000); nosound ;
         END   { Form Feed - New Screen }
                      else
      begin
      If abyte = GS_ then goto VectorMode ;
      If abyte > $20 then outText(chr(abyte))
                     else
          if abyte = $0D then Moveto(0,gety)
                         else
             if abyte = $0A then Moveto(getx,gety+(YDim div 24)) ;
      end ;
    End ; (* Tek4100 Emulation  *)
exit :
    CloseGraph ;
End ; (* Tektronics Procedure *)
(* ----------------------------------------------------------------- *)

 (* Tek4100 Unit *)
Begin (* tek4100 *)
DetectGraph(GraphDriver,GraphMode);
   New(SaveScreen);
   If GraphResult = 0 then
   Case GraphDriver of
     CGA : Begin
           Graphmode := CGAHi ;
           GraphScreen := PTR($B800,0000);
           Graphics := ' - Tek4100  / CGA        ';
           End ;
    MCGA : Begin
           Graphmode := MCGAC0 ;
           GraphScreen := PTR($A000,0000);
           Graphics := ' - Tek4100  / MCGA       ';
           End ;
     EGA : Begin
           Graphmode := EGAHi ;
           GraphScreen := PTR($A000,0000);
           Graphics := ' - Tek4100  / EGA        ';
           End ;
   EGA64 : Begin
           Graphmode := EGA64Hi ;
           GraphScreen := PTR($A000,0000);
           Graphics := ' - Tek4100  / EGA64      ';
           End ;
  EGAMono: Begin
           Graphmode := EGAMonoHi ;
           GraphScreen := PTR($A000,0000);
           Graphics := ' - Tek4100  / EGAMono    ';
           End ;
HercMono : Begin
           Graphmode := HercMonoHi ;
           GraphScreen := PTR($B000,0000);
           Graphics := ' - Tek4100  / Hercules    ';
           End ;
  ATT400 : Begin
           Graphmode := ATT400C0 ;
           GraphScreen := PTR($B800,0000);
           Graphics := ' - Tek4100  / AT&T       ';
           End ;
     VGA : Begin
           Graphmode := VGAHi ;
           GraphScreen := PTR($A000,0000);
           Graphics := ' - Tek4100  / VGA        ';
           End ;
  PC3270 : Begin
           Graphmode := PC3270Hi ;
           GraphScreen := PTR($B800,0000);
           Graphics := ' - Tek4100  / PC3270     ';
           End ;
    End   (* case *)
           else {From 'If GraphResult = 0'}
              begin
              Sound (800); delay (50); nosound;
              Graphics := 'No graphics';
              WriteLn ('No graphic card.');
              end;
savescreen := graphscreen ;

End. (* Tek4100 Unit *)