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