LEX    'ESCSTRLX'    * FUNCTIONS TO CREATE ESCAPE SEQUENCES
        ID     #EC           * J.ELHAY 18/5/87
        MSG    0             * PURPOSE: TO CREATE ESCAPE SEQUENCES THAT CAN
        POLL   0             * BE CONCATENATED WITH OTHER STRINGS
        ENTRY  Bold          * BOLD MODE FOR THINKJET
        CHAR   #F
        ENTRY  Perf          * PERFORATION SKIP OPTION
        CHAR   #F
        ENTRY  Pp            * PRINT PITCH CHOICE
        CHAR   #F
        ENTRY  Ul            * UNDERLINE ON OR OFF
        CHAR   #F
        KEY    'BOLD$'       * BOLD$(0)=BOLD OFF, BOLD$(1)=BOLD ON
        TOKEN  16
        KEY    'PERF$'       * PERF$(0)=PERF SKIP OFF, PERF$(1)=ON
        TOKEN  17
        KEY    'PP$'         * PP$(n)=PRINT PITCH n,n=0 =>80 CHARACTERS,
        TOKEN  18            * n=1 =>40, n=2 =>142, n=3 =>71.
        KEY    'UL$'         * UL$(0)=UNDERLINE OFF, UL$(1)=ON
        TOKEN  19            * ALL FUNCTIONS ARE FOR THE THINKJET
        ENDTXT
ARGERR  EQU    #0BF19        * INVALID ARGUMENT ERROR EXIT
POP1R   EQU    #0E8FD        * POP 1 REAL
RJUST   EQU    #12AE2        * FLOATING POINT NUMBER TO DECIMAL INTEGER CONV
D=AVMS  EQU    #1A460        * NEEDED BEFORE EXIT VIA ADHEAD
ADHEAD  EQU    #181B7        * ADD HEADER TO STRING ON STACK
        NIBHEX 811           * ONE OBLIGATORY NUMERIC PARAMETER
Ul      LCHEX  1B266440      * LOAD UL OFF ESC.SEQ. INTO C (REVERSED REVERSED!)
        B=0    S             * B(S) USED AS FLAG
        B=B+1  S             * SET FOR 4 BYTE STRING
        GONC   LBL1          * BET *
        NIBHEX 811           * 1 NUMERIC PAR
Perf    LCHEX  1B266C304C    * PERF OFF ESC.SEQ INTO C
        B=0    S             * B(S) PSEUDO-FLAG CLEAR FOR 5 BYTE STRING
        GONC   LBL1          * BET *
        NIBHEX 811           * 1 NUMERIC PAR
Bold    LCHEX  1B28733042    * BOLD OFF ESC.SEQ INTO C
        B=0    S             * ANOTHER 5 BYTE STRING, B(S) CLEAR
LBL1    CR0EX                * SAVE THE ESC.SEQ. IN R0
        LC(1)  1             * MAX PARAMETER VALUE FOR BOLD$,PERF$,UL$
        R1=C                 * SAVE THIS IN R1
        GONC   LBL2          * BET *
argerr  GOVLNG ARGERR        * ERROR EXIT POINT
        NIBHEX 811           * 1 NUMERIC PARAMETER
Pp      LCHEX  1B266B3053    * PRINT PITCH ESC.SEQ INTO C
        B=0    S             * B(S) CLEAR FOR 5 BYTE STRING
        CR0EX                * SAVE ESC.SEQ IN R0
        LC(1)  3             * MAX PARAMETER VALUE FOR PP$
        R1=C                 * ALSO SAVED IN R1 (SAVES CODE DUPLICATION)
LBL2    GOSBVL POP1R         * NOW WE POP THE ARGUMENT
        ?A#0   S             * IS IT NEGATIVE?
        GOYES  argerr        * DON'T WANT IT!
        GOSBVL RJUST         * REAL IN A(W)=>DEC INT IN A(W)
        C=R1                 * PUT MAX PAR VALUE INTO C
        ?A>C   A             * IS OUR ARG GREATER?
        GOYES  argerr        * DON'T WANT IT
        SETHEX               * NECESSARY FOR ADHEAD TO WORK CORRECTLY
        ?B=0   S             * 5 BYTES ?
        GOYES  LBL3          * SKIP - ONLY INCREMENT ESC.SEQ BY 1 WHEN n=1
        A=A+A  A             * DOUBLE TWICE TO INCREMENT UL ESC.SEQ
        A=A+A  A             * BY 4
LBL3    ?B#0   S             * 4 BYTES ?
        GOYES  SKIP          * ADJUSTED ARG IS ADDED TO LAST NIBBLE
        ASL    A             * FOR THE OTHERS, n IS ADDED TO 3rd LAST NIBBLE
        ASL    A             * BY TWO LEFT SHIFTS OF A
SKIP    C=R0                 * RESTORE ESC.SEQ TO C
        A=A+C  W             * ADD MODIFIED ARGUMENT IN A TO ESC.SEQ IN C
        P=     9             * POINT TO WHERE START OF STRING WILL BE
        ?B=0   S             * 5 BYTES ?
        GOYES  LBL4          * P=9 IS OK
        P=P-1                * FOR 4 BYTE STRING,
        P=P-1                * WE WANT P=7
LBL4    D1=D1+ 16            * STRING HEADER WILL OVERWRITE INPUT PARAMETER
        CD1EX                * SAVE D1 IN R1
        D1=C                 * USING C(A)
        R1=C                 * BECAUSE R1 POINTS TO END(!) OF STRING
        D1=D1- 10            * POINT D1 TO START(!) OF STRING (5 BYTE)
        ?B=0   S             * IT IS 5 BYTES, ISN'T IT?
        GOYES  LBL5          * OK
        D1=D1+ 2             * NO! SHIFT D1 BACK 2 NIBS FOR UL$ (4 BYTES)
LBL5    DAT1=A WP            * WRITE STRING TO STACK
        P=     0             * NEEDED BY ADHEAD
        ST=0   0             * ALSO NEEDED, BUT FOR EXIT THROUGH EXPR
        GOSBVL D=AVMS        * ADHEAD NEEDS THIS TOO (DEMANDING ISN'T IT?)
        GOVLNG ADHEAD        * OUTPUT! (IF ST0 HAD BEEN SET, WE WOULD HAVE
        END                  * RETURNED AFTER ADHEAD)