Frozen Fish 1: Amiga/FrozenFish-Apr94.iso/bbs/alib/d4xx/d499/diglib.lha/Diglib/diglib.lzh/source/gsfill.for

Text File | 1991-05-01 | 5.7 KB | 195 lines

        SUBROUTINE GSFILL(X,Y,N,TX,TY)
        IMPLICIT NONE
        REAL*4 X(N),Y(N), TX(N),TY(N)
C
C       DIGLIB POLYGON FILL SUPPORT
C       DERIVED FROM "HATCH" ALGORITHM BY KELLY BOOTH
C
        INCLUDE DIGLIB$KOM:GCDCHR.PRM
        INCLUDE DIGLIB$KOM:GCDPRM.PRM
        INCLUDE DIGLIB$KOM:GCLTYP.PRM
C
        REAL*4 XINS(40),FACT,YMAP,XMIN,YMIN,XMAX,YMAX,DX1,DY1,DY
        REAL*4 COSTH,DX2,DY2,A,YSCALE,DLINES,YSCAN,YBEGIN
        REAL*4 XBEGIN,YEND,XKEY,TEMP,YY
        COMMON /MAPCOM/ YSCALE

        INTEGER GSIVIS,I,J,NCHNGS,L,LINOLD,INISEC,IFIRST
        LOGICAL LEFT
    INTEGER*1 IAND
        DATA FACT /16.0/
C
C
        IF (N .LT. 3) RETURN
C
C
C       CONVERT TO ABSOLUTE COORD.
C
        DO 10 I=1,N
                CALL GSRST(X(I),Y(I),TX(I),TY(I))
10              CONTINUE
        CALL MINMAX(TY,N,YMIN,YMAX)
        CALL MINMAX(TX,N,XMIN,XMAX)
C
C       IF CLIPPING NEEDED OR IF NO HARDWARE POLYGON FILL, USE SOFTWARE
C
        IF ((GSIVIS(XMIN,YMIN) .NE. 0) .OR.
     1   (GSIVIS(XMAX,YMAX) .NE. 0) .OR.
     2   (IAND(IDVBTS,256) .EQ. 0)) GO TO 200
C
C       IF CAN HANDLE CONCAVE POLYGONS, JUST CALL DRIVER
C
        IF ((IAND(IDVBTS,512) .EQ. 0) .OR.
     1   (N .EQ. 3)) GO TO 150
C
C       IF HERE, DRIVER CAN HANDLE CONVEX NON-INTERSECTING POLYGONS ONLY,
C        SO MAKE SURE THIS POLYGON IS CONVEX AND NON-SELF-INTERSECTING.
C
        DX1 = X(1)-X(N)
        DY1 = Y(1)-Y(N)
C       !OLD NON-ZERO DELTA-Y
        DY = DY1
C       NUMBER OF TIMES DELTA-Y CHANGES SIGN
        NCHNGS = 0
        L = 1
        COSTH = 0.0
110     CONTINUE
C
C               CONVEXITY TEST
C
                DX2 = X(L+1)-X(L)
                DY2 = Y(L+1)-Y(L)
                A = DX1*DY2-DX2*DY1
                IF (A*COSTH .LT. 0.0) GO TO 200
                IF (COSTH .EQ. 0.0) COSTH = A
C
C               SELF INTERSECTION CHECK - RELYS ON "CONVEXITY" CHECK
C
                IF (DY .NE. 0.0) GO TO 120
                        DY = DY2
                        GO TO 130
120             CONTINUE
                IF (DY2*DY .GE. 0.0) GO TO 130
                        DY = DY2
                        NCHNGS = NCHNGS + 1
                        IF (NCHNGS .GE. 3) GO TO 200
130             CONTINUE
                DX1 = DX2
                DY1 = DY2
                L = L + 1
                IF (L .LT. N) GO TO 110
150     CONTINUE
        CALL GSDRVR(1024+N,TX,TY)
        RETURN
C
C       **********
C       SOFTWARE FILL
C       **********
C
200     CONTINUE
C
C       FILLING A POLYGON IS VERY SIMPLE IF AND ONLY IF THE VERTICES OF
C        THE POLYGON NEVER LIE ON A SCAN LINE.   WE CAN FORCE THIS TO HAPPEN
C        BY THE FOLLOWING TRICK: MAKE ALL VERTICES LIE JUST BARELY ABOVE
C        THE SCAN LINE THEY SHOULD LIE ON.   THIS IS DONE BY MAPPING THE
C        VERTICES TO A GRID THAT IS "FACT" TIMES THE DEVICE RESOLUTION,
C        AND THEN DOUBLING THE GRID DENSITY, AND OFFSETTING THE VERTICES
C        BY 1.   BECAUSE WE DO THIS, WE MUST OUTLINE THE POLYGON.
C
C       *******
C
C       FILL WITH SOLID LINES
C
        LINOLD = ILNTYP
        ILNTYP = 1
C
        LEFT = .TRUE.
        YSCALE = YS*YRES*FACT
        DLINES = 2.0*FACT
        CALL MINMAX(Y,N,YMIN,YMAX)
        YMIN = AINT(YMAP(YMIN)/DLINES)*DLINES+DLINES
        YMAX = AINT(YMAP(YMAX)/DLINES)*DLINES
        YSCAN = YMIN
210     CONTINUE
                INISEC = 0
                IFIRST = 0
C
C               DO EACH SIDE OF THE POLYGON. PUT ANY X INTERSECTIONS
C               WITH THE SCAN LINE Y=YSCAN IN XINS
C
                YBEGIN = YMAP(Y(N))
                XBEGIN = X(N)
                DO 400 L = 1, N
                  YEND = YMAP(Y(L))
                  DY = YSCAN-YBEGIN
                  IF (DY*(YSCAN-YEND) .GT. 0.0) GO TO 390
C
C                 INSERT AN INTERSECTION
C
                  INISEC = INISEC + 1
                  XINS(INISEC) = DY*(X(L)-XBEGIN)/(YEND-YBEGIN)+XBEGIN
C
390               CONTINUE
                  YBEGIN = YEND
                  XBEGIN = X(L)
400               CONTINUE
C
C               FILL IF THERE WERE ANY INTERSECTIONS
C
                IF (INISEC .EQ. 0) GOTO 500
C
C               FIRST WE MUST SORT ON X INTERSECTION.
C               USE BUBBLE SORT BECAUSE USUALLY ONLY 2.
C               WHEN "LEFT" IS TRUE, ASCENDING SORT, FALSE IS DESCENDING SORT
C
                DO 450 I =  1, INISEC-1
                        XKEY = XINS(I)
                        DO 430 J = I+1, INISEC
                                IF (.NOT. LEFT) GOTO 420
                                IF (XKEY .GE. XINS(J)) GO TO 430
410                             CONTINUE
                                TEMP = XKEY
                                XKEY = XINS(J)
                                XINS(J) = TEMP
                                GO TO 430
420                             IF (XKEY .GT. XINS(J)) GOTO 410
430                             CONTINUE
                        XINS(I) = XKEY
450                     CONTINUE
C
C               DRAW FILL LINES NOW
C
                YY = YSCAN/(2.0*YSCALE)
                DO 460 I = 1, INISEC, 2
                        CALL GSMOVE(XINS(I),YY)
                        CALL GSDRAW(XINS(I+1),YY)
460                     CONTINUE
500             CONTINUE
        YSCAN = YSCAN + DLINES
        LEFT = .NOT. LEFT
        IF (YSCAN .LE. YMAX) GO TO 210
C
C       FINALLY, OUTLINE THE POLYGON
C
        CALL GSMOVE(X(N),Y(N))
        DO 510 L=1,N
                CALL GSDRAW(X(L),Y(L))
510             CONTINUE
C
C       RESTORE LINE TYPE
C
        ILNTYP = LINOLD
        RETURN
        END

C       DEFINE ARITHMETIC STATEMENT FUNCTION TO MAPPING VERTICES

        REAL FUNCTION YMAP(YYY)
        IMPLICIT NONE
        REAL*4 YSCALE
        COMMON /MAPCOM/ YSCALE
        REAL*4 YYY
        YMAP = 2.0*AINT(YSCALE*YYY+0.5)+1.0
        RETURN
        END