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
	INTEGER*2 LLCMD,LLDSP
	COMMON/DCTL/PROW,PCOL,DROW,DCOL,DRWV,DCLV,LLCMD,LLDSP
	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 LLDSP: 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.LLCMD.AND.N2.EQ.1)WRITE(6,1105)BONG
	IF(N1.EQ.2.AND.N2.EQ.1)WRITE(6,1105)RONG
	IF(N1.EQ.LLCMD)WRITE(6,1105)GONR
	IF(N1.EQ.LLDSP)WRITE(6,1105)YONB
	IF(N2.GT.1.AND.N1.EQ.2)WRITE(6,1105)RONY
	IF(N1.LT.3.OR.N1.GE.LLCMD) 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 .LE. LLDSP )) 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.LLCMD)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-LLCMD-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.LLDSP)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.LLCMD)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
	SUBROUTINE ESCTRN(LINE)
C CUSTOM ESCAPE SEQ TRANSLATIONS FOR COLORSCAN
C USE FOR VAX FLAVOR ONLY!!!
	LOGICAL*1 LINE(80)
	INTEGER*4 TTCHAN,STAT,SYS$ASSIGN,SYS$QIOW
	INTEGER*2 IOSB(4)
	INTEGER*4 MODEBF(3),IWRK
	INCLUDE '($IODEF)'
	INCLUDE '($TTDEF)'
	COMMON /TTCHN/TTCHAN
C HANDLES PF5 TO PF9
	II=LINE(1)
	IF(II.NE.2)RETURN
C NEED EXTRA READ SINCE TT DRIVER TERMINATES ON CONTROL B
	IWRK=IO$_READVBLK
	STAT=SYS$QIOW(,%VAL(TTCHAN),%VAL(IWRK),IOSB,,,LINE,%VAL(80),,,,)
C CONTROL B IS START
	II=LINE(1)
	DO 10 I=1,80
10	LINE(I)=0
	LINE(1)=27
	LINE(2)='['
	IF(II.GT.72)GOTO 100
C U.C CHARS
	LINE(3)=II-65+49
	LINE(4)='~'
	RETURN
100	CONTINUE
	I='g'
	I=II-I+49
	LINE(3)=I
	I=II-46
C I=II-97+51
	IF(I.GT.57)I=48
	LINE(4)=I
	RETURN
	END