C COPYRIGHT (C) 1983 GLENN EVERHART C PERMISSION IS GIVEN TO ANYONE TO USE, DISTRIBUTE, OR COPY THIS C PROGRAM FREELY BUT NOT TO SELL IT COMMERICALLY. C C VT100 VIDEO DISPLAY COMMAND PROGRAM. CALLING SEQUENCE IS C CALL UVT100(CMD,N1,N2), WHERE CMD IS ONE OF THE COMMANDS IN C THE PARAMETER LIST BELOW, AND N1 AND N2 ARE OPTIONAL PARAMETERS C DEPENDING UPON CMD. SEE THE UVT100 USER'S MANUAL FOR MORE DETAILS. C C AUTHOR: GLEN HOFFING C DATE: 24-FEB-81 C MODIFIED FOR PORTACALC BY GLENN EVERHART C SUBROUTINE UVT100 ( CMD, N1, N2 ) IMPLICIT INTEGER ( A - Z ) DIMENSION PRL ( 6 ) PARAMETER CUP = 1, CUU = 2, CUD = 3, CUF = 4, CUB = 5, DECDWL = 6 $, DECDHL = 7, DECRC = 8, DECSC = 9, DECSWL = 10, ED = 11, EL = 12 $, SGR = 13, NEL = 14, SCS = 15, SM = 16, RM = 17, ANSI = 18 BYTE OUTBUF ( 16 ) OUTBUF ( 1 ) = 27 DO 20000 I = 2, 16 OUTBUF ( I ) = 0 20000 CONTINUE 20001 CONTINUE IF (.NOT.( CMD .EQ. CUP )) GOTO 20002 OUTBUF ( 2 ) = 1H[ IF (.NOT.( N1 .GT. 0 . AND . N1 .LT. 25 )) GOTO 20004 ENCODE ( 2, 10, OUTBUF ( 3 ) ) N1 20004 CONTINUE OUTBUF ( 5 ) = 1H; IF (.NOT.( N2 .GT. 0 . AND . N2 .LT. 133 )) GOTO 20006 ENCODE ( 3, 105, OUTBUF ( 6 ) ) N2 20006 CONTINUE OUTBUF ( 9 ) = 1HH LEN = 9 GOTO 20003 20002 CONTINUE IF (.NOT.( CMD .EQ. CUB )) GOTO 20008 OUTBUF ( 2 ) = 1H[ IF (.NOT.( N1 .GT. 0 . AND . N1 .LT. 133 )) GOTO 20010 ENCODE ( 3, 105, OUTBUF ( 3 ) ) N1 20010 CONTINUE OUTBUF ( 6 ) = 1HD LEN = 6 GOTO 20009 20008 CONTINUE IF (.NOT.( CMD .EQ. CUD )) GOTO 20012 OUTBUF ( 2 ) = 1H[ IF (.NOT.( N1 .GT. 0 . AND . N1 .LT. 25 )) GOTO 20014 ENCODE ( 2, 10, OUTBUF ( 3 ) ) N1 20014 CONTINUE OUTBUF ( 5 ) = 1HB LEN = 5 GOTO 20013 20012 CONTINUE IF (.NOT.( CMD .EQ. CUF )) GOTO 20016 OUTBUF ( 2 ) = 1H[ IF (.NOT.( N1 .GT. 0 . AND . N1 .LT. 133 )) GOTO 20018 ENCODE ( 3, 105, OUTBUF ( 3 ) ) N1 20018 CONTINUE OUTBUF ( 6 ) = 1HC LEN = 6 GOTO 20017 20016 CONTINUE IF (.NOT.( CMD .EQ. CUU )) GOTO 20020 OUTBUF ( 2 ) = 1H[ IF (.NOT.( N1 .GT. 0 . AND . N1 .LT. 25 )) GOTO 20022 ENCODE ( 2, 10, OUTBUF ( 3 ) ) N1 20022 CONTINUE OUTBUF ( 5 ) = 1HA LEN = 5 GOTO 20021 20020 CONTINUE IF (.NOT.( CMD .EQ. DECDHL )) GOTO 20024 OUTBUF ( 2 ) = 1H# IF (.NOT.( N1 .EQ. 1 )) GOTO 20026 OUTBUF ( 3 ) = 1H4 GOTO 20027 20026 CONTINUE OUTBUF ( 3 ) = 1H3 20027 CONTINUE LEN = 3 GOTO 20025 20024 CONTINUE IF (.NOT.( CMD .EQ. DECDWL )) GOTO 20028 OUTBUF ( 2 ) = 1H# OUTBUF ( 3 ) = 1H6 LEN = 3 GOTO 20029 20028 CONTINUE IF (.NOT.( CMD .EQ. DECRC )) GOTO 20030 OUTBUF ( 2 ) = 1H8 LEN = 2 GOTO 20031 20030 CONTINUE IF (.NOT.( CMD .EQ. DECSC )) GOTO 20032 OUTBUF ( 2 ) = 1H7 LEN = 2 GOTO 20033 20032 CONTINUE IF (.NOT.( CMD .EQ. DECSWL )) GOTO 20034 OUTBUF ( 2 ) = 1H# OUTBUF ( 3 ) = 1H5 LEN = 3 GOTO 20035 20034 CONTINUE IF (.NOT.( CMD .EQ. ED )) GOTO 20036 OUTBUF ( 2 ) = 1H[ IF (.NOT.( N1 .EQ. 0 )) GOTO 20038 OUTBUF ( 3 ) = 1H0 GOTO 20039 20038 CONTINUE IF (.NOT.( N1 .EQ. 1 )) GOTO 20040 OUTBUF ( 3 ) = 1H1 GOTO 20041 20040 CONTINUE OUTBUF ( 3 ) = 1H2 20041 CONTINUE 20039 CONTINUE OUTBUF ( 4 ) = 1HJ LEN = 4 GOTO 20037 20036 CONTINUE IF (.NOT.( CMD .EQ. EL )) GOTO 20042 OUTBUF ( 2 ) = 1H[ IF (.NOT.( N1 .EQ. 0 )) GOTO 20044 OUTBUF ( 3 ) = 1H0 GOTO 20045 20044 CONTINUE IF (.NOT.( N1 .EQ. 2 )) GOTO 20046 OUTBUF ( 3 ) = 1H2 GOTO 20047 20046 CONTINUE OUTBUF ( 3 ) = 1H1 20047 CONTINUE 20045 CONTINUE OUTBUF ( 4 ) = 1HK LEN = 4 GOTO 20043 20042 CONTINUE IF (.NOT.( CMD .EQ. SGR )) GOTO 20048 OUTBUF ( 2 ) = 1H[ IF (.NOT.( N1 .EQ. 7 )) GOTO 20050 OUTBUF ( 3 ) = 1H7 GOTO 20051 20050 CONTINUE OUTBUF ( 3 ) = 1H0 20051 CONTINUE OUTBUF ( 4 ) = 1Hm OUTBUF ( 5 ) = 8 LEN = 5 GOTO 20049 20048 CONTINUE IF (.NOT.( CMD .EQ. NEL )) GOTO 20052 OUTBUF ( 2 ) = 1HE LEN = 2 GOTO 20053 20052 CONTINUE IF (.NOT.( CMD .EQ. SCS )) GOTO 20054 IF (.NOT.( N1 .EQ. 0 )) GOTO 20056 OUTBUF ( 2 ) = 1H( GOTO 20057 20056 CONTINUE OUTBUF ( 2 ) = 1H) 20057 CONTINUE IF (.NOT.( N2 .EQ. 0 )) GOTO 20058 OUTBUF ( 3 ) = 1HA GOTO 20059 20058 CONTINUE IF (.NOT.( N2 .EQ. 1 )) GOTO 20060 OUTBUF ( 3 ) = 1HB GOTO 20061 20060 CONTINUE OUTBUF ( 3 ) = 1H0 20061 CONTINUE 20059 CONTINUE LEN = 3 GOTO 20055 20054 CONTINUE IF (.NOT.( CMD .EQ. SM )) GOTO 20062 OUTBUF ( 2 ) = 1H[ OUTBUF ( 3 ) = 1H? IF (.NOT.( N1 .GT. 0 . AND . N1 .LT. 10 )) GOTO 20064 ENCODE ( 1, 5, OUTBUF ( 4 ) ) N1 20064 CONTINUE OUTBUF ( 5 ) = 1Hh LEN = 5 GOTO 20063 20062 CONTINUE IF (.NOT.( CMD .EQ. RM )) GOTO 20066 OUTBUF ( 2 ) = 1H[ OUTBUF ( 3 ) = 1H? IF (.NOT.( N1 .GT. 0 . AND . N1 .LT. 10 )) GOTO 20068 ENCODE ( 1, 5, OUTBUF ( 4 ) ) N1 20068 CONTINUE OUTBUF ( 5 ) = 1Hl LEN = 5 GOTO 20067 20066 CONTINUE IF (.NOT.( CMD .EQ. ANSI )) GOTO 20070 OUTBUF ( 2 ) = 1H< LEN = 2 20070 CONTINUE 20067 CONTINUE 20063 CONTINUE 20055 CONTINUE 20053 CONTINUE 20049 CONTINUE 20043 CONTINUE 20037 CONTINUE 20035 CONTINUE 20033 CONTINUE 20031 CONTINUE 20029 CONTINUE 20025 CONTINUE 20021 CONTINUE 20017 CONTINUE 20013 CONTINUE 20009 CONTINUE 20003 CONTINUE DO 20072 I = 1, LEN IF (.NOT.( OUTBUF ( I ) .EQ. 1H )) GOTO 20074 OUTBUF ( I ) = 0 20074 CONTINUE 20072 CONTINUE 20073 CONTINUE C CALL GETADR ( PRL, OUTBUF ) PRL ( 2 ) = LEN C 4608 = OCTAL 11000 = IO.WLB. COULD REPLACE BY FORTRAN WRITE C BUT THIS IS FASTER FOR RSX. WRITES LEN BYTES FROM OUTBUF. C TO LOGICAL UNIT 5 (USER'S TERMINAL). C HERE LUN 6 IS USER'S TERMINAL TOO AND USED FOR OUTPUT SO USE C IT INSTEAD OF 5 HERE. WRITE(6,400)(OUTBUF(KKK),KKK=1,LEN) 400 FORMAT(128A1) C CALL WTQIO ( 4608, 6, 20,,, PRL ) 5 FORMAT ( I1 ) 10 FORMAT ( I2 ) 105 FORMAT(I3) RETURN END