ソースコードの所在: /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