    	SUBROUTINE IFGIN_ABLE( MODE )
C
C  PROGRAMMER: R.S. ZHOU		JUNE-1986
C
C	THIS ROUTINE ENABLES OR DISABLES GIN ON TEK-4100 SERIES TERMINALS.
C
C		MODE=0: DISABLE GIN
C		MODE>0: ENABLE FOR LOCATOR MODE
C		MODE<0: ENABLE FOR PICKER MODE
C		|MODE| = CURSOR COLOR
C
    	INCLUDE		'TEKLIB.CBS'
    	DIMENSION	ICMAP(3,8)
     	COMMON/IFGINS/  MD
C
C  GIN CURSOR COLOR MAP....
C
    	DATA ICMAP(1,1), ICMAP(2,1), ICMAP(3,1) /   0, 100,   0 /
    	DATA ICMAP(1,2), ICMAP(2,2), ICMAP(3,2) / 120,  50, 100 /
    	DATA ICMAP(1,3), ICMAP(2,3), ICMAP(3,3) / 240,  50, 100 /
    	DATA ICMAP(1,4), ICMAP(2,4), ICMAP(3,4) /   0,  50, 100 /
    	DATA ICMAP(1,5), ICMAP(2,5), ICMAP(3,5) / 300,  50, 100 /
    	DATA ICMAP(1,6), ICMAP(2,6), ICMAP(3,6) /  60,  50, 100 /
    	DATA ICMAP(1,7), ICMAP(2,7), ICMAP(3,7) / 180,  50, 100 /
    	DATA ICMAP(1,8), ICMAP(2,8), ICMAP(3,8) /   0,   0,   0 /

     	ICODE = MODE
    	IF( ICODE.EQ.0 ) THEN		!DISABLE GIN
     	    IF( MD.EQ.0 ) RETURN
    	    IF( IPL.GT.NBS-IPK-4 ) CALL IFINIT_DUMP
    	    IPB(IPL+1) = 27
    	    IPB(IPL+2) = 73
    	    IPB(IPL+3) = 68
    	    IF( MD.GT.0 ) IPB(IPL+4) = 48
    	    IF( MD.LT.0 ) IPB(IPL+4) = 49
    	    IPL = IPL + 4
    	    CALL IFINIT_DUMP
     	    READ(5,*)
    	ELSE				!ENABLE GIN
     	    IF( IPL.GT.NBS-IPK-22 ) CALL IFINIT_DUMP
     	    IPB(IPL+1) = 27
    	    IPB(IPL+2) = 73
    	    IPB(IPL+3) = 67
    	    IF( ICODE.GT.0 ) IPB(IPL+4) = 48
    	    IF( ICODE.LT.0 ) IPB(IPL+4) = 49
    	    IPB(IPL+5) = 48
    	    IPB(IPL+6) = 27
    	    IPB(IPL+7) = 84
    	    IPB(IPL+8) = 67
    	    IPL = IPL + 8
    	    CALL IFPACK_TEKINT( ICMAP(1,IABS(ICODE)) )
    	    CALL IFPACK_TEKINT( ICMAP(2,IABS(ICODE)) )
    	    CALL IFPACK_TEKINT( ICMAP(3,IABS(ICODE)) )
    	    IPB(IPL+1) = 27
    	    IPB(IPL+2) = 73
    	    IPB(IPL+3) = 69
    	    IF( ICODE.GT.0 ) IPB(IPL+4) = 48
    	    IF( ICODE.LT.0 ) IPB(IPL+4) = 49
    	    IPB(IPL+5) = 48
    	    IPL = IPL + 5
    	ENDIF
     	CALL IFINIT_DUMP
    	MD = ICODE

999	RETURN
    	END

    	FUNCTION IFGIN_REPORT( NSG, XCP, YCP )
C
C  PROGRAMMER: R.S. ZHOU	JUNE-1986
C
C	THIS ROUTINE READS AND DECODES THE GIN LOCATOR OR PICK REPORT
C	AND RETURNS WITH
C
C	IFGIN_REPORT ------- KEY PRESSED.
C	NSG ---------------- SEGMENT NUMBER PICKED IF ANY.
C	XCP,YCP ------------ CURSOR POSITION RELATIVE TO GRAPH ORIGIN.
C
    	INCLUDE         'TEKLIB.CBS'
    	BYTE             REPORT(16)
     	CHARACTER	 TEXT*16
     	EQUIVALENCE	(TEXT,REPORT)
     	COMMON/IFGINS/   MD
C
C  READ A GIN REPORT...
C
  111	READ(5,222,END=888) REPORT
  222	FORMAT(16A1)
     	IF( TEXT.EQ.' ' ) GOTO 888
     	KEY = REPORT(1)
C
C  DECODE THE CURSOR LOCATION...
C
    	IHY = REPORT(2) - 32
    	IEX = REPORT(3) - 32
    	ILY = REPORT(4) - 32
    	IHX = REPORT(5) - 32
    	ILX = REPORT(6) - 32
    	YPS = FLOAT(IHY*128+ILY*4+IEX/4-IYO)/FUNI/YSCL
    	XPS = FLOAT(IHX*128+ILX*4+IEX-4*(IEX/4)-IXO)/FUNI/XSCL
     	IF( XANG.NE.0.0 .OR. YANG.NE.0.0 ) THEN
     	    DET = XCTH*YCTH + XSTH*YSTH
    	    XCP = (XPS*YCTH+YPS*YSTH)/DET
    	    YCP = (YPS*XCTH-XPS*XSTH)/DET
     	ELSE
     	    XCP = XPS
     	    YCP = YPS
     	ENDIF
C
C  DECODE THE SEGMENT NUMBER...
C
     	IF( MD.LT.0 ) THEN
    	    IHI = REPORT(7) - 32
    	    IHJ = REPORT(8) - 32
    	    ILI = REPORT(9) - 32
    	    NSG = IHI*1024 + IHJ*16 + ILI-16*(ILI/16)
    	    ILI = ILI/16
    	    ILI = ILI - 2*(ILI/2)
    	    IF( ILI.EQ.0 ) NSG = -NSG
     	ENDIF
    	GOTO 999
  888	READ(5,222) REPORT
     	KEY = 0
  999	IFGIN_REPORT = KEY
     	RETURN
    	END

    	SUBROUTINE IFGIN_PAP( AP )
C
C  PROGRAMMER: R.S. ZHOU		JUNE-1986
C
C	THIS ROUTINE SETS THE APERTURE "AP" IN INCHES
C	FOR GIN PICK OF A SEGMENT.
C
    	INCLUDE 'TEKLIB.CBS'

    	IF( IPL.GT.NBS-IPK-6 ) CALL IFINIT_DUMP
    	IPB(IPL+1) = 27
    	IPB(IPL+2) = 73
    	IPB(IPL+3) = 65
    	IPL = IPL + 3
    	PA = AP
    	IF( PA.LT.0.01 ) PA = 0.01
    	CALL IFPACK_TEKINT( INT(FUNI*PA) )

    	RETURN
    	END

     	FUNCTION IFGIN_NSEG( ID )
C
C	THIS ROUTINE CONVERTS A PICKED SEGMENT NUMBER
C	IN CASE OF SCREEN SAVING.
C
     	INCLUDE 'TEKLIB.CBS'

     	IS = ID
     	IF( NSE.GT.0 .AND. IS.GT.100 ) THEN
     	    IF( IS.LT.NSE*5101 ) THEN
     		IS = 0
     	    ELSE
     		IS = IS - NSE*5000
     	    ENDIF
     	ENDIF
     	IFGIN_NSEG = IS
     	RETURN
     	END

