home *** CD-ROM | disk | FTP | other *** search
/ Programmer 7500 / MAX_PROGRAMMERS.iso / PASCAL / QK3KER.ZIP / QK3TEK.PAS < prev    next >
Encoding:
Pascal/Delphi Source File  |  1988-05-17  |  11.4 KB  |  305 lines
  1. Unit Tek4010 ;
  2. (* ------------------------------------------------------------------ *)
  3. (* Tektronics 4010  Graphics emulation unit                           *)
  4. (* ------------------------------------------------------------------ *)
  5. Interface
  6.   Uses Crt,Graph,       (* Standard Turbo Pascal Units *)
  7.      Fonts,Drivers,     (* Optional Turbo Pascal generated Units *)
  8.      KGlobals,          (* Kermit Global constants *)
  9.      Sysfunc,
  10.      Modempro,
  11.      Packets ;
  12.   Const
  13.     Gversion = ' a' ;
  14.   Var
  15.     NewGraph : Boolean ;
  16.     Graphics : string [25] ;
  17.   Procedure Tektronics (var achar,bchar : byte) ;
  18.  
  19. Implementation
  20. (* ------------------------------------------------------------------ *)
  21.  { Type
  22.      screen  = array [0..$7FFF] of byte ; }
  23. var  (* Tek 4010 variables *)
  24.      LastX, LastY, NewX, NewY : Integer ;
  25.      XDim,YDim                : integer ;
  26.      CursorX,CursorY          : integer ;
  27.      Xscale,Yscale            : Real ;
  28.      HiY, LoY, HiX, LoX       : byte ;
  29.      XFlag, DrawVector        : Boolean ;
  30.      alphastr                 : string  ;
  31.      alphacnt                 : integer ;
  32.      GraphDriver,GraphMode    : integer ;
  33. (*   GraphScreen,SaveScreen    : ^screen ;  *)
  34.      SaveScreenP              : pointer ;
  35.  
  36. (* ------------------------------------------------------------------ *)
  37. Procedure CrossHair ( X,Y : integer );
  38. const    CrossX    = 24;
  39.          CrossY    = 10;
  40. var      x1,y1,x2,y2  :  integer;
  41.     begin (* Cross Hair *)
  42.     x1 := X - CrossX;  if x1 < 0 then x1 := 0;
  43.     x2 := X + CrossX;  if x2 >= XDim then x2 := XDim - 1;
  44.     y1 := Y - CrossY;  if y1 < 0 then y1 := 0;
  45.     y2 := Y + CrossY;  if y2 >= Ydim then y2 := YDim - 1;
  46.     for x1 := x1 to x2 do PutPixel(x1,(YDim-Y),GetPixel(x1,(YDim-Y)) xor $0F);
  47.     for y1 := y1 to y2 do PutPixel(X,(YDim-y1),GetPixel(X,(YDim-y1)) xor $0F);
  48.     end ; (* CrossHair *)
  49.  
  50. (* ------------------------------------------------------------------ *)
  51. Procedure Tektronics (var achar,bchar : byte) ;
  52.  Const
  53.     BitCheck = $60 ;
  54.     LoYBit   = $60 ;
  55.     LoXBit   = $40 ;
  56.     HiBit    = $20 ;
  57.     Bit6     = $20 ;
  58.     FiveBits = $1F ;
  59.   Var
  60.     TekState : (AlphaState,GraphicState,GraphicEscState);
  61.     Done     : boolean;
  62.     Temp,ix  : Integer;
  63.   Label
  64.     Exit ;
  65.  
  66. Begin (* Tektronics Procedure *)
  67. InitGraph(GraphDriver,GraphMode,' ') ;
  68. If Newgraph then
  69.     begin (* init new graph *)
  70.     Newgraph := false ;
  71.     CursorX := Xdim div 2 ;
  72.     CursorY := Ydim div 2 ;
  73.     end  (* init new graph *)
  74.             else
  75.  (* GraphScreen^ := Savescreen^ ;*)
  76.     PutImage(0,0,SaveScreenP^,Normalput) ;
  77. Tekstate := GraphicState ;
  78. HiY := 0; LoY := 0;
  79. HiX := 0; LoX := 0;
  80. LastX := 0; LastY := 0;
  81. XFlag := FALSE;
  82. DrawVector := FALSE;
  83. AlphaCnt := 0 ;
  84. AlphaStr := '' ;
  85. If achar = us then  TekState := AlphaState
  86.               else  TekState := GraphicState ;
  87. While True Do
  88.      Case TekState of
  89.  (* ==================== Alpha  State ============================= *)
  90. AlphaState :
  91.          BEGIN  {alphamode}
  92.          If achar = us then else
  93.           IF (AlphaCnt < 255) and not (achar in [esc,gs,ff,sub,bel]) then
  94.               BEGIN
  95.               AlphaStr := alphaStr + chr(achar);
  96.               AlphaCnt := AlphaCnt + 1;
  97.               END
  98.                                                                        else
  99.               Begin
  100.               SetTextStyle(SmallFont,0,4) ;
  101.               OutTextXY(Trunc(LastX*Xscale),Trunc(LastY*Yscale),AlphaStr);
  102.               DrawVector := false ;
  103.               AlphaCnt := 0 ;
  104.               AlphaStr := '' ;
  105.               IF (achar = gs)  THEN TekState := GraphicState ;
  106.               IF (achar = esc) THEN TekState := GraphicEscState ;
  107.               If (achar = bel) THEN
  108.                    begin
  109.                    write(chr(achar));
  110.                    repeat until keypressed ;
  111.                    CloseGraph ;
  112.                    goto exit ;
  113.                    end ;
  114.               End ;
  115.          If ReadMchar(achar) then else goto exit ;
  116.          END; {alphamode}
  117.  
  118. (* ==================== Graphic State ============================= *)
  119. GraphicState :
  120.          Begin (* GraphicState *)
  121.             IF achar = GS  then DrawVector := False
  122.                            else
  123.             IF achar = US  then TekState := AlphaState
  124.                            else
  125.             IF achar = ESC then TekState := GraphicEscState
  126.                            else
  127.             IF achar = bel then
  128.                begin
  129.                write(chr(achar));
  130.                repeat until keypressed ;
  131.                RestoreCrtMode ;
  132.                CloseGraph ;
  133.                goto exit ;
  134.                end
  135.                            else
  136.             BEGIN (* assume it a Hi or Lo byte for X or Y *)
  137.             IF (achar and BitCheck) = HiBit THEN
  138.                 IF XFlag THEN  HiX := achar and FiveBits
  139.                          ELSE  HiY := achar and FiveBits
  140.                                              ELSE
  141.                 IF (achar and BitCheck) = LoYBit THEN
  142.                      BEGIN
  143.                      LoY := achar and FiveBits;
  144.                      XFlag := TRUE;
  145.                      END
  146.                                                  ELSE
  147.                 IF (achar and BitCheck) = LoXBit THEN
  148.                      BEGIN  (* LoXBit *)
  149.                      LoX := achar and FiveBits;
  150.                      XFlag := FALSE;
  151.                      NewX := (HiX*32 + LoX);
  152.                      NewY := 779 - (HiY*32 + LoY);
  153.        if Round(NewX * Xscale) > XDim then NewX := 1 ;
  154.        if Round(Newy * Yscale) > YDim then NewY := 1 ;
  155.                      IF DrawVector THEN
  156.                         Line ( Round(LastX * Xscale),
  157.                                Round(LastY * Yscale),
  158.                                Round(NewX * Xscale),
  159.                                Round(NewY * Yscale) )
  160.                                    ELSE
  161.                           BEGIN
  162.                           DrawVector := TRUE;
  163.                           END;
  164.                      LastX := NewX;
  165.                      LastY := NewY;
  166.                      END ; (* LoXBit *)
  167.             END ; (* assume it a Hi or Lo byte for X or Y *)
  168.          If ReadMchar(achar) then  else goto exit ;
  169.          End ; (* Graphic State *)
  170.  
  171. (* ==================== Graphic Escape State ======================= *)
  172. GraphicEscState :
  173.          Begin (* Graphic Escape State *)
  174.  (*      savescreen^ := GraphScreen^ ; *)
  175.          GetImage(0,0,Xdim,Ydim,SaveScreenP^);
  176.          If achar=Sub then
  177.               begin  (* GIN - Graphics INput *)
  178.               Done := false;
  179.                 repeat
  180.                 begin (* move cursor *)
  181.                    CrossHair(CursorX, CursorY);  {draw it}
  182.                    REPEAT UNTIL KeyChar(achar,bchar);
  183.                    CrossHair(CursorX, CursorY);  {erase it}
  184.                    if achar = 0 then
  185.                         begin {special key}
  186.                         case bchar of
  187.                         $48: begin {up arrow}
  188.                              CursorY := CursorY + 1 ;
  189.                              if CursorY >= YDim then
  190.                                  CursorY := (YDim - 1) ;
  191.                              end;
  192.                         $4B: begin {left arrow}
  193.                              CursorX := CursorX - 1 ;
  194.                              if CursorX < 0 then CursorX := 0;
  195.                              end;
  196.                         $4D: begin {right arrow}
  197.                              CursorX := CursorX + 1 ;
  198.                              if CursorX >= XDim then
  199.                                   CursorX := (XDim - 1) ;
  200.                              end;
  201.                         $50: begin {down arrow}
  202.                              CursorY := CursorY - 1 ;
  203.                              if CursorY < 0 then CursorY := 0;
  204.                              end;
  205.                         $4F: begin {END}
  206.                              Done := true;
  207.                              SendChar($0D);
  208.                              end;
  209.                         else
  210.                             {not recognized}
  211.                         end (* of case *);
  212.                         end { special key }
  213.                                  else
  214.                    begin (* send cursor location *)
  215.                    SendChar(achar);
  216.                    Temp := Round(CursorX / XScale );
  217.                    SendChar((Temp div 32) or Bit6 ) ;     (* Hi X *)
  218.                    SendChar((Temp and FiveBits) or Bit6); (* Lo X *)
  219.                    Temp := Round(CursorY / YScale );
  220.                    SendChar((Temp div 32) or Bit6) ;      (* Hi Y *)
  221.                    SendChar((Temp and FiveBits) or Bit6); (* Lo Y *)
  222.                    SendChar($0D);
  223.                    Done := True;
  224.                    end; (* send cursor location *)
  225.                 end until Done;  (* move cursor *)
  226.               End  (* GIN - Graphics INput *)
  227.                     else
  228.          If achar = FF then
  229.               begin
  230.               RestoreCrtMode ;   TextMode(2) ;
  231.               InitGraph(GraphDriver,Graphmode,' ') ;   (* clear screen *)
  232.               CloseGraph ;
  233.               newgraph := true ;
  234.               end
  235.                         else
  236.               CloseGraph ;
  237.          Goto Exit ;  (* exit  Graphics procedure *)
  238.          End ; (* Graphic Escape State *)
  239. (* ================================================================= *)
  240.     End ; (* Case of Tekmode *)
  241. Exit:
  242.     CloseGraph ;
  243. End ; (* Tektronics Procedure  *)
  244.  
  245. (* ----------------------------------------------------------------- *)
  246. Begin (* Tek4010 Unit *)
  247. DetectGraph(GraphDriver,GraphMode);
  248.    Case GraphDriver of
  249.      CGA : Begin
  250.            Graphmode := CGAHi ;
  251.          { GraphScreen := PTR($B800,0000); }
  252.            Graphics := ' - Tek4010  / CGA        ';
  253.            End ;
  254.     MCGA : Begin
  255.            Graphmode := MCGAHi ;
  256.          { GraphScreen := PTR($A000,0000); }
  257.            Graphics := ' - Tek4010  / MCGA       ';
  258.            End ;
  259.      EGA : Begin
  260.            Graphmode := EGAHi ;
  261.          { GraphScreen := PTR($A000,0000); }
  262.            Graphics := ' - Tek4010  / EGA        ';
  263.            End ;
  264.    EGA64 : Begin
  265.            Graphmode := EGA64Hi ;
  266.          { GraphScreen := PTR($A000,0000); }
  267.            Graphics := ' - Tek4010  / EGA64      ';
  268.            End ;
  269.   EGAMono: Begin
  270.            Graphmode := EGAMonoHi ;
  271.          { GraphScreen := PTR($A000,0000); }
  272.            Graphics := ' - Tek4010  / EGAMono    ';
  273.            End ;
  274. HercMono : Begin
  275.            Graphmode := HercMonoHi ;
  276.          { GraphScreen := PTR($B000,0000); }
  277.            Graphics := ' - Tek4010  / Hercules    ';
  278.            End ;
  279.   ATT400 : Begin
  280.            Graphmode := ATT400Hi ;
  281.          { GraphScreen := PTR($B800,0000); }
  282.            Graphics := ' - Tek4010  / AT&T       ';
  283.            End ;
  284.      VGA : Begin
  285.            Graphmode := VGAHi ;
  286.          { GraphScreen := PTR($A000,0000); }
  287.            Graphics := ' - Tek4010  / VGA        ';
  288.            End ;
  289.   PC3270 : Begin
  290.            Graphmode := PC3270Hi ;
  291.          { GraphScreen := PTR($B800,0000); }
  292.            Graphics := ' - Tek4010  / PC3270     ';
  293.            End ;
  294.     End ; (* case *)
  295.   { New(Savescreen); }
  296.     InitGraph(GraphDriver,Graphmode,' ');
  297.     XDim := GetMaxX ;
  298.     YDim := GetMaxY ;
  299.     XScale := XDim / 1024 ;
  300.     YScale := YDim / 780 ;
  301.     getmem(SaveScreenP,ImageSize(0,0,Xdim,YDim) ) ;
  302.     SetTextStyle(SmallFont,0,4) ;
  303.     CloseGraph ;
  304. End. (* Tek4010 Unit *)
  305.