C COPYRIGHT (C) 1983, 1984, 1985 GLENN C EVERHART C ALL RIGHTS RESERVED 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 C THIS VERSION MODIFIED FOR USE WITH PORTACALC. C ENTRIES NOT USED ARE DELETED, AND ALSO CODE ADDED TO SUPPORT COLOR C CRT'S THAT ARE BASICALLY VT100-LIKE WITH EXTENSIONS, OR VT100'S OR C EMULATORS WITH AVO OPTION. C C OPERATION: C ON B+W VT100'S (WITH ADVANCED VIDEO), THE SET GRAPHICS CODES C WILL BE USED AS FOLLOWS: C ALTERNATE ROWS WILL BE DISPLAYED IN BOLD C (ROW 3 TO 22 ONLY HOWEVER; THE REST IS NOT MATH AREA) C COMMAND AND DISPLAY ROWS (23 AND 24 NORMALLY) WILL BE BOLDED ALWAYS. C C IN COLOR MODE: C ON ED, SET BACKGROUND COLOR TO DARK BLUE C ALTERNATE ROWS WILL BE SET TO YELLOW OR GREEN C COLUMN LABEL ROW, LABEL ROW, AND ROW LABELS, AND COMMAND PROMPTS, C IN A DIFFERENT COLOR FOR EACH. DETERMINED AND SET AT TIME OF C CALL TO CURSOR POSITION. C C AUTHOR: GLENN EVERHART C SUBROUTINE UVT100 ( CMD, N1, N2 ) IMPLICIT INTEGER ( A - Z ) INCLUDE 'VKLUGPRM.FTN' 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 C NOTE WE DECLARE THESE VARIABLES USED IN PORTACALC. THEY ARE ALL IN C COMMONS, SO WE ADD NOTHING TO LENGTH OF THIS PROGRAM BY ADDING THEM. LOGICAL*1 FVLD DIMENSION FVLD(RRWP,RCLP) COMMON /FVLDC/FVLD INTEGER*2 PROW,PCOL,DROW,DCOL,DRWV,DCLV COMMON/DCTL/PROW,PCOL,DROW,DCOL,DRWV,DCLV INTEGER*2 TYPE(RRWP,RCLP),VLEN(9) REAL*8 XVBLS(RRWP,RCLP) LOGICAL*1 AVBLS(20,27),VBLS(8,RRWP,RCLP) EQUIVALENCE(XVBLS(1,1),VBLS(1,1,1)) INTEGER*2 N1S,N2S COMMON/V/TYPE,AVBLS,VBLS,VLEN C ICPOS COMMON HAS PHYS COORDS BEING DISPLAYED. MUST QUERY FVLD TO C SEE WHETHER TO INTENSIFY THE FIELD FOR NEGATIVE... INTEGER*2 IC1POS,IC2POS COMMON/ICPOS/IC1POS,IC2POS BYTE OUTBUF ( 16 ) C CONTROLS TO SET VARIOUS VISUAL ATTRIBUTES C NORMAL, BOLD LOGICAL*1 YONB(12),GONR(12),RONG(12),BONY(12) LOGICAL*1 GONB(12),RONB(12),BONR(12),RONY(12) LOGICAL*1 BONG(12) C TOP LINE YELLOW ON BLUE C NEXT LINE NORMAL:GREEN ON RED, REVERSED:RED ON GREEN C COL 1 ROWS 3-LCMDR: NORMAL B/Y, REV G/B C SHEET AREA: IF NUMBER =>0, Y/B NORMAL,B/Y REVERSED C IF NUMBER < 0, R/B NORMAL,B/R REVERSED C LCMDR: G/R C LDSPR: Y/B DATA YONB/27,'[',0,'m',27,'[','1','4',';','2','1','m'/ DATA GONR/27,'[',0,'m',27,'[','1','3',';','2','2','m'/ DATA RONG/27,'[',0,'m',27,'[','1','2',';','2','3','m'/ DATA BONY/27,'[',0,'m',27,'[','1','1',';','2','4','m'/ DATA BONG/27,'[',0,'m',27,'[','1','1',';','2','3','m'/ DATA GONB/27,'[',0,'m',27,'[','1','3',';','2','1','m'/ DATA RONB/27,'[',0,'m',27,'[','1','2',';','2','1','m'/ DATA BONR/27,'[',0,'m',27,'[','1','1',';','2','2','m'/ DATA RONY/27,'[',0,'m',27,'[','1','2',';','2','4','m'/ C COLOR SCHEME CODED DATA ABOVE... C 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 C CURSOR POSITION. C SHIP OUT APPROPRIATE CHARACTERISTICS. N1S=N1 N2S=N2 IF(N1.EQ.1)WRITE(6,1105)YONB IF(N1.GT.2.AND.N1.LT.LCMDR.AND.N2.EQ.1)WRITE(6,1105)BONG IF(N1.EQ.2.AND.N2.EQ.1)WRITE(6,1105)RONG IF(N1.EQ.LCMDR)WRITE(6,1105)GONR IF(N1.EQ.LDSPR)WRITE(6,1105)YONB IF(N2.GT.1.AND.N1.EQ.2)WRITE(6,1105)RONY IF(N1.LT.3.OR.N1.GE.LCMDR) GOTO 1500 IF(N2.LE.1)GOTO 1500 C HERE WE ARE IN DISPLAY ROW RANGE. C NO CHECK FOR AVO ON COLUMNS (NOT ENOUGH VARIATIONS AVAILABLE) NN=0 CALL FVLDGT(IC1POS,IC2POS,FVLD(1,1)) CALL XVBLGT(IC1POS,IC2POS,XVBLS(1,1)) IF(FVLD(1,1).NE.0.AND. 1 XVBLS(1,1).LT.0.)NN=1 IF(NN.EQ.0)WRITE(6,1105)YONB IF(NN.NE.0)WRITE(6,1105)RONB C ALWAYS SET NORMAL YELLOW ON BLUE DISPLAY HERE. SGR AREA MAY C MODIFY THIS, DEPENDING ON AREA. 1500 CONTINUE 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. ED )) GOTO 20036 C ERASE DISPLAY WRITE(6,1105)YONB N1S=0 N2S=0 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 C ERASE LINE 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 C SET GRAPHICS RENDITION (7=REVERSE VIDEO, 0=NORMAL,4=UNDERSCORE,1=BOLD C 5=BLINK) (PORTACALC CALLS WITH 0 OR 7 (VT100 W/O AVO)) C OUTBUF ( 2 ) = 1H[ IF (.NOT.( N1 .EQ. 7 )) GOTO 20050 C SGR 7, I.E., REVERSE VIDEO. SPECIAL COLOR VERSION. IF(N1S.LE.1.OR.N1S.GE.LCMDR)GOTO 1933 GOTO 1934 1933 CONTINUE C ROW 1 OR ROWS 23,24 REVERSE: RED ON GREEN WRITE(6,1105)RONG N1S=0 N2S=0 RETURN 1934 CONTINUE IF(N1S.EQ.2)GOTO 1935 GOTO 1936 1935 CONTINUE C ROW 2 WRITE(6,1105)RONG N1S=0 N2S=0 RETURN 1936 CONTINUE IF(N2S.LE.1)GOTO 1937 GOTO 1938 1937 CONTINUE C ROW 3-LCMDR-1 WRITE(6,1105)GONB N1S=0 N2S=0 RETURN 1938 CONTINUE NN=0 CALL FVLDGT(IC1POS,IC2POS,FVLD(1,1)) CALL XVBLGT(IC1POS,IC2POS,XVBLS(1,1)) IF(FVLD(1,1).NE.0.AND.XVBLS(1,1).LT.0.) 1 NN=1 C NN TELLS WHETHER TO USE RED OR NOT IN THIS REGION IF(NN.EQ.0)WRITE(6,1105)BONY IF(NN.NE.0)WRITE(6,1105)BONR N1S=0 N2S=0 RETURN 20050 CONTINUE C SET NORMAL VIDEO AGAIN... IF(N1S.LE.1.OR.N1S.GE.LDSPR)GOTO 2934 GOTO 2935 2934 CONTINUE C NOTE THIS MUST BE SAME AS ERASE SCREEN COLO4R. IF(N1S.NE.0)WRITE(6,1105)YONB N1S=0 N2S=0 RETURN 2935 CONTINUE IF(N1S.EQ.2.OR.N1S.EQ.LCMDR)GOTO 2936 GOTO 2937 2936 CONTINUE WRITE(6,1105)GONR N1S=0 N2S=0 RETURN 2937 CONTINUE IF(N2S.LE.1)GOTO 2938 GOTO 2939 2938 CONTINUE WRITE(6,1105)BONY N1S=0 N2S=0 RETURN 2939 CONTINUE NN=0 CALL FVLDGT(IC1POS,IC2POS,FVLD(1,1)) CALL XVBLGT(IC1POS,IC2POS,XVBLS(1,1)) IF(FVLD(1,1).NE.0.AND.XVBLS(1,1).LT.0.) 1 NN=1 C NN TELLS WHETHER TO USE RED OR NOT IN THIS REGION IF(NN.EQ.0)WRITE(6,1105)YONB IF(NN.NE.0)WRITE(6,1105)RONB N1S=0 N2S=0 20051 CONTINUE RETURN 20048 CONTINUE IF (.NOT.( CMD .EQ. SCS )) GOTO 20054 C SCS. IGNORE THIS ... NEVER REALLY USED. RETURN 20054 CONTINUE IF (.NOT.( CMD .EQ. SM )) GOTO 20062 C SET MODE. IGNORE. RETURN 20062 IF (.NOT.( CMD .EQ. RM )) GOTO 20066 C RESET MODE. IGNORE. RETURN 20066 CONTINUE IF (.NOT.( CMD .EQ. ANSI )) GOTO 20070 C ANSI MODE. LEAVE IN, ENSURING VT100'S HANDLE ANSI ESC. SEQUENCES. OUTBUF ( 2 ) = 1H< LEN = 2 20070 CONTINUE 20049 CONTINUE 20043 CONTINUE 20037 CONTINUE 20003 CONTINUE C THIS LOOP NULLS ALL SPACES STILL IN... C IT HAS TO GO IF YOU CONVERT FOR OTHER TERMINALS GENERALLY. DO 20072 I = 1, LEN IF (.NOT.( OUTBUF ( I ) .EQ. 1H )) GOTO 20074 OUTBUF ( I ) = 0 20074 CONTINUE 20072 CONTINUE 20073 CONTINUE C USE A FORTRAN WRITE SO THIS WILL WORK ON VAX OR PDP11 (OR WHATEVER...) C UNIT 6 MUST BE THE TERMINAL... WRITE(6,1105)(OUTBUF(IV),IV=1,LEN) 1105 FORMAT(16A1) 5 FORMAT ( I1 ) 10 FORMAT ( I2 ) 105 FORMAT(I3) RETURN END