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

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



      PROGRAM PGEX06
C----------------------------------------------------------------------
C Demonstration program for the PGPLOT plotting package.  This example
C illustrates the use of PGPOLY, PGCIRC, and PGRECT using SOLID, 
C OUTLINE, HATCHED, and CROSS-HATCHED fill-area attributes.
C----------------------------------------------------------------------
      REAL PI, TWOPI
      PARAMETER (PI=3.14159265359)
      PARAMETER (TWOPI=2.0*PI)
      INTEGER NPOL
      PARAMETER (NPOL=6)
      INTEGER I, J, N1(NPOL), N2(NPOL), K, PGOPEN
      REAL X(10), Y(10), Y0, ANGLE
      CHARACTER*32 LAB(4)
      DATA N1 / 3, 4, 5, 5, 6, 8 /
      DATA N2 / 1, 1, 1, 2, 1, 3 /
      DATA LAB(1) /'Fill style 1 (solid)'/
      DATA LAB(2) /'Fill style 2 (outline)'/
      DATA LAB(3) /'Fill style 3 (hatched)'/
      DATA LAB(4) /'Fill style 4 (cross-hatched)'/
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
C Initialize the viewport and window.
C
      CALL PGBBUF
      CALL PGSAVE
      CALL PGPAGE
      CALL PGSVP(0.0, 1.0, 0.0, 1.0)
      CALL PGWNAD(0.0, 10.0, 0.0, 10.0)
C
C Label the graph.
C
      CALL PGSCI(1)
      CALL PGMTXT('T', -2.0, 0.5, 0.5, 
     :     'PGPLOT fill area: routines PGPOLY, PGCIRC, PGRECT')
C
C Draw assorted polygons.
C
      DO 30 K=1,4
         CALL PGSCI(1)
         Y0 = 10.0 - 2.0*K
         CALL PGTEXT(0.2, Y0+0.6, LAB(K))
         CALL PGSFS(K)
         DO 20 I=1,NPOL
            CALL PGSCI(I)
            DO 10 J=1,N1(I)
               ANGLE = REAL(N2(I))*TWOPI*REAL(J-1)/REAL(N1(I))
               X(J) = I + 0.5*COS(ANGLE)
               Y(J) = Y0 + 0.5*SIN(ANGLE)
 10         CONTINUE
            CALL PGPOLY (N1(I),X,Y)
 20      CONTINUE
         CALL PGSCI(7)
         CALL PGCIRC(7.0, Y0, 0.5)
         CALL PGSCI(8)
         CALL PGRECT(7.8, 9.5, Y0-0.5, Y0+0.5)
 30   CONTINUE
C
      CALL PGUNSA
      CALL PGEBUF
C
C Finally, call PGCLOS to terminate things properly.
C
      CALL PGCLOS
C
      END