     	SUBROUTINE IFMAC_MACROS( ICODE )
C
C  PROGRAMMER: R.S. ZHOU	MARCH-1986
C
C	THIS ROUTINE DEFINES THE FOLLOWING KEY-EXPANDED MACROS
C	ON A TEK-4100 SERIES TERMINAL( UNSHIFT ).
C
C	ICODE = 0: DELETE ALL VOLATILE MACROS.
C	ICODE = 1: DEFINE F1-F8 AND KEYPAD NUMBERS FOR DIALOGUE.
C	ICODE = 2: DEFINE F1-F8, <DEL>, <ENTER> FOR GIN.
C
     	INCLUDE		'TEKLIB.CBS'
     	DIMENSION	MACS(3)

     	IF( CTRL_C .OR. ITM.NE.2 ) RETURN
C
C  CALL IFMAC_DEFINE TO DEFINE THE MACROS...
C
    	ICD = IABS(ICODE)
C
C  DELETE ALL VOLATILE MACROS FIRST...
C
     	CALL IFMAC_DEFINE( -1, 0, 0 )
    	IF( ICD.EQ.0 ) GOTO 999
C
C  DEFINE MACROS...
C
     	IF( ICD.EQ.1 ) THEN
C
C		10 NUMBER KEYS ON KEYPAD AS
C	   	0,1,2,3,4,5,6,7,8,9 PLUS <CR>
C
C		F1  ====  F1<CR>
C		F2  ====  F2<CR>
C		F3  ====  F3<CR>
C		F4  ====  F4<CR>
C		F5  ====  F5<CR>
C		F6  ====  F6<CR>
C		F7  ====  F7<CR>
C		F8  ====  F8<CR>
C
     	    MACS(1) = 70
     	    MACS(3) = 13
     	    DO  I= 1, 8
     		MACS(2) = 48+I
     		CALL IFMAC_DEFINE( 127+I, 3, MACS(1) )
    	    ENDDO
     	    MACS(2) = 13
     	    DO  I= 0, 9
     		MACS(1) = 48+I
     		CALL IFMAC_DEFINE( -55-I, 2, MACS(1) )
     	    ENDDO
     	ENDIF

     	IF( ICD.EQ.2 ) THEN
C
C		F1  ====  86 (ASCII CODE) --- V
C		F2  ====  88 (ASCII CODE) --- X
C		F3  ====  82 (ASCII CODE) --- R
C		F4  ====  26 (ASCII CODE) --- ^Z
C		F5  ====  73 (ASCII CODE) --- I
C		F6  ====  74 (ASCII CODE) --- J
C		F7  ====  75 (ASCII CODE) --- K
C		F8  ====  76 (ASCII CODE) --- L
C	    <ENTER> ====  92 (ASCII CODE) --- `
C	      <DEL> ==== 126 (ASCII CODE) --- ~
C
     	    CALL IFMAC_DEFINE( 128, 1, 86 )
     	    CALL IFMAC_DEFINE( 129, 1, 88 )
     	    CALL IFMAC_DEFINE( 130, 1, 82 )
     	    CALL IFMAC_DEFINE( 131, 1, 26 )
     	    CALL IFMAC_DEFINE( 132, 1, 73 )
     	    CALL IFMAC_DEFINE( 133, 1, 74 )
     	    CALL IFMAC_DEFINE( 134, 1, 75 )
     	    CALL IFMAC_DEFINE( 135, 1, 76 )
     	    CALL IFMAC_DEFINE( -68, 1, 96 )
     	    CALL IFMAC_DEFINE( 127, 1,126 )
     	ENDIF

999	CALL IFINIT_DUMP

     	RETURN
    	END

     	SUBROUTINE IFMAC_DEFINE( NUMBER, LENGTH, STRING )
C
C  PROGRAMMER:  R.S. ZHOU
C		ALFRED UNIVERSITY, MAY-1987
C
C	THIS ROUTINE DEFINES A VOLATILE MACRO ON A TEK-4100 TERMINAL.
C
C	*** READ TEK-4100 MANUAL FOR MACRO DEFINITION ***
C
C	NUMBER: MACRO NUMBER FOR A NON-KEY MACRO.
C		ASCII DECIMAL EQUIVALENCE FOR A KEY MACRO.
C		VALID RANGE OF "NUMBER": -150 TO -2, 0 TO 32767.
C		NUMBER = -1: DELETE ALL DEFINED MACROS.
C		FORMAT: INTEGER
C	LENGTH: NUMBER OF CHARACTERS IN THE MACRO.
C		LENGTH = 0: DELETE THE "NUMBER" MACRO.
C		FORMAT: INTEGER
C	STRING: MACRO CONTENTS IN ASCII	DECIMAL EQUIVALENCES.
C		FORMAT: INTEGER ARRAY
C
C	TEK-4100 COMMAND: <ESC>KD macro-number macro-contents
C
     	INCLUDE 'TEKLIB.CBS'

     	INTEGER STRING(1)

     	ICD = NUMBER
     	LEN = IABS(LENGTH)
C
C  IF THE BUFFER IS FULL, DUMP IT...
C
     	IF( IPL.GT.NBS-LEN*3-IPK-9 ) CALL IFINIT_DUMP
C
C  LOAD <ESC>KD...
C
    	IPB(IPL+1) = 27
    	IPB(IPL+2) = 75
    	IPB(IPL+3) = 68
    	IPL = IPL + 3
C
C  PACK THE MACRO NUMBER...
C
    	CALL IFPACK_TEKINT( ICD )
     	IF( ICD.EQ.-1 ) GOTO 999
C
C  PACK THE STRING LENGTH...
C
     	CALL IFPACK_TEKINT( LEN )
     	IF( LEN.EQ.0 ) GOTO 999
C
C  PACK THE MACRO CONTENTS...
C
     	DO I=1, LEN
     	   IKEY = STRING(I)
     	   CALL IFPACK_TEKINT( IKEY )
     	ENDDO

999	RETURN
     	END

    	SUBROUTINE IFMAC_EXPAND( NUMBER )
C
C  PROGRAMMER: R.S. ZHOU		JUNE-1986
C
C	THIS ROUTINE EXPANDS A MACRO OF NUMBER "NUMBER",
C	WHICH COULD BE A KEY-MACRO OR NON-KEY-MACRO.
C	VALID RANGE OF "NUMBER": -150 TO -2, 0 TO 32767.
C
    	INCLUDE 'TEKLIB.CBS'

     	MNUM = NUMBER
     	IF( MNUM.EQ.-1 ) RETURN
C
C  IF BUFFER IS FULL, DUMP IT...
C
    	IF( IPL.GT.NBS-IPK-6 ) CALL IFINIT_DUMP

    	IPB(IPL+1) = 27		!<ESC>KX
    	IPB(IPL+2) = 75
    	IPB(IPL+3) = 88
    	IPL = IPL + 3
     	CALL IFPACK_TEKINT( MNUM )
    	CALL IFINIT_DUMP

    	RETURN
    	END

    	SUBROUTINE IFMAC_KEYEXP( ICODE )
C
C  PROGRAMMER: R.S. ZHOU		JUNE-1986
C
C	THIS ROUTINE ENABLES( ICODE=1 ) OR DISABLES( ICODE=0 )
C	KEY EXPANSION OF MACROS.
C
    	INCLUDE 'TEKLIB.CBS'
C
C  IF BUFFER IS FULL, DUMP IT...
C
    	IF( IPL.GT.NBS-IPK-4 ) CALL IFINIT_DUMP

    	IPB(IPL+1) = 27		!<ESC>KW
    	IPB(IPL+2) = 75
    	IPB(IPL+3) = 87
    	IPL = IPL + 4
    	IF( ICODE.EQ.0 ) IPB(IPL) = 48
    	IF( ICODE.EQ.1 ) IPB(IPL) = 49
    	CALL IFINIT_DUMP

    	RETURN
    	END

