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 DATAMEDIA VARIANT FOR PORTACALC ONLY. UVT100 COMPATIBLE (MORE OR LESS) C THIS VERSION MAY BE USED AS A TEMPLATE FOR SCREENS LACKING REVERSE C VIDEO OR SIMILAR FEATURES. IT USES THE LEFTMOST COLUMN OF A CELL C TO HOLD A SPECIAL CHARACTER (">" IN THIS CASE) TO INDICATE ONE'S C POSITION ON THE SCREEN. BY MAIN FORCE & AWKWARDNESS IT WILL MOVE C THIS AROUND WHEREVER NEEDED. ONLY ENTRIES CALLED BY PORTACALC C ARE SUPPORTED HERE, MANY AS NO-OPS. C NOTE THE REVERSE VIDEO ON THE TITLE PAGE IS LIKELY TO GET C SOMEWHAT FOULED UP DUE TO THIS, WHICH IS JUST TOO BAD BUT WILL C NOT BE ADDRESSED HERE. C THIS VERSION MAY BE USED ON PDP11 OR VAX; ITS OUTPUT IS C STRICTLY FORTRAN I/O TO LOGICAL UNIT 6. C THIS VERSION IS FOR DATAMEDIA 1500 SERIES TERMINAL. C ERASE TO EOL= GS C ERASE TO ENDPAGE=VT C CLEAR SCREEN=FF C CURSOR ADDRESSING IS C RS WHERE CHARACTER IS COL OR ROW # + 31. C C AUTHOR: GLENN EVERHART C SUBROUTINE UVT100 ( CMD, N1, N2 ) IMPLICIT INTEGER ( A - Z ) INCLUDE 'VKLUGPRM.FTN' 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 ( 8 ) 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 LOGICAL*1 OUTSV(4),OUTBFF(4) INTEGER*2 S7FLG,SCFG C SET INITIAL ESCAPE INTO BUFFER. DO 20000 I = 1, 8 OUTBUF ( I ) = 0 20000 CONTINUE 20001 CONTINUE IF(CMD.EQ.SCS)SCFG=0 IF(CMD.EQ.SCS)RETURN IF (.NOT.( CMD .EQ. CUP )) GOTO 20002 C CUP - CURSOR POSITION OUTBUF ( 1 ) = 30 IF (.NOT.( N1 .GT. 0 . AND . N1 .LT. 25 )) GOTO 20004 OUTBUF(3)=N1+31 20004 CONTINUE IF (.NOT.( N2 .GT. 0 . AND . N2 .LT. 81 )) GOTO 20006 OUTBUF(2)=N2+31 20006 CONTINUE LEN = 3 C SAVE THIS COORD TILL NEXT TIME FOR MAYBE USE BY SGR(7) DO 151 N151=1,4 151 OUTBFF(N151)=OUTBUF(N151) SCFG=1 GOTO 20003 20002 CONTINUE IF (.NOT.( CMD .EQ. ED )) GOTO 20036 SCFG=0 OUTBUF ( 1 ) = 12 C ERASE DISPLAY. ALWAYS ERASE IT ALL. LEN = 1 GOTO 20037 20036 CONTINUE IF (.NOT.( CMD .EQ. EL )) GOTO 20042 SCFG=0 IF (.NOT.( N1 .EQ. 0 )) GOTO 20044 OUTBUF(1)=29 LEN=1 GOTO 20043 20044 CONTINUE IF (.NOT.( N1 .EQ. 2 )) GOTO 20046 C N1=2 1109 OUTBUF(1)=13 OUTBUF(2)=29 C CR FIRST, THEN ERASE LINE LEN=2 GOTO 20043 20046 CONTINUE GOTO 1109 20042 CONTINUE C SGR - SET GRAPHICS RENDITION. SUPPORTS ARGS 7 OR 0 C FOR REVERSE VIDEO/NORMAL C C FOR PORTACALC USE THE FOLLOWING LOGIC: C C WHEN CALLED WITH ARG 7, SAVE LAST CURSOR POSITIONS C CALLED AND KEEP AROUND, UNLESS FVLD IS 0 FOR THIS C CELL (IN WHICH CASE DO NOTHING) C WHEN CALLED WITH ARG 0, IF LAST CALL WAS ARG 7, C THEN REPOSITION CURSOR TO SAVED LOCATIONS AND C WRITE A CHARACTER TO LUN 6 (USE A ">" CHARACTER FOR NOW) C THEN REPOSITION ONCE MORE TO THE SAVED POSITION. C THIS SIMULATES ACTION OF REVERSE VIDEO WHERE NONE IS AVAILABLE C BY AT LEAST PUTTING A ">" CHARACTER OUT AT CURRENT CELL. C IF (.NOT.( CMD .EQ. SGR )) GOTO 20048 IF (.NOT.( N1 .EQ. 7 )) GOTO 20050 IF(SCFG.NE.1)RETURN C ARG=7 IF(PROW.LE.0.OR.PCOL.LE.0)RETURN IF(PROW.GT.RRW.OR.PCOL.GT.RCL)RETURN IF(FVLD(PROW,PCOL).EQ.0)RETURN C KNOW NOW THAT WE HAVE A VALID LOCATION. DO 150 N150=1,3 150 OUTSV(N150)=OUTBFF(N150) S7FLG=1 C FLAGS SAVED COORDS AND C SAVES LAST OUTPUT BUFFER AND LENGTH FOR LATER USE. C NOTHING MORE TO DO HERE; JUST EMIT THE DATA WHEN WE ARE CALLED ON TO. RETURN 20050 CONTINUE C ARG=0 20051 CONTINUE IF(SCFG.NE.1)RETURN IF(S7FLG.NE.1)RETURN WRITE(6,1100)(OUTSV(IV),IV=1,3) 1100 FORMAT(4A1) WRITE(6,1101) 1101 FORMAT('>') C SPECIAL POINTER CHARACTER IS ">" C WRITE(6,1100)(OUTSV(IV),IV=1,3) C REPOSITION CURSOR TO INITIAL POSITION. C FLAG NO REVERSE MODE NOW S7FLG=0 C RETURN CURSOR TO LAST SET LOCATION. WRITE(6,1100)(OUTBFF(IV),IV=1,3) RETURN 20048 CONTINUE IF (.NOT.( CMD .EQ. SM )) GOTO 20062 SCFG=0 C IGNORE SET MODES RETURN 20062 CONTINUE IF (.NOT.( CMD .EQ. RM )) GOTO 20066 SCFG=0 C IGNORE RESET MODES RETURN 20066 CONTINUE IF (.NOT.( CMD .EQ. ANSI )) GOTO 20070 SCFG=0 C ANSI MODE DOES NOTHING. RETURN 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 20072 CONTINUE 20073 CONTINUE WRITE(6,1105)(OUTBUF(IV),IV=1,LEN) 1105 FORMAT(16A1) 5 FORMAT ( I1 ) 10 FORMAT ( I2 ) RETURN END