*
* $Id$
*
* $Log$
* Revision 1.1  1996/02/14 13:10:52  mclareni
* Initial revision
*
*
#include "higz/pilot.h"
*CMZ :  1.18/05 26/05/93  17.59.17  by  O.Couet
*-- Author :
      SUBROUTINE IHRFIL(NN,XY)
************************************************************************
*                                                                      *
*     IHRFIL                                     Date:    14.05.93     *
*     Author: E. Chernyaev (IHEP/Protvino)       Revised:              *
*                                                                      *
*     Function: Fill a polygon including border ("RASTER SCREEN")      *
*                                                                      *
*     Input: NN      - number of polygon nodes                         *
*            XY(2,*) - polygon nodes                                   *
*                                                                      *
************************************************************************
#include "higz/hcrast.inc"
      PARAMETER         (LMAX=12)
      REAL              XY(2,*)
      INTEGER           YMIN,YMAX,X,Y,XX,YY,DX,DY,SIGNDX,T,STEP,YSCAN
      INTEGER           XX1,XX2
      INTEGER           X1(LMAX+2),Y1(LMAX+2),X2(LMAX),Y2(LMAX)
      INTEGER           XCUR(LMAX),XNEX(LMAX),TEST(LMAX),XSCAN(2,LMAX)
*-
**          T R A N S F E R   T O   S C R E E N   C O O R D I N A T E S
*
      IF (IFRAST .NE. 1)                GOTO 999
      N      = NN
      DO 100 I=1,N
        X1(I)  = NXRAST * ((XY(1,I)-XRAST)/DXRAST) - 0.01
        Y1(I)  = NYRAST * ((XY(2,I)-YRAST)/DYRAST) - 0.01
  100   CONTINUE
      X1(N+1) = X1(1)
      Y1(N+1) = Y1(1)
*
**          F I N D   Y - M I N   A N D   Y - M A X
**          S E T   R I G H T   E D G E   O R I E N T A T I O N
*
      YMIN   = Y1(1)
      YMAX   = Y1(1)
      DO 200 I=1,N
        IF (YMIN  .GT. Y1(I))           YMIN  = Y1(I)
        IF (YMAX  .LT. Y1(I))           YMAX  = Y1(I)
        IF (Y1(I) .LE. Y1(I+1)) THEN
          X2(I)  = X1(I+1)
          Y2(I)  = Y1(I+1)
        ELSE
          X2(I)  = X1(I)
          Y2(I)  = Y1(I)
          X1(I)  = X1(I+1)
          Y1(I)  = Y1(I+1)
        END IF
  200   CONTINUE
      IF (YMIN .GE. NYRAST)             GOTO 999
      IF (YMAX .LT. 0)                  GOTO 999
      IF (YMAX .GE. NYRAST)             YMAX = NYRAST - 1
*
**          S O R T   L I N E S
*
      DO 250 I=1,N-1
        IF (Y1(I+1) .GE. Y1(I))         GOTO 250
        Y      = Y1(I+1)
        K      = 1
        DO 210 J=I-1,1,-1
          IF (Y .LT. Y1(J))             GOTO 210
          K      = J + 1
          GOTO 220
  210     CONTINUE
  220   X      = X1(I+1)
        XX     = X2(I+1)
        YY     = Y2(I+1)
        DO 230 J=I,K,-1
          X1(J+1) = X1(J)
          Y1(J+1) = Y1(J)
          X2(J+1) = X2(J)
          Y2(J+1) = Y2(J)
  230     CONTINUE
        X1(K) = X
        Y1(K) = Y
        X2(K) = XX
        Y2(K) = YY
  250   CONTINUE
*
**          S E T   I N I T I A L   V A L U E S
*
      DO 300 I=1,N
        XCUR(I) = X1(I)
        DY      = Y2(I) - Y1(I)
        DX      = X2(I) - X1(I)
        SIGNDX  = 1
        IF (DX .LT. 0)                  SIGNDX =-1
        IF (DX .LT. 0)                  DX =-DX
        IF (DX .LE. DY) THEN
          T       =-(DY+1)/2 + DX
          IF (T .LT. 0) THEN
            TEST(I) = T
            XNEX(I) = XCUR(I)
          ELSE
            TEST(I) = T - DY
            XNEX(I) = XCUR(I) + SIGNDX
          END IF
        ELSE IF (DY .NE. 0) THEN
          STEP    = (DX-1)/(DY+DY) + 1
          TEST(I) = STEP*DY - (DX+1)/2 - DX
          XNEX(I) = XCUR(I) + SIGNDX*STEP
        END IF
  300   CONTINUE
*
**          L O O P   O N   S C A N   L I N E S
*
      NSTART   = 1
      DO 700 YSCAN=YMIN,YMAX
        NX     = 0
        NXA    = 0
        NXB    = LMAX + 1
        DO 440 I=NSTART,N
          IF (Y1(I) .GT. YSCAN)         GOTO 500
          IF (Y2(I) .GT. YSCAN)         GOTO 410
          IF (I .EQ. NSTART)            NSTART = NSTART + 1
          IF (Y2(I) .NE. YSCAN)         GOTO 440
          NXB     = NXB - 1
          IF (X2(I) .GE. XCUR(I)) THEN
           XSCAN(1,NXB) = XCUR(I)
           XSCAN(2,NXB) = X2(I)
          ELSE
           XSCAN(1,NXB) = X2(I)
           XSCAN(2,NXB) = XCUR(I)
          END IF
          GOTO 440
*
**          S T O R E   C U R R E N T  X
**          P R E P A R E   X   F O R   N E X T   S C A N - L I N E
*
  410     NXA    = NXA + 1
          DY     = Y2(I) - Y1(I)
          DX     = X2(I) - X1(I)
          IF (DX .GE. 0) THEN
            SIGNDX = 1
            XSCAN(1,NXA) = XCUR(I)
            XSCAN(2,NXA) = XNEX(I)
            IF(XSCAN(1,NXA).NE.XSCAN(2,NXA)) XSCAN(2,NXA)=XSCAN(2,NXA)-1
          ELSE
            DX     =-DX
            SIGNDX =-1
            XSCAN(1,NXA) = XNEX(I)
            XSCAN(2,NXA) = XCUR(I)
            IF(XSCAN(1,NXA).NE.XSCAN(2,NXA)) XSCAN(1,NXA)=XSCAN(1,NXA)+1
          END IF
          XCUR(I) = XNEX(I)
          IF (DX .GT. DY)               GOTO 430
          TEST(I) = TEST(I) + DX
          IF (TEST(I) .LT. 0)           GOTO 440
          TEST(I) = TEST(I) - DY
          XNEX(I) = XNEX(I) + SIGNDX
          GOTO 440
  430     STEP   = DX/DY
          T      = TEST(I) + STEP*DY
          IF (T .GE. 0) THEN
            TEST(I) = T - DX
            XNEX(I) = XNEX(I) + SIGNDX*STEP
          ELSE
            TEST(I) = T + DY - DX
            XNEX(I) = XNEX(I) + SIGNDX*(STEP+1)
          END IF
  440     CONTINUE
*
**          S O R T   P O I N T S   A L O N G   X
*
  500   IF (YSCAN .LT. 0)                       GOTO 700
        IBASE  = YSCAN*NXRAST
        IF (NXA .LT. 2)                         GOTO 540
        DO 520 I=1,NXA-1
          DO 510 J=I,1,-1
            IF (XSCAN(1,J+1) .GE. XSCAN(1,J))   GOTO 520
            X            = XSCAN(1,J+1)
            XSCAN(1,J+1) = XSCAN(1,J)
            XSCAN(1,J)   = X
            X            = XSCAN(2,J+1)
            XSCAN(2,J+1) = XSCAN(2,J)
            XSCAN(2,J)   = X
  510       CONTINUE
  520     CONTINUE
        DO 530 I=1,NXA,2
          NX     = NX  + 1
          XSCAN(1,NX) = XSCAN(1,I)
          X           = XSCAN(2,I+1)
          IF (XSCAN(2,I) .GT. X)                X = XSCAN(2,I)
          XSCAN(2,NX) = X
  530     CONTINUE
*
  540   IF (NXB .GT. LMAX)                      GOTO 600
        DO 550 I=NXB,LMAX,1
          NX     = NX  + 1
          XSCAN(1,NX) = XSCAN(1,I)
          XSCAN(2,NX) = XSCAN(2,I)
  550     CONTINUE
*
**          C O N C A N T I N A T E   A N D   F I L L
*
  600   IF (NX .EQ. 0)                          GOTO 700
        XX1    = XSCAN(1,NX)
        XX2    = XSCAN(2,NX)
        NX     = NX - 1
        K      = 1
  610   IF (K .GT. NX)                          GOTO 630
        IF (XSCAN(1,K) .GT. XX2+1)              GOTO 620
        IF (XSCAN(2,K) .LT. XX1-1)              GOTO 620
        IF (XSCAN(1,K) .LT. XX1)                XX1 = XSCAN(1,K)
        IF (XSCAN(2,K) .GT. XX2)                XX2 = XSCAN(2,K)
        XSCAN(1,K) = XSCAN(1,NX)
        XSCAN(2,K) = XSCAN(2,NX)
        NX     = NX - 1
        GOTO 610
  620   K      = K + 1
        GOTO 610
  630   IF (XX1 .LT. 0)                         XX1 = 0
        IF (XX2 .GE. NXRAST)                    XX2 = NXRAST - 1
        NBIT   = XX2 - XX1 + 1
        KBIT   = IBASE + XX1
        IW     = KBIT / NBW
        IB     = KBIT - IW*NBW + 1
        IW     = IW + JRAST + 1
        NB     = NBW - IB + 1
        IF (NB .GT. NBIT)                       NB = NBIT
        IRAST(IW) = IOR(IRAST(IW),MASK(JMASK(NB)+IB))
        NBIT   = NBIT - NB
        IF (NBIT .EQ. 0)                        GOTO 600
        DO 640 WHILE (NBIT .GT. NBW)
          IW        = IW + 1
          IRAST(IW) = MASK(LMASK)
          NBIT      = NBIT - NBW
  640   CONTINUE
        IW        = IW + 1
        IRAST(IW) = IOR(IRAST(IW),MASK(JMASK(NBIT)+1))
        GOTO 600
  700   CONTINUE
*
  999 RETURN
      END
