C COPYRIGHT (C) 1983 GLENN and MARY EVERHART
C All Rights Reserved
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
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    VERSION FOR IBM PC UNDER PCDOS V2 ANSI.SYS WITH COLOR MONITOR...
C MADE FROM COLORSCAN 10 VERSION WITH IBM ESC SEQUENCES INSTEAD, FOR
C COLORS.
C	SHOULD WORK WITH SOME OTHER COLOR CRT'S TOO. INTERCOLOR MAY
C BE ONE SUCH.
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
	COMMON/DCTL/PROW,PCOL,DROW,DCOL,DRWV,DCLV
	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 LDSPR: Y/B
	DATA YONB/27,'[',0,'m',27,'[','3','3',';','4','4','m'/
	DATA GONR/27,'[',0,'m',27,'[','3','2',';','4','1','m'/
	DATA RONG/27,'[',0,'m',27,'[','3','1',';','4','2','m'/
	DATA BONY/27,'[',0,'m',27,'[','3','4',';','4','3','m'/
	DATA BONG/27,'[',0,'m',27,'[','3','4',';','4','2','m'/
	DATA GONB/27,'[',0,'m',27,'[','3','2',';','4','4','m'/
	DATA RONB/27,'[',0,'m',27,'[','3','1',';','4','4','m'/
	DATA BONR/27,'[',0,'m',27,'[','3','4',';','4','1','m'/
	DATA RONY/27,'[',0,'m',27,'[','3','1',';','4','3','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.LCMDR.AND.N2.EQ.1)WRITE(6,1105)BONG
	IF(N1.EQ.2.AND.N2.EQ.1)WRITE(6,1105)RONG
	IF(N1.EQ.LCMDR)WRITE(6,1105)GONR
	IF(N1.EQ.LDSPR)WRITE(6,1105)YONB
	IF(N2.GT.1.AND.N1.EQ.2)WRITE(6,1105)RONY
	IF(N1.LT.3.OR.N1.GE.LCMDR) 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 .LT. 25 )) GOTO 20004
      ENCODE ( 2, 10, OUTBUF ( 3 ) ) N1
20004 CONTINUE
      OUTBUF ( 5 ) = 1H;
C NOTE LOSING IBM PC WON'T HANDLE WIDER THAN 80 CHARACTERS, SO
C CHOP IT OFF THERE. A VT100 OR EMULATOR WOULD OF COURSE
C HANDLE 132 OR MAYBE MORE...
      IF (.NOT.( N2 .GT. 0 . AND . N2 .LT. 80 )) GOTO 20006
      ENCODE ( 2, 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.LCMDR)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-LCMDR-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.LDSPR)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.LCMDR)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
	RETURN
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(1X,16A1$
5     FORMAT ( I1 )
10    FORMAT ( I2.2 )
105    FORMAT(I2.2)
      RETURN
      END
