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(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))
	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 NORMIT(12),BOLDIT(12)
	LOGICAL*1 COLBG(12),ULIT(12),BOLDUL(12)
	LOGICAL*1 COLC1(12),COLR1(12),COLCM(12),COLDS(12),COLT(12)
	DATA COLC1/27,'[','0','m',27,'[','2','2',';','1','4','m'/
	DATA COLR1/27,'[','0','m',27,'[','1','5',';','2','6','m'/
	DATA COLCM/27,'[','0','m',27,'[','2','5',';','1','1','m'/
	DATA COLDS/27,'[','0','m',27,'[','1','1',';','2','3','m'/
	DATA COLT/27,'[','0','m',27,'[','1','0',';','2','6','m'/
	DATA COLBG/27,'[','0','m',27,'[','1','3',';','2','2','m'/
	DATA NORMIT/27,'[','0','m',27,'[','1','1',';','2','2','m'/
	DATA BOLDIT/27,'[','0','m',27,'[','1','4',';','2','1','m'/
	DATA ULIT/27,'[','0','m',27,'[','2','4',';','1','2','m'/
	DATA BOLDUL/27,'[','0','m',27,'[','2','3',';','1',
     1  '5','m'/
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)COLR1
	IF(N1.NE.1.AND.N1.LT.LCMDC.AND.N2.EQ.1)WRITE(6,1105)COLC1
	IF(N1.EQ.LCMDR)WRITE(6,1105)COLCM
	IF(N1.EQ.LDSPR)WRITE(6,1105)COLDS
	IF(N1.EQ.2)WRITE(6,1105)COLT
	IF(N1.LT.3.OR.N1.GE.LCMDR) GOTO 1500
C HERE WE ARE IN DISPLAY ROW RANGE.
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
C NOW HAVE ALL SET UP, NBD=1 IF BOLDING, NUL=1 IF UNDERLINE NEEDED.
C NEVER BOLD 1ST COLUMN ON SCREEN...LABELS ONLY THERE.
	IF(N2.LE.1)NBD=0
	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(MUL.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
      GOTO 20003
20002 CONTINUE
      IF (.NOT.( CMD .EQ. ED )) GOTO 20036
C ERASE DISPLAY
	WRITE(6,1105)COLBG
      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	IF(N1S.NE.0.AND.(N1S.LT.3.OR.N1S.GE.LCMDR))GOTO 1600
C	GOTO 1602
C1600	N1S=0
CC IGNORE SETS FOR 1ST 2 AND LAST 2 ROWS
C	RETURN
C1602	CONTINUE
C	IF(N2S.NE.1)GOTO 1604
C	N2S=0
C	RETURN
CC IGNORE SETS FOR COL 1
C1604	CONTINUE
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)=1H0
	OUTBUF(4)=1H;
	OUTBUF(5)=1H1
	OUTBUF(6)=1H3
	OUTBUF(7)=1H;
	OUTBUF(8)=1H2
	OUTBUF(9)=1H2
	OUTBUF(10)=1H;
	OUTBUF(11)=1H7
	OUTBUF(12)=1Hm
	OUTBUF(13)=8
	LEN=13
      GOTO 20049
20050 CONTINUE
	OUTBUF(3)=1H0
	OUTBUF(4)=1H;
      OUTBUF ( 5 ) = 1H1
	OUTBUF(6)=1H2
	OUTBUF(7)=1H;
	OUTBUF(8)=1H2
	OUTBUF(9)=1H6
20051 CONTINUE
      OUTBUF ( 10) = 1Hm
      OUTBUF ( 11) = 8
      LEN = 11
      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