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