ソースコードの所在: /home/kizu/pgplot/samples/pgex14.f

(このプログラムで描ける絵は、こちら)



      PROGRAM PGEX14
C-----------------------------------------------------------------------
C Test routine for PGPLOT: polygon fill and color representation.
C-----------------------------------------------------------------------
      INTEGER I, J, N, M, PGOPEN
      REAL PI, THINC, R, G, B, THETA
      REAL XI(100),YI(100),XO(100),YO(100),XT(3),YT(3)
      PARAMETER (PI=3.14159265359)
C
C Call PGOPEN to initiate PGPLOT and open the output device; PGOPEN
C will prompt the user to supply the device name and type. Always
C check the return code from PGOPEN.
C
      IF (PGOPEN('?') .LE. 0) STOP
C
      N = 33
      M = 8
      THINC=2.0*PI/N
      DO 10 I=1,N
        XI(I) = 0.0
        YI(I) = 0.0
   10 CONTINUE
      CALL PGBBUF
      CALL PGSAVE
      CALL PGENV(-1.,1.,-1.,1.,1,-2)
      CALL PGLAB(' ', ' ', 'PGPLOT Example 14: PGPOLY and PGSCR')
      DO 50 J=1,M
        R = 1.0
        G = 1.0 - REAL(J)/REAL(M)
        B = G
        CALL PGSCR(J, R, G, B)
        THETA = -REAL(J)*PI/REAL(N)
        R = REAL(J)/REAL(M)
        DO 20 I=1,N
          THETA = THETA+THINC
          XO(I) = R*COS(THETA)
          YO(I) = R*SIN(THETA)
   20   CONTINUE
        DO 30 I=1,N
          XT(1) = XO(I)
          YT(1) = YO(I)
          XT(2) = XO(MOD(I,N)+1)
          YT(2) = YO(MOD(I,N)+1)
          XT(3) = XI(I)
          YT(3) = YI(I)
          CALL PGSCI(J)
          CALL PGSFS(1)
          CALL PGPOLY(3,XT,YT)
          CALL PGSFS(2)
          CALL PGSCI(1)
          CALL PGPOLY(3,XT,YT)
   30   CONTINUE
        DO 40 I=1,N
          XI(I) = XO(I)
          YI(I) = YO(I)
   40   CONTINUE
   50 CONTINUE
      CALL PGUNSA
      CALL PGEBUF
C
C Finally, call PGCLOS to terminate things properly.
C
      CALL PGCLOS
C
      END