C*********************************************************************** C Module: squares.f C C Copyright (C) 1996 Harold Youngren, Mark Drela C C This program is free software; you can redistribute it and/or modify C it under the terms of the GNU General Public License as published by C the Free Software Foundation; either version 2 of the License, or C (at your option) any later version. C C This program is distributed in the hope that it will be useful, C but WITHOUT ANY WARRANTY; without even the implied warranty of C MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the C GNU General Public License for more details. C C You should have received a copy of the GNU General Public License C along with this program; if not, write to the Free Software C Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA. C C Report problems to: guppy@maine.com C or drela@mit.edu C*********************************************************************** C---Test of filled polyline plotting C Displays a sine wave of filled color rectangles dimension xp(100), yp(100), x(100), y(100) C CHARACTER*4 INP, DUMMY LOGICAL LDBUFF CH = 0.02 C x(1) = 0. y(1) = 0. x(2) = 0.5 y(2) = 0. x(3) = 0.5 y(3) = 0.3 x(4) = 0. y(4) = 0.3 x(5) = x(1) y(5) = y(1) n = 5 C C---Decide about what devices to plot to WRITE(*,*) ' ' WRITE(*,*) 'SQUARES Plot test' WRITE(*,*) ' You may just for each question to take defaults' WRITE(*,*) ' ' WRITE(*,*) ' Double buffer? (Y/n)' READ(*,1000,end=2000) INP LDBUFF = .NOT.(INP.EQ.'n' .OR. INP.EQ.'N') C IDEV = 1 ipslu = 0 relsize = 0.7 ccc relsize = -0.7 C C---- for REPLOT: X11 only IDEVRP = 1 C C CALL PLINITIALIZE C C---Now, how many colors... WRITE(*,*) ' Enter # colors (0 or 1 gives no colors)' READ(*,1000,end=2000) INP ncolors = 64 if(INP.ne.' ') then READ(INP,*,end=2000,err=2000) ncolors endif C---Set up colormap spectrum colors if(ncolors.LE.1) ncolors = 0 CALL COLORSPECTRUMHUES(ncolors,'MBCGYR') C C---Cycle the colors twice through the sinewave 10 DO IX = 1, 2*ncolors+1 C CALL PLOPEN(relsize,ipslu,IDEV) C---Set up double buffering for plotting IF(LDBUFF) THEN CALL DRAWTOBUFFER ENDIF C CALL PLOT(0.5,0.5,-3) do ii = 1,ncolors iix = mod(ii-1+ix-1,ncolors) + 1 cc write(*,*) 'ii,ix,iix ',ii,ix,iix call NEWCOLOR(-iix) f = float(ii-1)/float(ncolors-1) xx = 9.0*f yy = 3.0*sin(2.0*3.1416*f) do i = 1, n xp(i) = x(i) + xx yp(i) = 4.0 + y(i) + yy end do call POLYLINE(xp,yp,n,1) end do C CALL NEWCOLORNAME('green') CALL PLCHAR(0.,0.,10.*CH,'Test ',0.0,5) CALL NEWCOLORRGB(0,0,255) CALL PLCHAR(999.,999.,10.*CH,'of ',0.0,3) CALL NEWCOLORNAME('yellow') CALL PLCHAR(999.,999.,10.*CH,'Color ',0.0,6) CALL NEWCOLORNAME('red') CALL PLCHAR(999.,999.,10.*CH,'Fill',0.0,4) C C---Display the buffered plot c IF(LDBUFF) THEN c CALL SHOWBUFFER c ELSE CALL PLFLUSH c ENDIF C C---Timing loop hack to slow things down c DO I = 1, 1000000 c XXX = sin(float(i)) c END DO C C---Stop every frame as a check ccc READ(5,1000) DUMMY c END DO C ccc relsize = -relsize C WRITE(*,*) 'Hit return to end test, R to recycle' READ(5,1000) DUMMY IF(DUMMY.EQ.'r' .OR. DUMMY.EQ.'R') GO TO 10 1000 FORMAT(A) C 2000 CALL PLCLOSE STOP END