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.
	NN=RCL
	IF(NNFG.EQ.0.OR.NN.GT.99)GOTO 1667
C GO BACK TO LAST LOC. AND DRAW NUMBER LABELS IN.
	WRITE(6,1105)CLSV
	NN=N1SV-2
	IF(NN.GT.0)WRITE(6,1106)NN
1106	FORMAT(I2,':')
C THEN ON TO SET UP LOCATION.
1667	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
	IF(NNFG.EQ.0)GOTO 1672
	NNFG=0
	WRITE(6,1105)CLSV
	NN=N1SV-2
	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