SUBROUTINE RECT( X1, X2, Y1, Y2, IFLG )
C
C	NAME: RECT
C
C	LANGUAGE:  FORTRAN
C
C	OPERATING SYSTEM:  DEC VAX/VMS
C
C	ORDER NUMBER:  5448-SE
C
C	PART NUMBER:  000-025522-001  OCTOBER 1985
C
C	PRODUCT:  DEC VAX/VMS VERSAPLOT COLOR RANDOM 2.0
C
C	VERSATEC, INC., SANTA CLARA, CALIFORNIA 95051
C	A XEROX COMPANY
C
C	Copyright (C) 1985 by Xerox Corporation.  All rights reserved.
C
C	"NOTICE. THIS PROGRAM IS THE EXCLUSIVE PROPERTY OF VERSATEC,
C	INC. AND IS ISSUED IN STRICT CONFIDENCE UNDER A PREARRANGED
C	LICENSE AGREEMENT AND IS NOT TO BE DISCLOSED IN ANY MANNER TO
C	PERSONS OUTSIDE THE LICENSED ORGANIZATION AND SHALL NOT BE
C	REPRODUCED OR DISSEMINATED, IN WHOLE OR PART, TO ANYONE OUTSIDE
C	THE LICENSED ORGANIZATION WITHOUT THE PRIOR WRITTEN APPROVAL OF
C	VERSATEC, INC. UNLESS OTHERWISE PROVIDED FOR BY SUCH LICENSE
C	AGREEMENT.  THIS WORK IS PROTECTED AS AN UNPUBLISHED WORK UNDER
C	THE COPYRIGHT ACT OF 1976."
C
C	REVISION HISTORY
C		REV. C
C		2/20/85		THIS IS A NEW SUBROUTINE CREATED FOR
C				THIS REVISION.
C
C	RECT - PERFORM PATTERN SHADING OF A USER-DEFINED RECTANGLE
C	       (A RECTANGLE WITH HORIZONTAL AND VERTICAL SIDES)
C
C	THE RECTANGLE DEFINED BY THE FOUR POINTS <X1,Y1>,<X1,Y2>,
C	<X2,Y1>, AND <X2,Y2> IS DRAWN USING THE CURRENTLY DEFINED
C	FILL PATTERN.  THE FILL PATTERN MUST ALREADY HAVE BEEN DEFINED
C	AND ACTIVATED BY EITHER A DEFPAT, SETPAT SEQUENCE OR A
C	CALL TO TONE.  IF IFLG <> 0, THEN THE RECTANGLE IS OUTLINED
C	USING THE CURRENT PEN.  OTHERWISE, NO OUTLINE IS DRAWN.
C	IF THE RECTANGLE IS OUTLINED, THE CURRENT POINT BECOMES <X1,Y1>.
C
C	ENTRY: CALL RECT( X1, X2, Y1, Y2, IFLG )
C
C		<X1,Y1>,<X1,Y2>, - COORDINATES OF THE FOUR CORNERS
C		<X2,Y2>,<X2,Y1>    OF THE RECTANGLE
C
C			    IFLG - FLAG INDICATING WHETHER TO OUTLINE
C				   THE RECTANGLE:
C				   = 0  NO OUTLINE
C				   # 0  OUTLINE USING CURRENT PEN
C
C	EXIT:  THE PARAMETERS ARE UNCHANGED.  THE FILLED RECTANGLE AND
C	       POSSIBLY ITS OUTLINE HAVE BEEN DRAWN.  IF THE OUTLINE
C	       IS DRAWN, THE CURRENT POSITION BECOMES <X1,Y1>.
C
C	CALLS: PLOT, TRAP
C
C	CALLED BY: USER, GRID
C
C	COMMON USED:
C	/DVCOM/
C		I ILWP    - (LINE WIDTH - 1)/2
C		I ILWM    - LINE WIDTH/2
C		I KPAT    - NUMBER OF CURRENTLY ACTIVE TONE PATTERN
C		I MSB     - WORD TO SET HIGH ORDER BIT DETERMINED BY
C		            PRECISION (16/32) SELECTED.
C		I NCLIP   - NUMBER OF CLIPPED VECTORS
C		L PMOVE   - STATUS OF LAST PLOT CALL (.TRUE.=MOVE)
C		R RORG()  - AN X,Y PAIR WHICH DEFINES THE CURRENT
C		            SOFTWARE ORIGIN. SET BY REORIGIN CALL
C			    TO *PLOT*
C		L ROT90   - IF ROT90 = .TRUE. THEN ROTATE THE PLOT
C		            COUNTERCLOCKWISE 90 DEGREES
C		R VCP()   - CURRENT POINT IN COMPUTATIONAL COORDINATES
C		L VSFLAG  - .TRUE. IFF STRIPPING IN THE Y-DIRECTION
C		            IS NECESSARY
C		R WIN()   - THE CURRENT VIEW WINDOW IN COMPUTATIONAL
C		            COORDINATES
C		R WTV()   - WINDOW TRANSFORMATION VARIABLES. USED TO
C		            TRANSFORM COORDINATES FROM THE VIEW WINDOW
C		            SYSTEM TO THE  VIEWPORT SYSTEM
C		I XNIPS   - NUMBER OF NIBS PER PAGE IN THE X-DIRECTION
C		I YNIPS   - NIBS PER SCAN
C	/VRFCOM/
C		R BYTKNT()- BYTE COUNT FOR EACH COLOR
C		R DRWKNT  - BYTE COUNT FOR A DRAW COMMAND
C		I IBXMAX  - MAXIMUM X VALUE (USED FOR BANDING)
C		R VRFKNT()- COUNTER FOR RANDOM ELEMENTS
C		R OBJKNT()- NUMBER OF EACH TYPE OF OBJECT OUTPUT
C			    OBJKNT(1) - VECTORS
C			    OBJKNT(2) - POLYGONS
C			    OBJKNT(3) - CIRCLES
C			    OBJKNT(4) - CHARACTERS
C		I PRECIS  - COORDINATE PRECISION FOR THE VRF
C		            OUTPUT FILE (16 OR 32-BIT PRECISION)
C       /CLRCOM/
C               I ICLRDF()- ARRAY CONTAINING COLOR DEFINITIONS
C		I ITNCLR  - CURRENT TONE COLOR INDEX
C		I ITNFLG  - USE PEN OR TONE COLOR FOR AREAS
C		I ITNSEQ()- TONING SEQUENCE FOR OUTPUT
C		I NCPASS  - NUMBER OF COLOR PASSES
C
C	/PRMCOM/
C		I IFONT   - DEFAULT FONT PATTERN NUMBER.
C		I KREP    - TARGET OUTPUT CONTROLLER
C			    = 0 - UNKNOWN
C		            = 1 - REP CONTROLLER
C		            = 4 - RPM CONTROLLER
C	/KLCOM/
C		L KFLAG   - FLAG INDICATING REP OUTPUT AND .GT. 13.65'
C		            PLOTTING REQUIRED.
C		I KSIZE   - VARIABLE DEFINING 13.65' IN SCANS, USED TO
C		            DETERMINE IF ELEMENT CROSSES A 13.65' PAGE
C		            BOUNDARY.
C
C	LOCAL:
C	  I ICOM     - DRAW-POLYGON COMMAND
C	  I JX1,JY1, - INTEGER COORDINATES OF THE RECTANGLE
C	    JX2,JY2
C	  I MINX,MAXX- MIN AND MAX VALUES OF THE RECTANGLE IN
C	    MINY,MAXY  INTEGER COORDINATES
C	  I NSTRIP   - THE STRIP NUMBER WHERE THE RECTANGLE IS
C	  I NTNSEQ() - (,1) - SAVED VALUE OF ITNSEQ()
C		       (,2) - TURNED ON IFF AN OUTLINE IS TO BE DONE
C		       (,3) - TURNED ON IFF A FILL IS TO BE DONE
C	  I POLYGN   - VRF DRAW-POLYGON COMMAND WORD
C	  L SAVROT   - SAVED VALUE OF ROT90
C	  I SAVORG() - SAVED VALUES OF RORG()
C	  R T()      - ARRAY USED TO PASS A TRAPEZOID TO TRAP
C	  R XMIN,YMIN- MIN AND MAX VALUES OF THE RECTANGLE IN THE
C	    XMAX,YMAX  WINDOW COORDINATES
C	  R XX1,XX2, - LOCAL VARIABLES CORRESPONDING TO
C	    YY1,YY2      X1, X2, Y1, AND Y2
C	  R XX1SAV,  - SAVED VALUES OF XX1 AND YY1
C	    YY1SAV
C
C
	INCLUDE 'DVCOM.CMN'
C
C
	INCLUDE 'VRFCOM.CMN'
C
C
	INCLUDE 'CLRCOM.CMN'
C
C
	INCLUDE 'PRMCOM.CMN'
C
C
	INCLUDE 'KLCOM.CMN'
C
C
	DIMENSION SAVORG(2)
C
	LOGICAL SAVROT,LPAT
	INTEGER NTNSEQ(4,3),T(6),POLYGN
C
C...	VRF DRAW-POLYGON COMMAND WORD
	DATA POLYGN/34817/
C
C...	CHECK FOR A NULL WINDOW
	IF (WIN(1) .LT. WIN(3) .AND. WIN(2) .LT. WIN(4)) GO TO 20
	  NCLIP = NCLIP + 1
	  GO TO 999
C
C...	GET WORKING COPIES IF THE VARIABLES
   20	XX1 = X1
	XX2 = X2
	YY1 = Y1
	YY2 = Y2
C
C...	TRANSLATE COORDINATES TO ACCOUNT FOR REORIGIN
	IF ( RORG(1) .EQ. 0.0 ) GO TO 30
	  XX1 = XX1 + RORG(1)
	  XX2 = XX2 + RORG(1)
   30	IF ( RORG(2) .EQ. 0.0 ) GO TO 40
	  YY1 = YY1 + RORG(2)
	  YY2 = YY2 + RORG(2)
   40	CONTINUE
C
C...	ROTATE COORDINATES TO SCAN LINE ORIENTATION, IF NECESSARY
	IF ( .NOT. ROT90 ) GO TO 50
	  TMP = XX1
	  XX1 = -YY1
	  YY1 = TMP
	  TMP = XX2
	  XX2 = -YY2
	  YY2 = TMP
   50	CONTINUE
C
C...	SAVE COORDINATE POSITION
	XX1SAV = XX1
	YY1SAV = YY1
C
C...	CHECK IF FILL PATTERN DEFINED
	LPAT = .FALSE.
	IF (ITNFLG .NE. 0 .OR. KPAT .GE. 0) GO TO 55
	  CALL MSGLG1 (124)
	  LPAT = .TRUE.
	  KPAT = 63
C
C...	CHECK IF A NULL RECTANGLE
   55	IF (IFLG.EQ.0 .AND. ITNFLG.EQ.0 .AND. KPAT.EQ.63) GO TO 999
C
C...	GET THE MAX AND MIN VALUES
	XMIN = AMIN1(XX1,XX2)
	XMAX = AMAX1(XX1,XX2)
	YMIN = AMIN1(YY1,YY2)
	YMAX = AMAX1(YY1,YY2)
C
C...	CHECK IF THE RECTANGLE NEEDS TO BE CLIPPED
	IF (XMIN .GE. WIN(1) .AND. XMAX .LE. WIN(3) .AND.
     *	    YMIN .GE. WIN(2) .AND. YMAX .LE. WIN(4)) GO TO 100
C
	  NCLIP = NCLIP + 1
C
C...	  CHECK FOR AN INVISIBLE RECTANGLE
	  IF (XMIN .GT. WIN(3) .OR. XMAX .LT. WIN(1) .OR.
     *	      YMIN .GT. WIN(4) .OR. YMAX .LT. WIN(2)) GO TO 999
C
C...	  CLIP THE RECTANGLE
	  IF (XMIN .GE. WIN(1)) GO TO 60
	    XMIN = WIN(1)
	    IF (XX1 .LT. XMIN) XX1 = XMIN
	    IF (XX2 .LT. XMIN) XX2 = XMIN
   60	  IF (YMIN .GE. WIN(2)) GO TO 70
	    YMIN = WIN(2)
	    IF (YY1 .LT. YMIN) YY1 = YMIN
	    IF (YY2 .LT. YMIN) YY2 = YMIN
   70	  IF (XMAX .LE. WIN(3)) GO TO 80
	    XMAX = WIN(3)
	    IF (XX1 .GT. XMAX) XX1 = XMAX
	    IF (XX2 .GT. XMAX) XX2 = XMAX
   80	  IF (YMAX .LE. WIN(4)) GO TO 100
	    YMAX = WIN(4)
	    IF (YY1 .GT. YMAX) YY1 = YMAX
	    IF (YY2 .GT. YMAX) YY2 = YMAX
C
  100	CONTINUE
C
C...	COMPUTE THE INTEGER ORDINATES OF THE RECTANGLE
	JX1 = XX1*WTV(1) + WTV(2)
	JX2 = XX2*WTV(1) + WTV(2)
	JY1 = YY1*WTV(3) + WTV(4)
	JY2 = YY2*WTV(3) + WTV(4)
C
C...	GET THE MAX AND MIN VALUES
	MINX = MIN0(JX1,JX2)
	MAXX = MAX0(JX1,JX2)
	MINY = MIN0(JY1,JY2)
	MAXY = MAX0(JY1,JY2)
C
C...	ADJUST FOR THE OUTLINE, IF ANY
	IF (IFLG .EQ. 0) GO TO 110
	  MINX = MINX - ILWM
	  MAXX = MAXX + ILWP
	  MINY = MINY - ILWM
	  MAXY = MAXY + ILWP
  110	CONTINUE
C
C..	UPDATE IBXMAX
	IF (MAXX .GT. IBXMAX) IBXMAX = MAXX
C
C...	CHECK IF THE RECTANGLE IS OUTLINED WITH A DASHED PEN
	IF (IFLG .NE. 0 .AND. DASHPN) GO TO 900
C
C...	CHECK IF THE RECTANGLE CROSSES A Y-STRIPPING BOUNDARY
	IF (.NOT. VSFLAG) GO TO 120
	IF ((MINY/YNIPS) .NE. (MAXY/YNIPS)) GO TO 900
C
C...	ADJUST THE RECTANGLE IF IT IS NOT IN THE FIRST STRIP
	NSTRIP = MINY/YNIPS
	IF (NSTRIP .EQ. 0) GO TO 120
	  ITMP = NSTRIP*XNIPS
	  JX1 = JX1 + ITMP
	  JX2 = JX2 + ITMP
	  MINX = MINX + ITMP
	  MAXX = MAXX + ITMP
	  ITMP = NSTRIP*YNIPS
	  JY1 = JY1 - ITMP
	  JY2 = JY2 - ITMP
C
  120	CONTINUE
C
C...	CHECK IF X-STRIPPING CHECK REQUIRED
	IF (.NOT. KFLAG) GO TO 200
	IF (MAXX-MINX .GE. KSIZE) GO TO 900
	IF (KREP .EQ. 4) GO TO 200
	IF ((MINX+8)/KSIZE .NE. (MAXX+8)/KSIZE) GO TO 900
  200	CONTINUE
C
C...	THE RECTANGLE (AND OUTLINE) DOES NOT CROSS A STRIPPING
C	BOUNDARY.
C
C...	SET UP NTNSEQ IF A TONE COLOR
	IF (ITNFLG .EQ. 0) GO TO 250
	DO 225 IBND=1,NCPASS
C
C...	  SAVE CURRENT VALUE
	  NTNSEQ(IBND,1) = ITNSEQ(IBND)
C
C...	  CHECK IF RECTANGLE IS OUTLINED WITH THIS TONER
	  NTNSEQ(IBND,2) = ITNSEQ(IBND)
	  ITNSEQ(IBND) = IABS(ITNSEQ(IBND))
	  IF (IFLG .EQ. 0) NTNSEQ(IBND,2) = ITNSEQ(IBND)
C
C...	  CHECK IF RECTANGLE IS FILLED WITH THIS TONER
	  NTNSEQ(IBND,3) = ITNSEQ(IBND)
	  IF (ICLRDF(NTNSEQ(IBND,3),ITNCLR).NE.63)
     *	     NTNSEQ(IBND,3) = -NTNSEQ(IBND,3)
C
	  IF (NTNSEQ(IBND,2) .LT. 0 .OR. NTNSEQ(IBND,3) .LT. 0)
     *	     ITNSEQ(IBND) = -ITNSEQ(IBND)
  225	CONTINUE
  250	CONTINUE
C
C...	OUTPUT THE FIRST POINT AS A MOVE COMMAND
	CALL OCHUNK (JX1,-1)
	CALL OCHUNK (JY1,-1)
C
	IF (ITNFLG .EQ. 0) GO TO 290
C
C...	*** TONE COLOR ***
C
C...	TURN OFF ITNSEQ
	DO 260 IBND=1,NCPASS
	  ITNSEQ(IBND) = IABS(ITNSEQ(IBND))
  260	CONTINUE
C
C...	OUTPUT THE DRAW POLYGON COMMANDS
	DO 270 IBND=1,NCPASS
	  IF (NTNSEQ(IBND,2).GE.0 .AND. NTNSEQ(IBND,3).GE.0) GO TO 270
	  ITNSEQ(IBND) = -ITNSEQ(IBND)
C
C...	  DETERMINE COUNT
	  ITMP = 6
	  IF (NTNSEQ(IBND,2) .LT. 0) ITMP = 8
	  IF (PRECIS .EQ. 32) ITMP = ITMP*2
	  ICOM = POLYGN + ITMP
C
C...	  OUTPUT POLYGON COMMAND AND FILL PATTERN
	  CALL OCHUNK (ICOM,0)
	  CALL OCHUNK (ICLRDF(-ITNSEQ(IBND),ITNCLR),0)
	  ITNSEQ(IBND) = -ITNSEQ(IBND)
C
C...	  COUNT BYTES
	  VRFKNT(IBND) = VRFKNT(IBND) + 5.0
	  BYTKNT(IBND) = BYTKNT(IBND) + 14.0
	  IF (NTNSEQ(IBND,2).LT.0)
     *	    BYTKNT(IBND) = BYTKNT(IBND) + DRWKNT * 4.0
C
  270	CONTINUE
C
C...	CHECK IF OUTLINED
	IF (IFLG .NE. 0) GO TO 275
C
C...	  TURN ON TONERS FOR THE FILL
	  DO 272 IBND=1,NCPASS
	    ITNSEQ(IBND) = NTNSEQ(IBND,3)
  272	  CONTINUE
	  GO TO 320
C
C...	  TURN ON TONERS FOR THE OUTLINE
  275	  DO 280 IBND=1,NCPASS
	    ITNSEQ(IBND) = NTNSEQ(IBND,2)
  280	  CONTINUE
	  GO TO 300
C
C...	*** HATCH PATTERN AND PEN COLOR ***
C
C...	DETERMINE COUNT
  290	ITMP = 6
	IF (IFLG .NE. 0) ITMP = 8
	IF (PRECIS .EQ. 32) ITMP = ITMP*2
	ICOM = POLYGN + ITMP
C
C...	OUTPUT POLYGON COMMAND AND FILL PATTERN
	CALL OCHUNK (ICOM,0)
	CALL OCHUNK (KPAT,0)
C
C...	COUNT BYTES
	DO 295 IBND=1,NCPASS
	  IF (ITNSEQ(IBND) .GE. 0) GO TO 295
	  VRFKNT(IBND) = VRFKNT(IBND) + 5.0
	  BYTKNT(IBND) = BYTKNT(IBND) + 14.0
	  IF (IFLG.NE.0) BYTKNT(IBND) = BYTKNT(IBND) + DRWKNT * 4.0
  295	CONTINUE
C
	IF (IFLG .EQ. 0) GO TO 320
C
C
C...	OUTPUT AN OUTLINED RECTANGLE
  300	CONTINUE
	IY = IOR (JY2,MSB)
	CALL OCHUNK (JX1,-1)
	CALL OCHUNK (IY,-1)
	CALL OCHUNK (JX2,-1)
	CALL OCHUNK (IY,-1)
	IY = IOR (JY1,MSB)
	CALL OCHUNK (JX2,-1)
	CALL OCHUNK (IY,-1)
	CALL OCHUNK (JX1,-1)
	CALL OCHUNK (IY,-1)
C
	IF (ITNFLG .EQ. 0) GO TO 400
C
C...	CHECK IF ANY OF THE FILL COLORS ARE DIFFERENT FROM THE OUTLINE
C	COLORS.  TURN THESE COLORS ON.
	ICNT = 0
	DO 310 IBND=1,NCPASS
	  ITNSEQ(IBND) = IABS(ITNSEQ(IBND))
	  IF (NTNSEQ(IBND,2).LT.0 .AND. NTNSEQ(IBND,3).GE.0) GO TO 310
	    ITNSEQ(IBND) = -ITNSEQ(IBND)
	    ICNT = 1
  310	CONTINUE
	IF (ICNT .EQ. 0) GO TO 380
C
C...	OUTPUT A NON-OUTLINED RECTANGLE
  320	CALL OCHUNK (JX1,-1)
	CALL OCHUNK (JY2,-1)
	CALL OCHUNK (JX2,-1)
	CALL OCHUNK (JY2,-1)
	CALL OCHUNK (JX2,-1)
	CALL OCHUNK (JY1,-1)
	IF (ITNFLG .EQ. 0) GO TO 400
C
C...	RESET ITNSEQ
  380	DO 390 IBND=1,NCPASS
	  ITNSEQ(IBND) = NTNSEQ(IBND,1)
  390	CONTINUE
C
C...	COUNT ANOTHER POLYGON
  400	OBJKNT(2) = OBJKNT(2) + 1.0
C
	GO TO 999
C
C...	THE RECTANGLE CROSSES A STRIPPING BOUNDARY OR IS OUTLINED
C	WITH A DASHED PEN.
C	THE OUTLINE IS OUTPUT USING PLOT CALLS AND THE
C	RECTANGLE IS OUTPUT (AND STRIPPED) BY TRAP.
  900	CONTINUE
C
C...	CHECK FOR A NULL FILL PATTERN
	IF (ITNFLG .EQ. 0 .AND. KPAT .EQ. 63) GO TO 940
C
C...	SET TONING SEQUENCE IF TONE COLOR
	IF (ITNFLG .EQ. 0) GO TO 920
	DO 910 IBND=1,NCPASS
	  NTNSEQ(IBND,1) = ITNSEQ(IBND)
	  ITNSEQ(IBND) = IABS(ITNSEQ(IBND))
	  IF (ICLRDF(ITNSEQ(IBND),ITNCLR) .NE. 63)
     *	     ITNSEQ(IBND) = -ITNSEQ(IBND)
  910	CONTINUE
C
  920	T(1) = JX1
	T(2) = JX2
	T(3) = JY1
	T(4) = JY2
	T(5) = JY1
	T(6) = JY2
	CALL TRAP(T)
C
C...	RESET TONE SEQUENCE IF TONE COLOR
	IF (ITNFLG .EQ. 0) GO TO 940
	DO 930 IBND=1,NCPASS
	  ITNSEQ(IBND) = NTNSEQ(IBND,1)
  930	CONTINUE
C
  940	IF (IFLG .EQ. 0) GO TO 999
C
C...	  SAVE THE REORIGIN AND ROTATE VALUES
	  SAVROT = ROT90
	  SAVORG(1) = RORG(1)
	  SAVORG(2) = RORG(2)
	  ROT90 = .FALSE.
	  RORG(1) = 0.0
	  RORG(2) = 0.0
C
C...	  OUTLINE THE RECTANGLE
	  CALL PLOT ( XX1, YY1, 3 )
	  CALL PLOT ( XX1, YY2, 2 )
	  CALL PLOT ( XX2, YY2, 2 )
	  CALL PLOT ( XX2, YY1, 2 )
	  CALL PLOT ( XX1, YY1, 2 )
C
C...	  RESTORE THE REORIGIN AND ROTATE VALUES
	  ROT90 = SAVROT
	  RORG(1) = SAVORG(1)
	  RORG(2) = SAVORG(2)
C
C...	UPDATE COORDINATE POSITION
  999	VCP(1) = XX1SAV
	VCP(2) = YY1SAV
	PMOVE = .TRUE.
C
C...	RESET KPAT IF NECESSARY
	IF (LPAT) KPAT = -1
C
	RETURN
	END