SUBROUTINE HATCH(XVERT, YVERT, NUMPTS, PHI, CMSPAC, IFLAGS, 1 XX, YY) IMPLICIT NONE REAL*4 XVERT(NUMPTS), YVERT(NUMPTS), XX(NUMPTS), YY(NUMPTS) REAL*4 CMSPAC,PHI INTEGER NUMPTS,IFLAGS C C ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ C C H A T C H C by Kelly Booth and modified for DIGLIB by Hal Brand C C PROVIDE SHADING FOR A GENERAL POLYGONAL REGION. THERE IS ABSOLUTELY C ASSUMPTION MADE ABOUT CONVEXITY. A POLYGON IS SPECIFIED BY ITS VERTI C GIVEN IN EITHER A CLOCKWISE OR COUNTER-CLOCKWISE ORDER. THE DENSITY C THE SHADING LINES (OR POINTS) AND THE ANGLE FOR THE SHADING LINES ARE C BOTH DETERMINED BY THE PARAMETERS PASSED TO THE SUBROUTINE. C C THE INPUT PARAMETERS ARE INTERPRETED AS FOLLOWS: C C XVERT - AN ARRAY OF X COORDINATES FOR THE POLYGON(S) VERTICES C C YVERT - AN ARRAY OF Y COORDINATES FOR THE POLYGON(S) VERTICES C C NOTE: AN X VALUE >=1E38 SIGNALS A NEW POLYGON. THIS ALLOWS C FILLING AREAS THAT HAVE HOLES WHERE THE HOLES ARE C DEFINED AS POLYGONS. IT ALSO ALLOWS MULTIPLE C POLYGONS TO BE FILLED IN ONE CALL TO HATCH. C C NUMPTS - THE NUMBER OF VERTICES IN THE POLYGON(S) INCLUDING C THE SEPERATOR(S) IF ANY. C C PHI - THE ANGLE FOR THE SHADING, MEASURED COUNTER-CLOCKWISE C IN DEGREES FROM THE POSITIVE X-AXIS C C CMSPAC - THE DISTANCE IN VIRTUAL COORDINATES (CM. USUALLY) C BETWEEN SHADING LINES. THIS VALUE MAY BE ROUNDED C A BIT, SO SOME CUMMULATIVE ERROR MAY BE APPARENT. C C IFLAGS - GENERAL FLAGS CONTROLLING HATCH C 0 ==> BOUNDARY NOT DRAWN, INPUT IS VIRTUAL COORD. C 1 ==> BOUNDARY DRAWN, INPUT IS VIRTUAL COORD. C 2 ==> BOUNDARY NOT DRAWN, INPUT IS WORLD COORD. C 3 ==> BOUNDARY DRAWN, INPUT IS WORLD COORD. C C XX - A WORK ARRAY ATLEAST "NUMPTS" LONG. C C YY - A SECOND WORK ARRAY ATLEAST "NUMPTS" LONG. C C ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ C INCLUDE DIGLIB$KOM:GCDCHR.PRM C C THIS SUBROUTINE HAS TO MAINTAIN AN INTERNAL ARRAY OF THE TRANSFORMED C COORDINATES. THIS REQUIRES THE PASSING OF THE TWO WORKING ARRAYS C CALLED "XX" AND "YY". C THIS SUBROUTINE ALSO NEEDS TO STORE THE INTERSECTIONS OF THE HATCH C LINES WITH THE POLYGON. THIS IS DONE IN "XINTCP". C REAL*4 XINTCP(20),BIGNUM,FACT,PI180,COSPHI,SINPHI,YMIN,YMAX REAL*4 YSCALE,YSCAL2,XV1,STEP,Y,YHEAD,YTAIL,DELX,DELY,XKEY REAL*4 XTEMP,YR,YV1,XV2,YV2 LOGICAL LMOVE INTEGER IDIMX,ITAIL,IHEAD,I,NVERT,ICOUNT,IBASE,IVERT INTEGER*1 IAND INTEGER J,K DATA IDIMX /20/ C C X >= 'BIGNUM' SIGNALS THE END OF A POLYGON IN THE INPUT. C DATA BIGNUM /1E38/ DATA FACT /16.0/ DATA PI180 /0.017453292/ C C------------------------------------------------------------------------ C C CHECK FOR VALID NUMBER OF VERTICES. C IF (NUMPTS .LT. 3) RETURN C C CONVERT ALL OF THE POINTS TO INTEGER COORDINATES SO THAT THE SHADING C LINES ARE HORIZONTAL. THIS REQUIRES A ROTATION FOR THE GENERAL CASE. C THE TRANSFORMATION FROM VIRTUAL TO INTERNAL COORDINATES HAS THE TWO C OR THREE PHASES: C C (1) CONVERT WORLD TO VIRTUAL COORD. IF INPUT IN WORLD COORD. C C (2) ROTATE CLOCKWISE THROUGH THE ANGLE PHI SO SHADING IS HORIZONTAL, C C (3) SCALE TO INTEGERS IN THE RANGE C [0...2*FACT*(DEVICE_MAXY_COORDINATE)], FORCING COORDINATES C TO BE ODD INTEGERS. C C THE COORDINATES ARE ALL ODD SO THAT LATER TESTS WILL NEVER HAVE AN C OUTCOME OF "EQUAL" SINCE ALL SHADING LINES HAVE EVEN COORDINATES. C THIS GREATLY SIMPLIFIES SOME OF THE LOGIC. C C AT THE SAME TIME THE PRE-PROCESSING IS BEING DONE, THE INPUT IS CHECK C FOR MULTIPLE POLYGONS. IF THE X-COORDINATE OF A VERTEX IS >= 'BIGNUM C THEN THE POINT IS NOT A VERTEX, BUT RATHER IT SIGNIFIES THE END OF A C PARTICULAR POLYGON. AN IMPLIED EDGE EXISTS BETWEEN THE FIRST AND LAS C VERTICES IN EACH POLYGON. A POLYGON MUST HAVE AT LEAST THREE VERTICE C ILLEGAL POLYGONS ARE REMOVED FROM THE INTERNAL LISTS. C C C COMPUTE TRIGONOMETRIC FUNCTIONS FOR THE ANGLE OF ROTATION. C COSPHI = COS(PI180*PHI) SINPHI = SIN(PI180*PHI) C C FIRST CONVERT FROM WORLD TO VIRTUAL COORD. IF NECESSARY AND ELIMINATE C ANY POLYGONS WITH TWO OR FEWER VERTICES C ITAIL = 1 IHEAD = 0 DO 120 I = 1, NUMPTS C C ALLOCATE ANOTHER POINT IN THE VERTEX LIST. C IHEAD = IHEAD + 1 C C A XVERT >= 'BIGNUM' IS A SPECIAL FLAG. C IF (XVERT(I) .LT. BIGNUM) GO TO 110 XX(IHEAD) = BIGNUM IF ((IHEAD-ITAIL) .LT. 2) IHEAD = ITAIL - 1 ITAIL = IHEAD + 1 GO TO 120 110 CONTINUE C C CONVERT FROM WORLD TO VIRTUAL COORD. IF INPUT IS WORLD COORD. C IF (IAND(IFLAGS,2) .EQ. 0) GO TO 115 CALL SCALE(XVERT(I),YVERT(I),XX(IHEAD),YY(IHEAD)) GO TO 120 115 CONTINUE XX(IHEAD) = XVERT(I) YY(IHEAD) = YVERT(I) 120 CONTINUE IF ((IHEAD-ITAIL) .LT. 2) IHEAD = ITAIL - 1 NVERT = IHEAD C C DRAW BOUNDARY(S) IF DESIRED C IF (IAND(IFLAGS,1) .EQ. 0) GO TO 138 IHEAD = 0 ITAIL = 1 LMOVE = .TRUE. 130 CONTINUE IHEAD = IHEAD + 1 IF (IHEAD .GT. NVERT) GO TO 133 IF (XX(IHEAD) .NE. BIGNUM) GO TO 135 133 CONTINUE CALL GSDRAW(XX(ITAIL),YY(ITAIL)) ITAIL = IHEAD + 1 LMOVE = .TRUE. GO TO 139 135 CONTINUE IF (LMOVE) GO TO 137 CALL GSDRAW(XX(IHEAD),YY(IHEAD)) GO TO 139 137 CONTINUE CALL GSMOVE(XX(IHEAD),YY(IHEAD)) LMOVE = .FALSE. 139 CONTINUE IF (IHEAD .LE. NVERT) GO TO 130 138 CONTINUE C C ROTATE TO MAKE SHADING LINES HORIZONTAL C YMIN = BIGNUM YMAX = -BIGNUM YSCALE = YRES*FACT YSCAL2 = 2.0*YSCALE DO 140 I = 1, NVERT IF (XX(I) .EQ. BIGNUM) GO TO 140 C C PERFORM THE ROTATION TO ACHIEVE HORIZONTAL SHADING LINES. C XV1 = XX(I) XX(I) = +COSPHI*XV1 + SINPHI*YY(I) YY(I) = -SINPHI*XV1 + COSPHI*YY(I) C C CONVERT TO INTEGERS AFTER SCALING, AND MAKE VERTICES ODD. IN C YY(I) = 2.0*AINT(YSCALE*YY(I)+0.5)+1.0 YMIN = AMIN1(YMIN,YY(I)) YMAX = AMAX1(YMAX,YY(I)) 140 CONTINUE C C MAKE SHADING START ON A MULTIPLE OF THE STEP SIZE. C STEP = 2.0*AINT(YRES*CMSPAC*FACT) YMIN = AINT(YMIN/STEP) * STEP YMAX = AINT(YMAX/STEP) * STEP C C AFTER ALL OF THE COORDINATES FOR THE VERTICES HAVE BEEN PRE-PROCESSED C THE APPROPRIATE SHADING LINES ARE DRAWN. THESE ARE INTERSECTED WITH C THE EDGES OF THE POLYGON AND THE VISIBLE PORTIONS ARE DRAWN. C Y = YMIN 150 CONTINUE IF (Y .GT. YMAX) GO TO 250 C C INITIALLY THERE ARE NO KNOWN INTERSECTIONS. C ICOUNT = 0 IBASE = 1 IVERT = 1 160 CONTINUE ITAIL = IVERT IVERT = IVERT + 1 IHEAD = IVERT IF (IHEAD .GT. NVERT) GO TO 165 IF (XX(IHEAD) .NE. BIGNUM) GO TO 170 C C THERE IS AN EDGE FROM VERTEX N TO VERTEX 1. C 165 IHEAD = IBASE IBASE = IVERT + 1 IVERT = IVERT + 1 170 CONTINUE C C SEE IF THE TWO ENDPOINTS LIE ON C OPPOSITE SIDES OF THE SHADING LINE. C YHEAD = Y - YY(IHEAD) YTAIL = Y - YY(ITAIL) IF (YHEAD*YTAIL .GE. 0.0) GO TO 180 C C THEY DO. THIS IS AN INTERSECTION. COMPUTE X. C ICOUNT = ICOUNT + 1 DELX = XX(IHEAD) - XX(ITAIL) DELY = YY(IHEAD) - YY(ITAIL) XINTCP(ICOUNT) = (DELX/DELY) * YHEAD + XX(IHEAD) 180 CONTINUE IF ( IVERT .LE. NVERT ) GO TO 160 C C SORT THE X INTERCEPT VALUES. USE A BUBBLESORT BECAUSE THERE C AREN'T VERY MANY OF THEM (USUALLY ONLY TWO). C IF (ICOUNT .EQ. 0) GO TO 240 DO 200 I = 2, ICOUNT XKEY = XINTCP(I) K = I - 1 DO 190 J = 1, K IF (XINTCP(J) .LE. XKEY) GO TO 190 XTEMP = XKEY XKEY = XINTCP(J) XINTCP(J) = XTEMP 190 CONTINUE XINTCP(I) = XKEY 200 CONTINUE C C ALL OF THE X COORDINATES FOR THE SHADING SEGMENTS ALONG THE C CURRENT SHADING LINE ARE NOW KNOWN AND ARE IN SORTED ORDER. C ALL THAT REMAINS IS TO DRAW THEM. PROCESS THE X COORDINATES C TWO AT A TIME. C YR = Y/YSCAL2 DO 230 I = 1, ICOUNT, 2 C C CONVERT BACK TO VIRTUAL COORDINATES. C ROTATE THROUGH AN ANGLE OF -PHI TO ORIGINAL ORIENTATI C THEN UNSCALE FROM GRID TO VIRTUAL COORD. C XV1 = + COSPHI*XINTCP(I) - SINPHI*YR YV1 = + SINPHI*XINTCP(I) + COSPHI*YR XV2 = + COSPHI*XINTCP(I+1) - SINPHI*YR YV2 = + SINPHI*XINTCP(I+1) + COSPHI*YR C TYPE *,'LINE: (',XV1,YV1,') TO (',XV2,YV2,')' C C DRAW THE SEGMENT OF THE SHADING LINE. C CALL GSMOVE(XV1,YV1) CALL GSDRAW(XV2,YV2) 230 CONTINUE 240 CONTINUE Y = Y + STEP GO TO 150 250 CONTINUE RETURN END