SUBROUTINE CONVEX (XP,YP,NPT) C NAME: CONVEX 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. C C 2/19/85 CODE TO DO STRIPPING OF PLOTS WIDER C THAN THE PLOTTER. SUBROUTINE CONVEX C NOW STRIPS THE CLIPPED POLYGON AND C CALLS SUBROUTINE CONVX TO OUTPUT EACH C STRIPPED POLYGON. C C CURRENT POSITION (VCP) NOW SET TO THE C FIRST POINT OF THE POLYGON, EVEN IF THE C POLYGON IS CLIPPED OR STRIPPED. C C THE CODE TO X-STRIP THE POLYGON AND TO C OUTPUT THE POLYGON TO THE VRF FILE IS C NOW IN SUBROUTINE CONVX. FOR REVISIONS C TO THIS CODE, SEE SUBROUTINE CONVX. C C 8/09/85 CHECK FOR NON-CONVEX POLYGONS, OUTPUT C A MESSAGE WITH THE FIRST ELEMENT PAIR, C AND IGNORE CALL. C CONVEX - CLIP AND STRIP CONVEX POLYGONS C C SUBROUTINE CONVEX CLIPS CONVEX POLYGONS TO THE VIEWING C WINDOW, CONVERTS THE WINDOW COORDINATES TO VIEWPORT C COORDINATES, STRIPS THE POLYGON IN THE Y-DIRECTION (POSSIBLY C CREATING MULTIPLE POLYGONS,) AND CALLS CONVX TO OUTPUT C EACH RESULTING POLYGON. C C CONVEX USES THE SUTHERLAND-HODGMAN POLYGON CLIPPING ALGORITHM C TO CLIP CONVEX POLYGONS TO THE VIEWING WINDOW. THIS C ALGORITHM CLIPS THE POLYGON AGAINST A SINGLE CLIPPING C EDGE. THE RESULTANT POLYGON IS THEN CLIPPED AGAINST C THE NEXT EDGE AND SO ON UNTIL IT IS CLIPPED TO ALL C FOUR WINDOW EDGES. C C CONVEX STRIPS THE POLYGON BY FINDING THE POINT WITH THE LEAST C Y VALUE, FOLLOWING THE EDGES OF THE POLYGON IN BOTH FORWARD AND C BACKWARD DIRECTIONS UNTIL THE STRIPPING BOUNDARY IS REACHED, C AND OUTPUTTING THAT PART OF THE POLYGON THAT LIES IN THE C CURRENT STRIP. THE PROCESS IS THEN REPEATED ON THE REMAINING C POLYGON. C C C ENTRY: CALL CONVEX (XP,YP,NPT) C C XP,YP - THE COORDINATE ARRAYS DEFINING THE POLYGON C NPT - THE NUMBER OF ELEMENTS DEFINING THE POLYGON C IF NPT < 0, OUTLINE THE POLYGON C THE MAXIMUM NUMBER OF ELEMENTS DEFINING THE C POLYGON ARE: C C PRECISION = 16: 127 ELEMENTS C PRECISION = 32: 63 ELEMENTS C C A MESSAGE IS OUTPUT IF THE ABOVE MAXIMUMS ARE C EXCEEDED AND THE CALL IS IGNORED. IF A POLYGON C IS CLIPPED AND/OR STRIPPED, IT IS POSSIBLE TO C GENERATE UP TO FOUR(4) ADDITIONAL ELEMENTS, C CAUSING THE NUMBER TO EXCEED THE MAXIMUM ALLOWED. C IF THE CLIPPING GENERATES TOO MANY POINTS, A C MESSAGE IS OUTPUT AND THE CALL IS IGNORED. C IF THE STRIPPING GENERATES TOO MANY POINTS, A C MESSAGE IS OUTPUT AND PROCESSING ON THE REST OF C THE POLYGON IS STOPPED. HOWEVER, SOME OF THE C STRIPPED POLYGONS MAY HAVE ALREADY BEEN OUTPUT. C C EXIT: RETURN C C CALLS: CONVX,MSGLG1,PLOT C C CALLED BY: APPLICATION PROGRAM, CIRCLE C C COMMON USED: C /DVCOM/ C I ICXPTS - MAXIMUM NUMBER OF POLYGON ELEMENTS ALLOWED C I ILWP - (LINE WIDTH - 1)/2 C I ILWM - LINE WIDTH/2 C I KPAT - NUMBER OF CURRENTLY ACTIVE TONE PATTERN 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 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 ITNFLG - USE PEN OR TONE COLOR FOR AREAS C C LOCAL VARIABLES USED: C C L FIRST - .TRUE. IFF THE STRIPPING ALGORITHM IS PROCESSING C THE FIRST STRIP OF THE POLYGON C I FOUT - FLAG TO INDICATE IF FIRST POINT OF POLYGON C WAS OUTSIDE THE CLIPPING EDGE C I ICURR - INDEX OF THE LAST BACKUP POINT IN THE CURRENT STRIP C I IFIRST - INDEX OF THE FIRST FORWARD POINT IN THE CURRENT C STRIP C I ILAST - INDEX OF THE FIRST BACKUP POINT IN THE CURRENT C STRIP C I IN - INDEX INTO COORDINATE ARRAYS OF POLYGON C TO BE CLIPPED C I IX(), - INTEGER COORDINATES OF THE CLIPPED POLYGON C IY() C I IXOFF, - OFFSETS USED TO PLACE A STRIPPED POLYGON IN THE C IYOFF CORRECT STRIP C I IXOUT, - COORDINATES OF THE STRIPPED POLYGON TO BE OUTPUT C IYOUT C I IXSAV1 - X VALUE OF THE INTERSECTION WITH THE STRIPPING C BOUNDARY OF THE FORWARD SET OF POINTS OF THE C POLYGON C I IXSAV2 - X VALUE OF THE INTERSECTION WITH THE STRIPPING C BOUNDARY OF THE BACKWARD SET OF POINTS OF THE C POLYGON C I MAXPT - INDEX OF COORDINATE POINT WITH MAXIMUM Y-VALUE C I MINPT - INDEX OF COORDINATE POINT WITH MINIMUM Y-VALUE C I NEXT - THE NEXT POINT (FORWARD OR BACKWARD) OF THE POLYGON C I NP1 - THE NUMBER OF POINTS IN THE CLIPPED POLYGON C I OUT - INDEX INTO COORDINATE ARRAYS OF CLIPPED POLYGON C L OUTLIN - .TRUE. IFF THE POLYGON WAS OUTLINED BY SUBROUTINE C CONVX C I POUT - FLAG INDICATING WHETHER CURRENT POINT WAS C OUTSIDE THE CLIPPING EDGE C L SAVROT - SAVED VALUE OF ROT90 C I SAVORG()- SAVED VALUES OF RORG() C I SOUT - FLAG INDICATING WHETHER PREVIOUS POINT WAS C OUTSIDE THE CLIPPING EDGE C R X(),Y(),- COORDINATE ARRAYS OF THE POLYGON USED DURING THE C X2(),Y2() CLIPPING PROCESS C R XORD, - COORDINATES OF THE INTERSECTION WITH THE STRIPPING C YORD BOUNDARY C 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 C DIMENSION XP(1),YP(1) DIMENSION X(131),Y(131) DIMENSION X2(131),Y2(131) DIMENSION IX(131),IY(131) DIMENSION IXOUT(131),IYOUT(131) DIMENSION SAVORG(2) C INTEGER IN,OUT,SOUT,FOUT,POUT LOGICAL FIRST,OUTLIN,SAVROT,LPAT C C DEFINE INTERSECTION FUNCTION C C... XINT -- RETURN X ORDINATE OF THE POINT LYING ON THE SEGMENT C (IAX,IAY),(IBX,IBY) WHOSE Y ORDINATE IS C. C THIS FUNCTION IS DERIVED BY TAKING THE TWO POINT FORMULA FOR A C LINE AND SOLVING FOR X. C XINT(IAX,IAY,IBX,IBY,C) = (C-IAY) * (IBX-IAX) / (IBY-IAY) + IAX C C C-D DEBUG MESSAGE C RELARG(1)=XP(1) C RELARG(2)=YP(1) C INTARG(1)=NPT C CALL MSGLG1(7) C-D C C C C... CHECK IF FILL PATTERN DEFINED LPAT = .FALSE. IF (KPAT .GE. 0 .OR. ITNFLG .NE. 0) GO TO 5 C-E CALL MSGLG1 (123) C-E LPAT = .TRUE. KPAT = 63 C C... CHECK FOR A NULL POLYGON (NO OUTLINE AND A NULL FILL) 5 IF (NPT .LT. 0 .OR. ITNFLG .NE. 0 .OR. KPAT .NE. 63) GO TO 20 C C... UPDATE THE CURRENT POINT AND EXIT X(1) = XP(1) + RORG(1) Y(1) = YP(1) + RORG(2) IF (.NOT. ROT90) GO TO 10 TMP = X(1) X(1) = -Y(1) Y(1) = TMP 10 VCP(1) = X(1) VCP(2) = Y(1) PMOVE = .TRUE. GO TO 9999 C C... INITIALIZE OUTLINED FLAG 20 OUTLIN = .FALSE. C C... GET NUMBER OF POINTS NP1 = IABS(NPT) C C... CHECK IF USER CLOSED THE POLYGON C (IE. LAST POINT SAME AS FIRST POINT) IF ((XP(1).EQ.XP(NP1)).AND.(YP(1).EQ.YP(NP1)) * .AND.(NP1.NE.3)) NP1 = NP1 - 1 C C... CHECK FOR ILLEGAL NUMBER OF ELEMENTS IF (NP1 .LE. 2 .OR. NP1 .GT. ICXPTS) GO TO 9100 C C... USER COORDINATES MUST BE TRANSLATED TO THE VIEW WINDOW C COORDINATE SYSTEM. IF PLOT ROTATION IS BEING PERFORMED, C USER COORDINATES MUST ALSO BE ROTATED SO THAT SCAN LINE C PROCESSING CAN TAKE PLACE IN THE POSITIVE X DIRECTION. C C... TRANSLATE COORDINATES TO ACCOUNT FOR REORIGIN DO 70 I=1,NP1 X(I) = XP(I) + RORG(1) Y(I) = YP(I) + RORG(2) 70 CONTINUE C C... CHECK IF POLYGON NEEDS TO BE CHECKED IF (NP1 .EQ. 3) GO TO 115 C C... CHECK IF THE POLYGON IS CONVEX, TWO CHECKS C ARE REQUIRED. C FIRST INITIALIZE VARIABLES ICUR = 1 INXT = 2 IXFLAG = 0 C C... DUPLICATE FIRST AND SECOND POINTS X(NP1+1) = X(1) Y(NP1+1) = Y(1) X(NP1+2) = X(2) Y(NP1+2) = Y(2) NP2 = NP1 + 1 C C... CHECK IF INCREASING OR DECREASING X 73 IF (X(INXT) - X(ICUR)) 75,74,78 74 ICUR = INXT INXT = INXT + 1 IF (INXT .GT. NP2) GO TO 90 GO TO 73 C C... DECREASING X 75 ICUR = INXT INXT = INXT + 1 IF (INXT .GT. NP2) GO TO 80 C C... CHECK IF X IS STILL DECREASING IF (X(INXT) .LE. X(ICUR)) GO TO 75 C C... CHANGED DIRECTION, INCREMENT FLAG IXFLAG = IXFLAG + 1 C C... INCREASING X 78 ICUR = INXT INXT = INXT + 1 IF (INXT .GT. NP2) GO TO 80 C C... CHECK IF X IS STILL INCREASING IF (X(INXT) .GE. X(ICUR)) GO TO 78 C C... CHANGED DIRECTION, INCREMENT FLAG IXFLAG = IXFLAG + 1 GO TO 75 C C... CHECK IF TOO MANY DIRECTION CHANGES 80 IF (IXFLAG .GT. 2) GO TO 9200 C C... CHECK IF TOO MANY CHANGES IN DIRECTION FOR Y 90 ICUR = 1 INXT = 2 IYFLAG = 0 C C... CHECK IF INCREASING OR DECREASING Y 92 IF (Y(INXT) - Y(ICUR)) 95,94,96 94 ICUR = INXT INXT = INXT + 1 IF (INXT .GT. NP2) GO TO 99 GO TO 92 C C... DECREASING Y 95 ICUR = INXT INXT = INXT + 1 IF (INXT .GT. NP2) GO TO 98 C C... CHECK IF Y IS STILL DECREASING IF (Y(INXT) .LE. Y(ICUR)) GO TO 95 C C... CHANGED DIRECTION, INCREMENT FLAG IYFLAG = IYFLAG + 1 C C... INCREASING Y 96 ICUR = INXT INXT = INXT + 1 IF (INXT .GT. NP2) GO TO 98 C C... CHECK IF Y IS STILL INCREASING IF (Y(INXT) .GE. Y(ICUR)) GO TO 96 C C... CHANGED DIRECTION, INCREMENT FLAG IYFLAG = IYFLAG + 1 GO TO 95 C C... CHECK IF TOO MANY DIRECTION CHANGES 98 IF (IYFLAG .GT. 2) GO TO 9200 C C... CHECK X AND Y FOR DIRECTION CHANGES 99 IF (IXFLAG .EQ. 0 .AND. IYFLAG .GT. 1) GO TO 9200 IF (IYFLAG .EQ. 0 .AND. IXFLAG .GT. 1) GO TO 9200 C C... NOW CHECK POLYGON AGAIN USING THE SIDES C 100 INXT = 0 C C... COMPUTE FIRST DELTA VALUES 105 INXT = INXT + 1 IF (INXT .GT. NP1) GO TO 115 DX1 = X(INXT+1) - X(INXT) DY1 = Y(INXT+1) - Y(INXT) C C... COMPUTE NEXT DELTA VALUES DX2 = X(INXT+2) - X(INXT+1) DY2 = Y(INXT+2) - Y(INXT+1) C C... CALCULATE AND SAVE THE SIGN TEMP = (DX1 * DY2) - (DX2 * DY1) IF (TEMP .EQ. 0.0) GO TO 105 LSIGN = 0 IF (TEMP .LT. 0.0) LSIGN = -1 C C... CHECK REMAINING POINTS IB = INXT + 2 DO 110 IA = IB,NP2 KSIGN = 0 DX1 = DX2 DY1 = DY2 C C... COMPUTE NEXT DELTA VALUES DX2 = X(IA+1) - X(IA) DY2 = Y(IA+1) - Y(IA) TEMP = (DX1 * DY2) - (DX2 * DY1) IF (TEMP .EQ. 0.0) GO TO 110 IF (TEMP .LT. 0.0) KSIGN = -1 C C... CHECK IF SAME SIGN IF (KSIGN .NE. LSIGN) GO TO 9200 110 CONTINUE C C... ROTATE COORDINATES TO SCAN LINE ORIENTATION,IF NECESSARY 115 IF (.NOT.ROT90) GO TO 150 DO 120 I=1,NP1 TMP = X(I) X(I) = -Y(I) Y(I) = TMP 120 CONTINUE C C... SAVE COORDINATE POSITION 150 VCP(1) = X(1) VCP(2) = Y(1) PMOVE = .TRUE. C C... CHECK IF CLIPPING REQUIRED DO 160 I = 1,NP1 IF (X(I).LT.WIN(1) .OR. X(I).GT.WIN(3)) GO TO 170 IF (Y(I).LT.WIN(2) .OR. Y(I).GT.WIN(4)) GO TO 170 160 CONTINUE C C... CLIPPING NOT REQUIRED, SKIP CLIPPING CODE GO TO 600 C C... FIRST CLIP POLYGON AGAINST X-MINIMUM WINDOW EDGE 170 OUT = 1 NCLIP = NCLIP + 1 DO 200 IN=1,NP1 POUT = 0 C C... IS POINT OUTSIDE WINDOW EDGE? IF (X(IN).LT.WIN(1)) POUT = -1 IF (IN.NE.1) GO TO 180 FOUT = POUT GO TO 190 180 IF (POUT.EQ.SOUT) GO TO 190 X2(OUT) = WIN(1) Y2(OUT) = Y(IN)+(WIN(1)-X(IN))*(Y(IN-1)-Y(IN))/ 1 (X(IN-1)-X(IN)) OUT = OUT + 1 190 SOUT = POUT IF (POUT.NE.0) GO TO 200 X2(OUT) = X(IN) Y2(OUT) = Y(IN) OUT = OUT + 1 200 CONTINUE C C... CLOSE ROUTINE FOR THIS EDGE IF (SOUT.EQ.FOUT) GO TO 210 X2(OUT) = WIN(1) Y2(OUT) = Y(1) + (WIN(1)-X(1))*(Y(NP1)-Y(1))/(X(NP1)-X(1)) OUT = OUT + 1 C C... CHECK FOR NULL POLYGON 210 IF (OUT.EQ.1) GO TO 9999 C C C... CLIP POLYGON AGAINST Y-MAXIMUM WINDOW EDGE NP1 = OUT - 1 OUT = 1 DO 300 IN=1,NP1 POUT = 0 IF (Y2(IN).GT.WIN(4)) POUT = -1 IF (IN.NE.1) GO TO 220 FOUT = POUT GO TO 250 220 IF (POUT.EQ.SOUT) GO TO 250 X(OUT)=X2(IN)+(WIN(4)-Y2(IN))*(X2(IN-1)-X2(IN))/ 1 (Y2(IN-1)-Y2(IN)) Y(OUT) = WIN(4) OUT = OUT + 1 250 SOUT = POUT IF (POUT.NE.0) GO TO 300 X(OUT) = X2(IN) Y(OUT) = Y2(IN) OUT = OUT + 1 300 CONTINUE C C... CLOSE ROUTINE FOR Y-MAXIMUM EDGE IF (SOUT.EQ.FOUT) GO TO 310 X(OUT) = X2(1) + (WIN(4)-Y2(1))*(X2(NP1)-X2(1))/ 1 (Y2(NP1)-Y2(1)) Y(OUT) = WIN(4) OUT = OUT + 1 C C... CHECK FOR NULL POLYGON 310 IF (OUT.EQ.1) GO TO 9999 C C C... CLIP POLYGON AGAINST X-MAXIMUM WINDOW EDGE NP1 = OUT - 1 OUT = 1 DO 400 IN=1,NP1 POUT = 0 IF (X(IN).GT.WIN(3)) POUT = -1 IF (IN.NE.1) GO TO 320 FOUT = POUT GO TO 350 320 IF (POUT.EQ.SOUT) GO TO 350 X2(OUT) = WIN(3) Y2(OUT) = Y(IN)+(WIN(3)-X(IN))*(Y(IN-1)-Y(IN))/ 1 (X(IN-1)-X(IN)) OUT = OUT + 1 350 SOUT = POUT IF (POUT.NE.0) GO TO 400 X2(OUT) = X(IN) Y2(OUT) = Y(IN) OUT = OUT + 1 400 CONTINUE C C... CLOSE ROUTINE FOR X-MAXIMUM EDGE IF (SOUT.EQ.FOUT) GO TO 410 X2(OUT) = WIN(3) Y2(OUT) = Y(1) + (WIN(3)-X(1))*(Y(NP1)-Y(1))/(X(NP1)-X(1)) OUT = OUT + 1 C C... CHECK FOR NULL POLYGON 410 IF (OUT.EQ.1) GO TO 9999 C C C... CLIP POLYGON AGAINST Y-MINIMUM WINDOW EDGE NP1 = OUT - 1 OUT = 1 DO 500 IN=1,NP1 POUT = 0 IF (Y2(IN).LT.WIN(2)) POUT = -1 IF (IN.NE.1) GO TO 420 FOUT = POUT GO TO 450 420 IF (POUT.EQ.SOUT) GO TO 450 X(OUT)=X2(IN)+(WIN(2)-Y2(IN))*(X2(IN-1)-X2(IN))/ 1 (Y2(IN-1)-Y2(IN)) Y(OUT) = WIN(2) OUT = OUT + 1 450 SOUT = POUT IF (POUT.NE.0) GO TO 500 X(OUT) = X2(IN) Y(OUT) = Y2(IN) OUT = OUT + 1 500 CONTINUE C C... CLOSE ROUTINE FOR Y-MINIMUM EDGE IF (SOUT.EQ.FOUT) GO TO 510 X(OUT) = X2(1) + (WIN(2)-Y2(1))*(X2(NP1)-X2(1))/ 1 (Y2(NP1)-Y2(1)) Y(OUT) = WIN(2) OUT = OUT + 1 C C... CHECK FOR NULL POLYGON 510 IF (OUT.EQ.1) GO TO 9999 C NP1 = OUT - 1 C C... CHECK IF MAXIMUM NUMBER OF ELEMENTS EXCEEDED IF (NP1 .GT. ICXPTS) GO TO 9100 C C... CONVERT WORLD COORDINATES TO VIEWPORT COORDINATES. C ALSO, FIND THE MAXIMUM AND MINIMUM Y-VALUES. 600 MINPT = 1 MAXPT = 1 DO 650 J = 1,NP1 IX(J) = X(J)*WTV(1) + WTV(2) IY(J) = Y(J)*WTV(3) + WTV(4) IF ( IY(J) .LT. IY(MINPT) ) MINPT = J IF ( IY(J) .GT. IY(MAXPT) ) MAXPT = J 650 CONTINUE C C... CHECK AGAIN IF POLYGON IS CONVEX IF (NP1 .EQ. 3) GO TO 670 C C... DUPLICATE FIRST AND SECOND POINTS IX(NP1+1) = IX(1) IY(NP1+1) = IY(1) IX(NP1+2) = IX(2) IY(NP1+2) = IY(2) NP2 = NP1 + 1 C C... NOW CHECK POLYGON AGAIN USING THE SIDES C INXT = 0 C C... COMPUTE FIRST DELTA VALUES 655 INXT = INXT + 1 IF (INXT .GT. NP1) GO TO 670 IDX1 = IX(INXT+1) - IX(INXT) IDY1 = IY(INXT+1) - IY(INXT) C C... COMPUTE NEXT DELTA VALUES IDX2 = IX(INXT+2) - IX(INXT+1) IDY2 = IY(INXT+2) - IY(INXT+1) C C... CALCULATE AND SAVE THE SIGN ITEMP = (IDX1 * IDY2) - (IDX2 * IDY1) IF (ITEMP .EQ. 0) GO TO 655 LSIGN = 0 IF (ITEMP .LT. 0) LSIGN = -1 C C... CHECK REMAINING POINTS IB = INXT + 2 DO 660 IA = IB,NP2 KSIGN = 0 IDX1 = IDX2 IDY1 = IDY2 C C... COMPUTE NEXT DELTA VALUES IDX2 = IX(IA+1) - IX(IA) IDY2 = IY(IA+1) - IY(IA) ITEMP = (IDX1 * IDY2) - (IDX2 * IDY1) IF (ITEMP .EQ. 0) GO TO 660 IF (ITEMP .LT. 0) KSIGN = -1 C C... CHECK IF SAME SIGN IF (KSIGN .NE. LSIGN) GO TO 9200 660 CONTINUE C C... DETERMINE IF STRIPPING CHECK IS NECESSARY 670 IF ( VSFLAG ) GO TO 675 C C... SET NUMBER OF POINTS NEGATIVE IF AREA IS TO BE OUTLINED IF (NPT .LT. 0) NP1 = -NP1 GO TO 690 C C... CHECK IF THE AREA NEEDS STRIPPING 675 IF ( IY(MAXPT) .GE. YNIPS ) GO TO 700 C C... THE AREA DOES NOT NEED TO BE STRIPPED. C IF THE AREA IS OUTLINED, WE MUST CHECK WHETHER THE C OUTLINE NEEDS TO BE STRIPPED. IF (NPT .GE. 0) GO TO 690 IF (IY(MAXPT)+ILWP .LT. YNIPS) NP1 = -NP1 C C... OUTPUT THE AREA 690 CALL CONVX(IX,IY,NP1,OUTLIN) GO TO 9900 C C... FIND THE STRIP WHERE THE POLYGON STARTS 700 IYOFF = 0 IXOFF = 0 725 IF ( IY(MINPT)-IYOFF .LT. YNIPS ) GO TO 750 C C... INCREMENT OFFSETS FOR NEXT STRIP IYOFF = IYOFF + YNIPS IXOFF = IXOFF + XNIPS GO TO 725 C C... CHECK WHETHER THE POLYGON CROSSES THE NEXT STRIPPING BOUNDARY 750 IF ( IY(MAXPT)-IYOFF .GE. YNIPS ) GO TO 775 C C... THE POLYGON DOES NOT CROSS A STRIPPING BOUNDARY. C USE THE OFFSETS TO TRANSLATE THE POLYGON. DO 760 J=1,NP1 IX(J) = IX(J) + IXOFF IY(J) = IY(J) - IYOFF 760 CONTINUE C C... CHECK WHETHER THE OUTLINE CROSSES THE STRIPPING BOUNDARY IF (NPT .GE. 0) GO TO 765 IF ( (IY(MINPT)-ILWM) .GE. 0 .AND. * (IY(MAXPT)+ILWP) .LT. YNIPS ) NP1 = -NP1 765 CALL CONVX(IX,IY,NP1,OUTLIN) GO TO 9900 C C... THE POLYGON CROSSES A STRIPPING BOUNDARY. 775 CONTINUE C C... INITIALIZE POINTERS TO THE CURRENT POLYGON IFIRST = MINPT ILAST = MINPT FIRST = .TRUE. GO TO 900 C C... CHECK WHETHER THE CURRENT POLYGON IS ENTIRELY WITHIN THE C CURRENT STRIP. 800 IF ( IY(MAXPT)-IYOFF .GE. YNIPS ) GO TO 900 C C... OUTPUT THE CURRENT POLYGON K = 0 C C... OUTPUT THE POINTS FROM "IFIRST" UP TO, C BUT NOT INCLUDING, "ILAST" 850 K = K + 1 IXOUT(K) = IX(IFIRST) + IXOFF IYOUT(K) = IY(IFIRST) - IYOFF IF (IFIRST .EQ. NP1) IFIRST = 0 IFIRST = IFIRST + 1 IF (IFIRST .NE. ILAST) GO TO 850 C C... OUTPUT PREVIOUS INTERSECTION POINT #2 K = K + 1 IXOUT(K) = IXSAV2 + IXOFF IYOUT(K) = 0 C IF ( K .LE. ICXPTS ) GO TO 875 C NP1 = K GO TO 9100 C 875 CALL CONVX(IXOUT,IYOUT,K,OUTLIN) GO TO 9900 C C... OUTPUT VERTICES STARTING WITH "IFIRST" UNTIL THE NEXT C STRIPPING BOUNDARY IS CROSSED 900 K = 0 925 K = K + 1 IXOUT(K) = IX(IFIRST) + IXOFF IYOUT(K) = IY(IFIRST) - IYOFF C C... CHECK IF THE NEXT POINT IS IN THE CURRENT STRIP NEXT = IFIRST + 1 IF ( IFIRST .EQ. NP1 ) NEXT = 1 IF ( (IY(NEXT) - IYOFF) .GE. YNIPS ) GO TO 950 C C... THE NEXT POINT IS IN THE CURRENT STRIP IFIRST = NEXT GO TO 925 C C... DETERMINE THE INTERSECTION POINT WITH THE C STRIPPING BOUNDARY (INTERSECTION POINT #1) 950 YORD = FLOAT(IYOFF + YNIPS) - 0.5 XORD = XINT( IX(IFIRST), IY(IFIRST), IX(NEXT), IY(NEXT), YORD ) K = K + 1 IXOUT(K) = IFIX(XORD + 0.5) + IXOFF IYOUT(K) = YNIPS - 1 C C... SAVE INTERSECTION POINT #1 IXSAV1 = XORD + 0.5 C C... BACK UP FROM ILAST UNTIL THE STRIPPING BOUNDARY IS REACHED ICURR = ILAST 1000 NEXT = ICURR - 1 IF ( NEXT .EQ. 0 ) NEXT = NP1 IF ( (IY(NEXT) - IYOFF) .GE. YNIPS ) GO TO 1025 ICURR = NEXT GO TO 1000 C C... DETERMINE THE INTERSECTION POINT WITH THE C STRIPPING BOUNDARY (INTERSECTION POINT #2) 1025 YORD = FLOAT(IYOFF + YNIPS) - 0.5 XORD = XINT( IX(ICURR), IY(ICURR), IX(NEXT), IY(NEXT), YORD ) C C... OUTPUT THE INTERSECTION POINT K = K + 1 IXOUT(K) = IFIX(XORD + 0.5) + IXOFF IYOUT(K) = YNIPS - 1 C C... OUTPUT THE POINTS FROM "ICURR" UP TO, BUT NOT INCLUDING, "ILAST" NEXT = ICURR 1050 IF ( NEXT .EQ. ILAST ) GO TO 1075 K = K + 1 IXOUT(K) = IX(NEXT) + IXOFF IYOUT(K) = IY(NEXT) - IYOFF IF ( NEXT .EQ. NP1 ) NEXT = 0 NEXT = NEXT + 1 GO TO 1050 C C... CHECK IF THIS IS THE FIRST STRIP 1075 IF (FIRST) GO TO 1100 C C... OUTPUT THE PREVIOUS INTERSECTION POINT #2 K = K + 1 IXOUT(K) = IXSAV2 + IXOFF IYOUT(K) = 0 C 1100 FIRST = .FALSE. C C... MAKE "IFIRST" THE INTERSECTION POINT #1 IX(IFIRST) = IXSAV1 IY(IFIRST) = IYOFF + YNIPS C C... SAVE INTERSECTION POINT #2 C AND SET UP ILAST FOR THE NEXT STRIP IXSAV2 = XORD + 0.5 ILAST = ICURR C C... CHECK WHETHER TOO MANY SIDES CREATED IF (K .LE. ICXPTS) GO TO 1125 C NP1 = K GO TO 9100 C C... OUTPUT THE POLYGON 1125 CALL CONVX(IXOUT,IYOUT,K,OUTLIN) C C... UPDATE OFFSETS FOR THE NEXT STRIP IXOFF = IXOFF + XNIPS IYOFF = IYOFF + YNIPS C GO TO 800 C-E C... ERROR MESSAGE - ILLEGAL NUMBER OF ELEMENTS 9100 INTARG(1)=NP1 CALL MSGLG1(8) GO TO 9999 C C... ERROR MESSAGE - POLYGON IS NOT CONVEX, CALL IGNORED 9200 RELARG(1) = XP(1) RELARG(2) = YP(1) INTARG(1) = NPT CALL MSGLG1(137) GO TO 9999 C-E C C... CHECK IF AN OUTLINE NEEDS TO BE DONE 9900 IF (OUTLIN .OR. NPT .GE. 0) GO TO 9999 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... DO THE OUTLINE CALL PLOT(X(1),Y(1),3) NP1 = IABS(NP1) DO 9925 I = 2,NP1 9925 CALL PLOT(X(I),Y(I),2) CALL PLOT(X(1),Y(1),2) C C... RESTORE THE REORIGIN AND ROTATE VALUES ROT90 = SAVROT RORG(1) = SAVORG(1) RORG(2) = SAVORG(2) C C... RESET KPAT IF NECESSARY 9999 IF (LPAT) KPAT = -1 C RETURN END