      SUBROUTINE TONE(X,Y,NE,NA)
C
C     NAME: TONE
C
C    LANGUAGE:  FORTRAN
C
C    OPERATING SYSTEM:  UNIVERSAL
C
C    ORDER NUMBER:  5428-SE
C
C    PART NUMBER:  000-026366  NOVEMBER 1985
C
C    PRODUCT:  UNIVERSAL 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. B  5/22/84      MAKE DELTAX CALCULATION DEPEND ON
C                          VARIABLE DLTSCN INSTEAD OF CONSTANT 2.0
C
C     REV. C  2/19/85      THE CODE TO OUTPUT EACH TRAPEZOID HAS
C                          BEEN MOVED TO SUBROUTINE TRAP.  TRAP
C                          WILL STRIP TRAPEZOIDS IN THE Y-DIRECTION
C                          AS WELL AS X-STRIPPING AND OUTPUTTING
C                          THE TRAPEZOID.
C
C                          THE CURRENT POSITION (VCP) HAS BEEN
C                          CHANGED SO THAT UPON EXIT OF TONE IT
C                          WILL ALWAYS BE THE FIRST POINT GIVEN BY
C                          THE USER.
C
C                          TONE WILL NOW ALLOW THE USER TO USE
C                          PATTERN 0.
C
C                          IBXMAX IS NOW CALCULATED CORRECTLY (BY
C                          SUBROUTINE TRAP.)  IT IS CALCULATED
C                          ONLY FOR THOSE TRAPEZOIDS THAT ARE
C                          ACTUALLY OUTPUT.
C
C                          IF THE OUTPUT IS GOING TO A PRISM
C                          (KREP=4), THEN ONLY THOSE TRAPEZOIDS
C                          THAT HAVE DELTA X >= KSIZE ARE STRIPPED.
C
C                          A BYTE COUNT IS NOW KEPT (BY TRAP.)
C
C     TONE - PATTERN SHADING OF USER DEFINED POLYGONAL AREAS
C
C     SUBROUTINE TONE IS USED TO PERFORM PATTERNED SHADING OF USER
C     DEFINED POLYGONAL AREAS.  TONE DECOMPOSES USER POLYGONS INTO A
C     SET OF TRAPEZOIDS AND CLIPS THEM TO THE VIEWING WINDOW.  THE
C     RESULTING TRAPEZOIDS ARE OUTPUT TO THE VDS OUTPUT FILE.
C
C     ENTRY:
C     A) TO SET ACTIVE TONE PATTERN: CALL TONE(0.,0.,IPAT,-NTP)
C
C      IPAT() - TONE PATTERN ARRAY OF UP TO 16 ELEMENTS
C      NTP    - THE NUMBER (ABSOLUTE) OF ELEMENTS IN 'IPAT'
C
C        A MAXIMUM OF 255 DISTINCT PATTERNS CAN BE DEFINED PER
C        PLOT.  EACH PATTERN MAY BE RESET ACTIVE AS MANY TIMES AS
C        DESIRED.
C
C     NOTE:  TONE PATTERNS ARE NOT ROTATED BY VERSAPLOT RANDOM.  USER
C            MUST ROTATE THE PATTERN ELEMENTS IF PLOT ROTATION IS
C            IS SPECIFIED (CALL ROTATE (-1)).
C
C            FOR 32 BIT COMPUTERS, ONLY THE LOWER 16 BITS OF A PATTERN
C            WORD ARE USED IN VERSAPLOT RANDOM.
C
C
C     B) TO TONE AREAS: CALL TONE(X,Y,NE,NA)
C
C      X,Y - THE COORDINATE ARRAYS DEFINING POLYGONS.  IF AN AREA
C             IS NOT CLOSED THE FIRST AND LAST ELEMENT ARE CONNECTED
C             TO CLOSE THE AREA.
C      NE  - AN ARRAY DESIGNATING THE NUMBER OF X,Y ELEMENTS
C            DEFINING EACH POLYGON.  FOR EXAMPLE:
C             NE(1) - SPECIFIES THE NUMBER OF COORDINATES
C                    FOR AREA ONE,
C             NE(2) - SPECIFIES THE NUMBER OF COORDINATES
C                    FOR AREA TWO, AND SO FORTH).
C      NA  - THE NUMBER OF AREAS DEFINED WITHIN X AND Y. (NE
C            DIMENSIONED TO NE(NA) ELEMENTS).
C
C     EXIT: THE VALUES IN X() AND Y() MAY BE GARBAGE.
C
C     CALLS: DEFPAT,MSGLG1,OCODE,SETPAT,TRAP
C
C     CALLED BY:  USER
C
C     COMMON USED:
C
C     /DVCOM/
C            I IPAT()  - ARRAY OF TONE PATTERNS
C            I KPAT    - NUMBER OF CURRENTLY ACTIVE TONE PATTERN
C            I MAXPAT  - MAXIMUM NUMBER OF FILL PATTERNS DEFINABLE
C            I NCLIP   - NUMBER OF CLIPPED VECTORS
C            I NPAT()  - NPAT(I) IS THE NUMBER OF WORDS IN TONE
C                        PATTERN #I
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            R WTV()   - WINDOW TRANSFORMATION VARIABLES. USED TO
C                        TRANSFORM COORDINATES FROM THE VIEW WINDOW
C                        SYSTEM TO THE  VIEWPORT SYSTEM
C            R WX()    - ARRAY OF X ORDINATES FOR REPRESENTING THE
C                        VIEW WINDOW AS POLYGONS.
C            R WY()    - ARRAY OF Y ORDINATES FOR REPRESENTING THE
C                        VIEW WINDOW AS POLYGONS.
C            R XDEN    - NUMBER OF NIBS PER VIEWPORT UNIT IN THE X
C                        DIRECTION
C
C     /MSGCOM/
C            I INTARG()- ARRAY FOR PASSING INTEGER OUTPUT ARGUMENTS
C            R RELARG()- ARRAY FOR PASSING REAL OUTPUT ARGUMENTS
C
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       LOCAL:
C              L CLIPPD  - .TRUE. IFF PART OF THE AREA WAS CLIPPED
C              R DELTAX  - MIN SIZE OF TRAPEZOID POSSIBLE
C              R DELXLF  - LEFT X LIMIT PLUS MIN TRAP SIZE
C              R DLT     - DIFFERENCE BETWEEN XLF AND THE X ORDINATE
C                         OF THE CURRENT EDGE BEING PROCESSED
C              R DLTSCN  - VARIABLE TO DETERMINE SPACING OF DATA POINTS
C              R DXLF    - LEFT X LIMIT PLUS 1/2 SCAN LINE
C              I I,J,K,L - COUNTERS AND INDEXES
C              I IBND    - POINTER TO CURRENT BAND
C              I INSZE   - SIZE OF THE THE ARRAYS YL AND YR
C              I ITMP    - OUT CODE FOR A POINT ON THE INTERIOR OF
C                         THE CURRENT TRAPEZOID
C              I IP      - PROCESSING FLAG: POLYGON OR WINDOW
C              I IPLMT   - LIMIT COUNT FOR TONE PATTERN (ELEMENTS)
C              I KK      - COMPARISON COUNTER
C              I N       - NUMBER OF POLYGON EDGES CROSSING
C                         CURRENT AREA
C              I NET     - TOTAL NUMBER OF ELEMENTS IN X() & Y()
C              I NM1     - N MINUS 1
C              I NP      - NUMBER OF TONE PATTERNS DEFINED
C              I NTOTAL  - TOTAL NUMBER OF VERTICES TO BE PROCESSED
C                         (I.E.: VERTICES IN USER POLYGON + VERTICES
C                         IN CLIPPING WINDOWS)
C              I NTNSEQ()- TEMP STORAGE FOR ITNSEQ()
C              I NTP     - NUMBER OF WORDS IN A TONE PATTERN
C                         DEFINITION
C              R SLOPE   - SLOPE OF CURRENT POLYGON EDGE
C              R T()     - TRAPEZOID ARRAY
C              R TMP     - USED FOR SHORT TERM STORAGE
C              R VCPSAV()- SAVED VALUE OF CURRENT COORDINATE POSITION
C              R XC,YC   - POINT ON THE INTERIOR OF CURRENT TRAPEZOID
C              R XDELTA  - DELTA X OF AREA IN NIBS
C              R XGNF    - DISTANCE OF 1/2 SCAN LINE IN X DIRECTION
C              R XLF     - LEFT X LIMIT OF AN AREA SECTION
C              R XRI     - RIGHT X LIMIT OF AN AREA SECTION
C              R XXMAX   - MAX X SENT IN THE X ARRAY
C              R XX1     - MIN VAL OF CURRENT VECTOR
C              R XX2     - MAX VAL OF CURRENT VECTOR
C              R X1,Y1   - ENDPOINT OF CURRENT EDGE
C              R X2,Y2   - ENDPOINT OF CURRENT EDGE
C              R YGNF    - DISTANCE OF 1/2 SCAN LINE IN X DIRECTION
C              R YL()    - ARRAY OF Y INTERSECTIONS BETWEEN POLYGON
C                         EDGES AND XLF
C              R YR()    - ARRAY OF Y INTERSECTIONS BETWEEN POLYGON
C                         EDGES AND XRI
C
C
      DIMENSION X(1),Y(1),NE(1)
C
C
      LOGICAL ROT90,PMOVE,IPDEF,DASHPN,XMAJOR,VSFLAG
      INTEGER PWIDTH,XNIPS,YNIPS,PENPAT,VSMAX,PFONT
C...  COMMON /DVCOM/  PHASE I COMMON VARIABLES
C
      COMMON /DVCOM/
     *         ANC,    DASHPN, FACT,   HTC,    ICUT,   ICWTV,  ICXPTS,
     *         IEOJ,   ILWM,   ILWP,   IOPEN,  ISORT,  ITFLAG, IX1,
     *         IX2,    IY1,    IY2,    JFONT,  JPEN,   KPAT,   KWIDTH,
     *         LASTX,  LASTY,  MAXPAT, MSB,    MSKALL, NCH,    NCLIP,
     *         NIBSX,  NLPAT,  NPLOT,  PFONT,  PMOVE,  PXMIN,  PXMAX,
     *         PYMIN,  PYMAX,  RADN,   ROT90,  SXC,    SYC,    TSINA,
     *         TCOSA,  XDEN,   XFAC,   XNIPS,  XOFF,   YDEN,   YFAC,
     *         YOFF,   YNIPS,  VSFLAG, VSMAX,  XMAJOR,
     *         IPAT(16,256), IEOP(4),  IHBUF(2), IPDEF(64),
     *         NPAT(255),    PENPAT(4,64), PWIDTH(64),
     *         RORG(2), VCP(2), VP(4), WIN(4), WTV(4), WX(4),  WY(4),
     *         IAUTXT(15)
C
C
C
C...  COMMON /MSGCOM/ - MESSAGE OUTPUT VARIABLES
C
      COMMON /MSGCOM/ INTARG(8), RELARG(12)
C
C
C...  COMMON /CLRCOM/ - COLOR VARIABLES
C
      INTEGER PCOLOR, CURPEN
      LOGICAL PENCHG
      COMMON /CLRCOM/
     *    ICLMAX,  ITNCLR,  ITNFLG,  IVCFLG,  NCPASS,  PENCHG,
     *         CURPEN(4), ICLRDF(4,512), IDASRT(4), ITNSEQ(4),
     *         PCOLOR(64)
C
      DIMENSION NTNSEQ(4,2)
      DIMENSION YL(100),YR(100)
      INTEGER T(6)
      DIMENSION VCPSAV(2)
      LOGICAL CLIPPD
C
      DATA NTP/1/,IPLMT/16/
C
C...VARIABLE MUST BE SET TO THE DIMENSION OF YL AND YR
      DATA INSZE/100/
C
C...  VARIABLE DLTSCN SHOULD BE INITIALIZED TO 2.0 FOR NORMALLY
C     SPACED DATA POINTS.  IF DATA POINTS ARE VERY CLOSELY SPACED
C     THEN REDUCE DLTSCN TO 1.0 OR 0.5.
      DATA DLTSCN/2.0/
C
C
C
C-D   OUTPUT DEBUG MESSAGE IF ENABLED
C      RELARG(1)=X(1)
C      RELARG(2)=Y(1)
C      INTARG(1)=NE(1)
C      INTARG(2)=NA
C      CALL MSGLG1(91)
C-D
C
C...  CHECK TYPE OF TONE CALL
      IF (NA) 10,900,100
C
C
C
C
C     ****************************
C...  * SET TONE PATTERN ARRAY *
C     ****************************
C
C
   10 NTP = -NA
C
C... CHECK IF PATTERN COUNT EXCEEDED LIMIT
      IF(NTP .LE. IPLMT) GO TO 12
C
C... PATTERN COUNT EXCEEDED
C-I
      INTARG(1)=NTP
      CALL MSGLG1(92)
C-I
C
C...  TRUNCATE FILL PATTERN TO MAXIMUM ALLOWABLE WORDS
      NTP = IPLMT
C
C...  SEARCH FOR A DUPLICATE PATTERN DEFINITION
   12 DO 30 I = 1,MAXPAT
C
C...  DOES NEW PATTERN HAVE SAME NUMBER OF ELEMENTS AS PATTERN(I)?
      IF (NTP .NE. NPAT(I))  GO TO 30
C
C...  YES, COMPARE ELEMENTS
      DO 20 J = 1,NTP
C
C...  IF PATTERNS DIFFER, GO ON TO NEXT OLD PATTERN
C
C...  USE ONLY LOWER 16 BITS OF ELEMENT WORD
      ITEMP = AND (NE(J),65535)
      IF (ITEMP .NE. IPAT(J,I))  GO TO 30
   20 CONTINUE
C
C...  A PATTERN MATCH HAS BEEN FOUND, ACTIVATE PATTERN INDEX
      GO TO 60
C
   30 CONTINUE
C
C...  AT THIS POINT THE PATTERN ARRAY HAS BEEN SEARCHED
C...  IS THE PATTERN ARRAY FULL?
      DO 40 I = 1,MAXPAT
      IF (NPAT(I) .EQ. 0)  GO TO 50
   40 CONTINUE
C-I
C...  YES, OUTPUT MESSAGE AND IGNORE CALL
      CALL MSGLG1(93)
      GO TO 999
C-I
C
C...  DEFINE NEW TONE PATTERN
   50 CALL DEFPAT (I,NE(1),NTP)
C
C...  SET PATTERN INDEX
   60 KPAT = I
      CALL SETPAT(I)
      GO TO 999
C     ************************
C     * TONE AREA PROCESSING *
C     ************************
C
C
C...  CHECK FOR A NULL FILL PATTERN
  100 IF (ITNFLG .NE. 0 .OR.
     *           (KPAT .NE. 63 .AND. KPAT .NE. -1)) GO TO 105
C
C...      OUTPUT ERROR MESSAGE IF PATTERN NOT DEFINED
          IF (KPAT .EQ. -1)  CALL MSGLG1 (94)
C
C...      UPDATE CURRENT POSITION AND EXIT
          PMOVE = .TRUE.
          VCP(1) = X(1) + RORG(1)
          VCP(2) = Y(1) + RORG(2)
          IF (.NOT.ROT90) GO TO 999
             TMP = VCP(1)
             VCP(1) = -VCP(2)
             VCP(2) = TMP
             GO TO 999
C
C...  SET X-STEP VALUE AND Y-SIGNIFICANCE CONSTANT
  105 YGNF = 0.5/ABS(WTV(3))
      XGNF = .5/ABS(WTV(1))
      DELTAX = 1.0/ABS(WTV(1)) * DLTSCN
C
C...  INITIALIZED CLIPPED FLAG
      CLIPPD = .FALSE.
C
C...  SET TOTAL NUMBER OF WINDOWS TO BE PROCESSED
      NWIN = 1
C
C...  DETERMINE TOTAL NUMBER OF ELEMENTS IN X,Y
      NET = 0
      DO 110 I=1,NA
  110 NET = NET + NE(I)
C
C
C...  DETERMINE MAX AND MIN X ORDINATES
      XXMAX = X(1)
      XLF = X(1)
      NTOTAL = NET + NWIN*4
C
C     USER POLYGONS WILL BE PROCESSED WITH POLYGONAL REPRESENTATIONS
C     OF THE VIEWING WINDOW.  USER COORDINATES MUST BE TRANSLATED TO
C     THE VIEW WINDOW COORDINATE SYSTEM.  IF PLOT ROTATION IS BEING
C     PERFORMED, USER COORDINATES MUST ALSO BE ROTATED SO THAT SCAN
C     LINE PROCESSING CAN TAKE PLACE IN THE POSITIVE X DIRECTION.
C
         IF (RORG(1) .EQ. 0.0 .AND. RORG(2) .EQ. 0.0) GO TO 135
C...     TRANSLATE COORDINATES TO ACCOUNT FOR REORIGIN
      DO 130 I=1,NET
         X(I) = X(I) + RORG(1)
         Y(I) = Y(I) + RORG(2)
  130 CONTINUE
C
C...     ROTATE COORDINATES TO SCAN LINE ORIENTATION, IF NECESSARY
  135 IF (.NOT.ROT90) GO TO 145
      DO 140 I=1,NET
         TMP = X(I)
         X(I) = -Y(I)
         Y(I) = TMP
  140 CONTINUE
C
C...  SAVE COORDINATE POSITION
  145 VCPSAV(1) = X(1)
      VCPSAV(2) = Y(1)
C
      DO 150 I=1,NET
         IF (X(I).GT.XXMAX) XXMAX = X(I)
         IF (X(I).LT.XLF)  XLF = X(I)
C-D   OUTPUT DEBUG MESSAGE IF ENABLED
C      INTARG(1)=I
C      RELARG(1)=X(I)
C      RELARG(2)=Y(I)
C      CALL MSGLG1(95)
C-D
  150 CONTINUE
C
C-D   OUTPUT DEBUG MESSAGE IF ENABLED
C      INTARG(1)=NET
C      RELARG(1)=XXMAX
C      RELARG(2)=XLF
C      RELARG(3)=YGNF
C      CALL MSGLG1(96)
C-D
C
C...  ADJUST MINIMUM DELTA X FOR SMALL AREAS
      XDELTA = (XXMAX-XLF) * ABS(WTV(1)) + .5
      IF (XDELTA .LT. XDEN/4.0)  DELTAX = 1.0/ABS(WTV(1)) * 1.0
C
C...  SET ITNSEQ FOR TONE COLOR OR PEN COLOR
      IF (ITNFLG .EQ. 0) GO TO 200
      DO 155 IBND=1,NCPASS,1
         NTNSEQ(IBND,1) = ITNSEQ(IBND)
         ITNSEQ(IBND) = IABS(ITNSEQ(IBND))
         IF (ICLRDF(ITNSEQ(IBND),ITNCLR) .NE. 63)
     X        ITNSEQ(IBND) = -ITNSEQ(IBND)
  155 CONTINUE
C
C     ******************************************
C...  * TRAPEZOID PROCESSING LOOP: 200-(550+1) *
C     ******************************************
C
C
C      TONE TRANSFORMS POLYGONS INTO TRAPEZOIDS.  ALL TRAPEZOIDS
C      GENERATED BY THIS PROCESS ARE EITHER COMPLETELY INSIDE OR
C      COMPLETELY OUTSIDE THE VIEWING WINDOW.  THE CLIPPING PROCESS
C      IS THEN REDUCED TO ACCEPTING OR REJECTING TRAPEZOIDS BASED ON
C      WHETHER THEY ARE INSIDE OR OUTSIDE THE WINDOW.
C
  200 XRI = XXMAX
      DXLF = XLF + XGNF
      DELXLF = XLF + DELTAX
C
C...     DETERMINE XRI, NEXT LOWEST X ORDINATE (>XLF AND >=DELTAX)
         DO 240 I=1,NTOTAL
            IF (I.LE.NET) X1 = X(I)
            IF (I.GT.NET) X1 = WX(I-NET)
            IF (X1.LE.DXLF)  GO TO 240
            IF (X1 .LE. DELXLF) GO TO 230
            IF (X1.LT.XRI)  XRI = X1
            GO TO 240
  230 IF ((X1 .GT. XRI) .OR. (XRI .GT. DELXLF)) XRI = X1
  240 CONTINUE
C
C
C        *****************************************************
C...     * CHECK FOR LINES CROSSING CURRENT AREA: XLF TO XRI *
C        *****************************************************
C
C        AT STATEMENT 300 AN AREA SECTION HAS BEEN DEFINED BY THE TWO
C        LIMITS XLF AND XRI EXTENDED ACROSS THE PLOTTING ARE PARALLEL
C        TO THE Y AXIS. (FIGURE A)
C
  300 N = 0
         IP = 1
         NAREAS = NA
C
C
C        THE LOOP BETWEEN 310 AND 410 IS EXECUTED TWICE FOR EACH
C        SUBSECTION.  THE FIRST PASS SEARCHES FOR USER PLYGON EDGES
C        CROSSING THE CURRENT AREA.  THE SECOND PASS SEARCHES FOR
C        WINDOW EDGES CROSSING THE CURRENT AREA.
C
  310 L = 0
C
C...     LOOP TO PROCESS EACH POLYGON AND EACH WINDOW
C        EACH POLYGON AND WINDOW EDGE IS TESTED TO DETERMINE IF IT
C        CROSSES THE CURRENT AREA SECTION.  IF IT DOES CROSS THE AREA,
C        ITS INTERSECTIONS AT THE XLF AND XRI BOUNDARIES ARE
C        CALCULATED AND STORED IN THE ARRAYS YL() AND YR().
         DO 410 I = 1,NAREAS
            KK = -1
C
C...        K INDEXES THE FIRST COORDINATE OF POLYGON(I) ON THE FIRST
C           PASS AND WINDOW(I) ON THE SECOND PASS.
            K = L+1
            IF (IP .EQ. 0) GO TO 320
C
C...          PROCESS POLYGON EDGES
C             L INDEXES THE LAST COORDINATE OF POLYGON(I)
               L = L + NE(I)
               X1 = X(L)
               Y1 = Y(L)
               GO TO 330
C
C...          PROCESS WINDOW EDGES
C             L INDEXES THE LAST COORDINATE OF WINDOW(I)
  320 L = L + 4
               X1 = WX(L)
               Y1 = WY(L)
C
C...        LOOP TO PROCESS EACH EDGE OF THE CURRENT POLYGON OR WINDOW
C           EACH EDGE IS DEFINED BY THE TWO ENDPOINTS X1,Y1 AND X2,Y2
  330 DO 404 J = K,L
               IF (IP .EQ. 0) GO TO 340
C
C...             POLYGON EDGES
                  X2 = X(J)
                  Y2 = Y(J)
                  GO TO 350
C
C...             WINDOW EDGES
  340 X2 = WX(J)
                  Y2 = WY(J)
C
C             CHECK TOO SEE IF AND OF THE VECTOR LIES IN THE AREA
C             BETWEEN XLF AND XRI.
  350 XX1 = AMIN1(X1,X2)
               XX2 = AMAX1(X1,X2)
               IF (XX1 .GE. XRI .OR. XX2 .LE. DXLF) GO TO 402
C...          A CHECK TO AVOID NONDEFINABLE SLOPES.
C
C***************************************************************************
C	AET 03/05/88
C	This line removed
C               IF (X2 .EQ. X1) GO TO 402
C
C	Replaced by
C
		IF (X2 .EQ. X1) THEN
		   IF (KK+1 .EQ. J) KK = J
		   GOTO 402
		END IF
C
C****************************************************************************
C
               DLT = XLF - X1
C
C...          IF A VECTOR IS COMPLETELY IN THE AREA THEN THERE ARE
C             MORE VECTORS TO AVERAGE SO FALL THROUGH TO THE NEXT
C             STATEMENT.
C
               IF (XX1.LE.DXLF .AND. XX2.GE.XRI) GO TO 380
C
C...          COMPUTE Y INTERSECTIONS OF LINE CROSSING CURRENT AREA
C             IT HAS BEEN DETERMINED THAT EDGE X1,Y1 TO X2,Y2 CROSSES
C             THE CURRENT AREA SECTION.  THE INTERSECTION OF THE EDGE
C             WITH THE TWO AREA LIMITS MUST BE CALCULATED.  YL()
C             HOLDS THE Y INTERSECT VALUE AT THE XLF LIMIT.  YR()
C             HOLDS THE Y INTERSECT VALUE AT THE XRI LIMIT.
C             GIVEN THE EQUATION OF A LINE EXPRESS IN THE TWO POINT
C             FORMULA:
C                Y-Y1=(SLOPE) * (X-X1), WHERE SLOPE =(Y2-Y1)/(X2-X1)
C             THE Y INCEPT CAN BE CALCULATED AS:
C                Y = (SLOPE) * (X-X1) + Y1
C             YL IS CALCULATED AS:
C                YL = (SLOPE) * (XLF-X1) + Y1
C             AND YR IS CALCULATED AS:
C                YR = (SLOPE) * (XRI-X1) + Y1
C
               IF (KK+1 .EQ. J) GO TO 386
C
C****************************************************************************
C             AET 03/05/88
C             This line changed from
C
C               IF (X2 .LE. XLF .OR. X2 .GE. XRI) GO TO 380
C
C		to
C
		IF (X2 .LE. DXLF .OR. X2 .GE. XRI) GO TO 380
C
C****************************************************************************
C...  THE CURRENT LINE LIES PART INSIDE AND OUTSIDE THE TRAPEZOID.
C     THE NEXT LINE MUST BE COMPLETELY INSIDE THE TRAPEZOID OR
C     MUST EXIT.  IF IT EXITS IT CAN LEVE BY PASSING THROUGH
C     THE TRAPEZOID OR BY RETURNING THROUGH THE SAME SIDE IT ENTERED.
C     IF THE LINE ENTERS THE TRAPEZOID FROM THE TOP IFLG = -1;
C     FROM THE BOTTOM, IFLG = 1.
             KK = J
             IFLG = 1
C
C***************************************************************************
C       AET 03/05/88
C	This line changed from
C
C             IF (X1 .LE. XLF)  IFLG = -1
C
C	to
C
		IF (X1 .LE. DXLF) IFLG = -1
C
C*******************************************************************************
  380 SLOPE = (Y2-Y1)/(X2-X1)
               N = N + 1
               IF (N .LE. INSZE) GO TO 385
C
C...             ARRAY OVERFLOW IMMINENT.  WARN USER, ABORT
C                COMPUTATION
C-I
                  CALL MSGLG1(97)
C-I
                  GO TO 550
  385 YL(N) = SLOPE*DLT + Y1
               YR(N) = SLOPE*(XRI-X1) + Y1
               GO TO 387
C
C...  THE LINE IS NOW BEING TRACKED INSIDE THE TRAPEZOID.  WHEN
C     THE LINE EXITS THE TRAPEZOID A VALUE IS ADDED TO IFLG TO
C     DETERMINE IF IT LEFT THE SAME WAY IT ENTERED THE TRAPEZOID
C     OR IF IT PASSED THROUGH THE TRAPEZOID.  IF THE LINE PASSES
C     THROUGH THE TRAPEZOID, THEN IFLG = 0.  IF THE LINE GOES
C     OUT THE SIDE IT ENTERED, THEN IFLG = -+2 DEPENDING ON
C     WHICH SIDE IT ENTERED AND LEFT.  IF IFLG = -+2, THE LAST
C     VALUE OF YL(N) AND YR(N) WILL BE DISCARDED BY SETTING
C     N = N-1 AND THEN THE SEARCH FOR ANOTHER LINE CONTINUES.
C
C**********************************************************************
C	AET 03/05/88
C	The following two lines changed from
C
C  386        IF (X2 .GT. XLF .AND. X2 .LT. XRI)  KK = J
C             IF (KK .NE. J .AND. X2 .LE. XLF)  IFLG = IFLG - 1
C
C	to
C
  386	     IF (X2 .GT. DXLF .AND. X2 .LT. XRI) KK = J
		IF (KK .NE. J .AND. X2 .LE. DXLF) IFLG = IFLG - 1
C
C************************************************************************:1
             IF (KK .NE. J .AND. X2 .GE. XRI)  IFLG = IFLG + 1
             IF (IABS(IFLG) .LT. 2)  GO TO 3861
             IFLG = 0
             N = N - 1
             GO TO 402
3861         SLOPE = (Y2-Y1)/(X2-X1)
               YL(N) = (SLOPE*DLT+Y1+YL(N))/2.0
               YR(N) = (SLOPE*(XRI-X1)+Y1+YR(N))/2.0
  387 IF (SLOPE) 388,390,389
  388 IF (YL(N) .GT. Y1 .AND. YL(N) .GT. Y2) YL(N)=AMAX1(Y1,Y2)
               IF (YR(N) .LT. Y1 .AND. YR(N) .LT. Y2)
     1                      YR(N)=AMIN1(Y1,Y2)
               GO TO 390
  389 IF (YL(N) .LT. Y1 .AND. YL(N) .LT. Y2) YL(N)=AMIN1(Y1,Y2)
               IF (YR(N) .GT. Y1 .AND. YR(N) .GT. Y2)
     1                      YR(N)=AMAX1(Y1,Y2)
C-D   OUTPUT DEBUG MESSAGE IF ENABLED
C      INTARG(1)=N
C      RELARG(1)=YL(N)
C      RELARG(2)=YR(N)
C      RELARG(3)=SLOPE
C      CALL MSGLG1(98)
C-D
C
C...          THE FIRST EDGE ENDPOINT (X1,Y1) IS UPDATED TO THE VALUE
C             OF THE SECOND EDGE ENDPOINT BEFORE LOOPING BACK TO
C             UPDATE (X2,Y2) WITH THE NEXT POLYGON OR WINDOW VERTEX.
C
C
C        ******************************************************
C...     * TEST FOR SEGMENTS INTERSECTING WITHIN CURRENT AREA *
C        ******************************************************
C
C
C
C...  WHEN KK = J, WE HAVE ANOTHER POINT IN THE TRAPEZOID AND
C     THERE IS NO NEED TO CHECK FOR INTERSECTIONS SINCE THE
C     SLOPE MAY BE MODIFIED ON THE NEXT PASS OR THE LINE MAY
C     BE REMOVED BECAUSE IT DOES NOT PASS THROUGH THE TRAPEZOID.
  390 IF (N .LE. 1 .OR. KK .EQ. J)  GO TO 402
C
C...     CHECK WIDTH OF CURRENT AREA
         IF (XRI .LE. DELXLF) GO TO 402
C
C
C        IT MUST BE DETERMINED IF ANY OF THE SEGMENTS CROSSING THE
C        AREA SUBSECTION CROSS EACH OTHER IN THE INTERVAL XLF TO XRI.
C        THE PROCEDURE INVOLVES CHECKING EACH INDIVIDUAL EDGE SEGMENT
C        AGAINST ALL OTHER SEGMENTS TO FIND ANY POSSIBLE CROSSINGS.
C        INTERSECTIONS ARE DETERMINED BY EXAMINING THE LEFT Y
C        ORDINATES OF TWO SEGMENTS TO DETERMINE WHICH IS GREATER.
C        THE ASSOCIATED RIGHT Y ORDINATES ARE THEN COMPARED TO
C        DETERMINE IF THE SEGMENT ENDPOINTS MAINTAIN THE SAME ORDER
C        AT BOTH AREA BOUNDARIES.
C        IF A SEGMENT BEGINS ABOVE ANOTHER BUT ENDS BELOW IT, THEN THE
C        SEGMENTS MUST CROSS IN THE SUBSECTION INTERVAL.
C
         NM1 = N-1
         DO 400 II=1,NM1
C
C...          DETERMINE THE ORDER OF THE TWO LEFT Y INTERSECTIONS
               YY1 = YL(II) - YL(N)
C
C...          DETERMINE THE ORDER OF THE TWO RIGHT Y INTERSECTIONS
               YY2 = YR(II) - YR(N)
C
C-D   OUTPUT DEBUG MESSAGE IF ENABLED
C      INTARG(1)=II
C      INTARG(2)=N
C      RELARG(1)=XLF
C      RELARG(2)=YL(II)
C      RELARG(3)=YL(N)
C      RELARG(4)=XRI
C      RELARG(5)=YR(II)
C      RELARG(6)=YR(N)
C      RELARG(7)=YY1
C      RELARG(8)=YY2
C      CALL MSGLG1(99)
C-D
C
               IF (YY1-YGNF) 392,400,396
  392 IF (YY1+YGNF) 394,400,400
C
C...          ALONG THE LEFT SUBSECTION BOUNDARY (XLF), YL(N) IS
C             GREATER THAN YL(II).   STATEMENT 394 DETERMINES IF
C             YR(II) IS GREATER THAN YR(N).  IF SO, THEN AN
C             INTERSECTION HAS OCCURRED AND THE CURRENT AREA MUST
C             BE SUBDIVIDED.
  394 IF (YY2-YGNF) 400,400,398
C
C             YL(II) IS GREATER THAN YL(N).  STATEMENT 396 DETERMINES
C             IF YR(N) IS GREATER THAN YL(II).  IF SO AN INTERSECTION
C             HAS OCCURRED AND THE CURRENT AREA MUST BE SUBDIVIDED.
  396 IF (YY2+YGNF) 398,400,400
C
C...          SUBSECTION CURRENT AREA
C             IT HAS BEEN DETEMINED THAT TWO SEGMENTS CROSS WITHIN
C             THE CURRENT AREA SUBSECTION.  THE AREA MUST THEREFORE
C             BE SUBDIVIDED AT THE POINT OF INTERSECTION.  THE POINT
C             OF INTERSECTION OF THE TWO SEGMENTS IS DERIVED FROM THE
C             THE TWO POINT FORMULA FOR A LINE.
C
C             IF THE EQUATION FOR LINE 1 IS
C                Y = (SLOPE1) * (X-XLF) + YL(II)
C                WHERE SLOPE2= (YL(II)-YR(II))/(XLF-XRI)
C             AND THE EQUATION FOR LINE 2 IS
C                Y = (SLOPE2) * (X-XLF) + YL(N),
C                WHERE SLOPE2= (YL(N)-YR(N))/(XLF-XRI)
C             THEN AT THE POINT OF INTERSECTION THE Y'S OF THE TWO
C             EQUATIONS WILL BE EQUAL. IF THE RIGHT PORTIONS OF THE
C             TWO EQUATIONS ARE SET EQUAL WE CAN SOLVE FOR THE X
C             ORDINATE OF THE INTERSECTION.
C
C             AFTER SOME ELEMENTARY ALGEBRA THE EQUATION STABILIZES
C             TO:
C
C             X = XLF-(XLF-XRI)*(YL(II)-YL(N))/
C                 (YL(II)-YL(N)-YR(II)-YR(N))
C
C             SINCE YY1 = YL(II)-YL(N)  AND  YY2 = YR(II)-YR(N)
C             THE EQUATION FOR THE X ORDINATE OF THE INTERSECTION
C             CAN BE SIMPLIFIED TO:
C
C             X = XLF + (XRI-XLF)*YY1/(YY1-YY2) AS IN STATEMENT 398.
C
  398 XRI = XLF + (XRI-XLF) * (YY1/(YY1-YY2))
C
C-D   OUTPUT DEBUG MESSAGE IF ENABLED
C      RELARG(1)=XRI
C      CALL MSGLG1(100)
C-D
C
C...          PROCESS NEW SUBSECTIONED INTERVAL
               GO TO 300
  400 CONTINUE
C
  402 X1 = X2
               Y1 = Y2
  404 CONTINUE
            IF (((N/2)*2) .NE. N) N = N - 1
  410 CONTINUE
C
         IF (N.GT.0) GO TO 415
C
C...        NO USER POLYGON EDGES CROSS CURRENT AREA,
C           PROCESS NEXT AREA
            GO TO 550
C
C...     HAVE ALL POLYGONS AND CLIPPING WINDOWS BEEN PROCESSED?
  415 IF (IP .EQ. 0) GO TO 420
C
C...     NO.  MAKE SECOND PASS TO ADD CLIPPING WINDOW EDGES
         IP = 0
         NAREAS = NWIN
         GO TO 310
C
C
C        ******************************************************
C...     * TEST FOR SEGMENTS INTERSECTING WITHIN CURRENT AREA *
C        ******************************************************
C
C
C...     ALL POLYGON AND WINDOW EDGES HAVE BEEN TESTED FOR CROSSING
C        THE CURRENT AREA SECTION.  WHEN AN INTERSECTION OCCURRED,
C        THE Y ORDINATES OF THE INTERSECTION WERE COMPUTED AND STORED
C        IN THE ARRAYS YL() AND YR().
  420 NM1 = N-1
C
C...     CHECK WIDTH OF CURRENT AREA
         IF (XRI .GE. DXLF) GO TO 470
C
C...        AREA IS LESS THAN .5 NIBS WIDE.  TRUNCATE AREA PROCESSING
C           AREA SUBSECTION PROCESSING IS TERMINATE WHEN THE AREA
C           BECOMES NARROWER THAN .5 NIBS.  THIS AVOIDS UNNECESSARY
C           COMPUTATION AND THE POSSIBILITY OF NUMERICAL ROUNDOFF
C           ERROR.  PROCESSING IS TRUNCATED BY COPYING THE LEFT EDGE Y
C           INTERSECTIONS TO THE RIGHT EDGE INTERSECTION LIST.
C           THE RESULTING TRAPEZOIDS WILL BE RECTANGLES THAT
C           ARE LESS THAN .5 NIBS WIDE.
            DO 405 I=1,N
  405 YR(I) = YL(I)
C
C
C        ****************************************
C...     * ORDER SEGMENTS LOWEST Y TO HIGHEST Y *
C        ****************************************
C
C
C        THE SEGMENTS DEFINED BY THE Y ORDINATES ARE STORED IN YL()
C        & YR(), AND IT HAS BEEN VERIFIED THAT NO TWO SEGMENTS INTER-
C        SECT EACH OTHER WITHIN THE CURRENT AREA SECTION.  NOW THE
C        SEGMENTS DEFINED BY YL() AND YR() MUST BE SORTED FORM LOWEST
C        HIGHEST.  STATEMENTS 470 TO 490 ACCOMPLISH THE ORDERING WITH
C        A BUBBLE SORT.
C
  470 DO 490 I=1,NM1
            K = I + 1
C
            DO 490 J=K,N
C
C             IF THE POINTS ARE WITHIN .5 SCAN LINES THEN THEY ARE
C             CONSIDERED EQUAL, AND THE OTHER SET OF POINTS MUST BE
C             CHECKED IN THE SAME MANNER.
C
               IF(YL(I)-YL(J).LE.YGNF.AND.YR(I)-YR(J).LE.YGNF)
     1                     GO TO 490
C
C...             SWAP ORDER OF SCAN LINE INTERSECTIONS
                  TMP = YL(J)
                  YL(J) = YL(I)
                  YL(I) = TMP
                  TMP = YR(J)
                  YR(J) = YR(I)
                  YR(I) = TMP
C
  490 CONTINUE
C
C
C
C     ********************************
C...  * DISCARD INVISIBLE TRAPEZOIDS *
C     ********************************
C
C
C        TONE PROCESSES POLYGON REPRESENTATIONS OF THE CLIPPING WINDOW
C        AND ALL ACTIVE EXCLUSIVE CLIPPING WINDOWS ALONG WITH THE USER
C        POLYGON ARRAY.  ALL TRAPEZOID AREAS GENERATED IN THIS MANNER
C        LIE COMPLETELY INSIDE OR COMPLETELY OUTSIDE OF THE CLIPPING
C        WINDOWS.  BECAUSE OF THIS IT IS ONLY NECESSARY TO TEST A
C        SINGLE POINT ON THE INTERIOR OF A TRAPEZOID TO DETERMINE IF
C        THE ENTIRE TRAPEZOID FALLS INSIDE OR OUTIDE OF A CLIPPING
C        WINDOW.
C
      XC = (XLF+XRI)/2.0
C
C...  COMPUTE X COORDINATES
      JX1 = XLF * WTV(1) + WTV(2)
      JX2 = XRI * WTV(1) + WTV(2)
C
      DO 540 I=2,NM1,2
C
C...     POINT XC,YC IS IS THE AVERAGE OF THE TRAPEZOID VERTICES.
         YC = (YL(I)+YL(I+1)+YR(I)+YR(I+1))/4.0
C
C...     IF POINT IS OUTSIDE CLIPPING WINDOW DISCARD TRAPEZOID
         CALL OCODE(XC,YC,ITMP)
         IF (ITMP .EQ. 0) GO TO 530
            CLIPPD = .TRUE.
            GO TO 540
C
C
C
C        ********************
C...     * OUTPUT TRAPEZOID *
C        ********************
C
  530    T(1) = JX1
         T(2) = JX2
         T(3) = YL(I) * WTV(3) + WTV(4)
         T(4) = YL(I+1) * WTV(3) + WTV(4)
         T(5) = YR(I) * WTV(3) + WTV(4)
         T(6) = YR(I+1) * WTV(3) + WTV(4)
         CALL TRAP(T)
  540 CONTINUE
C
C
C...  UPDATE LEFT X LIMIT
C     ALL PROCESSING OF 'ELEMENTARY AREAS' WITHIN THE CURRENT AREA
C     SECTION HAS BEEN COMPLETED.  STATEMENT 550 UPDATES THE LEFT X
C     TO THE RIGHT LIMIT WHICH WILL NOW BE USED AS THE LEFT LIMIT FOR
C     THE NEXT AREA SECTION.
  550 XLF = XRI
C
C
C...  TEST FOR AREA PROCESSING COMPLETE
C     IF THE UPDATED LEFT X LIMIT IS GREATER THAN OR EQUAL TO THE MAX-
C     IMUM X ORDINATE, THEN ALL AREA PROCESSING IS COMPLETE.
      IF (XLF.LT.XXMAX)  GO TO 200
C
C     ************************************
C...  * END OF TRAPEZOID PROCESSING LOOP *
C     ************************************
C
C
C...  RESTORE TONING SEQUENCE IF NECESSARY
      IF (ITNFLG .EQ. 0) GO TO 556
      DO 554 IBND=1,NCPASS,1
         ITNSEQ(IBND) = NTNSEQ(IBND,1)
  554 CONTINUE
C
C...  CHECK IF THE AREA WAS CLIPPED
  556 IF (CLIPPD) NCLIP = NCLIP + 1
C
C...  UPDATE CURRENT POSITION
      VCP(1) = VCPSAV(1)
      VCP(2) = VCPSAV(2)
      PMOVE = .TRUE.
C
C...  HAVE THE USER'S POLYGON ARRAYS BEEN MODIFIED?
      IF ((.NOT.ROT90) .AND. RORG(1).EQ.0.0 .AND. RORG(2).EQ.0.0)
     1   GO TO 999
C
C...  YES.  RESTORE VALUES IN USER ARRAY
      DO 699 I=1,NET
         IF (.NOT. ROT90) GO TO 600
            TMP = Y(I)
            Y(I) = -X(I)
            X(I) = TMP
C
  600 X(I) = X(I) - RORG(1)
         Y(I) = Y(I) - RORG(2)
  699 CONTINUE
      GO TO 999
C
C-I
C...  ILLEGAL CALLING PARAMETER
  900 CALL MSGLG1(101)
C-I
C
  999 MSK = 0
      RETURN
      END
