C*TTDRIV -- PGPLOT Tektronix terminal drivers
C+
      SUBROUTINE TTDRIV (IFUNC, RBUF, NBUF, CHR, LCHR, MODE)
      INTEGER IFUNC, NBUF, LCHR, MODE
      REAL    RBUF(*)
      CHARACTER*(*) CHR
C
C PGPLOT driver for Tektronix terminals and emulators.
C
C 1993 Jan 18 - T. J. Pearson.
C 1993 Jun 24 - L. Staveley-Smith, minor alteration of 
C               flush-buffer for better /tek
C               compatibility. Also added MODE 7 for
C               Visual 603's and MODE 8 for IBM-PCs 
C               running as remote terminals using
C               Kermit version 3 (for DOS).
C 1994 Dec 19 - TJP: better XTERM support.
C 1994 Dec 29 - TJP: and Tek4100 support (MODE 9).
C 1996 Apr 18 - TJP: prevent concurrent access.
C 1998 Mar 09 - M. Zolliker: new MODE 10 for VersaTerm-PRO for Macintosh
C
C Supported device:
C 1. Tektronix 4006/4010 storage-tube terminal; can be used with
C   emulators, but the options below take advantage of features not
C   present in the basic Tektronix terminal.
C 2. GraphOn Corporation 200-series terminals. These emulate a
C   Tektronix-4010 with enhancements (selective erase, rectangle fill,
C   switch between Tek and VT100 modes).
C 3. Digital Engineering, Inc., Retrographics modified VT100
C   terminal (VT640). 
C 4. IRAF GTERM Tektronix terminal emulator, with color extensions.
C 5. Xterm window on an X-window server. Emulates a Tektronix-4014,
C   with extensions (switch between Tek and VT100 windows).
C 6. ZSTEM 240 and ZSTEM 4014 terminal emulators for the IBM PC and
C   clones. ZSTEM supports Tektronix 4014 emulation and the 4105 color
C   escape sequences. ZSTEM can be obtained from: KEA Systems Ltd.,
C   2150 West Broadway, Suite 412, Vancouver, British Columbia, Canada,
C   V6K 4L9.
C 7.Visual-603 and 630 terminals. These are VT100/220 compatible
C   terminals with Tektronix 4010/4014 emulation (Visual Technology
C   Incorporated, 1703 Middlesex Street, Lowell, Mass 01851). The 
C   Visual 630 has the capability of displaying dual text and graphics.
C   This feature is not used in this driver. Graphics mode is entered 
C   automatically when the graph is drawn but only exited when PGPAGE 
C   or PGEND is called. Therefore, for multiple plots interspersed
C   with text I/O, use PGPAGE at the end of each plot. This will prompt
C   for a carriage return before switching. If this is not done,
C   intervening text will appear on the graphics screen. Graphics mode
C   can be entered and exited from the setup menu, or by SHIFT-PF1.
C   Graphics extensions include rectangle fill, selective erase and 
C   switch between Tek and VT100 modes.
C 8.IBM PC's and compatibles running MS-Kermit 3 as a terminal emulator.
C   The video board is assumed to have sufficient memory to retain the 
C   graphics image in memory when switched to text. This will be true 
C   for VGA and EGA, but some early PCs might not be able to do this. 
C   If Kermit is using full VGA resolution (ie SET TERMINAL GRAPHICS 
C   VGA), there is not usually enough memory to store the full 480 
C   vertical lines, so the bottom few lines may disappear. Tektronix 
C   enhancements include selective erase, colours, rectangle fill, and
C   switching between text and graphics mode. The cursor may be
C   operated with the mouse. Tested with Kermit version 3.1.
C 9.Tektronix 4100 series color terminals (and emulators)
C 10.Versaterm-PRO for Macintosh (Tek 4105 emulation).
C
C Device type codes:
C 1.  /TEK4010 Tektronix-4010 terminal
C 2.  /GF      GraphOn terminal
C 3.  /RETRO   Retrographics VT640 terminal
C 4.  /GTERM   GTERM terminal emulator
C 5.  /XTERM   XTERM terminal emulator
C 6.  /ZSTEM   ZSTEM terminal emulator
C 7.  /V603    Visual V603 terminal
C 8.  /KRM3    Kermit 3 on IBM-PC
C 9.  /TK4100  Tektronix 4100 series terminals
C 10. /VMAC    VersaTerm-PRO for Macintosh
C
C Default device name: the logged-in terminal
C   /dev/tty (UNIX)
C   TT: (VMS)
C
C Default view surface dimensions:
C   Depends on monitor; nominally 8in (horizontal) by 6in (vertical).
C
C Resolution:
C   A standard Tektronix terminal displays a screen of 1024 pixels
C   (horizontal) by 780 pixels (vertical), with a nominal resolution
C   of 130 pixels per inch. The actual resolution may be less.
C
C Color capability:
C   /TEK4010, /XTERM: none; only color index 1 is available; selective
C       erase is not possible. Requests to draw in color index 0 are
C       ignored.
C   /GF, /RETRO, /V603: color indices 0 (erase, black) and 1 (bright:
C       usually white, green or amber) are supported. It is not 
C       possible to change color representation.
C   /GTERM:  color indices 0 to 15 are available and default to the
C       standard PGPLOT colors. The color representation can be changed.
C   /ZSTEM: color indices 0 to 7 are available and default to the
C       indicated in the ZSTEM setup menu (which default to the standard
C       PGPLOT colors).  The color representation cannot be changed.
C   /KRM3: color indices 0 to 7 are the standard PGPLOT colors. Indices
C       8 to 14 are also available, but are BRIGHT versions of 1 to 7,
C       and thus non-standard. Color representation can't be changed.
C   /TK4100: color indices 0-15.
C   /VMAC: color indices 0 to 15 are available and default to the
C       standard PGPLOT colors. The color representation of the indices
C       2 to 15 can be changed.
C
C Input capability:
C   Depending on the emulation, the graphics cursor may be a pointer,
C   a small cross, or a crosshair across the entire screen. The user
C   positions the cursor using thumbwheels, mouse, trackball, or the
C   arrow keys on the keyboard. The user indicates that the cursor has
C   been positioned by typing any printable ASCII character on the 
C   keyboard. Most control characters (eg, ^C) are intercepted by the
C   operating system and cannot be used. 
C
C File format: 
C   Binary byte stream. Under Unix, the output may be directed to
C   a file; under VMS, this is not possible: the output device must
C   be a terminal.
C
C Obtaining hardcopy:
C
C Environment variables:
C   None.
C--
C Implementation Notes:
C
C Standard Tektronix codes:
C   graph mode: [GS]=char(29)
C   alpha mode: [US]=char(31)
C The emulators provide various extensions to basic Tektronix
C operation, using the following codes:
C    [SOH]=char(1),  [STX]=char(2),  [ETX]=char(3),
C    [DLE]=char(16), [CAN]=char(24), [ESC]=char(27)
C
C Enter Tektronix mode (from VT100 mode):
C   graphon: automatic on receipt of [GS]
C   gterm:   [GS]
C   tek:     not available
C   retro:   automatic on receipt of [GS]
C   xterm:   [ESC][?38h
C   zstem:   [ESC][?38h
C   v603:    [GS]
C   krm3:    [ESC][?38h
C Return to VT100 mode (from Tektronix mode):
C   graphon: [CAN]
C   gterm:   [CAN]
C   tek:     not available
C   xterm:   [ESC][ETX]
C   zstem:   [CAN]
C   v603:    [CAN][ESC][?38l
C   krm3:    [ESC][?38l
C Rectangle fill:
C   graphon: draw the diagonal in special rectangle mode, 
C     entered with [ESC][STX], exit with [ESC][ETX]
C   v603: bottom corner and rectangle width
C   krm3: bottom corner and rectangle width
C   vmac: use panel boundary commands [ESC]LP and [ESC]LE
C Color index zero (erase):
C   graphon select erase:        [ESC][DLE]
C   graphon unselect erase:      [ESC][SOH]
C   retro,v603 select erase:     [ESC]/1d
C   retro,v603 unselect erase:   [ESC]/0d
C   krm3, select erase:          [ESC][0;30m
C   krm3, unselect erase:        [ESC][0;37m
C-----------------------------------------------------------------------
      INTEGER NDEVS
      PARAMETER (NDEVS=10)
      INTEGER CAN, ESC, GS, US
      PARAMETER (CAN=24, ESC=27, GS=29, US=31)
C
      CHARACTER*48 DEVICE(NDEVS)
      SAVE         DEVICE
      CHARACTER*80 TEXT
      CHARACTER*32 CTMP, CADD, CSCR(4)*4
      CHARACTER*500 CBUF
      SAVE          CBUF
      INTEGER I, J, INTEN, I0, J0, I1, J1, LADD, LTMP, ICH, IER
      INTEGER XSIZE(NDEVS), YSIZE(NDEVS), MAXCI(NDEVS), I4014(NDEVS)
      SAVE    XSIZE,        YSIZE,        MAXCI,        I4014
      INTEGER ICHAN, LASTI, LASTJ, NPAGE, ICI, LBUF, STATE
      SAVE    ICHAN, LASTI, LASTJ, NPAGE, ICI, LBUF, STATE
      INTEGER GROTER
      INTEGER IBUF(4), ITOT
      LOGICAL APPEND
      SAVE    APPEND
      REAL    XRESLN(NDEVS), YRESLN(NDEVS)
      SAVE    XRESLN,        YRESLN
      REAL    HUE,SAT,LIG
      LOGICAL SEFCOL
      SAVE    SEFCOL
C
      INTEGER IRGB(3,0:15), TKRGB(3,0:15)
C
      DATA DEVICE(1) /'TEK4010 (Tektronix 4010 terminal)'/
      DATA DEVICE(2) /'GF    (GraphOn Tek terminal emulator)'/
      DATA DEVICE(3) /'RETRO (Retrographics VT640 Tek emulator)'/
      DATA DEVICE(4) /'GTERM (Color gterm terminal emulator)'/
      DATA DEVICE(5) /'XTERM (XTERM Tek terminal emulator)'/
      DATA DEVICE(6) /'ZSTEM (ZSTEM Tek terminal emulator)'/
      DATA DEVICE(7) /'V603  (Visual 603 terminal)'/
      DATA DEVICE(8) /'KRM3  (Kermit 3 IBM-PC terminal emulator)'/
      DATA DEVICE(9) /'TK4100 (Tektronix 4100 terminals)'/
      DATA DEVICE(10) /'VMAC  (VersaTerm-PRO for Mac, Tek 4105)'/
C                 TEK  GF   RET  GTER XTER ZSTE V603 KRM3 TK41 VMAC
      DATA XSIZE /1023,1023,1023,1023,1023,1023,1023,1023,1023,1023/
      DATA YSIZE / 779, 779, 779, 779, 779, 779, 779, 779, 779, 779/
      DATA MAXCI /   1,   1,   1,  15,   1,   7,   1,  14,  15,  15/
      DATA XRESLN/130.,128.,128.,130.,128.,130.,115.,110.,100.,128./
      DATA YRESLN/130.,130.,130.,130.,130.,130.,115.,110.,100.,128./
      DATA I4014/    0,   0,   0,   0,   1,   1,   0,   0,   1,   1/
      DATA IRGB /  0,  0,  0, 255,255,255, 255,  0,  0,   0,255,  0,
     1             0,  0,255,   0,255,255, 255,  0,255, 255,255,  0,
     2           255,128,  0, 128,255,  0,   0,255,128,   0,128,255,
     3           128,  0,255, 255,  0,128, 085,085,085, 170,170,170/
      DATA TKRGB/  0,  0,  0, 100,100,100, 100,  0,  0,   0,100,  0,
     1             0,  0,100,   0,100,100, 100,  0,100, 100,100,  0,
     2           100, 50,  0,  50,100,  0,   0,100, 50,   0, 50,100,
     3            50,  0,100, 100,  0, 50,  33, 33, 33,  67, 67, 67/
      DATA STATE/0/
C-----------------------------------------------------------------------
C
      IF (MODE.LT.1 .OR. MODE.GT.NDEVS) CALL GRWARN('Error in GRTT00')
      GOTO( 10, 20, 30, 40, 50, 60, 70, 80, 90,100,
     1     110,120,130,140,150,160,170,180,900,900,
     2     210,900,900,240), IFUNC
C     -- Ignore unimplemented function
  900 RETURN
C
C--- IFUNC = 1, Return device name.-------------------------------------
C
   10 CONTINUE
      CHR  = DEVICE(MODE)
      LCHR = LEN(DEVICE(MODE))
      RETURN
C
C--- IFUNC = 2, Return physical min and max for plot device, and range
C               of color indices.---------------------------------------
C
   20 CONTINUE
      RBUF(1) = 0
      RBUF(2) = XSIZE(MODE)
      RBUF(3) = 0
      RBUF(4) = YSIZE(MODE)
      RBUF(5) = 0
      RBUF(6) = MAXCI(MODE)
      NBUF = 6
      RETURN
C
C--- IFUNC = 3, Return device resolution. ------------------------------
C
   30 CONTINUE
      RBUF(1) = XRESLN(MODE)
      RBUF(2) = YRESLN(MODE)
      RBUF(3) = 1
      NBUF = 3
      RETURN
C
C--- IFUNC = 4, Return misc device info. -------------------------------
C    (This device is Interactive, Cursor, No dashed lines, No areafill, 
C    No thick lines, No markers; some varieties have rectangle fill)
C
   40 CONTINUE
      CHR = 'ICNNNNNNNN'
      IF (MODE.EQ.2 .OR. MODE.EQ.7 .OR. MODE.EQ.8) CHR(6:6) = 'R'
      IF (MODE.EQ.10) THEN
C       -- VMAC: rect. fill and wait before closing graph window
        CHR(6:6) = 'R'
        CHR(8:8) = 'V'
      ENDIF
      LCHR = 10
      RETURN
C
C--- IFUNC = 5, Return default file name. ------------------------------
C
   50 CONTINUE
      CALL GRTRML(CHR,LCHR)
      RETURN
C
C--- IFUNC = 6, Return default physical size of plot. ------------------
C
   60 CONTINUE
      RBUF(1) = 0
      RBUF(2) = XSIZE(MODE)
      RBUF(3) = 0
      RBUF(4) = YSIZE(MODE)
      NBUF = 4
      RETURN
C
C--- IFUNC = 7, Return misc defaults. ----------------------------------
C
   70 CONTINUE
      RBUF(1) = 2.0
      NBUF = 1
      RETURN
C
C--- IFUNC = 8, Select plot. -------------------------------------------
C
   80 CONTINUE
C     -- do nothing
      RETURN
C
C--- IFUNC = 9, Open workstation. --------------------------------------
C
   90 CONTINUE
C     -- check for concurrent access
      IF (STATE.EQ.1) THEN
         CALL GRWARN('a PGPLOT Tektronix device is already open')
         RBUF(1) = 0
         RBUF(2) = 0
         RETURN
      END IF
      APPEND = RBUF(3) .NE. 0.0
      RBUF(1) = 0.0
      NBUF = 2
      ICHAN = GROTER(CHR, LCHR)
      IF (ICHAN .LT. 0) THEN
          TEXT = 'Cannot open output device for plot type '//
     :           DEVICE(MODE)
          CALL GRWARN(TEXT)
          RBUF(2) = 0.0
          RETURN
      ELSE
          STATE = 1
          RBUF(2) = 1.0
      END IF
      LASTI = -1
      LASTJ = -1
      ICI = 1
      NPAGE = 0
      LBUF = 0
      IF (.NOT.APPEND) THEN
         IF ( MODE.EQ.4 ) THEN
C           -- load gterm default color table.
            DO 91 I=0,15
               CTMP(1:6) = CHAR(GS)//CHAR(ESC)//'TG14'
               LTMP = 6
               CALL GRTT05(I,         CADD, LADD)
               CTMP(LTMP+1:LTMP+LADD) = CADD(:LADD)
               LTMP = LTMP + LADD
C              -- red
               CALL GRTT05(IRGB(1,I), CADD, LADD)
               CTMP(LTMP+1:LTMP+LADD) = CADD(:LADD)
               LTMP = LTMP + LADD
C              -- green
               CALL GRTT05(IRGB(2,I), CADD, LADD)
               CTMP(LTMP+1:LTMP+LADD) = CADD(:LADD)
               LTMP = LTMP + LADD
C              -- blue
               CALL GRTT05(IRGB(3,I), CADD, LADD)
               CTMP(LTMP+1:LTMP+LADD) = CADD(:LADD)
               LTMP = LTMP + LADD
               CTMP(LTMP+1:LTMP+1) = CHAR(US)
               LTMP = LTMP + 1
               CALL GRTT02(ICHAN, MODE, CTMP, LTMP, CBUF, LBUF)
 91         CONTINUE
            CALL GRTT02(ICHAN, MODE, CHAR(CAN), 1, CBUF, LBUF)
         ELSE IF (MODE.EQ.10) THEN
C           -- VMAC: put into Tek 4105 mode
            CTMP(1:5)=CHAR(ESC)//'%!1'//CHAR(GS)
            CALL GRTT02(ICHAN, MODE, CTMP, 5, CBUF, LBUF)
            SEFCOL = .TRUE.
C           -- set default color representation (only indices 2 to 15
            DO 92,I=2,15
              CALL GRXHLS(IRGB(1,I)/255.,IRGB(2,I)/255.,IRGB(3,I)/255.
     :              ,HUE,LIG,SAT)
              CALL GRTT06(I, NINT(HUE), NINT(LIG*100), NINT(SAT*100)
     :              , CTMP, LTMP)
              CALL GRTT02(ICHAN, MODE, CTMP, LTMP, CBUF, LBUF)
92          CONTINUE
         END IF
      END IF
      RETURN
C
C--- IFUNC=10, Close workstation. --------------------------------------
C
  100 CONTINUE
      IF ( MODE.EQ.6 ) THEN
C         -- For zstem switch back to alpha mode at the last possible
C            moment.
          LTMP = 1
          CALL GRWTER(ICHAN, CHAR(CAN), LTMP)
      ELSE IF ( MODE.EQ.7 ) THEN
C         -- For v603 switch back to alpha mode at the last possible
C            moment.
          CTMP(1:7) = CHAR(CAN)//CHAR(ESC)//CHAR(91)//CHAR(63)//
     :                CHAR(51)//CHAR(56)//CHAR(108)
          LTMP=7
          CALL GRWTER(ICHAN, CTMP, LTMP)
      ELSE IF (MODE.EQ.10) THEN
C         -- VMAC: put into VT100 Mode without window resize
          CTMP(1:5)=CHAR(GS)//CHAR(ESC)//'%!7'
          LTMP=5
          CALL GRWTER(ICHAN, CTMP, LTMP)
      END IF
      CALL GRCTER(ICHAN)
      STATE = 0
      RETURN
C
C--- IFUNC=11, Begin picture. ------------------------------------------
C
  110 CONTINUE
      NPAGE = NPAGE+1
      LASTI = -1
      IF (.NOT.APPEND) THEN
         IF (MODE.EQ.5 .OR. MODE.EQ.6 .OR. MODE. EQ.8) THEN
C           -- xterm, zstem, krm3: select Tek mode, erase screen
            CTMP(1:1) = CHAR(ESC)
            CTMP(2:2) = CHAR(12)
            CALL GRTT02(ICHAN, MODE, CTMP, 2, CBUF, LBUF)
         ELSE IF (MODE.EQ.7) THEN
C           -- V603: select Tek mode
            CTMP(1:1) = CHAR(GS)
            CTMP(2:2) = CHAR(ESC)
            CTMP(3:3) = CHAR(12)
            CALL GRTT02(ICHAN, MODE, CTMP, 3, CBUF, LBUF)
         ELSE
C           -- erase graphics screen
            CTMP(1:1) = CHAR(GS)
            CTMP(2:2) = CHAR(ESC)
            CTMP(3:3) = CHAR(12)
            CTMP(4:4) = CHAR(CAN)
            CALL GRTT02(ICHAN, MODE, CTMP, 4, CBUF, LBUF)
            IF (MODE.EQ.10) THEN
C             -- clear type ahead buffer (for cursor)
              CALL GRTT03(ICHAN, -3, I0, J0, ICH, IER)
C             -- fill screen with background color
              CTMP=CHAR(ESC)//'MP0'//CHAR(ESC)//'LP'
     :          //CHAR(32)//CHAR(96)//CHAR(32)//CHAR(64)//'0'
              LTMP=12
              CALL GRTT02(ICHAN, MODE, CTMP, LTMP, CBUF, LBUF)
              LASTI=0
              LASTJ=0
              CALL GRTT01(ICHAN, MODE, I4014(MODE), LASTI, LASTJ,
     :          0, 4095, 4095, 4095, CBUF, LBUF)
              CALL GRTT01(ICHAN, MODE, I4014(MODE), LASTI, LASTJ,
     :          4095, 4095, 4095, 0, CBUF, LBUF)
              CTMP=CHAR(ESC)//'LE'
              LTMP=3
              CALL GRTT02(ICHAN, MODE, CTMP, LTMP, CBUF, LBUF)
            END IF
         END IF
      ELSE IF (MODE.EQ.8) THEN
C        -- krm3: enter graph mode without deleting screen
         CTMP(1:1) = CHAR(ESC)
         CTMP(2:2) = CHAR(91)
         CTMP(3:3) = CHAR(63)
         CTMP(4:4) = CHAR(51)
         CTMP(5:5) = CHAR(56)
         CTMP(6:6) = CHAR(104)
         CALL GRTT02(ICHAN, MODE, CTMP, 6, CBUF, LBUF)
      ELSE IF (MODE.EQ.9) THEN
C        -- TK4100: put device in graphics mode, erase screen
         CTMP(1:1) = CHAR(ESC)
         CTMP(2:4) = '%!0'
         CTMP(5:5) = CHAR(ESC)
         CTMP(6:6) = CHAR(12)
         CALL GRTT02(ICHAN, MODE, CTMP, 6, CBUF, LBUF)
         CTMP(1:1) = CHAR(ESC)
         CTMP(2:6) = 'RU1;4'
         CALL GRTT02(ICHAN, MODE, CTMP, 6, CBUF, LBUF)
C        -- set default color representation
         DO 111 I=0,15
            CTMP(1:5) = CHAR(ESC)//'TG14'
            LTMP = 5
            CALL GRTT05(I,         CADD, LADD)
            CTMP(LTMP+1:LTMP+LADD) = CADD(:LADD)
            LTMP = LTMP + LADD
C           -- red
            CALL GRTT05(TKRGB(1,I), CADD, LADD)
            CTMP(LTMP+1:LTMP+LADD) = CADD(:LADD)
            LTMP = LTMP + LADD
C           -- green
            CALL GRTT05(TKRGB(2,I), CADD, LADD)
            CTMP(LTMP+1:LTMP+LADD) = CADD(:LADD)
            LTMP = LTMP + LADD
C           -- blue
            CALL GRTT05(TKRGB(3,I), CADD, LADD)
            CTMP(LTMP+1:LTMP+LADD) = CADD(:LADD)
            LTMP = LTMP + LADD
            CALL GRTT02(ICHAN, MODE, CTMP, LTMP, CBUF, LBUF)
 111     CONTINUE
C         -- set color index 1
         CTMP(1:1) = CHAR(ESC)
         CTMP(2:4) = 'ML1'
         CALL GRTT02(ICHAN, MODE, CTMP, 4, CBUF, LBUF)
      END IF
      RETURN
C
C--- IFUNC=12, Draw line. ----------------------------------------------
C     (omitted for color 0 on devices without selective erase)
C
  120 CONTINUE
      IF (ICI.EQ.0 .AND. (MODE.EQ.1 .OR. MODE.EQ.5)) RETURN
      IF ( I4014(MODE).EQ.0 ) THEN
         I0 = NINT(RBUF(1))
         J0 = NINT(RBUF(2))
         I1 = NINT(RBUF(3))
         J1 = NINT(RBUF(4))
      ELSE
         I0 = NINT(4.*RBUF(1))
         J0 = NINT(4.*RBUF(2))
         I1 = NINT(4.*RBUF(3))
         J1 = NINT(4.*RBUF(4))
      END IF
      CALL GRTT01(ICHAN, MODE, I4014(MODE), LASTI, LASTJ,
     :      I0, J0, I1, J1, CBUF, LBUF)
      RETURN
C
C--- IFUNC=13, Draw dot. -----------------------------------------------
C     (omitted for color 0 on devices without selective erase)
C
  130 CONTINUE
      IF (ICI.EQ.0 .AND. (MODE.EQ.1 .OR. MODE.EQ.5)) RETURN
      IF ( I4014(MODE).EQ.0 ) THEN
         I0 = NINT(RBUF(1))
         J0 = NINT(RBUF(2))
      ELSE
         I0 = NINT(4.*RBUF(1))
         J0 = NINT(4.*RBUF(2))
      END IF
      CALL GRTT01(ICHAN, MODE, I4014(MODE), LASTI, LASTJ,
     :      I0, J0, I0, J0, CBUF, LBUF)
      RETURN
C
C--- IFUNC=14, End picture. --------------------------------------------
C
  140 CONTINUE
      IF (MODE.EQ.7) THEN
C        -- V603: enter alphanumerics and unset graphics
         CTMP(1:7) = CHAR(CAN)//CHAR(ESC)//CHAR(91)//CHAR(63)//
     :               CHAR(51)//CHAR(56)//CHAR(108)
         LTMP=7
         CALL GRWTER(ICHAN, CTMP, LTMP)
      ELSE IF (MODE.EQ.8) THEN
C         -- krm3: enter alphanumerics and unset graphics
         CTMP(1:6) = CHAR(ESC)//CHAR(91)//CHAR(63)//
     :               CHAR(51)//CHAR(56)//CHAR(108)
         LTMP=6
         CALL GRWTER(ICHAN, CTMP, LTMP)
      ELSE IF (MODE.EQ.9 .OR. MODE.EQ.10) THEN
C        -- TK4100, VMAC: return to text mode
         CTMP(1:1) = CHAR(ESC)
         CTMP(2:4) = '%!1'
         LTMP=4
         CALL GRWTER(ICHAN, CTMP, LTMP)
         IF (MODE .EQ. 10) THEN
C          -- flush type ahead buffer
           CALL GRTT03(ICHAN, -2, I0, J0, ICH, IER)
           CALL GRETER
         END IF
      END IF
      RETURN
C
C--- IFUNC=15, Select color index. -------------------------------------
C
  150 CONTINUE
      ICI = RBUF(1)
      IF (ICI.LT.0 .OR. ICI.GT.MAXCI(MODE)) THEN
          ICI = 1
          RBUF(1) = ICI
      END IF
      LASTI = -1
      IF (MODE.EQ.2) THEN
C         -- GraphOn
          CTMP(1:1) = CHAR(GS)
          CTMP(2:2) = CHAR(ESC)
          CTMP(3:3) = CHAR(1)
          IF (ICI.EQ.0) CTMP(3:3) = CHAR(16)
          CALL GRTT02(ICHAN, MODE, CTMP, 3, CBUF, LBUF)
      ELSE IF (MODE.EQ.3 .OR. MODE.EQ.7) THEN
C         -- Retrographics, V603
          CTMP(1:1) = CHAR(GS)
          CTMP(2:2) = CHAR(ESC)
          CTMP(3:3) = CHAR(47)
          CTMP(4:4) = CHAR(49-ICI)
          CTMP(5:5) = CHAR(100)
          CALL GRTT02(ICHAN, MODE, CTMP, 5, CBUF, LBUF)
      ELSE IF ( MODE.EQ.4 .OR. MODE.EQ.6 .OR. MODE.EQ.10) THEN
C         -- gterm and zstem, VMAC
          CTMP(1:4) = CHAR(GS)//CHAR(ESC)//'ML'
          CALL GRTT02(ICHAN, MODE, CTMP, 4, CBUF, LBUF)
          CALL GRTT05(ICI, CTMP, LTMP)
          CALL GRTT02(ICHAN, MODE, CTMP, LTMP, CBUF, LBUF)
          SEFCOL=.TRUE.
      ELSE IF (MODE.EQ.9) THEN
C         -- TK4100
          CTMP(1:3) = CHAR(ESC)//'ML'
          CALL GRTT02(ICHAN, MODE, CTMP, 3, CBUF, LBUF)
          CALL GRTT05(ICI, CTMP, LTMP)
          CALL GRTT02(ICHAN, MODE, CTMP, LTMP, CBUF, LBUF)
      ELSE IF( MODE.EQ.8) THEN
C         -- krm3: all attributes off
          CTMP(1:1) = CHAR(27)
          CTMP(2:2) = CHAR(91)
          CTMP(3:3) = CHAR(48)
          CTMP(4:4) = CHAR(59)
C
C  Load color definitions (8-14 are bold versions of 1-7, so are not the
C  standard PGPLOT ones)
C
          IF ( ICI.EQ.0 ) I=0
          IF ( ICI.EQ.1 .OR. ICI.EQ.8)  I=7
          IF ( ICI.EQ.2 .OR. ICI.EQ.9)  I=1
          IF ( ICI.EQ.3 .OR. ICI.EQ.10) I=2
          IF ( ICI.EQ.4 .OR. ICI.EQ.11) I=4
          IF ( ICI.EQ.5 .OR. ICI.EQ.12) I=6
          IF ( ICI.EQ.6 .OR. ICI.EQ.13) I=5
          IF ( ICI.EQ.7 .OR. ICI.EQ.14) I=3
          CTMP(5:5) = CHAR(51)
          CTMP(6:6) = CHAR(48+I)
          IF (ICI.GT.7) THEN
              CTMP(7:7) = CHAR(59)
              CTMP(8:8) = CHAR(49)
              CTMP(9:9) = CHAR(109)
              CALL GRTT02(ICHAN, MODE, CTMP, 9, CBUF, LBUF)
          ELSE
              CTMP(7:7) = CHAR(109)
              CALL GRTT02(ICHAN, MODE, CTMP, 7, CBUF, LBUF)
          END IF
      END IF
      RETURN
C
C--- IFUNC=16, Flush buffer. -------------------------------------------
C
  160 CONTINUE
      IF (MODE.EQ.1 .OR. MODE.GT.5) THEN
C         -- tek4010, zstem, v603, krm3, or tk4100
          CTMP(1:6) = CHAR(GS)//CHAR(55)//CHAR(127)//CHAR(32)//
     :                CHAR(64)//CHAR(US)
          CALL GRTT02(ICHAN, MODE, CTMP, 6, CBUF, LBUF)
      ELSE IF (MODE.EQ.5) THEN
C         -- xterm
          CTMP(1:3) = CHAR(US)//CHAR(ESC)//CHAR(3)
          CALL GRTT02(ICHAN, MODE, CTMP, 3, CBUF, LBUF)
      ELSE
          CTMP(1:8) = CHAR(GS)//CHAR(55)//CHAR(127)//CHAR(32)//
     :                CHAR(64)//CHAR(3)//CHAR(CAN)//CHAR(US)
          CALL GRTT02(ICHAN, MODE, CTMP, 8, CBUF, LBUF)
      END IF
      CALL GRWTER(ICHAN, CBUF, LBUF)
      LASTI = -1
      RETURN
C
C--- IFUNC=17, Read cursor. --------------------------------------------
C
  170 CONTINUE
C     -- flush buffer
      CALL GRWTER(ICHAN, CBUF, LBUF)
      LASTI = -1
      IF ( MODE.EQ.5 .OR. MODE.EQ.6 ) THEN
C         -- xterm and zstem make sure terminal is in Tektronix mode.
          LTMP = 6
          CALL GRWTER(ICHAN, CHAR(ESC)//'[?38h', LTMP)
      END IF
C     -- initial cursor position
      I0 = NINT(RBUF(1))
      J0 = NINT(RBUF(2))
C     -- timeout mode
      IF (MODE .EQ. 10) THEN
        I1 = -NINT(RBUF(5))
        IF (I1 .LT. 0) I1=0
      ELSE
        I1 = -1
      END IF
C     -- read cursor
      CALL GRTT03(ICHAN, I1, I0, J0, ICH, IER)
C     -- on XTERM, map mouse button clicks onto A, D, X.
      IF (MODE.EQ.5) THEN
         IF (ICH.EQ.236) THEN
            ICH = ICHAR('a')
         ELSE IF (ICH.EQ.237) THEN
            ICH = ICHAR('d')
         ELSE IF (ICH.EQ.242) THEN
            ICH = ICHAR('x')
         ELSE IF (ICH.EQ.204) THEN
            ICH = ICHAR('A')
         ELSE IF (ICH.EQ.205) THEN
            ICH = ICHAR('D')
         ELSE IF (ICH.EQ.210) THEN
            ICH = ICHAR('X')
         END IF
      END IF
C     -- return result
      IF (IER.EQ.0) THEN
          RBUF(1) = I0
          RBUF(2) = J0
          CHR(1:1) = CHAR(ICH)
      ELSE
          CHR(1:1) = CHAR(0)
      END IF
      NBUF = 2
      LCHR = 1
      RETURN
C
C--- IFUNC=18, Erase alpha screen. -------------------------------------
C
  180 CONTINUE
      IF (MODE.EQ.2 .OR. MODE.EQ.3) THEN
C         -- GraphOn, Retrographics: return to VT100 mode and
C            issue VT100 erase-screen command
          CTMP(1:8) = CHAR(GS)//CHAR(55)//CHAR(127)//CHAR(32)//
     :                CHAR(64)//CHAR(3)//CHAR(CAN)//CHAR(US)
          CALL GRTT02(ICHAN, MODE, CTMP, 8, CBUF, LBUF)
          CTMP(1:7) = CHAR(ESC)//'[2J'//CHAR(ESC)//'[H'
          CALL GRTT02(ICHAN, MODE, CTMP, 7, CBUF, LBUF)
          LASTI = -1
      END IF
      RETURN
C
C--- IFUNC=21, Set color representation. -------------------------------
C
  210 CONTINUE
      IF (MODE.EQ.4) THEN
C        -- gterm
         I = RBUF(1)
         CTMP(1:6) = CHAR(GS)//CHAR(ESC)//'TG14'
         LTMP = 6
         CALL GRTT05(I,     CADD, LADD)
         CTMP(LTMP+1:LTMP+LADD) = CADD(:LADD)
         LTMP = LTMP + LADD
C        -- red
         INTEN = RBUF(2)*255.0
         CALL GRTT05(INTEN, CADD, LADD)
         CTMP(LTMP+1:LTMP+LADD) = CADD(:LADD)
         LTMP = LTMP + LADD
C        -- green
         INTEN = RBUF(3)*255.0
         CALL GRTT05(INTEN, CADD, LADD)
         CTMP(LTMP+1:LTMP+LADD) = CADD(:LADD)
         LTMP = LTMP + LADD
C        -- blue
         INTEN = RBUF(4)*255.0
         CALL GRTT05(INTEN, CADD, LADD)
         CTMP(LTMP+1:LTMP+LADD) = CADD(:LADD)
         LTMP = LTMP + LADD
C
         CTMP(LTMP+1:LTMP+2) = CHAR(US)//CHAR(CAN)
         LTMP = LTMP + 2
         CALL GRTT02(ICHAN, MODE, CTMP, LTMP, CBUF, LBUF)
         CALL GRWTER(ICHAN, CBUF, LBUF)
         LASTI = -1
      ELSE IF (MODE.EQ.9) THEN
C        -- TK4100
         I = RBUF(1)
         CTMP(1:5) = CHAR(ESC)//'TG14'
         LTMP = 5
         CALL GRTT05(I,     CADD, LADD)
         CTMP(LTMP+1:LTMP+LADD) = CADD(:LADD)
         LTMP = LTMP + LADD
C        -- red
         INTEN = RBUF(2)*100.0
         CALL GRTT05(INTEN, CADD, LADD)
         CTMP(LTMP+1:LTMP+LADD) = CADD(:LADD)
         LTMP = LTMP + LADD
C        -- green
         INTEN = RBUF(3)*100.0
         CALL GRTT05(INTEN, CADD, LADD)
         CTMP(LTMP+1:LTMP+LADD) = CADD(:LADD)
         LTMP = LTMP + LADD
C        -- blue
         INTEN = RBUF(4)*100.0
         CALL GRTT05(INTEN, CADD, LADD)
         CTMP(LTMP+1:LTMP+LADD) = CADD(:LADD)
         LTMP = LTMP + LADD
         CALL GRTT02(ICHAN, MODE, CTMP, LTMP, CBUF, LBUF)
         CALL GRWTER(ICHAN, CBUF, LBUF)
         LASTI = -1
      ELSE IF (MODE.EQ.10) THEN
C        -- Only color indices >1 are treated (confusion with "Black Screen" option in VersaTerm)
         IF (NINT(RBUF(1)) .GT. 1) THEN
           CTMP(1:1)=CHAR(GS)
           CALL GRTT02(ICHAN, MODE, CTMP, 1, CBUF, LBUF)
           CALL GRXHLS(RBUF(2), RBUF(3), RBUF(4), HUE, LIG, SAT)
           CALL GRTT06(NINT(RBUF(1))
     :     , NINT(HUE), NINT(LIG*100), NINT(SAT*100), CTMP, LTMP)
           CALL GRTT02(ICHAN, MODE, CTMP, LTMP, CBUF, LBUF)
           CALL GRWTER(ICHAN, CBUF, LBUF)
         END IF
         LASTI = -1
      END IF
      RETURN
C
C--- IFUNC=24, Rectangle fill. -----------------------------------------
C
  240 CONTINUE
      IF ( I4014(MODE).EQ.0 ) THEN
         I0 = NINT(RBUF(1))
         J0 = NINT(RBUF(2))
         I1 = NINT(RBUF(3))
         J1 = NINT(RBUF(4))
      ELSE
         I0 = NINT(4.*RBUF(1))
         J0 = NINT(4.*RBUF(2))
         I1 = NINT(4.*RBUF(3))
         J1 = NINT(4.*RBUF(4))
      END IF
      IF (MODE.EQ.2) THEN
C         -- GraphOn
C         -- enter rectangle mode
          CALL GRTT02(ICHAN, MODE, CHAR(GS)//CHAR(ESC)//CHAR(2), 3,
     :         CBUF, LBUF)
C         -- draw rectangle
          CALL GRTT01(ICHAN, MODE, I4014(MODE), LASTI, LASTJ,
     :      I0, J0, I1, J1, CBUF, LBUF)
C         -- exit rectangle mode
          CALL GRTT02(ICHAN, MODE, CHAR(ESC)//CHAR(3), 2, CBUF, LBUF)
      ELSE IF (MODE.EQ.7 .OR. MODE.EQ.8) THEN
C         -- v603, krm3: needs bottom left corner and rectangle
C            dimensions
          IBUF(1)=I0+1
          IBUF(2)=J0+1
          IBUF(3)=I1+1
          IBUF(4)=J1+1
          DO 241 I=1,4
             IF (IBUF(I) .LT. 1)    IBUF(I)=1
             IF (IBUF(I) .GT. 1056) IBUF(I)=1056
  241     CONTINUE
          IBUF(3)=IBUF(3)-IBUF(1)
          IBUF(4)=IBUF(4)-IBUF(2)
          ITOT=0
          DO 244 I=1,4
             WRITE (CSCR(I)(1:4), '(I4)') IBUF(I)
             IBUF(I)=1
             DO 242 J=1,4
                IF (CSCR(I)(J:J) .NE. ' ') THEN
                   GOTO 243
                END IF
                IBUF(I)=IBUF(I)+1
  242        CONTINUE
  243        CONTINUE
             ITOT=ITOT+5-IBUF(I)
  244     CONTINUE
          CTMP(1:8+ITOT)=
     :         CHAR(ESC)//CHAR(47)//CSCR(1)(IBUF(1):4)//CHAR(59)//
     :         CSCR(2)(IBUF(2):4)//CHAR(59)//CSCR(3)(IBUF(3):4)//
     :         CHAR(59)//CSCR(4)(IBUF(4):4)//CHAR(59)//CHAR(49)//
     :         CHAR(121)
          CALL GRTT02(ICHAN, MODE, CTMP, 8+ITOT, CBUF, LBUF)
      ELSE IF (MODE.EQ.10) THEN
C         -- VMAC: use polygon fill commands
          IF (SEFCOL) THEN
C set fill color
            SEFCOL=.FALSE.
            CTMP(1:3) = CHAR(ESC)//'MP'
            CALL GRTT02(ICHAN, MODE, CTMP, 3, CBUF, LBUF)
            CALL GRTT05(-ICI, CTMP, LTMP)
            CALL GRTT02(ICHAN, MODE, CTMP, LTMP, CBUF, LBUF)
          ENDIF
C send "start polygon fill"
          CTMP(1:3) = CHAR(ESC)//'LP'
          LTMP=3
C make lasti,lastj different from i0,j0 in each bit
          LASTI=4095-I0
          LASTJ=4095-J0
C send first coordinate
          CALL GRTT04(I4014(MODE), LASTI, LASTJ, I0, J0, CTMP, LTMP)
          LASTI=I0
          LASTJ=J0
C '0' means: boundary has the same color as fill area
          CTMP(LTMP+1:LTMP+1)='0'
          LTMP=LTMP+1
          CALL GRTT02(ICHAN, MODE, CTMP, LTMP, CBUF, LBUF)
C further edges:
          CALL GRTT01(ICHAN, MODE, I4014(MODE), LASTI, LASTJ,
     :      I0, J1, I1, J1, CBUF, LBUF)
          CALL GRTT01(ICHAN, MODE, I4014(MODE), LASTI, LASTJ,
     :      I1, J1, I1, J0, CBUF, LBUF)
C send "end polygon fill"
          CTMP(1:3)=CHAR(ESC)//'LE'
          CALL GRTT02(ICHAN, MODE, CTMP, 3, CBUF, LBUF)
      END IF
      RETURN
C-----------------------------------------------------------------------
      END
C*GRTT01 -- PGPLOT Tektronix driver, draw line segment
C+
      SUBROUTINE GRTT01(ICHAN, MODE, I4014, LASTI, LASTJ, I0, J0,
     :         I1, J1, CBUF, LBUF)
      INTEGER   ICHAN, MODE, I4014, LASTI, LASTJ, I0, J0, I1, J1, LBUF
      CHARACTER CBUF*(*)
C
C This routine draws a line from (I0, J0) to (I1, J1).  If LASTI>=0
C assume that the cursor is at the position is at (LASTI, LASTJ).
C For this case, a minimum length move is done from (LASTI, LASTJ) to
C the nearer point.  Of course, if (LASTI, LASTJ) and the nearer point
C are the same, then no bytes of positioning data are generated and
C sent to the terminal.  If LASTI<0 then a move is done with the
C coordinate fully specified.  In both cases the line end point
C is specified using the fewest number of bytes allowed by the protocol.
C Upon return, LASTI,LASTJ will contain the current cursor position. 
C If I4014=0 then 10 bit (4010) coordinates are generated, for I4014=1,
C full 12 bit Tektronix (4014 and higher) coordinates are generated.
C Note:  The 'delete' character (127) can occur in LOY or EXTRA byte;
C it can be replaced by escape-? if desired.
C
C Arguments:
C   ICHAN       (in)     : passed to GRTT02 if called.
C   MODE        (in)     : passed to GRTT02 if called.
C   I4014       (in)     : =0 generate 4010 coords, =1 generate 4014.
C   LASTI,LASTJ (in/out) : current position
C   I0, J0      (in/out) : device coordinates of the starting point.
C   I1, J1      (in/out) : device coordinates of the end point.
C   CBUF        (in/out) : buffer for instruction.
C   LBUF        (in/out) : Number of valid characters in CBUF.
C
C 1993-Feb-02 - Created from GRZS01 - [AFT]
C-----------------------------------------------------------------------
      INTEGER    GS
      PARAMETER (GS = 29)
      INTEGER    MASKLX, MASKHX
      PARAMETER (MASKLX = 64, MASKHX = 32)
      INTEGER   MASKLY, MASKHY
      PARAMETER (MASKLY = 96, MASKHY = 32)
      INTEGER   MASKEX
      PARAMETER (MASKEX = 96)
C
      CHARACTER CTMP*12
      INTEGER ID0, ID1, IFLUSH, ITMP
      INTEGER IEX, ILOX, IHIX, ILOY, IHIY, LTMP
C
C If it is possible for this routine to generate enough data to fill
C the buffer, and thus cause it to be flushed to the terminal, then we
C force the write to take place now.  This will ensure that terminal
C is in the correct state for the following commands.
      IF ( LBUF+11.GE.LEN(CBUF) ) THEN
          CALL GRWTER(ICHAN, CBUF, LBUF)
          IFLUSH = 1
      ELSE
          IFLUSH = 0
      END IF
C
      LTMP = 0
      IF(LASTI.LT.0) THEN
C Last position is invalid, therefore do a dark vector move with all
C coordinates specified.
          LTMP=LTMP+1
          CTMP(LTMP:LTMP)=CHAR(GS)
          IF ( I4014.EQ.0 ) THEN
              IHIY = J0/32
              ILOY = MOD(J0, 32)
              IHIX = I0/32
              ILOX = MOD(I0, 32)
              CTMP(LTMP+1:LTMP+4) =
     :            CHAR( MASKHY + IHIY )//
     :            CHAR( MASKLY + ILOY )//
     :            CHAR( MASKHX + IHIX )//
     :            CHAR( MASKLX + ILOX )
              LTMP = LTMP + 4
          ELSE
              IHIY = J0/128
              ILOY = MOD(J0/4, 32)
              IHIX = I0/128
              ILOX = MOD(I0/4, 32)
              IEX  = 4*MOD(J0, 4) + MOD(I0, 4)
              CTMP(LTMP+1:LTMP+5) =
     :            CHAR( MASKHY + IHIY )//
     :            CHAR( MASKEX + IEX )//
     :            CHAR( MASKLY + ILOY )//
     :            CHAR( MASKHX + IHIX )//
     :            CHAR( MASKLX + ILOX )
              LTMP = LTMP + 5
          END IF
      ELSE
C Last position is valid, move pen to nearest end point of line.
          ID0=ABS(LASTI-I0)+ABS(LASTJ-J0)
          ID1=ABS(LASTI-I1)+ABS(LASTJ-J1)
          IF(ID1.LT.ID0) THEN
C Swap coordinates to minimize 'pen motion'.  For optimized coordinates
C this can reduce the amount of I/O to the the terminal.
              ITMP=I0
              I0=I1
              I1=ITMP
              ITMP=J0
              J0=J1
              J1=ITMP
              ITMP=ID0
              ID0=ID1
              ID1=ITMP
          END IF
          IF(ID0.NE.0 .OR. ID1.NE.0) THEN
C Position has changed, so do a move operation.
              LTMP=LTMP+1
              CTMP(LTMP:LTMP)=CHAR(GS)
              CALL GRTT04(I4014,LASTI,LASTJ,I0,J0,CTMP,LTMP)
          ELSE
              IF(IFLUSH.NE.0) THEN
C The position is valid, but the buffer was flushed, so terminal may
C no longer be in graph mode.  Therefore, send GS and followed by a
C zero length dark move (i.e., just resend LOX coordinate).
                  IF ( I4014.EQ.0 ) THEN
                      ILOX = MOD(I0, 32)
                  ELSE
                      ILOX = MOD(I0/4, 32)
                  END IF
                  CTMP(LTMP+1:LTMP+2)=CHAR(GS)//CHAR(MASKLX+ILOX)
                  LTMP=LTMP+2
              END IF
          END IF
      END IF
C
C Terminal is now in graph mode, and the `pen' has been positioned.
C Do an optimized draw.
      CALL GRTT04(I4014,I0,J0,I1,J1,CTMP,LTMP)
      CALL GRTT02(ICHAN, MODE, CTMP, LTMP, CBUF, LBUF)
C
C Remember current position.
      LASTI=I1
      LASTJ=J1
      RETURN
C
      END
C*GRTT02 -- PGPLOT Tektronix driver, transfer data to buffer
C+
      SUBROUTINE GRTT02 (ICHAN, MODE, CADD, LADD, CBUF, LBUF)
      INTEGER   ICHAN, MODE, LADD, LBUF
      CHARACTER CADD*(*), CBUF*(*)
C
C Arguments:
C   ICHAN  (input)  : channel number for output (when buffer is full).
C   MODE   (input)  : emulation type.
C   CADD   (input)  : text to add to buffer.
C   LADD   (input)  : number of characters to transfer.
C   CBUF   (input)  : output buffer.
C   LBUF   (in/out) : number of valid characters in CBUF.
C
C Subroutines called:
C   GRWTER
C-----------------------------------------------------------------------
      IF (LBUF+LADD.GE.LEN(CBUF) ) THEN
          CALL GRWTER(ICHAN, CBUF, LBUF)
      END IF
C
      IF ( LADD.GT.0 ) THEN
          IF ( LBUF.EQ.0 ) THEN
              IF ( MODE.EQ.5 .OR. MODE.EQ.6 ) THEN
                  CBUF(1:6) = CHAR(27)//'[?38h'
                  LBUF = 6
              END IF
          END IF
          CBUF(LBUF+1:LBUF+LADD) = CADD(1:LADD)
          LBUF = LBUF + LADD
      END IF
C-----------------------------------------------------------------------
      END
d	subroutine put_it(ch)
d	character ch*(*)
d	character logbuf*1000/'|'/
d	integer pos/1/
d	integer i,j
c
d	do i=1,len(ch)
d	  if (ch(i:i) .ge. ' ') then
d	    logbuf(pos+1:pos+1)=ch(i:i)
d	    pos=pos+1
d	  else
d	    logbuf(pos+1:pos+2)='^'//char(ichar(ch(1:1))+64)
d	    pos=pos+2
d	  endif
d	enddo
d	return
c
d	entry prt_it
d	if (pos .gt. 1) then
d	  j=1
d	  do i=2,pos
d	    if (logbuf(i:i) .eq. '|') then
d	      print *,logbuf(j:i)
d	      j=i
d	    end if
d	  enddo
d	  print *,logbuf(j:i)
d	  print *
d	end if
d	pos=1
d	end

C*GRTT03 -- PGPLOT Tektronix driver, cursor routine
C+
      SUBROUTINE GRTT03 (ICHAN, ITMO, IX, IY, IC, IER)
      INTEGER   ICHAN, ITMO, IX, IY, IC, IER
C
C Arguments:
C   ICHAN  (input)  : channel for output to device.
C   ITMO   (input)  : timeout/sec for VMAC or -1 for other devices
C                     -2 for clearing type-ahead buffer (on begin picture)
C   IX, IY (in/out) : initial/final coordinates of cursor (device 
C                     coordinates).
C   IC     (output) : character code.
C   IER    (output) : error status (0 is OK).
C
C-----------------------------------------------------------------------

      CHARACTER CBUF*16, CPROM*10, CNEXT*1
      INTEGER   I1, I2, LBUF, I, ITRM, IWARN
      LOGICAL FLUSH/.TRUE./
      SAVE LBUF, CBUF, ITRM, IWARN, FLUSH
      DATA LBUF/0/, ITRM/10/, IWARN/0/

      IF (ITMO .EQ. -3) THEN
C       -- flush next time
        FLUSH=.TRUE.
        LBUF=0
        RETURN
      END IF
      IF (ITMO .EQ. -2) THEN
C       -- flush type-ahead buffer now
1       CALL GRKTER(ICHAN, 1, CBUF(1:1))
        IF (CBUF(1:1) .NE. CHAR(0)) GOTO 1
d	call prt_it
        LBUF=0
        RETURN
      ENDIF
      IF (LBUF .GT. 5 .OR. LBUF .EQ. 1) THEN
        IC=ICHAR(CBUF(1:1))
d	call put_it('[pop:')
d	call put_it(cbuf(1:1))
d	call put_it(']|')
        IF (LBUF .GT. 1) CBUF(1:LBUF-1)=CBUF(2:LBUF)
        LBUF=LBUF-1
        RETURN
      END IF
      CNEXT=CHAR(0)
      IF (LBUF .LT. 5) THEN
C
C Position cursor (by drawing a dark vector).
C
        CPROM(1:1) = CHAR(29)
        CPROM(2:2) = CHAR(32+(IY/32))
        CPROM(3:3) = CHAR(96+MOD(IY,32))
        CPROM(4:4) = CHAR(32+(IX/32))
        CPROM(5:5) = CHAR(64+MOD(IX,32))
        CPROM(6:6) = CHAR(27)
        CPROM(7:7) = CHAR(47)
        CPROM(8:8) = CHAR(102)
        CPROM(9:9) = CHAR(27)
        CPROM(10:10) = CHAR(26)
        IF (ITMO .LT. 0) THEN

C         -- non-VMAC modes: Do a read with prompt.
          LBUF = 5
          CALL GRPTER(ICHAN, CPROM, 10, CBUF, LBUF)
C         -- must read at least 5 characters.
          IF (LBUF.LT.5) GOTO 90

        ELSE

C         -- VMAC mode: read key in type-ahead buffer
10        CALL GRKTER(ICHAN, 1, CBUF(1:1))
          IF (CBUF(1:1) .GE. ' ' .AND. .NOT. FLUSH) GOTO 60
C         -- flush control characters
          IF (CBUF(1:1) .NE. CHAR(0)) GOTO 10
          FLUSH=.FALSE.
          LBUF=10
          CALL GRWTER(ICHAN, CPROM, LBUF)
d	  call put_it('\')
C         -- first character with specified timeout
          CALL GRKTER(ICHAN, ITMO*10, CBUF(1:1))
          IF (CBUF(1:1) .EQ. CHAR(0)) THEN
d	    call put_it('[tmo]|')
C           -- Send LF (quit GIN mode)
            LBUF=1
            CPROM=CHAR(10)
            CALL GRWTER(ICHAN, CPROM, LBUF)
            CALL GRKTER(ICHAN, 5, CBUF(1:1))
            IF (CBUF(1:1) .EQ. CHAR(0)) GOTO 90
          END IF
d	  call put_it(cbuf(1:1))
          DO 20,I=2,5
            CALL GRKTER(ICHAN, 50, CBUF(I:I))
d	call put_it(cbuf(i:i))
            IF (CBUF(I:I) .LT. ' ') THEN
C             -- error or key in type-ahead buffer
              IF (I .EQ. 2) GOTO 60
d	call put_it('[err]|')
              GOTO 90
            END IF
20        CONTINUE
          LBUF=6
30        CALL GRKTER(ICHAN, ITRM, CBUF(LBUF:LBUF))
d	  call put_it(cbuf(lbuf:lbuf))
          IF (CBUF(LBUF:LBUF).GE.' '.AND.CBUF(LBUF:LBUF).LT.'@') THEN
            IF (CBUF(1:1) .LT. ' ') THEN
C             -- typed ahead control chars ignored
              CBUF(1:LBUF-1)=CBUF(2:LBUF)
            ELSE IF (LBUF .LT. LEN(CBUF)) THEN
              LBUF=LBUF+1
            ELSE
C             -- throw away some typed ahead chars
              CBUF(LBUF-5:LBUF-1)=CBUF(LBUF-4:)
            END IF
            GOTO 30
          END IF
C
C no GIN-terminator seen: reduce time out, else increase timeout
C
          IF (CBUF(LBUF:LBUF) .EQ. CHAR(0)) THEN
            ITRM=(ITRM+5)/2
	    IF (ITRM .LE. 7 .AND. IWARN .EQ. 0) THEN
              IWARN=1
              I=2
              CALL GRWTER(ICHAN, CHAR(27)//CHAR(12), I)
              CALL GRTT07(ICHAN,3
     :,'Please make sure that the following values are set')
              CALL GRTT07(ICHAN,2
     :,'in VersaTerm Menu Emulation/GraphicInput...')
              CALL GRTT07(ICHAN,1
     :,'Mouse Click: A, GIN Terminator ^M')
              CALL GRKTER(ICHAN, 0, CBUF(LBUF:LBUF))
            END IF
          ELSE
            ITRM=MIN(ITRM*2,50)
          END IF

          IF (CBUF(LBUF:LBUF) .GE. '@') THEN
	    CNEXT=CBUF(LBUF:LBUF)
          END IF
          LBUF=LBUF-1
          IF (LBUF .GT. 5) THEN
C
C There were characters typed while sending GIN, return them
C
d	    call put_it('[1st:')
d	    call put_it(cbuf(1:1))
d	    call put_it(']|')
            IC=ICHAR(CBUF(1:1))
            CBUF(1:LBUF-1)=CBUF(2:LBUF)
            LBUF=LBUF-1
            RETURN
          END IF
        ENDIF
      ENDIF
C
C Decode coordinates.
C
50    IC = ICHAR( CBUF(1:1) )
      I1 = MOD( ICHAR(CBUF(2:2)), 32 )
      I2 = MOD( ICHAR(CBUF(3:3)), 32 )
      IX = I1*32 + I2
      I1 = MOD( ICHAR(CBUF(4:4)), 32 )
      I2 = MOD( ICHAR(CBUF(5:5)), 32 )
      IY = I1*32 + I2
      IF (CNEXT .NE. CHAR(0)) THEN
        CBUF(1:1)=CNEXT
        LBUF = 1
      ELSE
        LBUF = 0
      ENDIF
      IER = 0
d	call put_it('[cor]|')
      RETURN
C
C Return key only leaving coordinates untouched
C
60    IC = ICHAR(CBUF(1:1))
d	call put_it(cbuf(1:1))
d	call put_it('[t]|')
      LBUF=0
      IER = 0
      RETURN
C
C An error occured
C
90    LBUF = 0
      IER = 1
      RETURN
C-----------------------------------------------------------------------
      END
C*GRTT04 -- PGPLOT Tektronix driver, encode coordinate pair, optimize
C+
      SUBROUTINE GRTT04(I4014, LASTI, LASTJ, I0, J0, CTMP, LTMP)
      INTEGER   I4014, LASTI, LASTJ, I0, J0, LTMP
      CHARACTER CTMP*(*)
C
C Assume cursor is at position LASTI, LASTJ and that the light or
C dark vector condition has been correctly set.  Add up to 5 characters
C to CTMP to draw a vector to I0, J0.  The minimum number of characters
C are encoded to obtain the motion.
C-----------------------------------------------------------------------
      INTEGER    MASKLX, MASKHX
      PARAMETER (MASKLX = 64, MASKHX = 32)
      INTEGER   MASKLY, MASKHY
      PARAMETER (MASKLY = 96, MASKHY = 32)
      INTEGER   MASKEX
      PARAMETER (MASKEX=96)
C
      INTEGER IEX, ILOX, IHIX, ILOY, IHIY
      INTEGER LEX, LLOX, LHIX, LLOY, LHIY
C
      IF ( I4014.EQ.0 ) THEN
          LHIY = LASTJ/32
          LLOY = MOD(LASTJ, 32)
          LHIX = LASTI/32
          LLOX = MOD(LASTI, 32)
          LEX = 0
          IHIY = J0/32
          ILOY = MOD(J0, 32)
          IHIX = I0/32
          ILOX = MOD(I0, 32)
          IEX = 0
      ELSE
          LHIY = LASTJ/128
          LLOY = MOD(LASTJ/4, 32)
          LHIX = LASTI/128
          LLOX = MOD(LASTI/4, 32)
          LEX = 4*MOD(LASTJ, 4) + MOD(LASTI, 4)
          IHIY = J0/128
          ILOY = MOD(J0/4, 32)
          IHIX = I0/128
          ILOX = MOD(I0/4, 32)
          IEX = 4*MOD(J0, 4) + MOD(I0, 4)
      END IF
C
      IF(IHIY.NE.LHIY) THEN
          LTMP=LTMP+1
          CTMP(LTMP:LTMP) = CHAR(32+IHIY)
      END IF
C Note, for 4010 mode, IEX=LEX (by definition)
      IF(IEX.NE.LEX) THEN
          LTMP=LTMP+1
          CTMP(LTMP:LTMP) = CHAR(96+IEX)
      END IF
      IF(IEX.NE.LEX .OR. ILOY.NE.LLOY .OR. IHIX.NE.LHIX) THEN
          LTMP=LTMP+1
          CTMP(LTMP:LTMP) = CHAR(96+ILOY)
      END IF
      IF(IHIX.NE.LHIX) THEN
          LTMP=LTMP+1
          CTMP(LTMP:LTMP) = CHAR(32+IHIX)
      END IF
      LTMP=LTMP+1
      CTMP(LTMP:LTMP) = CHAR(64+ILOX)
      RETURN
      END
C*GRTT05 -- PGPLOT Tektronix 4100 driver, encode integer
C+
      SUBROUTINE GRTT05(I, C, NC)
      INTEGER I
      CHARACTER*(*) C
      INTEGER NC
C
C Encode integer in host syntax. Input integer I; output encoded string
C C, containing NC characters (1, 2, or 3).  This version encodes
C integers up to 1023, which fit in two characters.
C-----------------------------------------------------------------------
      INTEGER J
C
      J = IABS(I)
      IF (J.LT.16) THEN
          IF (I.LT.0) THEN
              C(1:1) = CHAR(J+32)
          ELSE
              C(1:1) = CHAR(J+48)
          END IF
          NC = 1
      ELSE
          C(1:1) = CHAR(J/16+64)
          IF (I.LT.0) THEN
              C(2:2) = CHAR(MOD(J,16)+32)
          ELSE
              C(2:2) = CHAR(MOD(J,16)+48)
          END IF
          NC = 2
      END IF
C
      END
C*GRTT06 -- PGPLOT Tektronix 4100 driver, encode color definition
C+
      SUBROUTINE GRTT06(IDX, I1, I2, I3, C, NC)
      INTEGER ESC, GS, US
      PARAMETER (ESC=27, GS=29, US=31)
      INTEGER IDX, I1, I2, I3
      CHARACTER*(*) C
      INTEGER NC
C
C Encode color definition, Color index IDX, I1,I2,I3 are the 3 integer
C color components (definiton is device-dependent).
C output encoded string containing NC characters (max 20).
C-----------------------------------------------------------------------
      INTEGER L
C
      C(1:5) = CHAR(ESC)//'TG14'
      NC=5
      CALL GRTT05(IDX, C(NC+1:NC+3), L)
      NC=NC+L
      CALL GRTT05(I1, C(NC+1:NC+3), L)
      NC=NC+L
      CALL GRTT05(I2, C(NC+1:NC+3), L)
      NC=NC+L
      CALL GRTT05(I3, C(NC+1:NC+3), L)
      NC=NC+L
      END
C*GRTT07 -- PGPLOT Tektronix 4100 driver, write out warning for VersaTerm
C+
      SUBROUTINE GRTT07(ICHAN, ILINE, WARN)
      INTEGER ICHAN, ILINE
      CHARACTER WBUF*9, WARN*(*)
      INTEGER I,L,LBUF

      LBUF=5
      CALL GRWTER(ICHAN, CHAR(29)//CHAR(32+ILINE)//'a!A', LBUF)
      DO I=1,LEN(WARN),9
        WBUF=WARN(I:)
        L=MIN(9,LEN(WARN)-I+1)
        LBUF=L+4
        CALL GRWTER(ICHAN,CHAR(27)//'LT'//CHAR(L+48)//WBUF,LBUF)
      ENDDO
      END
