C*ZSDRIV -- PGPLOT ZSTEM driver
C+
      SUBROUTINE ZSDRIV (IFUNC, RBUF, NBUF, CHR, LCHR)
      INTEGER   IFUNC, NBUF, LCHR
      REAL      RBUF(*)
      CHARACTER CHR*(*)
C
C PGPLOT driver for ZSTEM terminal emulator.
C
C 1989-Mar- 2 - New version - [AFT]
C 1989-Aug-20 - Revised - [TJP]
C
C Supported device:  ZSTEM 240 and ZSTEM 4014 terminal emulators for
C the IBM PC and clones.  ZSTEM is the best VT240 terminal emulator
C that I've seen for the IBM thing.  ZSTEM supports Tektronix 4014
C emulation and the 4105 color index escape sequences.  If your VT240
C or emulator does not support this escape sequence, then you will need
C to modify the code for: IFUNC=15 to only allow color indices 0,1 and
C not to send the 4105 sequence; IFUNC=12 and 13 to not draw anything if
C color index=0; IFUNC=2 to reflect the reduction in supported indices.
C ZSTEM can be obtained from:
C    KEA Systems LTD.
C    2150 West Broadway, Suite 412
C    Vancouver, British Columbia
C    Canada, V6K 4L9
C
C Device type code: /ZSTEM
C
C Default device name: (the logged-in terminal).
C
C Default view surface dimensions: Depends on monitor; nominally
C 7.9in (horizontal) by 6.0in (vertical).
C
C Resolution: The display address space is 4092 pixels (horizontal) by
C 3120 pixels (vertical); actual resolution is much worse than this.
C NB I believe that there is a bug in ZSTEM that prevents plotting when
C the x coordinate is 4095.  To avoid this I set MAX X to 4092 (1023*4).
C
C Color capability: Only color indices 0 to 7 are supported.  This
C driver does not allow you to change the color representation.
C
C Input capability: the PGPLOT cursor routine enables the Tektronix 
C cross-hair cursor, and waits for the operator to move the cross-hair.
C When the operator strikes a keyboard character, the routine returns
C with the character and the cross-hair location. N.B. The `graphic
C input terminators' sent by the terminal to the computer can be
C changed by the emulator to be either, CR/EOT, CR or none.  To
C work with this driver the emulator MUST be configured to send a CR.
C 
C File format: It is not possible to send ZSTEM plots to a disk
C file. 
C 
C Obtaining hardcopy: Use the hardcopy switch on the terminal, if there
C is one, and if a suitable hard copy unit is connected.
C
C Supported systems: This version will run on both VAX VMS and Sun Unix
C systems.
C
C Required routines: This code requires the routines GROTRM, GRCTRM,
C GRWTRM, and GRRTRM.
C-----------------------------------------------------------------------
      INTEGER   NX, NY
      PARAMETER (NX=639, NY=409)
C
      CHARACTER CBUF*72
      CHARACTER CMSG*10
      INTEGER   GROTRM
      INTEGER   IER, I0, I1, J0, J1, IC, ICHAN
      INTEGER   IX, IY, ICH, IGRAPH, LASTI, LASTJ, LBUF
      LOGICAL   APPEND
C-----------------------------------------------------------------------
C
      GOTO( 10, 20, 30, 40, 50, 60, 70, 80, 90,100,
     1     110,120,130,140,150,160,170,180,190,200,
     2     210,220,230), IFUNC
  900 WRITE (CMSG,'(I10)') IFUNC
      CALL GRWARN('Unimplemented function in ZSTEM device driver:'
     1    //CMSG)
      NBUF = -1
      RETURN
C
C--- IFUNC = 1, Return device name -------------------------------------
C
   10 CHR = 'ZSTEM'
      LCHR = 7
      RETURN
C
C--- IFUNC = 2, Return physical min and max for plot device, and range
C               of color indices ---------------------------------------
C
   20 RBUF(1) = 0
      RBUF(2) = NX
      RBUF(3) = 0
      RBUF(4) = NY
      RBUF(5) = 0
      RBUF(6) = 7
      NBUF = 6
      RETURN
C
C--- IFUNC = 3, Return device resolution -------------------------------
C
   30 RBUF(1) = 65.0
      RBUF(2) = 65.0
      RBUF(3) = 1
      NBUF = 3
      RETURN
C
C--- IFUNC = 4, Return misc device info --------------------------------
C    (This device is Interactive, Cursor, No dashed lines, No area
C    fill, no thick lines)
C
   40 CHR = 'ICNNNNNNNN'
      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 RBUF(1) = 0
      RBUF(2) = NX
      RBUF(3) = 0
      RBUF(4) = NY
      NBUF = 4
      RETURN
C
C--- IFUNC = 7, Return misc defaults -----------------------------------
C
   70 RBUF(1) = 10.0
      NBUF=1
      RETURN
C
C--- IFUNC = 8, Select plot --------------------------------------------
C
   80 CONTINUE
      RETURN
C
C--- IFUNC = 9, Open workstation ---------------------------------------
C
   90 CONTINUE
      APPEND = RBUF(3).NE.0.0
      ICHAN=GROTRM(CHR,LCHR)
      IF (IER.NE.0) THEN
          CALL GRWARN('Cannot open output file for ZS plot')
          RBUF(2) = 0
      ELSE
          RBUF(2) = 1
      END IF
      IC = 1
      LASTI=-1
      LBUF = 0
      IGRAPH=0
C     -- no device initialization required
      RETURN
C
C--- IFUNC=10, Close workstation ---------------------------------------
C
  100 CONTINUE
C     -- close file
      CALL GRZS05(ICHAN, 1, IGRAPH, CBUF, LBUF)
      LBUF=LBUF+1
      CBUF(LBUF:LBUF)=CHAR(24)
      CALL GRZS05(ICHAN, LEN(CBUF), IGRAPH, CBUF, LBUF)
      CALL GRCTRM(ICHAN)
      RETURN
C
C--- IFUNC=11, Begin picture -------------------------------------------
C
  110 CONTINUE
      IF (.NOT.APPEND) THEN
C Erase screen
          CALL GRZS05(ICHAN, 3, IGRAPH, CBUF, LBUF)
          CBUF(LBUF+1:LBUF+3) = CHAR(29)//CHAR(27)//CHAR(12)
          LBUF=LBUF+3
      END IF
      RETURN
C
C--- IFUNC=12, Draw line -----------------------------------------------
C
  120 CONTINUE
      CALL GRZS05(ICHAN, 11, IGRAPH, CBUF, LBUF)
      I0 = MIN(MAX(0,NINT(RBUF(1)*4091./NX)),4095)
      J0 = MIN(MAX(0,NINT(RBUF(2)*3119./NY)),4095)
      I1 = MIN(MAX(0,NINT(RBUF(3)*4091./NX)),4095)
      J1 = MIN(MAX(0,NINT(RBUF(4)*3119./NY)),4095)
      CALL GRZS01(IGRAPH, LASTI, LASTJ, I0, J0, I1, J1, CBUF, LBUF)
      RETURN
C
C--- IFUNC=13, Draw dot ------------------------------------------------
C
  130 CONTINUE
      CALL GRZS05(ICHAN, 11, IGRAPH, CBUF, LBUF)
      I0 = MIN(MAX(0,NINT(RBUF(1)*4091./NX)),4095)
      J0 = MIN(MAX(0,NINT(RBUF(2)*3119./NY)),4095)
      CALL GRZS01(IGRAPH, LASTI, LASTJ, I0, J0, I0, J0, CBUF, LBUF)
      RETURN
C
C--- IFUNC=14, End picture ---------------------------------------------
C
  140 CONTINUE
      RETURN
C
C--- IFUNC=15, Select color index --------------------------------------
C
  150 CONTINUE
      IC = RBUF(1)
      IF (IC.LT.0 .OR. IC.GT.7) THEN
          IC = 1
          RBUF(1) = IC
      END IF
C The following 3 lines send the Tek 4105 escape seqence to set the
C color index.
      CALL GRZS05(ICHAN, 4, IGRAPH, CBUF, LBUF)
      CBUF(LBUF+1:LBUF+4)=CHAR(27)//'ML'//CHAR(48+IC)
      LBUF=LBUF+4
C Make sure that a GS character is sent in this buffer.
      LASTI=-1
      RETURN
C
C--- IFUNC=16, Flush buffer. -------------------------------------------
C
  160 CONTINUE
C Make room for 7 characters
      CALL GRZS05(ICHAN, 7, IGRAPH, CBUF, LBUF)
C Home cursor (by drawing a dark vector) and return to alpha mode
C (code US)
      LBUF=LBUF+1
      CBUF(LBUF:LBUF)=CHAR(29)
      CALL GRZS02(0,3119,CBUF,LBUF)
      LBUF=LBUF+1
      CBUF(LBUF:LBUF)=CHAR(31)
C Flush buffer
      CALL GRZS05(ICHAN, LEN(CBUF), IGRAPH, CBUF, LBUF)
      LASTI=-1
      RETURN
C
C--- IFUNC=17, Read cursor. --------------------------------------------
C           RBUF(1)   in/out : cursor x coordinate.
C           RBUF(2)   in/out : cursor y coordinate.
C           CHR(1:1)  output : keystroke.
C
  170 CONTINUE
      IX = MIN(MAX(0,NINT(RBUF(1)*4091./NX)),4095)
      IY = MIN(MAX(0,NINT(RBUF(2)*3119./NY)),4095)
      CALL GRZS04(ICHAN, IGRAPH, IX, IY, ICH, CBUF, LBUF, IER)
      IF (IER.EQ.0) THEN
          RBUF(1) = IX*NX/1023.
          RBUF(2) = IY*NY/779.
          CHR = CHAR(ICH)
      ELSE
          CHR = CHAR(0)
      END IF
      NBUF = 2
      LCHR = 1
      LASTI = -1
      RETURN
C
C--- IFUNC=18, Erase alpha screen. -------------------------------------
C    (Not implemented: no alpha screen)
C
  180 CONTINUE
      RETURN
C
C--- IFUNC=19, Set line style. -----------------------------------------
C    (Not implemented: should not be called)
C
  190 CONTINUE
      GOTO 900
C
C--- IFUNC=20, Polygon fill. -------------------------------------------
C    (Not implemented: should not be called)
C
  200 CONTINUE
      GOTO 900
C
C--- IFUNC=21, Set color representation. -------------------------------
C    (Not implemented: ignored)
C
  210 CONTINUE
      RETURN
C
C--- IFUNC=22, Set line width. -----------------------------------------
C    (Not implemented: should not be called)
C
  220 CONTINUE
      GOTO 900
C
C--- IFUNC=23, Escape --------------------------------------------------
C    (Not implemented: ignored)
C
  230 CONTINUE
      RETURN
C-----------------------------------------------------------------------
      END

C*GRZS01 -- PGPLOT ZSTEM driver, draw a line on screen
C+
      SUBROUTINE GRZS01(IGRAPH,LASTI,LASTJ,I0,J0,I1,J1,CBUF,LBUF)
      INTEGER   IGRAPH, LASTI, LASTJ, I0, J0, I1, J1, LBUF
      CHARACTER CBUF*(*)
C
C If LASTI<0 then the cursor is moved to I0,J0 and then a vector
C drawn to I1,J1.  If LASTI>=0 then this routine assumes the cursor
C is currently at position LASTI,LASTJ and moves to the nearest
C point (either I0,J0 or I1,J1) and draws a line to the more distant
C point.  Upon return, LASTI,LASTJ will have to the current cursor
C position.  Full 12 bit Tektronix coordinates are generated in
C optimized format.  Nothing is transimitted to terminal, but rather
C the info is stored in the CBUF buffer array.  Note:
C 1) This routine can require up to 10 characters of storage in CBUF,
C therefore, before calling you should ensure that LEN(CBUF)-LBUF>9.
C 2) The 'delete' character (127) can occur in LOY or EXTRA byte;
C it can be replaced by escape-? if desired.
C
C 1989-Jan-18 - Ensure that terminal is in Graph Mode - [AFT]
C 1989-Jan-13 - New routine - [AFT]
C-----------------------------------------------------------------------
      INTEGER ID0, ID1, ITMP
C
      IF(LASTI.LT.0) THEN
C Last position is invalid, therefore do a dark vector move with all
C coordinates specified.
          LBUF=LBUF+1
          CBUF(LBUF:LBUF)=CHAR(29)
          CALL GRZS02(I0,J0,CBUF,LBUF)
          IGRAPH=1
      ELSE
C Last position is valid, do an optimized move operation.
          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 IO 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 change, so do a move operation.
              LBUF=LBUF+1
              CBUF(LBUF:LBUF)=CHAR(29)
              CALL GRZS03(LASTI,LASTJ,I0,J0,CBUF,LBUF)
              IGRAPH=1
          END IF
      END IF
C
C If terminal is not in Graph Mode, then put it into Graph Mode and
C execute a zero length dark move.
      IF(IGRAPH.EQ.0) THEN
          ITMP = MOD(I0/4, 32)
          CBUF(LBUF+1:LBUF+2)=CHAR(29)//CHAR(64+ITMP)
          LBUF=LBUF+2
          IGRAPH=1
      END IF
C
C 'Pen' is now correctly positioned, do an optimized draw.
      CALL GRZS03(I0,J0,I1,J1,CBUF,LBUF)
C
C Remember current position.
      LASTI=I1
      LASTJ=J1
C
      END

C*GRZS02 -- PGPLOT ZSTEM driver, encode coordinate pair
C+
      SUBROUTINE GRZS02(I0, J0, CBUF, LBUF)
      INTEGER   I0, J0, LBUF
      CHARACTER CBUF*(*)
C
C Encode XY coordinate pair in host syntax. Input integers IX, IY; 
C output 5 characters in CBUF. The valid range of XY coordinates is
C (0,4095). The output string contains characters with ASCII values
C in the range 32-127. NB the 'delete' character (127) can occur in
C LOY or EXTRA byte; it can be replaced by escape-? if desired.
C-----------------------------------------------------------------------
      INTEGER IEX, ILOX, IHIX, ILOY, IHIY
C
      IHIY = J0/128
      ILOY = MOD(J0/4, 32)
      IHIX = I0/128
      ILOX = MOD(I0/4, 32)
      IEX = 4*MOD(J0, 4) + MOD(I0, 4)
      CBUF(LBUF+1:LBUF+1) = CHAR(32+IHIY)
      CBUF(LBUF+2:LBUF+2) = CHAR(96+IEX)
      CBUF(LBUF+3:LBUF+3) = CHAR(96+ILOY)
      CBUF(LBUF+4:LBUF+4) = CHAR(32+IHIX)
      CBUF(LBUF+5:LBUF+5) = CHAR(64+ILOX)
      LBUF=LBUF+5
C
      END

C*GRZS03 -- PGPLOT ZSTEM driver, encode coordinate pair, optimize coding.
C+
      SUBROUTINE GRZS03(LASTI, LASTJ, I0, J0, CBUF, LBUF)
      INTEGER   LASTI, LASTJ, I0, J0, LBUF
      CHARACTER CBUF*(*)
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 CBUF to draw a vector to I0, J0.  The minimum number of characters
C are encoded to obtain the motion.
C-----------------------------------------------------------------------
      INTEGER IEX, ILOX, IHIX, ILOY, IHIY
      INTEGER LEX, LLOX, LHIX, LLOY, LHIY
C
      LHIY = LASTJ/128
      LLOY = MOD(LASTJ/4, 32)
      LHIX = LASTI/128
      LLOX = MOD(LASTI/4, 32)
      LEX = 4*MOD(LASTJ, 4) + MOD(LASTI, 4)
C
      IHIY = J0/128
      ILOY = MOD(J0/4, 32)
      IHIX = I0/128
      ILOX = MOD(I0/4, 32)
      IEX = 4*MOD(J0, 4) + MOD(I0, 4)
C
      IF(IHIY.NE.LHIY) THEN
          LBUF=LBUF+1
          CBUF(LBUF:LBUF) = CHAR(32+IHIY)
      END IF
      IF(IEX.NE.LEX) THEN
          LBUF=LBUF+1
          CBUF(LBUF:LBUF) = CHAR(96+IEX)
      END IF
      IF(IEX.NE.LEX .OR. ILOY.NE.LLOY .OR. IHIX.NE.LHIX) THEN
          LBUF=LBUF+1
          CBUF(LBUF:LBUF) = CHAR(96+ILOY)
      END IF
      IF(IHIX.NE.LHIX) THEN
          LBUF=LBUF+1
          CBUF(LBUF:LBUF) = CHAR(32+IHIX)
      END IF
      LBUF=LBUF+1
      CBUF(LBUF:LBUF) = CHAR(64+ILOX)
      RETURN
      END

C*GRZS04 -- PGPLOT ZSTEM driver, cursor routine
C+
      SUBROUTINE GRZS04( ICHAN, IGRAPH, IX, IY, IC, CBUF, LBUF, IER )
      INTEGER   ICHAN, IGRAPH, IX, IY, IC, LBUF, IER
      CHARACTER CBUF*(*)
C
C Arguments:
C   ICHAN  (input)  : channel for input/output to device.
C   IX, IY (in/out) : initial/final coordinates of cursor (device 
C                     coordinates).
C   IC     (output) : character code.
C   IER    (output) : error status (0 => OK).
C
C-----------------------------------------------------------------------
      INTEGER I1, I2
C
C Flush buffer
      CALL GRZS05(ICHAN, LEN(CBUF), IGRAPH, CBUF, LBUF)
C
C Position cursor (by drawing a dark vector).  NOTE, The following
C code prevents the READ statement from echoing the Tek code for
C the cursor position.  I do not understand why this happens and
C therefore this code should not be modified unless it can be done
C in a way that prevents the echo in a clearer (and more standard)
C manner.
      CBUF(1:1) = CHAR( 29 )
      CBUF(2:2) = CHAR( 32+MOD(IY/32,32) )
      CBUF(3:3) = CHAR( 96+MOD(IY,32) )
      CBUF(4:4) = CHAR( 32+MOD(IX/32,32) )
      CBUF(5:5) = CHAR( 64+MOD(IX,32) )
      CBUF(6:6) = CHAR( 27 )
      CBUF(7:7) = CHAR( 26 )
      LBUF=7
      CALL GRZS05(ICHAN, LEN(CBUF), IGRAPH, CBUF, LBUF)
C
C Read position (must terminate with a CR).  With this read, the
C Tektronix coordinates read, will be echoed.
C
      LBUF=5
      CALL GRRTRM(ICHAN, CBUF, LBUF)
C Decode coordinates
      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
      IER = 0
      RETURN
C-----------------------------------------------------------------------
      END

C*GRZS05 -- PGPLOT ZSTEM driver, dump buffer (if needed)
C+
      SUBROUTINE GRZS05( ICHAN, NEW, IGRAPH, CBUF, LBUF )
      INTEGER   ICHAN, NEW, IGRAPH, LBUF
      CHARACTER CBUF*(*)
C
C Ensure that there is enough room in CBUF to write NEW characters.
C If there is not enough room in CBUF, then CBUF(:LBUF) will be
C written to logical unit ICHAN and LBUF set equal to zero.  If there
C is room in CBUF then no action is taken.  In order to ensure
C that all info in flushed to the terminal, set NEW=LEN(CBUF).
C The sequence ESC//'[?38h' tells VT240 terminals to go to Tektronix
C mode.  
C
C 1989-Jan-13 - New routine [AFT]
C-----------------------------------------------------------------------
      INTEGER ITMP
C---
      IF(LBUF+NEW.GT.LEN(CBUF)) THEN
          ITMP=6
          CALL GRWTRM(ICHAN,CHAR(27)//'[?38h',ITMP)
          CALL GRWTRM(ICHAN,CBUF(:LBUF),LBUF)
          IGRAPH=0
      END IF
      RETURN
      END
