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 SUBROUTINE UVT100(CMD, N1, N2,C1) IMPLICIT INTEGER(A - Z) BYTE C1 DIMENSION PRL(6) C CURSOR POSITION AND PRINT 1 CHARACTER C CURSOR POSITION REPORT C CURSOR UP C CURSOR DOWN C CURSOR FORWARD C CURSOR BACK C DOUBLE WIDTH LINE 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, CPP=19 BYTE OUTBUF(10),STORE(109) DATA ILEN/0/,ISTRT/1/ C SET FIRST CHARACTER TO 'ESCAPE' CODE 100 OUTBUF(1) = 27 DO 2000 I = 2, 10 OUTBUF(I) = 0 2000 CONTINUE IF (CMD .NE. CUP.AND.CMD .NE. CPP) GOTO 2020 C CURSOR POSITION OUTBUF(2) = '[' IF (.NOT.(N1 .GT. 0.AND.N1 .LT. 25)) GOTO 2040 C ...ROW N1 ENCODE(2, 10, OUTBUF(3)) N1 2040 CONTINUE OUTBUF(5) = ';' IF (.NOT.(N2 .GT. 0.AND.N2 .LT. 81)) GOTO 2060 C ...COLUMN N2 ENCODE(2, 10, OUTBUF(6)) N2 2060 CONTINUE OUTBUF(8) = 'H' LEN = 8 IF(CMD .EQ. CPP) THEN OUTBUF(9) = C1 LEN = 9 ENDIF GOTO 2030 2020 CONTINUE C IF (.NOT.(CMD .EQ. CUB)) GOTO 2080 C C CURSOR BACK C C OUTBUF(2) = '[' C IF (.NOT.(N1 .GT. 0.AND.N1 .LT. 81)) GOTO 2100 C C ...N1 COLUMNS C C ENCODE(2, 10, OUTBUF(3)) N1 C2100 CONTINUE C OUTBUF(5) = 'D' C LEN = 5 C GOTO 2030 C2080 CONTINUE C IF (.NOT.(CMD .EQ. CUD)) GOTO 2120 C C CURSOR DOWN C C OUTBUF(2) = '[' C IF (.NOT.(N1 .GT. 0.AND.N1 .LT. 25)) GOTO 2140 C C ...N1 ROWS C C ENCODE(2, 10, OUTBUF(3)) N1 C2140 CONTINUE C OUTBUF(5) = 'B' C LEN = 5 C GOTO 2030 C2120 CONTINUE C IF (.NOT.(CMD .EQ. CUF)) GOTO 2160 C C CURSOR FORWARD C C OUTBUF(2) = '[' C IF (.NOT.(N1 .GT. 0.AND.N1 .LT. 81)) GOTO 2180 C C ...N1 COLUMNS C C ENCODE(2, 10, OUTBUF(3)) N1 C2180 CONTINUE C OUTBUF(5) = 'C' C LEN = 5 C GOTO 2030 C2160 CONTINUE C IF (.NOT.(CMD .EQ. CUU)) GOTO 2200 C C CURSOR UP C C OUTBUF(2) = '[' C IF (.NOT.(N1 .GT. 0.AND.N1 .LT. 25)) GOTO 2220 C C ...N1 ROWS C C ENCODE(2, 10, OUTBUF(3)) N1 C2220 CONTINUE C OUTBUF(5) = 'A' C LEN = 5 C GOTO 2030 C2200 CONTINUE C IF (.NOT.(CMD .EQ. DECDHL)) GOTO 2240 C C DOUBLE-HEIGHT LINE C C OUTBUF(2) = '#' C IF (.NOT.(N1 .EQ. 1)) GOTO 2260 C C ...BOTTOM HALF C C OUTBUF(3) = '4' C GOTO 2270 C2260 CONTINUE C C ...TOP HALF C C OUTBUF(3) = '3' C2270 CONTINUE C LEN = 3 C GOTO 2030 C2240 CONTINUE C IF (.NOT.(CMD .EQ. DECDWL)) GOTO 2280 C C DOUBLE-WIDTH LINE C C OUTBUF(2) = '#' C OUTBUF(3) = '6' C LEN = 3 C GOTO 2030 C2280 CONTINUE C IF (.NOT.(CMD .EQ. DECRC)) GOTO 2300 C C RESTORE CURSOR C C OUTBUF(2) = '8' C LEN = 2 C GOTO 2030 C2300 CONTINUE C IF (.NOT.(CMD .EQ. DECSC)) GOTO 2320 C C SAVE CURSOR C C OUTBUF(2) = '7' C LEN = 2 C GOTO 2030 C2320 CONTINUE C IF (.NOT.(CMD .EQ. DECSWL)) GOTO 2340 C C SINGLE-WIDTH,SINGLE-HEIGHT LINE C C OUTBUF(2) = '#' C OUTBUF(3) = '5' C LEN = 3 C GOTO 2030 C2340 CONTINUE IF (.NOT.(CMD .EQ. ED)) GOTO 2360 C ERASE DISPLAY OUTBUF(2) = '[' IF (.NOT.(N1 .EQ. 0)) GOTO 2380 C ...CURSOR POSITION TO END OF SCREEN OUTBUF(3) = '0' GOTO 2390 2380 CONTINUE IF (.NOT.(N1 .EQ. 1)) GOTO 2400 C ...START OF SCREEN TO CURSOR POSITION OUTBUF(3) = '1' GOTO 2390 2400 CONTINUE C ...ENTIRE SCREEN OUTBUF(3) = '2' 2390 CONTINUE OUTBUF(4) = 'J' LEN = 4 GOTO 2030 2360 CONTINUE IF (.NOT.(CMD .EQ. EL)) GOTO 2420 C ERASE LINE OUTBUF(2) = '[' IF (.NOT.(N1 .EQ. 0)) GOTO 2440 C ...CURSOR POSITION TO END OF LINE OUTBUF(3) = '0' GOTO 2450 2440 CONTINUE IF (.NOT.(N1 .EQ. 2)) GOTO 2460 C ...ENTIRE LINE OUTBUF(3) = '2' C ...START OF LINE TO CURSOR POSITION GOTO 2450 2460 CONTINUE OUTBUF(3) = '1' 2450 CONTINUE OUTBUF(4) = 'K' LEN = 4 GOTO 2030 2420 CONTINUE C IF (.NOT.(CMD .EQ. SGR)) GOTO 2480 C C SELECT GRAPHIC RENDITION C C OUTBUF(2) = '[' C IF (.NOT.(N1 .EQ. 7)) GOTO 2500 C C ...REVERSE FIELD ON C C OUTBUF(3) = '7' C GOTO 2510 C2500 CONTINUE C C ...REVERSE FIELD OFF C C OUTBUF(3) = '0' C2510 CONTINUE C OUTBUF(4) = 'm' C OUTBUF(5) = 8 C LEN = 5 C GOTO 2030 C2480 CONTINUE C IF (.NOT.(CMD .EQ. NEL)) GOTO 2520 C C CURSOR TO NEW LINE C C OUTBUF(2) = 'E' C LEN = 2 C GOTO 2030 2520 CONTINUE IF (.NOT.(CMD .EQ. SCS)) GOTO 2540 C SELECT CHARACTER SET IF (.NOT.(N1 .EQ. 0)) GOTO 2560 C ...G0 CHARACTER SET OUTBUF(2) = '(' C ...G1 CHARACTER SET GOTO 2570 2560 CONTINUE OUTBUF(2) = ')' 2570 CONTINUE IF (.NOT.(N2 .EQ. 0)) GOTO 2580 C ...UNITED KINGDOM CHARACTER SET OUTBUF(3) = 'A' GOTO 2590 2580 CONTINUE IF (.NOT.(N2 .EQ. 1)) GOTO 2600 C ...ASCII CHARACTER SET OUTBUF(3) = 'B' C ...SPECIAL GRAPHICS SET GOTO 2590 2600 CONTINUE OUTBUF(3) = '0' 2590 CONTINUE LEN = 3 GOTO 2030 2540 CONTINUE IF (.NOT.(CMD .EQ. SM)) GOTO 2620 C SET MODE OUTBUF(2) = '[' OUTBUF(3) = '?' IF (.NOT.(N1 .GT. 0.AND.N1 .LT. 10)) GOTO 2640 C ...MODE TO SET ENCODE(1, 5, OUTBUF(4)) N1 2640 CONTINUE OUTBUF(5) = 'h' LEN = 5 GOTO 2030 2620 CONTINUE IF (.NOT.(CMD .EQ. RM)) GOTO 2660 C RESET MODE OUTBUF(2) = '[' OUTBUF(3) = '?' IF (.NOT.(N1 .GT. 0.AND.N1 .LT. 10)) GOTO 2680 C ...MODE TO RESET ENCODE(1, 5, OUTBUF(4)) N1 2680 CONTINUE OUTBUF(5) = 'l' LEN = 5 GOTO 2030 2660 CONTINUE IF (.NOT.(CMD .EQ. ANSI)) GOTO 2700 C ANSI MODE OUTBUF(2) = '<' LEN = 2 2700 CONTINUE 2030 CONTINUE C CONVERT ANY BLANKS TO ZEROES DO 2720 I = 1, LEN IF (OUTBUF(I) .EQ. ' ') OUTBUF(I) = 0 2720 CONTINUE IF(CMD .EQ. CPP) OUTBUF(9)=C1 GOTO 3500 ENTRY BUFFER(IFLAG) ITEMP = IFLAG IF(ITEMP .NE. 2) RETURN 3500 IF(ITEMP .EQ. 1) THEN ! IF WRITE LATER THEN DO 123 I = 1,LEN STORE(ISTRT+I-1) = OUTBUF(I) ! STORE UNTIL LATER 123 CONTINUE ISTRT = ISTRT + LEN ! UPDATE STORAGE POINTER ILEN = ILEN + LEN ! STORE NEW LENGTH RETURN ELSEIF(ITEMP .EQ. 2) THEN ! IF FLUSH STORAGE BUFFER THEN CALL GETADR(PRL,STORE) PRL(2) = ILEN ISTRT = 1 ! RESET STORAGE POINTER ITEMP = 0 ! RESET TO NO BUFFERING IF(ILEN .EQ. 0) RETURN ILEN = 0 ! RESET LENGTH ELSE CALL GETADR(PRL, OUTBUF) PRL(2) = LEN ENDIF CALL WTQIO(4608, 2, 20, , , PRL) 5 FORMAT(I1) 10 FORMAT(I2) 150 RETURN END