PARAMETER(NVP=5) DIMENSION VP(4,NVP) LOGICAL IOPN(NVP) DATA VP/0.0,0.5,0.5,1.0, + 0.5,0.5,1.0,1.0, + 0.0,0.0,0.5,0.5, + 0.5,0.0,1.0,0.5, + 0.1,0.1,0.9,0.9/ CALL init(VP,NVP) C DO N = 1, NVP CALL GWSELVP(IR,N) CALL GWSETOGN(IR,0,N) IF(N .EQ. 1) CALL view1 IF(N .EQ. 2) CALL view2 IF(N .EQ. 3) CALL view3 IF(N .EQ. 4) CALL view4 IF(N .EQ. 5) CALL view5 CALL GWSAVEVP(IR,N) IOPN(N) = .TRUE. ENDDO C N = NVP IVP = 1 DO WHILE(N .GT. 0 .AND. IVP .GT. 0) CALL GWCAPPNT(IC,X,Y,'消去したい図形上でクリックしてください') CALL GWLDCPOS(IR, X, Y, IU, IV) IVP = INVP(IU,IV,VP,NVP) IF(IVP .GE. 1 .AND. IVP .LE. NVP) THEN IF(IOPN(IVP)) THEN CALL GWSELVP(IR,IVP) CALL GWGETVP(IR,u1,v1,u2,v2) WRITE(*,'(/A,I1,4F10.3)') 'Viewport #',IVP,u1,v1,u2,v2 CALL GWGETWN(IR,u1,v1,u2,v2) WRITE(*,'(A,I1,4F10.3)') 'Window #',IVP,u1,v1,u2,v2 CALL GWERASE(IR,IVP,-1) DO I = 1, 4 VP(I,IVP) = -1 ENDDO IOPN(IVP) = .FALSE. N = N - 1 ENDIF ENDIF ENDDO CALL GWQUIT(IR) END C SUBROUTINE init(VP,NVP) DIMENSION VP(4,NVP) CALL GWOPEN(ID,0) CALL GWSIZE(IR,1,IW,IH) WH = REAL(IW)/IH IF(WH.GT.1.0) THEN DO I = 1, NVP VP(1,I) = VP(1,I)*WH VP(3,I) = VP(3,I)*WH ENDDO UNT = IH ELSE DO I = 1, NVP VP(2,I) = VP(2,I)/WH VP(4,I) = VP(4,I)/WH ENDDO UNT = IW ENDIF DO I = 1, NVP CALL GWVPORT(IR,VP(1,I),VP(2,I),VP(3,I),VP(4,I)) WRITE(*,'(A,I1,4F10.3)') + 'Viewport #',I,VP(1,I),VP(2,I),VP(3,I),VP(4,I) CALL GWSAVEVP(IR,I) DO J = 1, 4 VP(J,I) = VP(J,I)*UNT ENDDO DO J = 2, 4, 2 VP(J,I) = IH - VP(J,I) ENDDO ENDDO IW5 = VP(3,5) - VP(1,5) IH5 = VP(4,5) - VP(2,5) VP(1,5) = VP(1,5) + IW5/3 VP(2,5) = VP(2,5) - IH5/3 VP(3,5) = VP(3,5) - IW5/3 VP(4,5) = VP(4,5) + IH5/3 END C FUNCTION INVP(iu,iv,VP,NVP) DIMENSION VP(4,NVP) INVP = 0 DO I = 1, 5 IF((iu-VP(1,I))*(iu-VP(3,I)) .LT. 0.0 .AND. + (iv-VP(2,I))*(iv-VP(4,I)) .LT. 0.0) INVP = I ENDDO END C SUBROUTINE MYWINDOW(x1,y1,x2,y2) CALL GWGETVP(IR,u1,v1,u2,v2) R = (u2-u1)/(v2-v1) IF(R .GT. 1) THEN CALL GWINDOW(IR,x1*R,y1,x2*R,y2) ELSE CALL GWINDOW(IR,x1,y1/R,x2,y2/R) ENDIF * WRITE(*,*) 'Aspect ratio = ', GWASPECT() END C SUBROUTINE view1 PARAMETER(PAI2=6.28319, N=19) X(I)=COS(I*PAI2/N) Y(I)=SIN(I*PAI2/N) DATA K,MXOR/1,7/ CALL MYWINDOW(-1.1,-1.1,1.1,1.1) CALL GWNCOLOR(NC) CALL GWSETPEN(IR,K,-1,-1,MXOR) DO I=0,N-2 DO J=I+1,N-1 CALL GWSETPEN(IR,K,-1,-1,-1) CALL GWLINE(IR,X(I),Y(I),X(J),Y(J)) K=MOD(K,NC)+1 END DO END DO END C SUBROUTINE view2 CALL WINDOW(0.0, 200.0, 320.0, 0.0 ) CALL NEWPEN( 2 ) CALL PLOT( 30.0, 30.0, 3 ) CALL PLOT( 30.0, 130.0, 2 ) CALL PLOT( 130.0, 130.0, 2 ) CALL PLOT( 130.0, 30.0, 2 ) CALL PLOT( 30.0, 30.0, 2 ) CALL PLOT( 130.0, 130.0, 2 ) CALL NEWPEN( 4 ) CALL PLOT( 40.0, 40.0, 3 ) CALL PLOT( 40.0, 140.0, 2 ) CALL PLOT( 140.0, 140.0, 2 ) CALL PLOT( 140.0, 40.0, 2 ) CALL PLOT( 40.0, 40.0, 2 ) CALL NEWPEN( 3 ) CALL PLOT( 50.0, 50.0, 3 ) CALL PLOT( 50.0, 150.0, 2 ) CALL PLOT( 150.0, 150.0, 2 ) CALL PLOT( 150.0, 50.0, 2 ) CALL PLOT( 50.0, 50.0, 2 ) CALL NEWPEN( 5 ) CALL PLOT( 60.0, 60.0, 3 ) CALL PLOT( 60.0, 160.0, 2 ) CALL PLOT( 160.0, 160.0, 2 ) CALL PLOT( 160.0, 60.0, 2 ) CALL PLOT( 60.0, 60.0, 2 ) CALL NEWPEN( 6 ) CALL PLOT( 70.0, 70.0, 3 ) CALL PLOT( 70.0, 170.0, 2 ) CALL PLOT( 170.0, 170.0, 2 ) CALL PLOT( 170.0, 70.0, 2 ) CALL PLOT( 70.0, 70.0, 2 ) CALL NEWPEN( 7 ) CALL PLOT( 80.0, 80.0, 3 ) CALL PLOT( 80.0, 180.0, 2 ) CALL PLOT( 180.0, 180.0, 2 ) CALL PLOT( 180.0, 80.0, 2 ) CALL PLOT( 80.0, 80.0, 2 ) CALL NEWPEN( 1 ) CALL PLOT( 90.0, 90.0, 3 ) CALL PLOT( 90.0, 190.0, 2 ) CALL PLOT( 190.0, 190.0, 2 ) CALL PLOT( 190.0, 90.0, 2 ) CALL PLOT( 90.0, 90.0, 2 ) CALL NEWPEN( 1 ) CALL GWPUTMRK(IR,100.0, 100.0) CALL SYMBOL( 100.0, 100.0, 7.0, ' ABC', 0.0, 9) CALL SYMBOL( 100.0, 100.0, 6.0, ' def', 30.0, 9) CALL SYMBOL( 100.0, 100.0, 5.0, ' GHI', 60.0, 9) CALL SYMBOL( 100.0, 100.0, 4.0, ' jkl', 90.0, 9) CALL SYMBOL( 100.0, 100.0, 5.0, ' MNO',120.0, 9) CALL SYMBOL( 100.0, 100.0, 6.0, ' pqr',150.0, 9) CALL SYMBOL( 100.0, 100.0, 7.0, ' STU',180.0, 9) CALL SYMBOL( 100.0, 100.0, 8.0, ' vwx',210.0, 9) CALL SYMBOL( 100.0, 100.0, 9.0, ' YZ.',240.0, 9) CALL SYMBOL( 100.0, 100.0, 10.0, ' abc',270.0, 9) CALL SYMBOL( 100.0, 100.0, 9.0, ' DEF',300.0, 9) CALL SYMBOL( 100.0, 100.0, 8.0, ' GHI',330.0, 9) CALL SYMBOL(30.0,30.0,8.0,'ABCDEFGHIJKLMNOPQRSTUVWXYZ',0.0,26) CALL SYMBOL(30.0,15.0,8.0,'abcdefghijklmnopqrstuvwxyz',0.0,26) CALL NEWPEN( 1 ) CALL PLOT( 240.000, 160.000, 3 ) CALL PLOT( 188.038, 70.000, 2 ) CALL PLOT( 291.962, 70.000, 2 ) CALL PLOT( 240.000, 160.000, 2 ) CALL PLOT( 240.000, 40.000, 3 ) CALL PLOT( 188.038, 130.000, 2 ) CALL PLOT( 291.962, 130.000, 2 ) CALL PLOT( 240.000, 40.000, 2 ) CALL NUMBER( 250.0, 100.0, 5.0, 12345.67, 0.0, -1) CALL NUMBER( 248.5, 95.0, 5.0, 12345.67, -30.0, -1) CALL NUMBER( 245.0, 91.5, 5.0, 12345.67, -60.0, 0) CALL NUMBER( 240.0, 90.0, 5.0, 123.456, -90.0, 3) CALL NUMBER( 235.0, 91.5, 5.0, 0.123456, -120.0, 6) CALL NUMBER( 231.5, 95.0, 5.0, 0.987654, -150.0, 6) CALL NUMBER( 230.0, 100.0, 5.0, 0.987654, -180.0, 3) CALL NUMBER( 240.0, 100.0, 5.0, 123456789.0,90.0, 0) END C SUBROUTINE view3 PARAMETER(PAI2=6.28319) EXTERNAL F1,F2 REAL F1,F2 DATA K/1/ DATA X1,X2,N,MN/0.0,PAI2,100,20/ DATA M1,M2,S,SS/6,5,0.1,0.2/ CALL GWINDOW(IR,-.5,-1.3,PAI2+0.5,1.3) CALL GWLINE(IR,-.1,0.0,PAI2+0.1,0.0) CALL GWSETTXT(IR,0.1, 0.0, -1, 0, -1, ' ') CALL GWPUTTXT(IR,PAI2-0.5, 0.02, 'X-axis') CALL GWLINE(IR,0.0,1.1,0.0,-1.1) CALL GWSETTXT(IR,-1.0, 0.25, -1, -1, -1, ' ') CALL GWPUTTXT(IR,-0.02, 0.8, 'Y-axis') CALL GWSETMRK(IR,-1,S,K,-1,-1) CALL PLOTFN(X1, X2, N, MN, M1, K, F1) CALL PLOTFN(X1, X2, N, MN, M2, K, F2) X = PAI2*0.45 CALL GWSETTXT(IR,SS, ATAN(COS(X+S)/GWASPECT(-1))/PAI2, + -1, -1, -1, 'Arial') CALL GWPUTTXT(IR,X, SIN(X), 'sin') X = PAI2*0.3 CALL GWSETTXT(IR,-1.0, ATAN(-SIN(X+S)/GWASPECT(-1))/PAI2, + -1, -1, -1, ' ') CALL GWPUTTXT(IR,X, COS(X), 'cos') END C SUBROUTINE PLOTFN(X1, X2, N, MN, MK, K, F) X0 = X1 DO I=1,N X = I*(X2-X1)/N Y = F(X) CALL GWLINE(IR,X0,F(X0),X,F(X)) X0 = X END DO DO I=0,MN X = I*(X2-X1)/MN Y = F(X) K=MOD(K+1,36) CALL GWSETMRK(IR,MK,-1.0,K,-1,-1) CALL GWPUTMRK(IR,X,Y) END DO END C FUNCTION F1(X) F1 = SIN(X) END C FUNCTION F2(X) F2 = COS(X) END C SUBROUTINE view4 PARAMETER(TRH = 0.4330127, TRHM = -TRH, PI = 3.141592) DATA ND,A/128,2.0/ DATA RX, RY/-0.5, TRHM/ DATA GX, GY/ 0.0, TRH/ DATA BX, BY/ 0.5, TRHM/ C CALL GWmode(IR,3,0) CALL MYWINDOW(-1.5,-1.5,1.5,1.5) WH = 2*A/ND DO iy = 0, ND-1 y = iy * WH - A DO ix = 0, ND-1 x = ix * WH - A r = (x**2+y**2)**(0.3) ired = 256*SQRT((x-RX)**2+(y-RY)**2)*r IF(ired .GT. 255) ired = 255 igreen = 256*SQRT((x-GX)**2+(y-GY)**2)*r IF(igreen .GT. 255) igreen = 255 iblue = 256*SQRT((x-BX)**2+(y-BY)**2)*r IF(iblue .GT. 255) iblue = 255 IF(ired+igreen+iblue .LT. 3*255) + CALL GWSRECT(IR,x-WH/2,y-WH/2,x+WH/2,y+WH/2, + KRGB(ired,igreen,iblue)) ENDDO ENDDO C CALL GWmode(IR,3,1) END C SUBROUTINE view5 PARAMETER(N = 7, PI = 3.141593) REAL PN(2,N) C CALL MYWINDOW(-1.1,-1.1,1.1,1.1) T = -PI/2 DO I = 1, N PN(1, I) = COS(T) PN(2, I) = SIN(T) T = T + 2*PI/N*(N/2) ENDDO CALL GWSETPEN(IR,19,-1,-1,15) CALL GWSETBRS(IR,13, 1, -1) CALL GWPOLYGON(IR,PN, N, -1) T = PI/2 DO I = 1, N PN(1, I) = COS(T) PN(2, I) = SIN(T) T = T + 2*PI/N*(N/2) ENDDO CALL GWSETPEN(IR,0,-1,-1,4) CALL GWSETBRS(IR,14, 1, -1) CALL GWPOLYGON(IR,PN, N, -1) END