*-----------------------------------------------------------------------
*     TONE ROUTINE ON VC (CLIPPING)
*-----------------------------------------------------------------------
*     Copyright (C) 2000-2022 GFD Dennou Club. All rights reserved.
*-----------------------------------------------------------------------
      SUBROUTINE SZOPTV

      PARAMETER (NMAX=16384, NLMAX=100, EPSIL = 1.E-5, EP2 = 1.E-3)

      INTEGER   NBGN(NLMAX), NLEN(NLMAX), NSTAT(NLMAX)
      REAL      VXX (NMAX),  VYY (NMAX),  POS  (NLMAX)
      REAL      XB(2), YB(2), BDX(4), BDY(4)
      LOGICAL   LFIRST, LVALID, LMOVE, LCONT, LREQA

      COMMON    /SZBTN2/ IRMODE, IRMODR
      COMMON    /SZBTN3/ LCLIP
      LOGICAL   LCLIP

      EXTERNAL  IMOD

      SAVE

      POSBD(X,Y) =
     +     (-1)**(NINT(((XB(2)-X)/XWIDTH+(YB(2)-Y)/YWIDTH)/2) + IRMODE)
     +     *((XB(2)-X)/XWIDTH + (Y-YB(1))/YWIDTH) + 2

*     POSBD RAGES FROM 0 TO 4. (AT UPPER LEFT CORNER)
*     ANTI-CLOCK WISE (IMODE=0), CLOCK WISE (IMODE=1)


      CALL SZQCLL(XB(1), XB(2), YB(1), YB(2), 1)
      XWIDTH = XB(2) - XB(1)
      YWIDTH = YB(2) - YB(1)

      DO 5 I=1, 4
        BDX(I) = XB(MOD((I+3+IRMODE)/2, 2) + 1)
        BDY(I) = YB(MOD((I+2-IRMODE)/2, 2) + 1)
    5 CONTINUE

      NN = 0
      NLINE = 0
      LFIRST = .TRUE.

      RETURN
*-----------------------------------------------------------------------
      ENTRY SZSTTV(VX, VY)

      IF (LCLIP) THEN

        IF (LFIRST) THEN
          VX0 = VX
          VY0 = VY
          LFIRST = .FALSE.
        ELSE
          IF (LREQA(VX0, VX, EPSIL).AND.LREQA(VY0, VY, EPSIL)) RETURN
        END IF

        CALL SZPCLL(VX0, VY0, VX, VY, LVALID, 1)

        IF (LVALID) THEN
   10     CONTINUE
            NN = NN+1
            IF (NN.GT.NMAX) CALL MSGDMP('E', 'SZSTTV',
     +         'WORKING AREA OVER FLOW (TOO MANY POINTS)')
            CALL SZGCLL(VXX(NN), VYY(NN), LCONT, LMOVE, 1)
            IF (LMOVE) THEN
              NLINE = NLINE +1
              IF (NLINE.GT.NLMAX) CALL MSGDMP('E', 'SZSTTV',
     +           'WORKING AREA OVER FLOW (TOO MANY LINES)')
              NBGN(NLINE) = NN
            END IF
          IF (LCONT) GO TO 10
        END IF
        VX0 = VX
        VY0 = VY

      ELSE

        LFIRST = .FALSE.
        NN = NN + 1
        IF (NN.GT.NMAX) CALL MSGDMP('E', 'SZSTTV',
     +     'WORKING AREA OVER FLOW (TOO MANY POINTS)')
        VXX(NN) = VX
        VYY(NN) = VY

      END IF

      RETURN
*-----------------------------------------------------------------------
      ENTRY SZCLTV

      IF (LFIRST) RETURN

      IF (NLINE.EQ.0) THEN

        IF (NN.GE.3) THEN
          CALL SZOPTP
          DO 200 I=1, NN
            CALL SZSTTP(VXX(I), VYY(I))
  200     CONTINUE
          CALL SZCLTP
        END IF
        RETURN

      ELSE

*       / PREPEARIG /

        DO 300 I=1, NLINE-1
          NLEN(I) = NBGN(I+1) - NBGN(I)
  300   CONTINUE
        NLEN(NLINE) = NN - NBGN(NLINE) + NBGN(1)

        DO 310 I=1, NLINE
          NSTAT(I) = 0
          IF (NLEN(I).LE.2) NSTAT(I) = 2
          NBG = NBGN(I)
          POS(I) = POSBD(VXX(NBG), VYY(NBG))
  310   CONTINUE

*       / SCANNING STARTING POINT /

  400   CONTINUE

          NX = 0
          DO 410 ILINE=1, NLINE
            IF (NSTAT(ILINE).EQ.0) GO TO 420
  410     CONTINUE
          RETURN

  420     CONTINUE
          NSTAT(ILINE) = 1
          CALL SZOPTP
  430     CONTINUE
          NEND = NBGN(ILINE) + NLEN(ILINE) - 1

          DO 440 J = NBGN(ILINE), NEND
            NX = NX + 1
            JJ = MOD(J-1, NN) + 1
            CALL SZSTTP(VXX(JJ), VYY(JJ))
  440     CONTINUE
          NEND = MOD(NEND-1, NN) + 1
          POS0 = POSBD(VXX(NEND), VYY(NEND))

*         / SEARCH NEXT LINE /

          DIF0 = 4
          DO 450 I=1, NLINE
            IF (NSTAT(I).EQ.2) GO TO 450
            DIF = RMOD(POS(I) - POS0 + EP2, 4.)
            IF (DIF.GE.DIF0) GO TO 450
            IF (NLEN(I).LE.2) GO TO 450
            ILINE = I
            DIF0 = DIF
  450     CONTINUE

*         / BOUNDARY /

          POS1 = POS(ILINE)
          NS0 = POS0 + 1
          NS1 = POS1 + 1
          NST  = NS0 + 1
          NEND = NS0 + IMOD(NS1 - NS0, 4)
          IF (NS0.EQ.NS1 .AND. POS0.GT.POS1+EP2) NEND = NEND +4

          DO 600 I=NST, NEND
            II = IMOD(I-1, 4) + 1
            CALL SZSTTP(BDX(II), BDY(II))
  600     CONTINUE

          IF (NSTAT(ILINE).EQ.0) THEN
            NSTAT(ILINE) = 2
            GO TO 430
          END IF
          NSTAT(ILINE) = 2
          CALL SZCLTP

        GO TO 400

      END IF

      END
