home *** CD-ROM | disk | FTP | other *** search
/ Frozen Fish 1: Amiga / FrozenFish-Apr94.iso / bbs / alib / d2xx / d267 / diglib.lha / Diglib / diglib.zoo / diglib / HATCH.FOR < prev    next >
Encoding:
Text File  |  1989-06-20  |  10.2 KB  |  277 lines
  1.         SUBROUTINE HATCH(XVERT, YVERT, NUMPTS, PHI, CMSPAC, IFLAGS,
  2.      1   XX, YY)
  3.         DIMENSION XVERT(NUMPTS), YVERT(NUMPTS), XX(NUMPTS), YY(NUMPTS)
  4. C
  5. C       ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
  6. C
  7. C       H A T C H
  8. C       by Kelly Booth and modified for DIGLIB by Hal Brand
  9. C
  10. C       PROVIDE SHADING FOR A GENERAL POLYGONAL REGION.  THERE IS ABSOLUTELY
  11. C       ASSUMPTION MADE ABOUT CONVEXITY.  A POLYGON IS SPECIFIED BY ITS VERTI
  12. C       GIVEN IN EITHER A CLOCKWISE OR COUNTER-CLOCKWISE ORDER.  THE DENSITY
  13. C       THE SHADING LINES (OR POINTS) AND THE ANGLE FOR THE SHADING LINES ARE
  14. C       BOTH DETERMINED BY THE PARAMETERS PASSED TO THE SUBROUTINE.
  15. C
  16. C       THE INPUT PARAMETERS ARE INTERPRETED AS FOLLOWS:
  17. C
  18. C        XVERT    -  AN ARRAY OF X COORDINATES FOR THE POLYGON(S) VERTICES
  19. C
  20. C        YVERT    -  AN ARRAY OF Y COORDINATES FOR THE POLYGON(S) VERTICES
  21. C
  22. C               NOTE: AN X VALUE >=1E38 SIGNALS A NEW POLYGON.   THIS ALLOWS
  23. C                       FILLING AREAS THAT HAVE HOLES WHERE THE HOLES ARE
  24. C                       DEFINED AS POLYGONS.   IT ALSO ALLOWS MULTIPLE
  25. C                       POLYGONS TO BE FILLED IN ONE CALL TO HATCH.
  26. C
  27. C        NUMPTS  -  THE NUMBER OF VERTICES IN THE POLYGON(S) INCLUDING
  28. C                       THE SEPERATOR(S) IF ANY.
  29. C
  30. C        PHI      -  THE ANGLE FOR THE SHADING, MEASURED COUNTER-CLOCKWISE
  31. C                       IN DEGREES FROM THE POSITIVE X-AXIS
  32. C
  33. C        CMSPAC   -  THE DISTANCE IN VIRTUAL COORDINATES (CM. USUALLY)
  34. C                       BETWEEN SHADING LINES.   THIS VALUE MAY BE ROUNDED
  35. C                       A BIT, SO SOME CUMMULATIVE ERROR MAY BE APPARENT.
  36. C
  37. C        IFLAGS   -  GENERAL FLAGS CONTROLLING HATCH
  38. C                       0 ==>  BOUNDARY NOT DRAWN, INPUT IS VIRTUAL COORD.
  39. C                       1 ==>  BOUNDARY DRAWN, INPUT IS VIRTUAL COORD.
  40. C                       2 ==>  BOUNDARY NOT DRAWN, INPUT IS WORLD COORD.
  41. C                       3 ==>  BOUNDARY DRAWN, INPUT IS WORLD COORD.
  42. C
  43. C        XX       -  A WORK ARRAY ATLEAST "NUMPTS" LONG.
  44. C
  45. C        YY       -  A SECOND WORK ARRAY ATLEAST "NUMPTS" LONG.
  46. C
  47. C     ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
  48. C
  49.         INCLUDE GCDCHR.PRM
  50. C
  51. C       THIS SUBROUTINE HAS TO MAINTAIN AN INTERNAL ARRAY OF THE TRANSFORMED
  52. C       COORDINATES.  THIS REQUIRES THE PASSING OF THE TWO WORKING ARRAYS
  53. C       CALLED "XX" AND "YY".
  54. C       THIS SUBROUTINE ALSO NEEDS TO STORE THE INTERSECTIONS OF THE HATCH
  55. C       LINES WITH THE POLYGON.   THIS IS DONE IN "XINTCP".
  56. C
  57.         REAL XINTCP(20)
  58.         LOGICAL LMOVE
  59.         DATA IDIMX /20/
  60. C
  61. C       X >= 'BIGNUM' SIGNALS THE END OF A POLYGON IN THE INPUT.
  62. C
  63.         DATA BIGNUM /1E38/
  64.         DATA FACT /16.0/
  65.         DATA PI180 /0.017453292/
  66. C
  67. C------------------------------------------------------------------------
  68. C
  69. C       CHECK FOR VALID NUMBER OF VERTICES.
  70. C
  71.         IF (NUMPTS .LT. 3) RETURN
  72. C
  73. C       CONVERT ALL OF THE POINTS TO INTEGER COORDINATES SO THAT THE SHADING
  74. C       LINES ARE HORIZONTAL.  THIS REQUIRES A ROTATION FOR THE GENERAL CASE.
  75. C       THE TRANSFORMATION FROM VIRTUAL TO INTERNAL COORDINATES HAS THE TWO
  76. C       OR THREE PHASES:
  77. C
  78. C       (1)  CONVERT WORLD TO VIRTUAL COORD. IF INPUT IN WORLD COORD.
  79. C
  80. C       (2)  ROTATE CLOCKWISE THROUGH THE ANGLE PHI SO SHADING IS HORIZONTAL,
  81. C
  82. C       (3)  SCALE TO INTEGERS IN THE RANGE
  83. C               [0...2*FACT*(DEVICE_MAXY_COORDINATE)], FORCING COORDINATES
  84. C               TO BE ODD INTEGERS.
  85. C
  86. C       THE COORDINATES ARE ALL ODD SO THAT LATER TESTS WILL NEVER HAVE AN
  87. C       OUTCOME OF "EQUAL" SINCE ALL SHADING LINES HAVE EVEN COORDINATES.
  88. C       THIS GREATLY SIMPLIFIES SOME OF THE LOGIC.
  89. C
  90. C       AT THE SAME TIME THE PRE-PROCESSING IS BEING DONE, THE INPUT IS CHECK
  91. C       FOR MULTIPLE POLYGONS.  IF THE X-COORDINATE OF A VERTEX IS >= 'BIGNUM
  92. C       THEN THE POINT IS NOT A VERTEX, BUT RATHER IT SIGNIFIES THE END OF A
  93. C       PARTICULAR POLYGON.  AN IMPLIED EDGE EXISTS BETWEEN THE FIRST AND LAS
  94. C       VERTICES IN EACH POLYGON.  A POLYGON MUST HAVE AT LEAST THREE VERTICE
  95. C       ILLEGAL POLYGONS ARE REMOVED FROM THE INTERNAL LISTS.
  96. C
  97. C
  98. C       COMPUTE TRIGONOMETRIC FUNCTIONS FOR THE ANGLE OF ROTATION.
  99. C
  100.         COSPHI = COS(PI180*PHI)
  101.         SINPHI = SIN(PI180*PHI)
  102. C
  103. C       FIRST CONVERT FROM WORLD TO VIRTUAL COORD. IF NECESSARY AND ELIMINATE
  104. C       ANY POLYGONS WITH TWO OR FEWER VERTICES
  105. C
  106.         ITAIL = 1
  107.         IHEAD = 0
  108.         DO 120 I = 1, NUMPTS
  109. C
  110. C               ALLOCATE ANOTHER POINT IN THE VERTEX LIST.
  111. C
  112.                 IHEAD = IHEAD + 1
  113. C
  114. C               A XVERT >= 'BIGNUM' IS A SPECIAL FLAG.
  115. C
  116.                 IF (XVERT(I) .LT. BIGNUM) GO TO 110
  117.                  XX(IHEAD) = BIGNUM
  118.                  IF ((IHEAD-ITAIL) .LT. 2) IHEAD = ITAIL - 1
  119.                  ITAIL = IHEAD + 1
  120.                  GO TO 120
  121. 110             CONTINUE
  122. C
  123. C               CONVERT FROM WORLD TO VIRTUAL COORD. IF INPUT IS WORLD COORD.
  124. C
  125.                 IF (IAND(IFLAGS,2) .EQ. 0) GO TO 115
  126.                    CALL SCALE(XVERT(I),YVERT(I),XX(IHEAD),YY(IHEAD))
  127.                    GO TO 120
  128. 115                CONTINUE
  129.                         XX(IHEAD) = XVERT(I)
  130.                         YY(IHEAD) = YVERT(I)
  131. 120             CONTINUE
  132.         IF ((IHEAD-ITAIL) .LT. 2) IHEAD = ITAIL - 1
  133.         NVERT = IHEAD
  134. C
  135. C       DRAW BOUNDARY(S) IF DESIRED
  136. C
  137.         IF (IAND(IFLAGS,1) .EQ. 0) GO TO 138
  138.         IHEAD = 0
  139.         ITAIL = 1
  140.         LMOVE = .TRUE.
  141. 130             CONTINUE
  142.                 IHEAD = IHEAD + 1
  143.                 IF (IHEAD .GT. NVERT) GO TO 133
  144.                 IF (XX(IHEAD) .NE. BIGNUM) GO TO 135
  145. 133              CONTINUE
  146.                  CALL GSDRAW(XX(ITAIL),YY(ITAIL))
  147.                  ITAIL = IHEAD + 1
  148.                  LMOVE = .TRUE.
  149.                  GO TO 139
  150. 135             CONTINUE
  151.                 IF (LMOVE) GO TO 137
  152.                  CALL GSDRAW(XX(IHEAD),YY(IHEAD))
  153.                  GO TO 139
  154. 137             CONTINUE
  155.                 CALL GSMOVE(XX(IHEAD),YY(IHEAD))
  156.                 LMOVE = .FALSE.
  157. 139             CONTINUE
  158.                 IF (IHEAD .LE. NVERT) GO TO 130
  159. 138     CONTINUE
  160. C
  161. C       ROTATE TO MAKE SHADING LINES HORIZONTAL
  162. C
  163.         YMIN = BIGNUM
  164.         YMAX = -BIGNUM
  165.         YSCALE = YRES*FACT
  166.         YSCAL2 = 2.0*YSCALE
  167.         DO 140 I = 1, NVERT
  168.                 IF (XX(I) .EQ. BIGNUM) GO TO 140
  169. C
  170. C               PERFORM THE ROTATION TO ACHIEVE HORIZONTAL SHADING LINES.
  171. C
  172.                 XV1 = XX(I)
  173.                 XX(I) = +COSPHI*XV1 + SINPHI*YY(I)
  174.                 YY(I) = -SINPHI*XV1 + COSPHI*YY(I)
  175. C
  176. C               CONVERT TO INTEGERS AFTER SCALING, AND MAKE VERTICES ODD. IN
  177. C
  178.                 YY(I) = 2.0*AINT(YSCALE*YY(I)+0.5)+1.0
  179.                 YMIN = AMIN1(YMIN,YY(I))
  180.                 YMAX = AMAX1(YMAX,YY(I))
  181. 140             CONTINUE
  182. C
  183. C       MAKE SHADING START ON A MULTIPLE OF THE STEP SIZE.
  184. C
  185.         STEP = 2.0*AINT(YRES*CMSPAC*FACT)
  186.         YMIN = AINT(YMIN/STEP) * STEP
  187.         YMAX = AINT(YMAX/STEP) * STEP
  188. C
  189. C       AFTER ALL OF THE COORDINATES FOR THE VERTICES HAVE BEEN PRE-PROCESSED
  190. C       THE APPROPRIATE SHADING LINES ARE DRAWN.  THESE ARE INTERSECTED WITH
  191. C       THE EDGES OF THE POLYGON AND THE VISIBLE PORTIONS ARE DRAWN.
  192. C
  193.         Y = YMIN
  194. 150             CONTINUE
  195.                 IF (Y .GT. YMAX) GO TO 250
  196. C
  197. C               INITIALLY THERE ARE NO KNOWN INTERSECTIONS.
  198. C
  199.                 ICOUNT = 0
  200.                 IBASE = 1
  201.                 IVERT = 1
  202. 160                     CONTINUE
  203.                         ITAIL = IVERT
  204.                         IVERT = IVERT + 1
  205.                         IHEAD = IVERT
  206.                         IF (IHEAD .GT. NVERT) GO TO 165
  207.                         IF (XX(IHEAD) .NE. BIGNUM) GO TO 170
  208. C
  209. C                         THERE IS AN EDGE FROM VERTEX N TO VERTEX 1.
  210. C
  211. 165                       IHEAD = IBASE
  212.                           IBASE = IVERT + 1
  213.                           IVERT = IVERT + 1
  214. 170                     CONTINUE
  215. C
  216. C                       SEE IF THE TWO ENDPOINTS LIE ON
  217. C                       OPPOSITE SIDES OF THE SHADING LINE.
  218. C
  219.                         YHEAD =  Y - YY(IHEAD)
  220.                         YTAIL =  Y - YY(ITAIL)
  221.                         IF (YHEAD*YTAIL .GE. 0.0) GO TO 180
  222. C
  223. C                       THEY DO.  THIS IS AN INTERSECTION.  COMPUTE X.
  224. C
  225.                         ICOUNT = ICOUNT + 1
  226.                         DELX = XX(IHEAD) - XX(ITAIL)
  227.                         DELY = YY(IHEAD) - YY(ITAIL)
  228.                         XINTCP(ICOUNT) = (DELX/DELY) * YHEAD + XX(IHEAD)
  229. 180                     CONTINUE
  230.                         IF ( IVERT .LE. NVERT ) GO TO 160
  231. C
  232. C               SORT THE X INTERCEPT VALUES.  USE A BUBBLESORT BECAUSE THERE
  233. C               AREN'T VERY MANY OF THEM (USUALLY ONLY TWO).
  234. C
  235.                 IF (ICOUNT .EQ. 0) GO TO 240
  236.                 DO 200 I = 2, ICOUNT
  237.                         XKEY = XINTCP(I)
  238.                         K = I - 1
  239.                         DO 190 J = 1, K
  240.                            IF (XINTCP(J) .LE. XKEY) GO TO 190
  241.                            XTEMP = XKEY
  242.                            XKEY = XINTCP(J)
  243.                            XINTCP(J) = XTEMP
  244. 190                        CONTINUE
  245.                         XINTCP(I) = XKEY
  246. 200                     CONTINUE
  247. C
  248. C               ALL OF THE X COORDINATES FOR THE SHADING SEGMENTS ALONG THE
  249. C               CURRENT SHADING LINE ARE NOW KNOWN AND ARE IN SORTED ORDER.
  250. C               ALL THAT REMAINS IS TO DRAW THEM.  PROCESS THE X COORDINATES
  251. C               TWO AT A TIME.
  252. C
  253.                 YR = Y/YSCAL2
  254.                 DO 230 I = 1, ICOUNT, 2
  255. C
  256. C                       CONVERT BACK TO VIRTUAL COORDINATES.
  257. C                       ROTATE THROUGH AN ANGLE OF -PHI TO ORIGINAL ORIENTATI
  258. C                       THEN UNSCALE FROM GRID TO VIRTUAL COORD.
  259. C
  260.                         XV1 = + COSPHI*XINTCP(I) - SINPHI*YR
  261.                         YV1 = + SINPHI*XINTCP(I) + COSPHI*YR
  262.                         XV2 = + COSPHI*XINTCP(I+1) - SINPHI*YR
  263.                         YV2 = + SINPHI*XINTCP(I+1) + COSPHI*YR
  264. C                       TYPE *,'LINE: (',XV1,YV1,') TO (',XV2,YV2,')'
  265. C
  266. C                       DRAW THE SEGMENT OF THE SHADING LINE.
  267. C
  268.                         CALL GSMOVE(XV1,YV1)
  269.                         CALL GSDRAW(XV2,YV2)
  270. 230                     CONTINUE
  271. 240             CONTINUE
  272.                 Y = Y + STEP
  273.                 GO TO 150
  274. 250     CONTINUE
  275.         RETURN
  276.         END
  277.