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,N2THE MANDS 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(RRW,RCL) COMMON /FVLDC/FVLD INTEGER*2 PROW,PCOL,DROW,DCOL,DRWV,DCLV COMMON/DCTL/PROW,PCOL,DROW,DCOL,DRWV,DCLV INTEGER*2 TYPE(RRW,RCL),VLEN(9) REAL*8 XVBLS(RRW,RCL) LOGICAL*1 AVBLS(100,27),VBLS(8,RRW,RCL) EQUIVALENCE(XVBLS(1,1),VBLS(1,1,1)) 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 C CONTROLS TO SET VARIOUS VISUAL ATTRIBUTES C NORMAL, BOLD INTEGER*2 N1SV,N2SV,NNFG,N222 LOGICAL*1 CLSV(9),ULIT(8) LOGICAL*1 NORMIT(4),BOLDIT(8),OUTBUF(16),BOLDUL(10) DATA N222/0/ C OMIT THE UNDERLINING ... GETS IN THE WAY FOR USER FORMATTING C LEAVE IN THE BOLDING FOR NEGATIVE NUMBERS DATA BOLDUL/27,'[','0','m',27,'[','1',';','1','m'/ C DATA BOLDUL/27,'[','0','m',27,'[','1',';','4','m'/ DATA NORMIT/27,'[','0','m'/ C SET ATTRIBUTE 4 (UNDERLINE) RATHER THAN 1 (BOLD) FOR ALTERNATE LINES. DATA ULIT/27,'[','0','m',27,'[','1','m'/ C DATA BOLDIT/27,'[','0','m',27,'[','4','m'/ DATA BOLDIT/27,'[','0','m',27,'[','0','m'/ 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. N1CP=N1 IF(N1.LT.3.OR.N1.GE.LCMDR) GOTO 1500 C HERE WE ARE IN DISPLAY ROW RANGE. C C SEE IF N2=1. IF SO FLAG AND SAVE COORDS. C DO THIS TO TRY TO SHIP OUT COORDS. IF(N2.NE.1)GOTO 1655 C DON'T TRY TO DISPLAY DISPLAY ROW # IF > 99 ROWS; WE'D CLOBBER C PART OF ROW # IN DISPLAY IF WE DID. C NN=RCL C IF(NNFG.EQ.0.OR.NN.GT.99)GOTO 1667 CC GO BACK TO LAST LOC. AND DRAW NUMBER LABELS IN. C WRITE(6,1105)CLSV C NN=N1SV-2 C IF(NN.GT.0)WRITE(6,1106)NN C1106 FORMAT(I2,':') CC THEN ON TO SET UP LOCATION. C1667 CONTINUE NNFG=N222 N1SV=N1 N2SV=N2 GOTO 1656 1655 CONTINUE NNFG=0 1656 CONTINUE C NO CHECK FOR AVO ON COLUMNS (NOT ENOUGH VARIATIONS AVAILABLE) C THUS JUST DECIDE ON C 1. BOLDING NBD=0 NUL=0 C SEE IF WE NEED TO BOLD (SET NUL) IF(FVLD(IC1POS,IC2POS).LE.0)GOTO 1754 IF(XVBLS(IC1POS,IC2POS).LT.0.)NUL=1 1754 CONTINUE NNR=N1/2 NNR=NNR*2 IF(NNR.NE.N1)NBD=1 IF(N2.LE.1)NBD=0 C NOW HAVE ALL SET UP, NUL=1 IF BOLDING, NBD=1 IF UNDERLINE NEEDED. C NEVER BOLD 1ST COLUMN ON SCREEN...LABELS ONLY THERE. IF(N2.EQ.1)GOTO 1500 IF(NUL.EQ.0.AND.NBD.EQ.0)WRITE(6,1105)NORMIT IF(NUL.EQ.0.AND.NBD.EQ.1)WRITE(6,1105)BOLDIT IF(NUL.EQ.1.AND.NBD.EQ.0)WRITE(6,1105)ULIT IF(NUL.EQ.1.AND.NBD.EQ.1)WRITE(6,1105)BOLDUL 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 IF(N2.NE.1)GOTO 20003 IF(N1.LE.2.OR.N1.GE.LCMDR)GOTO 20003 C SAVE LAST COORD BUFFER WHERE COL 1 WAS SELECTED. DO 1670 NN=1,9 NNK=OUTBUF(NN) C CONVERT SPACES TO ZEROES IF(NNK.EQ.32)NNK=48 1670 CLSV(NN)=NNK GOTO 20003 20002 CONTINUE IF (.NOT.( CMD .EQ. ED )) GOTO 20036 C ERASE DISPLAY NNFG=0 N222=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 N222=0 NNFG=0 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)) OUTBUF ( 2 ) = 1H[ IF (.NOT.( N1 .EQ. 7 )) GOTO 20050 OUTBUF ( 3 ) = 1H7 IF(N1CP.EQ.2)N222=1 GOTO 20051 20050 CONTINUE OUTBUF ( 3 ) = 1H0 C IF(NNFG.EQ.0)GOTO 1672 NNFG=0 C WRITE(6,1105)CLSV C NN=N1SV-2 C IF(NN.GT.0)WRITE(6,1106)NN 1672 CONTINUE 20051 CONTINUE OUTBUF ( 4 ) = 1Hm OUTBUF ( 5 ) = 8 LEN = 5 GOTO 20049 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