      SUBROUTINE TK4105(X,Y,IND)
* THIS ROUTINE WILL HANDLE TEKTRONIX 4105, 4107, AND 4115 TERMINALS
C
C         Notice of Public Domain nature of this Program
C
C      'This computer program is a work of the United States 
C       Government and as such is not subject to protection by 
C       copyright (17 U.S.C. # 105.)  Any person who fraudulently 
C       places a copyright notice or does any other act contrary 
C       to the provisions of 17 U.S. Code 506(c) shall be subject 
C       to the penalties provided therein.  This notice shall not 
C       be altered or removed from this software and is to be on 
C       all reproductions.'
C
c
c	Modification #1 - 3/11/87, Dr. Joseph M. Leonard (jle)
c
c	This modification is an attempt to alter the graphics i/o of
c	Stewart's DRAW program to use unformatted block i/o (a la MMADS
c	Graphics Library).
c
c	Kludge #1 of Modification #1 - 3/11/87 (jle)
c	Partially link IND=99 to use the buffer flushing.
c
c       Storch: verified use of unformatted i/o is ca. 88% faster
c       Changing TEKSTR to call TEKOUT for coordinates.
c
      CHARACTER*1 ESC, FF, SI, SO, CAR, ASCII
      CHARACTER*5 TEKCOR, STEMP
      CHARACTER*4 TEKINT
      CHARACTER*80 REPLY
      COMMON /ASCIIC/ ASCII( 0: 255)
      COMMON /DEVICE/ ITYPE, ISCRN, KOROFF
      COMMON/ OUTPUT/ IPAPER,IPAGE
      LOGICAL DEBUG, DEBUGL, DEBUGN, DEBUGO, DEBUGP, DEBUGI
      COMMON /DEBCOM/ DEBUG, DEBUGL, DEBUGN, DEBUGO, DEBUGP, DEBUGI
      COMMON /TK41XX/ MINX,MAXX,MINY,MAXY
      INTEGER PIXROW, PIXCOL, PIXEL
      COMMON /TERM/ IMAXR, IMAXC, PIXROW, PIXCOL, PIXEL, LCOUNT, INGRAF,
     .              IXL, IXR, IYT, IYB, NCOLOR, MCOLOR( 64 ), ITTRM,
     .              MARGX, MARGY
* VARIABLES IN COMMON TERM:
*  IMAXR = MAX NUMBER OF ROWS
*  IMAXC = MAX NUMBER OF COLUMNS
*  PIXROW = NUMBER OF PIXELS PER ROW
*  PIXCOL = NUMBER OF PIXELS PER COLUMN
*  PIXEL  = LESSER OF PIXROW OR PIXCOL
*  LCOUNT = NUMBER OF LINES CURRENTLY WRITTEN TO DIALOG AREA
*  INGRAF = 0=> HOST TEXT GOES TO MONITOR SPACE\\ 1=> TEXT TO GRAPHICS
*  IXL    = LEFT MOST VALUE OF X
*  IXR    = RIGHT MOST VALUE OF X
*  IYT    = VALUE OF Y AT TOP OF SCREEN
*  IYB    = VALUE OF Y AT BOTTOM OF SCREEN
*  NCOLOR = NUMBER OF COLORS IN MCOLOR MAP
*  MCOLOR = MAP OF COLORS
*  ITTRM  = UNIQUE MODEL NUMBER OF GENERAL TERMINAL TYPE
*  MARGX  = NUMBER OF PIXELS PADDED TO X-COORDINATE
*  MARGY  = NUMBER OF PIXELS PADDED TO Y-COORDINATE
*
*
      EQUIVALENCE ( ESC, ASCII(27)), ( FF, ASCII(12)), (SI, ASCII(15))
      EQUIVALENCE ( SO, ASCII(14)), ( CAR, ASCII(13))
*
*   CODES FOR IND:
C
*     IND = 0   =>  REMOVE ALL GRAPHICS TO QUIT
*     IND = 1   =>  ANY ONE TIME ONLY INITIALIZATION
*     IND = 2   =>  MOVE GRAPHICS TO POINT (X,Y) -- DO NOT DRAW LINE
*     IND = 3   =>  DRAW LINE FROM LAST POINT TO NEW (X,Y)
*     IND = 4   =>  DRAW DARK LINE
*     IND = 5   =>  DRAW BRIGHT SOLID LINE
*     IND = 6   =>  INITIALIZE & SET-UP FOR NEXT PICTURE
*     IND = 8   =>  TEMPORARY RELEASE FROM GRAPHICS
*     IND = 9   =>  RETURN TO GRAPHICS FROM TEMP RELEASE
*     IND =10   =>  DONE DRAWING PICTURE
*
*     IND =99   =>  SET COLOR TO VALUE IN X
*
*
*  **   FORMAT TO REDUCE EXTRA CHARACTERS
 2000   FORMAT ( '+', A $)
c? 2000   FORMAT ( ' ',A )
C
      IF (IND.EQ.0) THEN
C
*  ALL DONE -- CLEAR TERMINAL AND WE WILL QUIT
*  ***  CLEAR SCREEN  (NEEDS TWO COMMANDS)
*  ***    FIRST WE CLEAR THE DIALOG AREA
         WRITE (*,2000) ESC//'LZ'
         IF ( ITRRM .EQ. 4105) THEN
            CONTINUE
         ELSEIF ( ITRRM .EQ. 4107 .OR. ITRRM .EQ. 4106) THEN
* if this is 4107, delete all segments
           STEMP = TEKINT( -1)
           ITEMP = INDEX( STEMP, CAR)
           IF ( ITEMP .GT. 0 ) THEN
              WRITE ( *, 2000 ) ESC//'SK'//STEMP(:ITEMP )
           ELSE
              WRITE ( *, 2000 ) ESC//'SK'//STEMP
           ENDIF
* delete all views and set current view to 1
           STEMP = TEKINT( -1)
           ITEMP = INDEX( STEMP, CAR)
           WRITE ( *, 2000 ) ESC//'RK'//STEMP(:ITEMP-1)
           CALL RESCOL
* RETURN THE QUEUESIZE TO 300 
         ELSEIF ( ITRRM .EQ. 4131) THEN
* if this is 4115, delete all segments
           STEMP = TEKINT( -1)
           WRITE ( *, 2000 ) ESC//'SK'//STEMP(:INDEX(STEMP, CAR)-1)
* delete all views and set current view to 1
           STEMP = TEKINT( -1)
           WRITE ( *, 2000 ) ESC//'RK'//STEMP(:INDEX(STEMP, CAR)-1)
           CALL RESCOL
         ENDIF
* ***    SECOND WE CLEAR THE GRAPHIC AREA
         WRITE (*,2000) ESC//FF
* ***  SELECT GREEN TEXT IN DIALOG AREA
         WRITE (*,2000) ESC//'LI300'
* NEED TO CLEAR DIALOG AREA ( ESPECIALLY FOR 4115b )
* ***  FIRST MAKE IT INVISIBLE
         WRITE (*,2000) ESC//'LV0'
* ***  CREATE DIALOG AREA
        STEMP = TEKINT( 30)
        WRITE ( *, 2000) ESC//'LL'//STEMP(:INDEX(STEMP, CAR)-1)
* ***  SET BUFFER AREA FOR DIALOG AREA
        STEMP = TEKINT( 39)
        WRITE ( *, 2000) ESC//'LB'//STEMP(:INDEX(STEMP, CAR)-1)
* ***  ENABLE DIALOG AREA
         WRITE (*,2000) ESC//'KA1'
*   AND NOW WE MAKE IT VISIBLE AGAIN
         WRITE (*,2000) ESC//'LV1'
* **   WE RESTORE THE ORIGINAL CODE VALUE
         IF ( ICODE.EQ.1 .OR. ICODE.EQ.2) THEN
* ***  AND BACK TO ANSI (VT-100) OR EDIT MODE
            WRITE( *,2000) ESC//'%!'//CHAR(ICODE+48)
* ***  SET EDIT MARGINS TO 1,30
            WRITE (*,2000) ESC//'[1;30r'
* ***  INVOKE G0 CHARACTER SET AND SELECTCHARSET ASCII
            WRITE (*,2000) ESC//SI//'(B'
            INGRAF = 0
         ELSEIF( ICODE.EQ. 0) THEN
* ***  TEK MODE IS CURRENT
            CONTINUE
         ELSEIF( ICODE.EQ.3) THEN
* ***  VT52 MODE
            WRITE( *,2000) ESC//'%!'//CHAR(ICODE+48)
         ELSE
            WRITE (*,*) 'UNKNOWN CODE VALUE IN TK4105 IND=0'
         ENDIF

      ELSEIF (IND.EQ.1) THEN
*  ONE TIME ONLY INITIALIZATION OF TERMINAL  (IF NEEDED)
*   NUMBER OF LINES DISPLAYED IN DIALOG AREA
      IDLINE = 8
*   NUMBER OF LINES BUFFERED FOR DIALOG AREA
      IDBUFF = 15
*   DEFAULT WINDOW CORNERS
      IXL = 0
      IXR = 4095
      IYT = 0
      IYB = 3132
* *****
      IMAXR = 30
      IMAXC = 80
      MARGX = 0
C??      MARGY = 800
      MARGY = 800 - 800 / IPAGE
c??      PIXEL = ( IYB - IYT - MARGY ) * IPAGE / 100.
      PIXEL = ( IYB - IYT - 1000 ) * IPAGE / 100.
C
* ***  HAVE TERMINAL REPORT SYNTAX MODE WHICH WE'LL SAVE
        WRITE (*,2000) ESC//'#!0'
  10    READ (*, '(A)' ) REPLY
*  Valid replies have form lll%!# where
*           lll is any number of characters and
*           # is a single ascii digit; 0 is TEK mode
        ITEMP = INDEX ( REPLY, '%!') + 2
        IF ( ITEMP .LE. 2 ) GOTO 10
        ICODE = ICHAR( REPLY( ITEMP+2: ITEMP+2) ) - 48
        IF ( DEBUGP) THEN
           WRITE (*,*) 'TERMINAL CODE IS ',ICODE
        ENDIF
* ***  SWITCH TERMINAL TO TEKTRONIX MODE IF NECESSARY
        IF ( ICODE .NE. 0) WRITE (*,2000) ESC//'%!0'
*  LET'S FIND-OUT WHAT KIND OF 41xx TERMINAL WE HAVE
        WRITE (*,2000) ESC//'IQ?T'
  11    READ (*, '( A )' ) REPLY
*  NOW WE SEND THE "CANCEL-BYPASS-CHARACTER"
        ITEMP = INDEX ( REPLY,'?T') + 2
        IF ( ITEMP .LE. 2 ) GOTO 11
c!        ITRRM = (ICHAR( REPLY( ITEMP: ITEMP) ) - 32 ) * 2**10
        ITRRM = (ICHAR( REPLY( ITEMP: ITEMP) ) - 32 ) * 1024
c!        ITRRM = ITRRM + (ICHAR( REPLY( ITEMP+1: ITEMP+1) ) - 32 )*2**5
        ITRRM = ITRRM + (ICHAR( REPLY( ITEMP+1: ITEMP+1) ) - 32 )*32
        ITRRM = ITRRM + (ICHAR( REPLY( ITEMP+2: ITEMP+2) ) - (32+16) )
        ITTRM = ITRRM
        IF (DEBUGP) THEN
           WRITE (*,2000) ESC//'KA1'
           WRITE (*,*) 'terminal is TK', ITRRM
        ENDIF
        ISCRN = 26
C?        KOROFF = 1
        IF ( ITRRM .EQ. 4105) THEN
           NCOLOR = 7
        ELSEIF ( ITRRM .EQ. 4107 .OR. ITRRM .EQ. 4106) THEN
           IF ( ITRRM .EQ. 4106 ) ISCRN=8
           NCOLOR = 15
* SET THE QUEUESIZE BASED UPON TERMINAL TYPE
           IF ( ITRRM .EQ. 4106) THEN
* SET THE QUEUESIZE TO 200
              WRITE ( *, 2000 ) ESC//'NQL0'
           ELSE
* SET THE QUEUESIZE TO 4096
              WRITE ( *, 2000 ) ESC//'NQD@0'
           ENDIF
* if this is 4107, delete all segments
           STEMP = TEKINT( -1)
           WRITE ( *, 2000 ) ESC//'SK'//STEMP(:INDEX(STEMP, CAR)-1)
* delete all views and set current view to 1
           STEMP = TEKINT( -1)
           WRITE ( *, 2000 ) ESC//'RK'//STEMP(:INDEX(STEMP, CAR)-1)
* set fixup level to 2 so updates are done fast
           WRITE ( *, 2000 ) ESC//'RF2'
           CALL RESCOL
         ELSEIF ( ITRRM .EQ. 4131) THEN
           NCOLOR = 15
* if this is 4115, delete all segments
           STEMP = TEKINT( -1)
           WRITE ( *, 2000 ) ESC//'SK'//STEMP(:INDEX(STEMP, CAR)-1)
* delete all views and set current view to 1
           STEMP = TEKINT( -1)
           WRITE ( *, 2000 ) ESC//'RK'//STEMP(:INDEX(STEMP, CAR)-1)
* set fixup level to 2 so updates are done fast
           WRITE ( *, 2000 ) ESC//'RF2'
           CALL RESCOL
         ELSE
* if none of above, set default
           NCOLOR = 1
           WRITE (*,2000) ESC//'KA1'
           WRITE (*,*) 'UNRECOGNIZED TERMINAL TYPE=',ITRRM
         ENDIF
* NOW SET COLOR MAP
         KLOCAL = 1
         DO 115 J=1, 64-NCOLOR, NCOLOR
         DO 115 I=1, NCOLOR
            MCOLOR( KLOCAL ) = I
            KLOCAL = KLOCAL + 1
  115    CONTINUE
* ***  CLEAR SCREEN  (NEEDS TWO COMMANDS)
* ***    FIRST WE CLEAR THE DIALOG AREA
         WRITE (*,2000) ESC//'LZ'
* ***    SECOND WE CLEAR THE GRAPHIC AREA
         WRITE (*,2000) ESC//FF
* ***  DISABLE DIALOG AREA
         WRITE (*,2000) ESC//'KA0'
* ***  CREATE DIALOG AREA
         STEMP = TEKINT( IDLINE)
         WRITE ( *, 2000 ) ESC//'LL'//STEMP(:INDEX(STEMP, CAR)-1)
* ***  SET BUFFER AREA FOR DIALOG AREA
         STEMP = TEKINT( IDBUFF)
         WRITE ( *, 2000 ) ESC//'LB'//STEMP(:INDEX(STEMP, CAR)-1)
* ***  SELECT GREEN TEXT IN DIALOG AREA
         IF ( ITTRM .EQ. 4105 ) THEN
            WRITE (*,2000) ESC//'LI300'
         ELSE
            WRITE (*,2000) ESC//'LI300'
         ENDIF
* ***  SELECT WHITE LINES IN DRAWING
         WRITE (*,2000) ESC//'ML1'
* ***  ENABLE DIALOG AREA
         WRITE (*,2000) ESC//'KA1'

      ELSEIF (IND.EQ.2 ) THEN
* MOVE TO NEW POINT WITHOUT DRAWING LINE  (PEN-UP)
         IXLX = X * PIXEL + MARGX
         IYLY = Y * PIXEL + MARGY
         IF (DEBUGP) THEN
            WRITE (*,2000) ESC//'KA1'
            WRITE (*,*) 'IND=2; SCALED COORD:',IXLX,IYLY
         ENDIF
           CALL TEKCRD(IXLX,IYLY,TEKCOR)
c          WRITE (*,2000) ESC//'LF'//TEKCOR
	   call tekout(8,esc//'LF'//tekcor)

      ELSEIF (IND.EQ.3) THEN
* DRAW LINE FROM LAST POINT TO NEW POINT
         IXLX = X * PIXEL + MARGX
         IYLY = Y * PIXEL + MARGY
         IF (DEBUGP) THEN
            WRITE (*,2000) ESC//'KA1'
            WRITE (*,*) 'IND=2; SCALED COORD:',IXLX,IYLY
         ENDIF
         CALL TEKCRD(IXLX,IYLY,TEKCOR)
c        WRITE (*,2000) ESC//'LG'//TEKCOR
	 call tekout(8,esc//'LG'//tekcor)

      ELSEIF (IND.EQ.4) THEN
c        WRITE (*,2000) ESC//'ML'//CHAR(64+0)//CHAR(32+16+0)
	 call tekout(5,esc//'ML'//char(64+0)//char(32+16+0))

      ELSEIF (IND.EQ.5) THEN
c        WRITE (*,2000) ESC//'ML'//CHAR(64+0)//CHAR(32+16+1)
	 call tekout(5,esc//'ML'//char(64+0)//char(32+16+1))

      ELSEIF (IND.EQ.6) THEN
*  INITIALIZE FOR DRAWING NEXT PICTURE
*   NUMBER OF LINES DISPLAYED IN DIALOG AREA
      IDLINE = 8
*   NUMBER OF LINES BUFFERED FOR DIALOG AREA
      IDBUFF = 15
* *****
* We must re-compute PIXEL incase user alters IPAGE
      MARGY = 800 - 800 / IPAGE
c??      PIXEL = ( IYB - IYT - MARGY ) * IPAGE / 100.
      PIXEL = ( IYB - IYT - 1000 ) * IPAGE / 100.
C
* ***  NEXT DISABLE THE DIALOG AREA SO THE
*                COORDINATES APPEAR IN GRAPHIC REGION
         WRITE (*,2000) ESC//'KA0'
* ***  SET WINDOW  ???   I DONT KNOW WHAT SETTINGS YET
*         WRITE (*,2000) ESC//'RW'//
*  here we do special TERMINAL junk
         IF ( ITRRM .EQ. 4105) THEN
           NCOLOR = 7
         ELSEIF ( ITRRM .EQ. 4107 .OR. ITRRM .EQ. 4106) THEN
           NCOLOR = 15
* delete all segments
           STEMP = TEKINT( -1)
           WRITE ( *, 2000 ) ESC//'SK'//STEMP(:INDEX(STEMP, CAR)-1)
* delete all views and set current view to 1
           STEMP = TEKINT( -1)
           WRITE ( *, 2000 ) ESC//'RK'//STEMP(:INDEX(STEMP, CAR)-1)
*  set viewport to normal value (0,0) AND (4095,3071)
           CALL TEKCRD( 0, 0, STEMP)
           CALL TEKCRD( 4095, 3071, TEKCOR)
           WRITE ( *, 2000 ) ESC//'RV'//STEMP//TEKCOR
*  AND set window to normal value (0,0) AND (4095,3136)
           CALL TEKCRD( 0, 0, STEMP)
           CALL TEKCRD( 4095, 3136, TEKCOR)
           WRITE ( *, 2000 ) ESC//'RW'//STEMP//TEKCOR
*  set pivot point to (0,0)
          CALL TEKCRD ( 0.0, 0.0, TEKCOR)
          WRITE ( *, 2000) ESC//'SP'//TEKCOR
* and now we open a segment so we can zoom and pan
C?           STEMP = TEKINT( 1)
C?           WRITE ( *, 2000 ) ESC//'SE'//STEMP(:INDEX(STEMP, CAR)-1)
           WRITE ( *, 2000 ) ESC// 'SE1'
         ELSEIF ( ITRRM .EQ. 4131) THEN
           NCOLOR = 15
* delete all segments
           STEMP = TEKINT( -1)
           WRITE ( *, 2000 ) ESC//'SK'//STEMP(:INDEX(STEMP, CAR)-1)
* delete all views and set current view to 1
           STEMP = TEKINT( -1)
           WRITE ( *, 2000 ) ESC//'RK'//STEMP(:INDEX(STEMP, CAR)-1)
*  set viewport to normal value (0,0) AND (4095,3071)
           CALL TEKCRD( 0, 0, STEMP)
           CALL TEKCRD( 4095, 3071, TEKCOR)
           WRITE ( *, 2000 ) ESC//'RV'//STEMP//TEKCOR
*  AND set window to normal value (0,0) AND (4095,3136)
           CALL TEKCRD( 0, 0, STEMP)
           CALL TEKCRD( 4095, 3136, TEKCOR)
           WRITE ( *, 2000 ) ESC//'RW'//STEMP//TEKCOR
*  set pivot point to (0,0)
          CALL TEKCRD ( 0.0, 0.0, TEKCOR)
          WRITE ( *, 2000) ESC//'SP'//TEKCOR
* and now we open a segment so we can zoom and pan
           STEMP = TEKINT( 1)
           WRITE ( *, 2000 ) ESC//'SE'//STEMP(:INDEX(STEMP, CAR)-1)
         ENDIF
* ***   WE CLEAR THE GRAPHIC AREA
         WRITE (*,2000) ESC//FF

      ELSEIF (IND.EQ.8) THEN
* TEMPORARY RELEASE FROM GRAPHICS  (USUALLY FOR TEXT)
	 call tekfls
         WRITE (*,2000) ESC//'LV1'//ESC//'KA1'
C?         WRITE (*,2000) ESC//'KA1'
         INGRAF = 0

      ELSEIF (IND.EQ.9) THEN
* RETURN TO GRAPHICS FROM TEMPORARY RELEASE
         WRITE (*,2000) ESC//'LV0'
C#         WRITE (*,2000) ESC//'KA0'
         INGRAF = 1

      ELSEIF (IND.EQ.10) THEN
* DONE DRAWING PICTURE
         IF ( ITRRM .EQ. 4105) THEN
	    call tekfls
            CONTINUE
         ELSEIF ( ITRRM .EQ. 4107 .OR. ITRRM .EQ. 4106) THEN
* now we end the segment
           WRITE ( *, 2000 ) ESC//'SC'
         ELSEIF ( ITRRM .EQ. 4131) THEN
* now we end the segment
           WRITE ( *, 2000 ) ESC//'SC'
         ENDIF
         WRITE (*,2000) ESC//'LV1'
         WRITE (*,2000) ESC//'KA1'

      ELSEIF (IND.EQ.99) THEN
* CHANGE COLOR OF LINE
         ICOLOR = MAX( 1, INT( X + 0.5 ) )
         ICOLOR = MIN( ICOLOR, NCOLOR )
         STEMP = TEKINT( MCOLOR( ICOLOR) )
c        WRITE (*, 2000) ESC//'ML'//STEMP(:INDEX(STEMP,CAR)-1)
	 call tekout(3+index(stemp,car)-1,esc//'ML'//
     1                           stemp(:index(stemp,car)-1))
*    ALSO CHANGE COLOR OF TEXT TO MATCH
c!st         WRITE (*, 2000) ESC//'MT'//STEMP(:INDEX(STEMP,CAR)-1)
	 call tekout(3+index(stemp,car)-1,esc//'MT'//
     1                           stemp(:index(stemp,car)-1))
       ELSE
* WE HAVE AN ERROR IN IND
         WRITE (*,*) ' ERROR IN PLOT, IND=',IND
      ENDIF
      RETURN
      END

      CHARACTER*4 FUNCTION TEKINT( IINT)
      CHARACTER STEMP*4, CAR*1, NULL*1, ASCII
      COMMON /ASCIIC/ ASCII( 0: 255)
      EQUIVALENCE ( NULL, ASCII(0)), ( CAR, ASCII( 13))
      ITEMP = IINT
      INDX = 1
      ISSIGN = SIGN( 1, ITEMP )
      ITEMP = ABS( ITEMP)
c!      I1 = ITEMP/2**10
      I1 = ITEMP/1024
      IF ( I1 .GT. 0 ) THEN
         STEMP( INDX: INDX) = ASCII( I1 + 64)
         INDX = INDX + 1
      ENDIF
c!      I2 = ( MOD( ITEMP, 2**10) ) / 2**4
      I2 = ( MOD( ITEMP, 1024) ) / 16
      IF ( I2 .GT. 0 .OR. I1 .GT. 0 ) THEN
         STEMP( INDX: INDX) = ASCII( I2 + 64)
         INDX = INDX + 1
      ENDIF
c!      I3 = MOD( ITEMP, 2**4)
      I3 = MOD( ITEMP, 16)
c!      IF ( ISSIGN .GT. 0) I3 = I3 + 2**4
      IF ( ISSIGN .GT. 0) I3 = I3 + 16
      STEMP( INDX: INDX) = ASCII( I3 + 32)
      INDX = INDX + 1
      IF ( INDEX .LT. 4 ) THEN
         STEMP( INDX: INDX) = CAR
         TEKINT = STEMP( : INDX+1)
      ELSE
         TEKINT = STEMP
      ENDIF
      RETURN
      END

      SUBROUTINE TEKCRD( INX, INY, TEKCOR)
      IMPLICIT INTEGER (A-Z)
      INTEGER PIXROW, PIXCOL, PIXEL
      COMMON /TERM/ IMAXR, IMAXC, PIXROW, PIXCOL, PIXEL, LCOUNT, INGRAF,
     .              IXL, IXR, IYT, IYB, NCOLOR, MCOLOR( 64 ), ITTRM,
     .              MARGX, MARGY
* VARIABLES IN COMMON TERM:
*  IMAXR = MAX NUMBER OF ROWS
*  IMAXC = MAX NUMBER OF COLUMNS
*  PIXROW = NUMBER OF PIXELS PER ROW
*  PIXCOL = NUMBER OF PIXELS PER COLUMN
*  PIXEL  = LESSER OF PIXROW OR PIXCOL
*  LCOUNT = NUMBER OF LINES CURRENTLY WRITTEN TO DIALOG AREA
*  INGRAF = 0=> HOST TEXT GOES TO MONITOR SPACE\\ 1=> TEXT TO GRAPHICS
*  IXL    = LEFT MOST VALUE OF X
*  IXR    = RIGHT MOST VALUE OF X
*  IYT    = VALUE OF Y AT TOP OF SCREEN
*  IYB    = VALUE OF Y AT BOTTOM OF SCREEN
*  NCOLOR = NUMBER OF COLORS IN MCOLOR MAP
*  MCOLOR = MAP OF COLORS
*  ITTRM  = UNIQUE MODEL NUMBER OF GENERAL TERMINAL TYPE
*  MARGX  = NUMBER OF PIXELS PADDED TO X-COORDINATE
*  MARGY  = NUMBER OF PIXELS PADDED TO Y-COORDINATE
*
*
      CHARACTER*5 TEKCOR
*
      IX = INX
      IY = INY
* FIRST CHECK FOR CLIPPING
      IF ( IX .LT. IXL ) THEN
         IX = IXL
      ELSEIF ( IX .GT. IXR ) THEN
         IX = IXR
      ENDIF
      IF ( IY .LT. IYT ) THEN
         IY = IYT
      ELSEIF ( IY .GT. IYB ) THEN
         IY = IYB
      ENDIF
* NOW CALCULATE TEK4010 COORDINATE
      HIGHX = IX/128
      LOWX = (IX - HIGHX*128)/4
      EXTRAX = IX - HIGHX*128 - LOWX*4
      HIGHY = IY/128
      LOWY = (IY - HIGHY*128)/4
      EXTRAY = IY - HIGHY*128 - LOWY*4
      EXTRA = EXTRAY*4 + EXTRAX
      TEKCOR = CHAR(32+HIGHY)//CHAR(64+32+16+EXTRA)//
     .         CHAR(64+32+LOWY)//CHAR(32+HIGHX)//CHAR(64+LOWX)
      RETURN
      END

      SUBROUTINE TEKSTR( IROW, ICOL, STRING )
* Places a string of text in GRAPHICS AREA
      INTEGER IROW, ICOL
      CHARACTER*(80) STRING
      CHARACTER*4 TEKINT
      CHARACTER*5 TEKCOR, STEMP
      CHARACTER*1 ESC, ASCII, CAR
      COMMON /ASCIIC/ ASCII( 0: 255)
      INTEGER PIXROW, PIXCOL, PIXEL
      COMMON /TERM/ IMAXR, IMAXC, PIXROW, PIXCOL, PIXEL, LCOUNT, INGRAF,
     .              IXL, IXR, IYT, IYB, NCOLOR, MCOLOR( 64 ), ITTRM,
     .              MARGX, MARGY
* VARIABLES IN COMMON TERM:
*  IMAXR = MAX NUMBER OF ROWS
*  IMAXC = MAX NUMBER OF COLUMNS
*  PIXROW = NUMBER OF PIXELS PER ROW
*  PIXCOL = NUMBER OF PIXELS PER COLUMN
*  PIXEL  = LESSER OF PIXROW OR PIXCOL
*  LCOUNT = NUMBER OF LINES CURRENTLY WRITTEN TO DIALOG AREA
*  INGRAF = 0=> HOST TEXT GOES TO MONITOR SPACE\\ 1=> TEXT TO GRAPHICS
*  IXL    = LEFT MOST VALUE OF X
*  IXR    = RIGHT MOST VALUE OF X
*  IYT    = VALUE OF Y AT TOP OF SCREEN
*  IYB    = VALUE OF Y AT BOTTOM OF SCREEN
*  NCOLOR = NUMBER OF COLORS IN MCOLOR MAP
*  MCOLOR = MAP OF COLORS
*  ITTRM  = UNIQUE MODEL NUMBER OF GENERAL TERMINAL TYPE
*  MARGX  = NUMBER OF PIXELS PADDED TO X-COORDINATE
*  MARGY  = NUMBER OF PIXELS PADDED TO Y-COORDINATE
*
*
      EQUIVALENCE ( ESC, ASCII(27))
      EQUIVALENCE ( CAR, ASCII(13))

      ILEN = LEN(STRING)
      PIXPC = IXR / IMAXC
C??      PIXPR = ( PIXEL / IMAXR ) + 1
      PIXPR = ( ( IYB - IYT - 1000 ) / IMAXR ) + 1

      STEMP = TEKINT(ILEN)
      IILEN = INDEX( STEMP, CAR)-1

      IF ( IROW*ICOL .LT. 1 ) THEN
         IF (ILEN .LT. 1) RETURN
c!st         WRITE ( *, 2000) ESC//'LT'//STEMP(1:IILEN)//STRING
           call tekout(3+iilen+ilen, ESC//'LT'//STEMP(1:IILEN)//STRING)
	   call tekout(8,esc//'LF'//tekcor)
      ELSE
         IXMOV = ICOL * PIXPC + MARGX
C??         IYMOV = ( 29 - IROW) * PIXPR + MARGY
         IYMOV = ( 29 - IROW) * PIXPR + 1000
         CALL TEKCRD( IXMOV, IYMOV, TEKCOR)
c!st         WRITE (*,2000) ESC//'LF'//TEKCOR
          call tekout(8, ESC//'LF'//TEKCOR )
         IF (ILEN .LT. 1) RETURN
c!st         WRITE ( *, 2000) ESC//'LT'//STEMP(1:IILEN)//STRING
           call tekout(3+iilen+ilen, ESC//'LT'//STEMP(1:IILEN)//STRING)
      ENDIF
 2000   FORMAT ( '+', A $)
c? 2000   FORMAT ( ' ', A )
      RETURN
      END

      SUBROUTINE RESCOL
* RESETS COLOR MAPS ON TEKTRONIX TERMINALS
*
      CHARACTER TEKINT*4, STEMP*10, ESC*1, CAR, ASCII*1
      COMMON /ASCIIC/ ASCII( 0: 255)
      INTEGER PIXROW, PIXCOL, PIXEL
      COMMON /TERM/ IMAXR, IMAXC, PIXROW, PIXCOL, PIXEL, LCOUNT, INGRAF,
     .              IXL, IXR, IYT, IYB, NCOLOR, MCOLOR( 64 ), ITTRM,
     .              MARGX, MARGY
* VARIABLES IN COMMON TERM:
*  IMAXR = MAX NUMBER OF ROWS
*  IMAXC = MAX NUMBER OF COLUMNS
*  PIXROW = NUMBER OF PIXELS PER ROW
*  PIXCOL = NUMBER OF PIXELS PER COLUMN
*  PIXEL  = LESSER OF PIXROW OR PIXCOL
*  LCOUNT = NUMBER OF LINES CURRENTLY WRITTEN TO DIALOG AREA
*  INGRAF = 0=> HOST TEXT GOES TO MONITOR SPACE\\ 1=> TEXT TO GRAPHICS
*  IXL    = LEFT MOST VALUE OF X
*  IXR    = RIGHT MOST VALUE OF X
*  IYT    = VALUE OF Y AT TOP OF SCREEN
*  IYB    = VALUE OF Y AT BOTTOM OF SCREEN
*  NCOLOR = NUMBER OF COLORS IN MCOLOR MAP
*  MCOLOR = MAP OF COLORS
*  ITTRM  = UNIQUE MODEL NUMBER OF GENERAL TERMINAL TYPE
*  MARGX  = NUMBER OF PIXELS PADDED TO X-COORDINATE
*  MARGY  = NUMBER OF PIXELS PADDED TO Y-COORDINATE
*
*
* IDHLS :=dialog/ IGHLS :=graphic \\ H:=hue/ L:=lightness/ S:=saturation
      DIMENSION IDHLS( 3, 8 ), IGHLS( 3, 16 )
      EQUIVALENCE ( CAR, ASCII( 13)), ( ESC, ASCII( 27))
      DATA IDHLS /   0,   0,   0,
     1            0, 100,   0,
     2          120,  50, 100,
     3          240,  50, 100,
     4          330,  60, 100,
     5          300,  50, 100,
     6           60,  50, 100,
     7          180,  50, 100 /
*
      DATA IGHLS /   0,   0,   0,
     1            0, 100,   0,
     2          120,  50, 100,
     3          240,  50, 100,
     4            0,  50, 100,
     5          300,  50, 100,
     6           60,  50, 100,
     7          180,  50, 100,
     8          150,  50, 100,
     9          210,  50, 100,
     A          270,  50, 100,
     B          330,  50, 100,
     C           30,  50, 100,
     D           90,  50, 100,
     E            0,  33,   0,
     F            0,  66,   0 /
*
 2000   FORMAT ( '+', A $)
c? 2000   FORMAT ( ' ', A )
*  SET COLOR MODE TO 'HLS'  'OPAQUE'  'ENABLE COLORS'
      WRITE ( *, 2000 ) ESC//'TM311'
*
      DO 10 I= 1, 8
         STEMP = TEKINT( I-1 )
         K = 2
         DO 8 II= 1, 3
            STEMP( K:) = TEKINT( IDHLS( II, I) )
            K = INDEX ( STEMP, CAR )
   8     CONTINUE
         WRITE ( *, 2000 ) ESC//'TF4'//STEMP( :K-1 )
  10  CONTINUE
*
      IF ( ITTRM .EQ. 4105 ) THEN
          MGHLS = 8
      ELSE
          MGHLS = 16
      ENDIF
      DO 50 I= 1, MGHLS
         STEMP = TEKINT( I-1 )
         K = 2
         DO 48 II= 1, 3
            STEMP( K:) = TEKINT( IGHLS( II, I) )
            K = INDEX( STEMP, CAR )
  48     CONTINUE
         WRITE ( *, 2000 ) ESC // 'TG15' // STEMP( :K-1 )
  50  CONTINUE
      RETURN
      END
