     	FUNCTION IFINIT( ITT )
C
C  PROGRAMMER:  RONG-SHENG ZHOU
C		ALFRED UNIVERSITY, FEB-1986
C
C	THIS ROUTINE:
C
C	o  PERFORMS SOME TERMINAL SETUPS
C	o  INITIALIZES THE DIALOG AREA
C	o  INITIALIZES THE GRAPHIC AREA AND BUFFER
C
C	FOR TERMINAL GRAPHICS. IT MUST BE CALLED FIRST BY
C	AN APPLICATION PROGRAM USING THIS LIBRARY.
C
C	ITT --- INPUT TYPE OF CRT ON LINE:
C
C	ITT = 0: INTERACTIVE SOLICITATION OF CRT
C	ITT = 1: ANSI/VT100 TEXT TERMINAL ON LINE
C	ITT = 2: TEKTRONIX-4100  TERMINAL ON LINE
C	ITT = 3: REGIS GRAPHICS  TERMINAL ON LINE
C
C	IFINIT: RETURN WITH TYPE OF CRT ON LINE IF ITT=0.
C	        IFINIT=0: BAIL OUT.
C
    	INCLUDE 'TEKLIB.CBS'

    	PARAMETER	INB0= 45
    	BYTE		ESC, INIT0(INB0)
    	DIMENSION	ICMAP(3,8)
C
C  INIT0 CONTAINS THE SETUP FOR TEK-4100 TERMINALS...
C
    	DATA INIT0 /
     +  27,78,67,13,  		!<ESC>NCCr: SET EOM CHARACTER
     +  27,73,77,49,		!<ESC>IM 1: SET REPORT EOM FREQUENCY
     +  27,75,65,49,		!<ESC>KA1 : ENABLE DIALOG AREA
     +  27,77,81,50,		!<ESC>MQ2 : GRAPHTEXT PRECISION = STROKE
     +  27,77,71,49,		!<ESC>MG1 : WRITING MODE = OVERSTRIKE
     +  27,84,68,50,51,		!<ESC>TD 2,3  : SET ALPHA CURSOR INDICES
     +  27,84,77,51,49,49,	!<ESC>TM 3,1,1: SET COLOR MODE
     +  27,77,65,48,48,		!<ESC>MA 00   : SET CHARACTER SLANT 0
     +  27,77,82,48,48, 	!<ESC>MR 00   : SET TEXTSTRING ROTATION 0
     +  27,77,86,48 /		!<ESC>MV 0    : SET LINE TYPE INDEX
C
C  INDEX COLOR MAP....
C
    	DATA ICMAP(1,1), ICMAP(2,1), ICMAP(3,1) /   0,   0,   0 /
    	DATA ICMAP(1,2), ICMAP(2,2), ICMAP(3,2) /   0, 100,   0 /
    	DATA ICMAP(1,3), ICMAP(2,3), ICMAP(3,3) / 120,  50, 100 /
    	DATA ICMAP(1,4), ICMAP(2,4), ICMAP(3,4) / 240,  50, 100 /
    	DATA ICMAP(1,5), ICMAP(2,5), ICMAP(3,5) /   0,  50, 100 /
    	DATA ICMAP(1,6), ICMAP(2,6), ICMAP(3,6) / 300,  50, 100 /
    	DATA ICMAP(1,7), ICMAP(2,7), ICMAP(3,7) /  60,  50, 100 /
    	DATA ICMAP(1,8), ICMAP(2,8), ICMAP(3,8) / 180,  50, 100 /
C
C  INITIALIZE SOME COMMON FLAGS...
C
     	NSE = 0			!PLOT OVERLAY OFF
     	IDF = 0			!PLOT DI FILE OFF
     	IDW = 0			!PLOT DI FILE OFF
C
C  OPEN LOGICAL UNIT "LUN" FOR THE TERMINAL GRAPHICS...
C
     	LUN = 50
    	OPEN( UNIT=LUN, FILE='SYS$OUTPUT:', STATUS='NEW',
     +        FORM='FORMATTED', CARRIAGECONTROL='NONE' )
C
C  SET TERMINAL KEYPAD INTO THE NUMERIC...
C
     	ESC = 27
     	WRITE(LUN,1000) ESC
1000	FORMAT(A1,'>')
C
C  GET THE TYPE OF TERMINAL ON LINE...
C
     	ITM = ITT
     	IF( ITM.EQ.0 ) THEN
     	    CALL IFINIT_CRT
     	    IF( ITM.EQ.0 ) GOTO 999
     	ENDIF
C
C  QUEUE AN ASYNCHRONOUS SYSTEM TRAP (AST) FOR "CTRL_Y" INTERRUPT...
C
     	CALL IFQAST_CTRLY
     	IF( ITM.EQ.1 ) GOTO 999
C
C  CLEAR THE GRAPHICS BUFFER...
C
     	DO I=1, NBS+5
     	   IPB(I) = 0
     	ENDDO
    	IF( ITM.EQ.3 ) GOTO 222
C
C  SET UP IN TEK-4100...
C
    	IPB(1) = 27		!ENTER TEK MODE: <ESC>%!0
    	IPB(2) = '%'
    	IPB(3) = '!'
    	IPB(4) = '0'
    	IPL = 4
     	IPK = 4
C
C  CLEAR THE TERMINAL MEMERY AND THE SCREEN...
C
    	CALL IFSEG_OPEN( 999999 )
    	CALL IFINIT_FRESH
C
C  SET VIEWPORT WINDOW TO BE IXM x IYM...
C
    	IPB(IPL+1) = 27		!<ESC>RW first-corner second-corner
    	IPB(IPL+2) = 82
    	IPB(IPL+3) = 87
    	IPL = IPL + 3
    	CALL IFPACK_TEKXY( 0, 0 )
    	CALL IFPACK_TEKXY( 4095, 3132 )
C
C  LOAD INIT ARRAY...
C
    	DO I=1, INB0
    	   IPL = IPL + 1
    	   IPB(IPL) = INIT0(I)
    	ENDDO
C
C  SET DIALOG AREA COLOR MAP...
C
    	DO I=1,8
    	   CALL IFINIT_DMAP( I-1,ICMAP(1,I),ICMAP(2,I),ICMAP(3,I) )
    	ENDDO
C
C  SET GRAPHIC AREA COLOR MAP FOR SURFACE #1...
C
    	DO I=1,8
    	   CALL IFINIT_CMAP(1,I-1,ICMAP(1,I),ICMAP(2,I),ICMAP(3,I),)
    	ENDDO
C
C  SET GIN PICK APERTURE...
C
    	CALL IFGIN_PAP( 0.1 )
C
C  ENABLE KEY EXPANSION OF KEY MACROS...
C
    	CALL IFMAC_KEYEXP( 1 )
C
C  SET DIALOG AREA LINES AND COLORS...
C
    	CALL IFINIT_LINE( 24 )
    	CALL IFINIT_INDEX( 1, 4, 4 )
     	GOTO 888
C
C  SET UP IN REGIS...
C
222	IPB(1) = 27
    	IPB(2) = 'P'
    	IPB(3) = 'p'
    	IPL = 3
     	IPK = 3
     	CALL IFINIT_REGIS
C
C  DUMP THE SETUP BUFFER...
C
888	CALL IFINIT_DUMP

999	IFINIT = ITM
     	RETURN
    	END

     	SUBROUTINE IFINIT_CRT
C
C	THIS ROUTINE GETS TERMINAL ID.
C
     	INCLUDE 'TEKLIB.CBS'
     	INTEGER*2 CHANNEL
     	CHARACTER ESC*14
     	BYTE      REPORT(16)

     	ITK = 0
     	CALL IF_DCL_CRT( ITM )
     	IF( ITM.GT.0 ) GOTO 1005
  1	CALL IFANSI_CLEAR(0)
     	CALL IFANSI_VIDEO(80)
     	CALL IFANSI_VIDEO(90)
     	CALL IFANSI_TEXT('      Types of graphics terminals supported:',
     +  50, 8, 15 )
     	CALL IFANSI_VIDEO(30)
     	CALL IFANSI_TEXT('   Please press a desired function code',
     +  44, 15, 18 )
     	CALL IFANSI_VIDEO(47)
     	CALL IFANSI_TEXT('1> ANSI_protocol text terminal',30,10,22)
     	CALL IFANSI_TEXT('2> Tektronix_4100 Graphics Terminal',35,11,22)
     	CALL IFANSI_TEXT('3> ReGIS Graphics Terminal', 26, 12, 22 )
     	CALL IFANSI_TEXT('?> Help      0> Exit', 20, 14, 22 )
     	CALL IFANSI_CURSOR(14,35)
1000	CALL IFQIOW_KEY( KEY )
     	IF( KEY.EQ.26 .OR. KEY.EQ.13 .OR. KEY.EQ.48 ) GOTO 999
     	IF( KEY.EQ.63 .OR. KEY.EQ.81 ) THEN	!? AND PF2
     	    CALL IFMISC_TYPE('GRAFIT$HLP:TERMINAL.HLP',' ',22)
     	    GOTO 1
     	ENDIF
     	IF( KEY.LT.49 .OR. KEY.GT.51 ) GOTO 1000
     	ITM = KEY-48
1005	IF( ITM.NE.2 ) GOTO 999
C
C  GET THE TEK-4100 MODEL NUMBER...
C  SEND TEKTRONIX ESCAPE SEQUENCE FOR DEVICE ID ...
C
     	ESC = '+#%!0#IQ?T#%!1'
     	ESC(2:2) = CHAR(27)
     	ESC(6:6) = CHAR(27)
     	ESC(11:11) = CHAR(27)
     	WRITE(6,2000) ESC
2000	FORMAT(A14,$)
C
C  QIO WAITS FOR 16 BYTE FEEDBACK OR 2 SECOND TIMEOUT...
C
     	CALL SYS$ASSIGN( 'SYS$INPUT:', CHANNEL,, )
     	CALL SYS$QIOW( %VAL(1), %VAL(CHANNEL), %VAL(177),,,,
     +  %REF(REPORT(1)), %VAL(16), %VAL(2),,, )
     	CALL SYS$DASSGN( %VAL(CHANNEL) )
C
C  THE REPORT FROM A TEKTRONIX-4100 SHOULD LOOK LIKE "..?T###"
C  WHERE "###" IS AN ENCODED INTEGER OF TEK MODEL NUMBER...
C
     	DO I=1, 6
     	   IF( REPORT(I).EQ.'?' ) GOTO 111
     	ENDDO
     	GOTO 999
C
C  IT'S A TEKTRONIX... DECODE THE MODEL NUMBER...
C
111	CALL IFPACK_INTTEK( REPORT(I+2), ITK )
999	RETURN
     	END

     	FUNCTION IFINIT_ITM( ICODE )
C
C	THIS ROUTINE REPORTS/SETS TYPE OF THE ON-LINE TERMINAL.
C
     	INCLUDE 'TEKLIB.CBS'

     	IF( ICODE.EQ.0 ) THEN
     	    IFINIT_ITM = ITM
     	ELSE
     	    ITM = ICODE
     	ENDIF

     	RETURN
     	END

     	FUNCTION IFINIT_ITK( ICODE )
C
C	THIS ROUTINE REPORTS/SETS TYPE OF THE ON-LINE TERMINAL.
C
     	INCLUDE 'TEKLIB.CBS'

     	IF( ICODE.EQ.0 ) THEN
     	    IFINIT_ITK = ITK
     	ELSE
     	    ITK = ICODE
     	ENDIF

     	RETURN
     	END

     	SUBROUTINE IFINIT_CMAP( NS, INDEX, IC1, IC2, IC3 )
C
C  PROGRAMMER: R.S. ZHOU 	FEB-1986
C
C	THIS ROUTINE DEFINES THE COLOR INDEX FOR GRAPHIC AREA
C	IN HLS SYSTEM FOR TEKTRONIX 4100 SERIES TERMINALS.
C
C	NS    : SURFACE NUMBER
C	INDEX : COLOR INDEX 0 - 15 ( 0 = SCREEN BACKGROUND INDEX )
C	IC1   : HUE ( 0 - 360 )
C	IC2   : LIGHTNESS ( 0 - 100 )
C	IC3   : SATURATION ( 0 - 100 )
C
    	INCLUDE 'TEKLIB.CBS'

    	IF( ITM.NE.2 ) RETURN

    	NSS = NS
    	INDX = INDEX
    	LC1 = IC1
    	LC2 = IC2
    	LC3 = IC3
    	IF( NSS.LT.1 ) NSS = -1		!ALL SURFACES
    	IF( NSS.GT.4 ) NSS =  4
    	IF( INDX.LT.0 ) INDX = 0
    	IF( INDX.GT.15) INDX = 15
    	IF( LC1.LT.0 ) LC1 = 0
    	IF( LC1.GT.360 ) LC1 = 360
    	IF( LC2.LT.0 ) LC2 = 0
    	IF( LC2.GT.100 ) LC2 = 100
    	IF( LC3.LT.0 ) LC3 = 0
    	IF( LC3.GT.100 ) LC3 = 100
C
C  IF THE BUFFER IS FULL, DUMP IT...
C
    	IF( IPL.GT.NBS-IPK-19 ) CALL IFINIT_DUMP
C
C  <ESC>TG surface-number, color-index, color-mixture
C
    	IPB(IPL+1) = 27
    	IPB(IPL+2) = 84
    	IPB(IPL+3) = 71
    	IPL = IPL + 3
    	CALL IFPACK_TEKINT( NSS )
    	IPB(IPL+1) = 52		!INTEGER ARRAY OF 4
    	IPL = IPL + 1
    	CALL IFPACK_TEKINT( INDX )
    	CALL IFPACK_TEKINT( LC1 )
    	CALL IFPACK_TEKINT( LC2 )
    	CALL IFPACK_TEKINT( LC3 )

    	RETURN
    	END

     	SUBROUTINE IFINIT_DMAP( INDEX, IC1, IC2, IC3 )
C
C  PROGRAMMER: R.S. ZHOU 	FEB-1986
C
C	THIS ROUTINE DEFINES THE COLOR INDEX FOR DIALOG AREA
C	IN HLS SYSTEM FOR TEKTRONIX 4100 SERIES TERMINALS.
C
C	INDEX: COLOR INDEX 0 - 7
C	IC1  : HUE ( 0 - 360 )
C	IC2  : LIGHTNESS ( 0 - 100 )
C	IC3  : SATURATION ( 0 - 100 )
C
    	INCLUDE 'TEKLIB.CBS'

    	INDX = INDEX
    	LC1 = IC1
    	LC2 = IC2
    	LC3 = IC3
    	IF( INDX.LT.0 ) INDX = 0
    	IF( INDX.GT.7 ) INDX = 7
    	IF( LC1.LT.0 ) LC1 = 0
    	IF( LC1.GT.360 ) LC1 = 360
    	IF( LC2.LT.0 ) LC2 = 0
    	IF( LC2.GT.100 ) LC2 = 100
    	IF( LC3.LT.0 ) LC3 = 0
    	IF( LC3.GT.100 ) LC3 = 100
C
C  IF THE BUFFER IS FULL, DUMP IT...
C
    	IF( IPL.GT.NBS-IPK-16 ) CALL IFINIT_DUMP
C
C  <ESC>TF color-index, color-mixture
C
    	IPB(IPL+1) = 27
    	IPB(IPL+2) = 84
    	IPB(IPL+3) = 70
    	IPL = IPL + 4
    	IPB(IPL) = 52		!INTEGER ARRAY OF 4
    	CALL IFPACK_TEKINT( INDX )
    	CALL IFPACK_TEKINT( LC1 )
    	CALL IFPACK_TEKINT( LC2 )
    	CALL IFPACK_TEKINT( LC3 )

    	RETURN
    	END

    	SUBROUTINE IFINIT_LINE( LINES )
C
C  PROGRAMMER: R.S. ZHOU 	FEB-1986
C
C	THIS ROUTINE SETS DIALOG AREA LINES FOR TEK-4100 TERMINALS.
C
C	LINES: DIALOG AREA LINES ( 2-30 )
C	       IF -1<LINES<2, DIALOG AREA IS INVISIBLE, OTHERWISE VISIBLE.
C	       IF LINES = -1, SKIPS SETTING DIALOG AREA.
C	       IF LINES> 1, DIALOG AREA IS SET AND ERASED.
C	       IF LINES<-1, DIALOG AREA IS SET BUT NOT ERASED.
C
    	INCLUDE 'TEKLIB.CBS'

     	IF( IF_DCL_HARDCOPY() ) RETURN

    	ILN = LINES
    	IF( ITM.NE.2 ) GOTO 999
C
C  IF BUFFER IS FULL, DUMP IT...
C
    	IF( IPL.GT.NBS-IPK-15 ) CALL IFINIT_DUMP

    	IPB(IPL+1) = 27		!<ESC>LV
    	IPB(IPL+2) = 76
    	IPB(IPL+3) = 86
    	IPL = IPL + 4
    	IF( ILN.GT.1 .OR. ILN.LT.0 ) GOTO 111
C
C  DAVISIBILITY NO...
C
    	IPB(IPL) = 48
    	GOTO 222
C
C  DAVISIBILITY YES...
C
111	IPB(IPL) = 49
    	IF( ILN.EQ.-1 ) GOTO 222
C
C  CLEAR DIALOGUE AREA IF ILN>0...
C
     	IF( ILN.GT.1 ) THEN
    	    IPB(IPL+1) = 27		!<ESC>LZ:
    	    IPB(IPL+2) = 76
    	    IPB(IPL+3) = 90
    	    IPL = IPL + 3
     	ENDIF
C
C  SET DIALOG AREA LINES...
C
    	IPB(IPL+1) = 27		!<ESC>LL number-of-lines
    	IPB(IPL+2) = 76
    	IPB(IPL+3) = 76
    	IPL = IPL + 3
     	JUNK = IABS(ILN)
    	IF( JUNK.GT.30 ) JUNK = 30
    	CALL IFPACK_TEKINT( JUNK )
C
C  DUMP THE BUFFER...
C
222	CALL IFINIT_DUMP
999	IF( ILN.GT.1 ) THEN
     	    CALL IFANSI_MARGIN( 0, 0 )
     	    IF( ITM.NE.2 ) CALL IFANSI_CLEAR(0)
     	    IF( ITM.EQ.3 ) CALL IFINIT_REGIS
     	ENDIF
    	RETURN
    	END

    	SUBROUTINE IFINIT_INDEX( IDL, IDC, IDB )
C
C  PROGRAMMER: R.S. ZHOU 	FEB-1986
C
C	THIS ROUTINE SETS DIALOGUE AREA COLOR INDICES
C	FOR TEKTRONIX 4100 SERIES TERMINALS.
C
C	IDL :      LETTER COLOR INDEX( 0-7 )
C	IDC : LETTER CELL COLOR INDEX( 0-7 )
C	IDB :  BACKGROUND COLOR INDEX( 0-7 )
C
    	INCLUDE 'TEKLIB.CBS'
	DIMENSION IDAC(8)
	DATA IDAC / 0, 7, 1, 2, 4, 6, 5, 3 /

	IF( ITM.NE.2 ) RETURN
C
C  IF BUFFER IS FULL, DUMP IT...
C
    	IF( IPL.GT.NBS-IPK-10 ) CALL IFINIT_DUMP
C
C  SET THE COLOR INDICES...
C
    	N1 = IDL
    	N2 = IDC
    	N3 = IDB
    	IF( N1.LT.0 ) N1 = 0
    	IF( N1.GT.7 ) N1 = 7
    	IF( N2.LT.0 ) N2 = 0
    	IF( N2.GT.7 ) N2 = 7
    	IF( N3.LT.0 ) N3 = 0
    	IF( N3.GT.7 ) N3 = 7
    	IPB(IPL+1) = 27		!<ESC>LI char-cell-back indices
    	IPB(IPL+2) = 76
    	IPB(IPL+3) = 73
    	IPL = IPL + 3
    	IPB(IPL+1) = 48 + N1
    	IPB(IPL+2) = 48 + N2
    	IPB(IPL+3) = 48 + N3
    	IPL = IPL + 3
C
C  DUMP THE BUFFER...
C
	CALL IFINIT_DUMP
    	RETURN
    	END

     	SUBROUTINE IFINIT_EXIT
C
C  PROGRAMMER:  R.S. ZHOU
C		ALFRED UNIVERSITY,  MAY-1987
C
C	THIS ROUTINE CLEANS UP GRAPHICS SCREEN
C	AND TERMINATES ALL PLOT SESSIONS.
C
     	INCLUDE 'TEKLIB.CBS'
C
C  CLEAN UP THE SCREEN...
C
     	IF(IDF.GT.0) CLOSE(UNIT=IDF,DISPOSE='DELETE')	!DELETE DI FILE
     	IF(ITM.EQ.2) THEN
     	    CALL IFGIN_ABLE( 0 )		!DIABLE GIN IF ACTIVE
    	    CALL IFSEG_OPEN( 999999 )		!DELETE ALL GRAPHIC SEGMENTS
    	    CALL IFMAC_MACROS( 0 )		!DELETE ALL DEFINED MACROS
     	    CALL IFINIT_LINE( -24 )		!RESET DIALOGUE AREA LINES
    	    CALL IFINIT_INDEX( 1,4,4 )		!RESET DIALOGUE AREA INDICES
    	    CALL IFINIT_FRESH			!ERASE THE GRAPHIC AREA
     	ENDIF
     	IF(ITM.EQ.3) CALL IFINIT_REGIS		!CLEAR REGIS SCREEN
     	CALL IFANSI_CLEAR(2)			!CLEAR THE BOTTOM SCREEN
     	CALL IFANSI_VIDEO(47)			!RESET WRITING COLOR
     	CLOSE(UNIT=LUN)				!CLOSE TERMINAL GRAPHICS
C
C  ENABLE DCL DETECTION OF CTRL_Y...
C
     	ITM = 2**25
     	CALL LIB$ENABLE_CTRL( %REF(ITM) )

     	RETURN
     	END

     	SUBROUTINE IFINIT_OVER( NS )
C
C	THIS ROUTINE RETURNS THE NUMBER OF PLOTS ON SCREEN
C
     	INCLUDE 'TEKLIB.CBS'
     	NS = NSE
     	RETURN
     	END

     	LOGICAL FUNCTION IFINIT_SAVE()
C
C	THIS ROUTINE SAVES THE CURRENT PLOT SESSION.
C
     	INCLUDE 'TEKLIB.CBS'

     	IF( NSE.LT.10 ) THEN
     	    IF( ITK.GT.4105 ) THEN
     		CALL IFSEG_PIVOT( 0.0, 0.0 )
     		CALL IFSEG_OPEN( NSE+10 )
     	    ENDIF
     	    IFINIT_SAVE = .TRUE.
     	ELSE
     	    CALL IFANSI_VIDEO(70)
     	    WRITE(6,1000)
1000	    FORMAT('_oops: Max number of saved plots hit.')
     	    IFINIT_SAVE = .FALSE.
     	ENDIF
     	RETURN
     	END

    	SUBROUTINE IFINIT_PLOT( XORG, YORG, DNAME )
C
C  PROGRAMMER: R.S. ZHOU		FEB-1986
C
C  	THIS ROUTINE INITIALIZES A PLOT SESSION.
C
C	XORG, YORG --- GRAPH ORIGIN IN INCHES.
C	DNAME -------- NAME OF DATA FILE TO BE PLOTTED.
C
    	INCLUDE		'TEKLIB.CBS'
     	CHARACTER	DNAME*(*)
C
C  QUEUE AN ASYNCHRONOUS SYSTEM TRAP (AST) FOR CTRL/C INTERRUPT...
C
     	CALL IFQAST_CTRLC
C
C  GET DATA FILENAME...
C
     	IF( DNAME.EQ.' ' ) THEN
     	    DTNAME = 'JUNK.DAT'
     	ELSE
     	    IF( DNAME.EQ.'$OVERLAY' ) THEN
     		IF( .NOT.IF_DCL_SKIPDI() .AND. IDF.EQ.0 ) GOTO 222
     		NSE = NSE + 1
     		GOTO 111
     	    ENDIF
     	    DTNAME = DNAME
     	ENDIF
     	IF( IF_DCL_SKIPDI() ) GOTO 111
C
C  OPEN THE DEVICE-INDEPENDENT "DI" FILE FOR HARDCOPY
C
222	DINAME = DTNAME
     	CALL IFMISC_NAMEXT( DINAME, '.DI' )
     	IF( IDF.GT.0 ) CLOSE(UNIT=IDF, DISPOSE='DELETE' )
     	IDF = 49
     	OPEN( UNIT=IDF, FILE=DINAME, STATUS='NEW',
     +        FORM='FORMATTED', CARRIAGECONTROL='LIST' )
     	NSE  = 0
     	NPPS = 0
111	IDW  = 0
C
C  INITIALIZE COMMON GRAPHICS PARAMETERS...
C
     	ILP = 0
     	IFN = 1
     	IFP = 0
     	IFF = 0
     	NEW = 1
     	LTY = 1
     	LWD = 1
     	XSCL = 1.0
     	YSCL = 1.0
     	XANG = 0.0
     	YANG = 0.0
     	XCTH = 1.0
     	XSTH = 0.0
     	YCTH = 1.0
     	YSTH = 0.0
     	XORS = 0.0
     	YORS = 0.0
     	FUNI = 410.0
     	IF( ITM.EQ.3 ) FUNI = 72.0
     	IXO  = XORG*FUNI
     	IYO  = YORG*FUNI
     	IXL  = IXO
     	IYL  = IYO
     	IF( NSE.EQ.0 ) THEN
     	    IF( ITM.EQ.2 ) CALL IFINIT_FRAME( XORG, YORG, DTNAME )
     	    IF( ITM.EQ.3 ) CALL IFINIT_REGIS
     	ENDIF

     	CALL IFSTYL(1,1)		!SELECT PLOTTING STYLUS
     	CALL IFINIT_DUMP		!DUMP INIT BUFFER
     	IF( IDF.GT.0 ) THEN
     	    IF( NPPS.GT.0 ) CALL IFPLOT_DUMP
     	    WRITE(IDF,1000) XORG,YORG
     	    IDW = 1			!WRITE "DI" FILE ON
     	ENDIF
1000	FORMAT('STAR:',2F8.3)

999	RETURN
    	END

    	SUBROUTINE IFINIT_FRAME( XORG, YORG, FNAME )
C
C  PROGRAMMER: R.S. ZHOU	FEB-1986
C
C	THIS ROUTINE DISPLAYS A FRAMEOWRK ON PLOTTING BACKGROUND.
C
     	CHARACTER FNAME*(*), FKEY*3

     	IF( FNAME.NE.' ' ) THEN
     	    I = INDEX( FNAME, ']' )
     	    IF(I.GT.0) FNAME = FNAME(I+1:)
     	ENDIF
     	CALL IFPLOT( -XORG, -YORG, -9 )		!REORIGIN TO CORNER
     	CALL IFSEG_OPEN( 999999 ) 		!CLEAR TERMINAL MEMERY
     	CALL IFINIT_FRESH			!CLEAR RASTER SCREEN
     	CALL IFSEG_OPEN( 1 )			!OPEN SEGMENT #1
     	CALL IFSPEN( 7 )
     	CALL IFPLOT( 0.00, 0.00, 3 )		!OUTLINE THE SCREEN SPACE
     	CALL IFPLOT( 0.00, 7.64, 2 )
     	CALL IFPLOT( 9.97, 7.64, 2 )
     	CALL IFPLOT( 9.97, 0.00, 2 )
     	CALL IFPLOT( 0.00, 0.00, 2 )
     	CALL IFSPEN( 1 )
     	CALL IFPLOT( 0.10, 7.35, 3 )
     	CALL IFPLOT( 9.87, 7.35, 2 )
     	CALL IFTEXT( 0.10,7.43,'FILE:',0.12,0.12,0.0)
     	CALL IFTEXT( 3.30,7.43,'REFERENCE ORIGIN',0.12,0.12,0.0)
     	CALL IFTEXT( 5.50,7.43,'WORKING ORIGIN',0.12,0.12,0.0)
     	CALL IFTEXT( 7.35,7.43,'PEN_CODE:',0.12,0.12,0.0)
     	IF( FNAME.NE.' ' ) THEN
     	    CALL IFSPEN( 3 )
     	    CALL IFTEXT( 0.75,7.43,FNAME,0.12,0.12,0.0)
     	ENDIF
     	CALL IFSPEN( 1 )
     	CALL IFMARK( 3.15,7.48,0.12,0.0,9 )
     	CALL IFSPEN( 2 )
     	CALL IFMARK( 5.35,7.48,0.12,0.0,9 )
     	DO I=1, 7
     	   CALL IFSPEN( I )
     	   CALL IFMARK( 8.30+I*0.2, 7.48, 0.12, 0.0, 1 )
     	ENDDO
     	CALL IFSEG_OPEN( 0 )			!CLOSE SEGMENT #1

     	CALL IFPLOT( XORG, YORG, -9 )		!MOVE TO THE ORIGIN
     	CALL IFSEG_OPEN( 2 )			!OPEN SEGMENT #2
     	CALL IFSPEN( 1 )
     	CALL IFSEG_PIVOT( 0.0, 0.0 )
     	CALL IFMARK( 0.0, 0.0, 0.12, 0.0, 9 )
     	CALL IFSEG_OPEN( 0 )			!CLOSE SEGMENT #2
     	CALL IFSEG_OPEN( 3 )			!OPEN SEGMENT #3
     	CALL IFSPEN( 2 )
     	CALL IFSEG_PIVOT( 0.0, 0.0 )
     	CALL IFMARK( 0.0, 0.0, 0.12, 0.0, 9 )
     	CALL IFSEG_OPEN( 0 )			!CLOSE SEGMENT #3

999	RETURN
    	END

    	SUBROUTINE IFINIT_FRESH
C
C  PROGRAMMER: R.S. ZHOU		MARCH-1986
C
C	THIS ROUTINE ISSUES A SCREEN CLEAR COMMAND TO FRESH THE SCREEN,
C	AS A RESULT, ALL DEFINED GRAPH SEGMENTS ARE REDRAWN.
C
    	INCLUDE 'TEKLIB.CBS'

    	IF( IPL.GT.NBS-IPK-2 ) CALL IFINIT_DUMP

    	IPB(IPL+1) = 27			!<ESC><FF>
    	IPB(IPL+2) = 12
    	IPL = IPL + 2

    	CALL IFINIT_DUMP

    	RETURN
    	END

     	SUBROUTINE IFINIT_REGIS
C
C  THIS ROUTINE CLEARS A REGIS SCREEN.
C
     	INCLUDE		'TEKLIB.CBS'
     	PARAMETER	INIB = 43
    	BYTE		INIT0(INIB)
    	CHARACTER	INIT1*43
    	EQUIVALENCE	(INIT0,INIT1)
    	DATA INIT1 / 'S(E)S(I0N0A)W(VI7A0S0M1N0P1M2)T(I0A0D0S1)@.' /
     	IF( IPL.GT.NBS-IPK-INIB ) CALL IFINIT_DUMP
    	DO I=1, INIB
    	   IPL = IPL + 1
    	   IPB(IPL) = INIT0(I)
    	ENDDO
     	RETURN
     	END

     	SUBROUTINE IFINIT_DIF( ICODE )
C
C	THIS ROUTINE ENABLES OR DISABLES WRITING OF "DI" FILE.
C
     	INCLUDE 'TEKLIB.CBS'

     	IDW = ICODE
     	IF( IDW.NE.0 ) IDW = 1
     	IF( IDF.EQ.0 ) IDW = 0

     	RETURN
     	END

    	SUBROUTINE IFINIT_DUMP
C
C  PROGRAMMER: R.S. ZHOU		FEB-1986
C
C  	THIS ROUTINE DUMPS THE GRAPHIC BUFFER.
C
    	INCLUDE 'TEKLIB.CBS'

     	IF( CTRL_C .OR. ITM.EQ.1 .OR. IPL.LT.5 ) RETURN

    	IF( ITM.EQ.2 ) THEN
    	    IPB(IPL+1) = 27		!<ESC>%!1: ENTER ANSI MODE
    	    IPB(IPL+2) = '%'
    	    IPB(IPL+3) = '!'
    	    IPB(IPL+4) = '1'
    	    IPL = IPL + 4
    	ENDIF
    	IF( ITM.EQ.3 ) THEN
    	    IPB(IPL+1) = 27		!EXIT GRAPHIC MODE
    	    IPB(IPL+2) = '\'
    	    IPL = IPL + 2
    	ENDIF
     	IF( CTRL_C ) RETURN
    	WRITE(LUN,1000) (IPB(I),I=1,IPL)
1000	FORMAT(<IPL>A1)
C
C  NULL THE BUFFER...
C
    	DO I = IPK+1, IPL
    	   IPB(I) = 0
    	ENDDO
    	IPL = IPK

999	RETURN
    	END

     	SUBROUTINE IFINIT_PLOT_END
C
C	COUNTER ROUTINE TO IFINIT_PLOT TO TERMINATE A PLOT SESSION.
C
     	INCLUDE 'TEKLIB.CBS'
     	BYTE     ESC

     	IF( CTRL_C ) THEN
     	    ESC = 27
     	    IF( ITM.EQ.2 ) WRITE(LUN,1000) ESC	!RESET TERMINAL TO ANSI
1000	    FORMAT(A1,'%!1')
     	    IF( ITM.EQ.3 ) WRITE(LUN,1001) ESC	!RESET TERMINAL TO ANSI
1001	    FORMAT(A1,'\')
     	    IDW = 0
     	    IF( IDF.GT.0 ) THEN
     		CLOSE(UNIT=IDF, DISPOSE='DELETE' )
     		IDF = 0
     		NSE = 0
     	    ENDIF
     	    CTRL_C = .FALSE.
     	ELSE
     	    CALL IFINIT_DUMP			!DUMP THE FINAL BUFFER
     	    CALL SYS$DASSGN( %VAL(NCC) )	!DEASSIGN THE AST CHANNEL
     	    CALL IFANSI_CLEAR(6)	!DELETE THE CURRENT DIALOGUE LINE
     	ENDIF

     	RETURN
     	END

     	SUBROUTINE IFINIT_FKEYS( F1,F2,F3,F4,F5,F6,F7,F8 )
C
C	THIS ROUTINE DISPLAYS FUNCTION KEY DEFINITIONS.
C
     	INCLUDE  'TEKLIB.CBS'
     	CHARACTER F1*(*), F2*(*), F3*(*), F4*(*)
     	CHARACTER F5*(*), F6*(*), F7*(*), F8*(*)
     	CHARACTER KEYF*3, FKEY(8)*8

     	IF( ITM.NE.2 ) RETURN
C
C  RESET ORIGIN TO (0,0)...
C
     	IXOS = IXO
     	IYOS = IYO
     	XORG = XORS
     	YORG = YORS
     	XSCF = XSCL
     	YSCF = YSCL
     	XSCL = 1.0
     	YSCL = 1.0
     	ANGX = XANG
     	ANGY = YANG
     	CALL IFROTA( 0.0, 0.0 )
     	IXO  = 0
     	IYO  = 0
     	XORS = 0.0
     	YORS = 0.0
     	IWD  = IDW
     	IDW  = 0
C
C  DISPLAY THE FKEYS...
C
     	FKEY(1) = F1
     	FKEY(2) = F2
     	FKEY(3) = F3
     	FKEY(4) = F4
     	FKEY(5) = F5
     	FKEY(6) = F6
     	FKEY(7) = F7
     	FKEY(8) = F8
     	CALL IFSEG_OPEN(-4 )
     	CALL IFSEG_OPEN( 4 )
     	CALL IFSPEN(3)
     	KEYF = 'F :'
     	DO  IKEY=1, 8
     	    ENCODE( 1, 111, KEYF(2:2) ) IKEY
  111	    FORMAT(I1)
     	    CALL IFTEXT( 1.25*IKEY-1.15,7.2, KEYF, 0.1,0.1,0 )
     	    IF(FKEY(IKEY).NE.' ') CALL IFTEXT(1.25*IKEY-.8,7.2,
     +      FKEY(IKEY),0.1,0.1,0)
     	ENDDO
     	CALL IFSEG_OPEN( 0 )
     	CALL IFINIT_DUMP
C
C  RESTORE ORIGIN...
C
     	IXO = IXOS
     	IYO = IYOS
     	XORS= XORG
     	YORS= YORG
     	XSCL= XSCF
     	YSCL= YSCF
     	CALL IFROTA( ANGX, ANGY )
     	IDW = IWD

     	RETURN
     	END

